Project

General

Profile

Revision 70df2f87

View differences:

src/clock_predef.ml
14 14
(** Predefined operator clocks *)
15 15
open Clocks
16 16

  
17
let ck_tuple cl = new_ck (Ctuple cl) true
18

  
17 19
let ck_bin_univ =
18 20
  let univ = new_univar () in
19 21
  new_ck (Carrow (new_ck (Ctuple [univ;univ]) true, univ)) true
src/corelang.ml
391 391
let expr_of_expr_list loc elist =
392 392
 match elist with
393 393
 | [t]  -> { t with expr_loc = loc }
394
 | t::_ -> { t with expr_desc = Expr_tuple elist; expr_loc = loc }
394
 | t::_ ->
395
    let tlist = List.map (fun e -> e.expr_type) elist in
396
    let clist = List.map (fun e -> e.expr_clock) elist in
397
    { t with expr_desc = Expr_tuple elist;
398
	     expr_type = Type_predef.type_tuple tlist;
399
	     expr_clock = Clock_predef.ck_tuple clist;
400
	     expr_tag = Utils.new_tag ();
401
	     expr_loc = loc }
395 402
 | _    -> assert false
396 403

  
397 404
let call_of_expr expr =
src/inliner.ml
62 62
  assert (reset = None);
63 63

  
64 64
  let assign_inputs = mkeq loc (List.map (fun v -> v.var_id) inputs', args) in
65
  let assign_inputs = Splitting.tuple_split_eq assign_inputs in
65 66
  let expr = expr_of_expr_list 
66 67
    loc 
67 68
    (List.map (fun v -> mkexpr loc (Expr_ident v.var_id)) outputs')
......
77 78
  in
78 79
  expr, 
79 80
  inputs'@outputs'@locals'@locals, 
80
  assign_inputs::eqs',
81
  assign_inputs@eqs',
81 82
  asserts'
82 83

  
83 84

  
......
118 119
      (* let _ =     Format.eprintf "Inlining call to %s@." id in *)
119 120
      let node = try List.find (check_node_name id) nodes 
120 121
	with Not_found -> (assert false) in
121
      let node = 
122
	match node.top_decl_desc with Node nd -> nd | _ -> assert false in
122
      let node = node_of_top node in
123 123
      let node = inline_node node nodes in
124 124
      let expr, locals', eqs'', asserts'' = 
125 125
	inline_call expr args' reset locals' node in
src/machine_code.ml
425 425
   to the computed schedule [sch]
426 426
*)
427 427
let sort_equations_from_schedule nd sch =
428
(*  Format.eprintf "%s schedule: %a@."
429
		 nd.node_id
430
		 (Utils.fprintf_list ~sep:" ; " Scheduling.pp_eq_schedule) sch;*)
428 431
  let split_eqs = Splitting.tuple_split_eq_list nd.node_eqs in
429 432
  let eqs_rev, remainder =
430 433
    List.fold_left 
......
439 442
      ([], split_eqs) 
440 443
      sch 
441 444
  in
442
  if List.length remainder > 0 then (
443
    Format.eprintf "Equations not used are@.%a@.Full equation set is:@.%a@.@?"
444
		   Printers.pp_node_eqs remainder
445
      		   Printers.pp_node_eqs nd.node_eqs;
446
    assert false);
447
  List.rev eqs_rev
445
  begin
446
    if List.length remainder > 0 then (
447
      Format.eprintf "Equations not used are@.%a@.Full equation set is:@.%a@.@?"
448
		     Printers.pp_node_eqs remainder
449
      		     Printers.pp_node_eqs nd.node_eqs;
450
      assert false);
451
    List.rev eqs_rev
452
  end
448 453

  
449 454
let translate_eqs node args eqs =
450 455
  List.fold_right (fun eq args -> translate_eq node args eq) eqs args;;
src/printers.ml
85 85

  
86 86
and pp_app fmt id e r =
87 87
  match r with
88
  | None ->
89
    (match id, e.expr_desc with
90
    | "+", Expr_tuple([e1;e2]) -> fprintf fmt "(%a + %a)" pp_expr e1 pp_expr e2
91
    | "uminus", _ -> fprintf fmt "(- %a)" pp_expr e
92
    | "-", Expr_tuple([e1;e2]) -> fprintf fmt "(%a - %a)" pp_expr e1 pp_expr e2
93
    | "*", Expr_tuple([e1;e2]) -> fprintf fmt "(%a * %a)" pp_expr e1 pp_expr e2
94
    | "/", Expr_tuple([e1;e2]) -> fprintf fmt "(%a / %a)" pp_expr e1 pp_expr e2
95
    | "mod", Expr_tuple([e1;e2]) -> fprintf fmt "(%a mod %a)" pp_expr e1 pp_expr e2
96
    | "&&", Expr_tuple([e1;e2]) -> fprintf fmt "(%a and %a)" pp_expr e1 pp_expr e2
97
    | "||", Expr_tuple([e1;e2]) -> fprintf fmt "(%a or %a)" pp_expr e1 pp_expr e2
98
    | "xor", Expr_tuple([e1;e2]) -> fprintf fmt "(%a xor %a)" pp_expr e1 pp_expr e2
99
    | "impl", Expr_tuple([e1;e2]) -> fprintf fmt "(%a => %a)" pp_expr e1 pp_expr e2
100
    | "<", Expr_tuple([e1;e2]) -> fprintf fmt "(%a < %a)" pp_expr e1 pp_expr e2
101
    | "<=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a <= %a)" pp_expr e1 pp_expr e2
102
    | ">", Expr_tuple([e1;e2]) -> fprintf fmt "(%a > %a)" pp_expr e1 pp_expr e2
103
    | ">=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a >= %a)" pp_expr e1 pp_expr e2
104
    | "!=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a != %a)" pp_expr e1 pp_expr e2
105
    | "=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a = %a)" pp_expr e1 pp_expr e2
106
    | "not", _ -> fprintf fmt "(not %a)" pp_expr e
107
    | _, Expr_tuple _ -> fprintf fmt "%s %a" id pp_expr e
108
    | _ -> fprintf fmt "%s (%a)" id pp_expr e
109
)
110
  | Some (x, l) -> fprintf fmt "%s (%a) every %s(%s)" id pp_expr e l x 
111

  
112

  
88
  | None -> pp_call fmt id e
89
  | Some (x, l) -> fprintf fmt "%t every %s(%s)" (fun fmt -> pp_call fmt id e) l x 
90

  
91
and pp_call fmt id e =
92
  match id, e.expr_desc with
93
  | "+", Expr_tuple([e1;e2]) -> fprintf fmt "(%a + %a)" pp_expr e1 pp_expr e2
94
  | "uminus", _ -> fprintf fmt "(- %a)" pp_expr e
95
  | "-", Expr_tuple([e1;e2]) -> fprintf fmt "(%a - %a)" pp_expr e1 pp_expr e2
96
  | "*", Expr_tuple([e1;e2]) -> fprintf fmt "(%a * %a)" pp_expr e1 pp_expr e2
97
  | "/", Expr_tuple([e1;e2]) -> fprintf fmt "(%a / %a)" pp_expr e1 pp_expr e2
98
  | "mod", Expr_tuple([e1;e2]) -> fprintf fmt "(%a mod %a)" pp_expr e1 pp_expr e2
99
  | "&&", Expr_tuple([e1;e2]) -> fprintf fmt "(%a and %a)" pp_expr e1 pp_expr e2
100
  | "||", Expr_tuple([e1;e2]) -> fprintf fmt "(%a or %a)" pp_expr e1 pp_expr e2
101
  | "xor", Expr_tuple([e1;e2]) -> fprintf fmt "(%a xor %a)" pp_expr e1 pp_expr e2
102
  | "impl", Expr_tuple([e1;e2]) -> fprintf fmt "(%a => %a)" pp_expr e1 pp_expr e2
103
  | "<", Expr_tuple([e1;e2]) -> fprintf fmt "(%a < %a)" pp_expr e1 pp_expr e2
104
  | "<=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a <= %a)" pp_expr e1 pp_expr e2
105
  | ">", Expr_tuple([e1;e2]) -> fprintf fmt "(%a > %a)" pp_expr e1 pp_expr e2
106
  | ">=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a >= %a)" pp_expr e1 pp_expr e2
107
  | "!=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a != %a)" pp_expr e1 pp_expr e2
108
  | "=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a = %a)" pp_expr e1 pp_expr e2
109
  | "not", _ -> fprintf fmt "(not %a)" pp_expr e
110
  | _, Expr_tuple _ -> fprintf fmt "%s %a" id pp_expr e
111
  | _ -> fprintf fmt "%s (%a)" id pp_expr e
113 112

  
114 113
and pp_eexpr fmt e =
115 114
  fprintf fmt "%a%t %a"

Also available in: Unified diff