Project

General

Profile

Revision 1bff14ac src/machine_code.ml

View differences:

src/machine_code.ml
43 43
    | Fun (n, vl)   -> Format.fprintf fmt "%s (%a)" n (Utils.fprintf_list ~sep:", " pp_val)  vl
44 44

  
45 45
let rec pp_instr fmt i =
46
  match i.instr_desc with
46
  let _ =
47
    match i.instr_desc with
47 48
    | MLocalAssign (i,v) -> Format.fprintf fmt "%s<-l- %a" i.var_id pp_val v
48 49
    | MStateAssign (i,v) -> Format.fprintf fmt "%s<-s- %a" i.var_id pp_val v
49 50
    | MReset i           -> Format.fprintf fmt "reset %s" i
50 51
    | MNoReset i         -> Format.fprintf fmt "noreset %s" i
51 52
    | MStep (il, i, vl)  ->
52
      Format.fprintf fmt "%a = %s (%a)"
53
	(Utils.fprintf_list ~sep:", " (fun fmt v -> Format.pp_print_string fmt v.var_id)) il
54
	i
55
	(Utils.fprintf_list ~sep:", " pp_val) vl
53
       Format.fprintf fmt "%a = %s (%a)"
54
	 (Utils.fprintf_list ~sep:", " (fun fmt v -> Format.pp_print_string fmt v.var_id)) il
55
	 i
56
	 (Utils.fprintf_list ~sep:", " pp_val) vl
56 57
    | MBranch (g,hl)     ->
57
      Format.fprintf fmt "@[<v 2>case(%a) {@,%a@,}@]"
58
	pp_val g
59
	(Utils.fprintf_list ~sep:"@," pp_branch) hl
58
       Format.fprintf fmt "@[<v 2>case(%a) {@,%a@,}@]"
59
	 pp_val g
60
	 (Utils.fprintf_list ~sep:"@," pp_branch) hl
60 61
    | MComment s -> Format.pp_print_string fmt s
61

  
62
       
63
  in
64
  (* Annotation *)
65
  (* let _ = *)
66
  (*   match i.lustre_expr with None -> () | Some e -> Format.fprintf fmt " -- original expr: %a" Printers.pp_expr e *)
67
  (* in *)
68
  let _ = 
69
    match i.lustre_eq with None -> () | Some eq -> Format.fprintf fmt " -- original eq: %a" Printers.pp_node_eq eq
70
  in
71
  ()
72
    
62 73
and pp_branch fmt (t, h) =
63 74
  Format.fprintf fmt "@[<v 2>%s:@,%a@]" t (Utils.fprintf_list ~sep:"@," pp_instr) h
64 75

  
......
149 160
let is_memory m id =
150 161
  List.exists (fun o -> o.var_id = id.var_id) m.mmemory
151 162

  
152
let conditional (* TODO ?(lustre_expr:expr option=None) *) c t e =
153
  mkinstr (* TODO ?lustre_expr *) (MBranch(c, [ (tag_true, t); (tag_false, e) ]))
163
let conditional ?lustre_eq c t e =
164
  mkinstr ?lustre_eq:lustre_eq  (MBranch(c, [ (tag_true, t); (tag_false, e) ]))
154 165

  
155 166
let dummy_var_decl name typ =
156 167
  {
......
189 200
let arrow_top_decl =
190 201
  {
191 202
    top_decl_desc = Node arrow_desc;
192
    top_decl_owner = (Options.core_dependency "arrow");
203
    top_decl_owner = (Options_management.core_dependency "arrow");
193 204
    top_decl_itf = false;
194 205
    top_decl_loc = Location.dummy_loc
195 206
  }
......
409 420
  | _ -> (Format.eprintf "internal error: translate_guard %s %a@." node.node_id Printers.pp_expr expr;assert false)
410 421

  
411 422
let rec translate_act node ((m, si, j, d, s) as args) (y, expr) =
423
  let eq = Corelang.mkeq Location.dummy_loc ([y.var_id], expr) in
412 424
  match expr.expr_desc with
413 425
  | Expr_ite   (c, t, e) -> let g = translate_guard node args c in
414
			    conditional (* TODO ?lustre_expr:(Some expr) *) g
426
			    conditional ?lustre_eq:(Some (Some eq)) g
415 427
                              [translate_act node args (y, t)]
416 428
                              [translate_act node args (y, e)]
417
  | Expr_merge (x, hl)   -> mkinstr (* TODO ?lustre_expr:(Some expr) *) (MBranch (translate_ident node args x,
429
  | Expr_merge (x, hl)   -> mkinstr ?lustre_eq:(Some (Some eq)) (MBranch (translate_ident node args x,
418 430
                                     List.map (fun (t,  h) -> t, [translate_act node args (y, h)]) hl))
419
  | _                    -> mkinstr (* TODO ?lustre_expr:(Some expr) *) (MLocalAssign (y, translate_expr node args expr))
431
  | _                    -> mkinstr ?lustre_eq:(Some (Some eq))  (MLocalAssign (y, translate_expr node args expr))
420 432

  
421 433
let reset_instance node args i r c =
422 434
  match r with
......
436 448
      mkinstr (MReset o) :: si,
437 449
      Utils.IMap.add o (arrow_top_decl, []) j,
438 450
      d,
439
      (control_on_clock node args eq.eq_rhs.expr_clock (mkinstr (* TODO ?lustre_eq:eq *) (MStep ([var_x], o, [c1;c2])))) :: s)
451
      (control_on_clock node args eq.eq_rhs.expr_clock (mkinstr ?lustre_eq:(Some (Some eq)) (MStep ([var_x], o, [c1;c2])))) :: s)
440 452
  | [x], Expr_pre e1 when ISet.mem (get_node_var x node) d     ->
441 453
     let var_x = get_node_var x node in
442 454
     (ISet.add var_x m,
443 455
      si,
444 456
      j,
445 457
      d,
446
      control_on_clock node args eq.eq_rhs.expr_clock (mkinstr (* TODO ?lustre_eq:(Some eq) *) (MStateAssign (var_x, translate_expr node args e1))) :: s)
458
      control_on_clock node args eq.eq_rhs.expr_clock (mkinstr ?lustre_eq:(Some (Some eq)) (MStateAssign (var_x, translate_expr node args e1))) :: s)
447 459
  | [x], Expr_fby (e1, e2) when ISet.mem (get_node_var x node) d ->
448 460
     let var_x = get_node_var x node in
449 461
     (ISet.add var_x m,
450
      mkinstr (* TODO ?lustre_eq:(Some eq) *) (MStateAssign (var_x, translate_expr node args e1)) :: si,
462
      mkinstr ?lustre_eq:(Some (Some eq)) (MStateAssign (var_x, translate_expr node args e1)) :: si,
451 463
      j,
452 464
      d,
453
      control_on_clock node args eq.eq_rhs.expr_clock (mkinstr (* TODO ?lustre_eq:(Some eq) *) (MStateAssign (var_x, translate_expr node args e2))) :: s)
465
      control_on_clock node args eq.eq_rhs.expr_clock (mkinstr ?lustre_eq:(Some (Some eq)) (MStateAssign (var_x, translate_expr node args e2))) :: s)
454 466

  
455 467
  | p  , Expr_appl (f, arg, r) when not (Basic_library.is_expr_internal_fun eq.eq_rhs) ->
456 468
     let var_p = List.map (fun v -> get_node_var v node) p in
......
473 485
      (if Stateless.check_node node_f
474 486
       then []
475 487
       else reset_instance node args o r call_ck) @
476
	(control_on_clock node args call_ck (mkinstr (* TODO ?lustre_eq:(Some eq) *) (MStep (var_p, o, vl)))) :: s)
488
	(control_on_clock node args call_ck (mkinstr ?lustre_eq:(Some (Some eq)) (MStep (var_p, o, vl)))) :: s)
477 489
  (*
478 490
    (* special treatment depending on the active backend. For horn backend, x = ite (g,t,e)
479 491
    are preserved. While they are replaced as if g then x = t else x = e in  C or Java

Also available in: Unified diff