Project

General

Profile

Revision e7cc5186

View differences:

src/backends/C/c_backend.ml
51 51
    match Machine_code.get_machine_opt main_node machines with
52 52
    | None -> begin
53 53
      Global.main_node := main_node;
54
      Format.eprintf "Code generation error: %a@." Corelang.pp_error LustreSpec.Main_not_found;
55
      raise (Corelang.Error (Location.dummy_loc, LustreSpec.Main_not_found))
54
      Format.eprintf "Code generation error: %a@." Error.pp_error_msg Error.Main_not_found;
55
      raise (Corelang.Error (Location.dummy_loc, Error.Main_not_found))
56 56
    end
57 57
    | Some m -> begin
58 58
      let source_main_file = (if !Options.cpp then destname ^ "_main.cpp" else destname ^ "_main.c") in (* Could be changed *)
......
73 73
    match Machine_code.get_machine_opt mauve machines with
74 74
    | None -> begin
75 75
      Global.main_node := mauve;
76
      Format.eprintf "Code generation error: %a@." Corelang.pp_error LustreSpec.Main_not_found;
77
      raise (Corelang.Error (Location.dummy_loc, LustreSpec.Main_not_found))
76
      Format.eprintf "Code generation error: %a@." Error.pp_error_msg Error.Main_not_found;
77
      raise (Corelang.Error (Location.dummy_loc, Error.Main_not_found))
78 78
    end
79 79
    | Some m -> begin
80 80
      let source_mauve_file = destname ^ "_mauve.hpp" in
src/backends/C/c_backend_main.ml
42 42
      begin
43 43
	Global.main_node := !Options.main_node;
44 44
	Format.eprintf "Code generation error: %a%a@."
45
	  pp_error Main_wrong_kind
45
	  Error.pp_error_msg Error.Main_wrong_kind
46 46
	  Location.pp_loc v'.var_loc;
47
	raise (Error (v'.var_loc, Main_wrong_kind))
47
	raise (Error (v'.var_loc, Error.Main_wrong_kind))
48 48
      end
49 49
  in
50 50
  List.iteri2 (fun idx v' v ->
src/causality.ml
18 18
open LustreSpec
19 19
open Corelang
20 20
open Graph
21
open Format
22 21

  
22

  
23
type identified_call = eq * tag
23 24
type error =
24
  | DataCycle of ident list
25
  | DataCycle of ident list list (* multiple failed partitions at once *) 
25 26
  | NodeCycle of ident list
26 27

  
27 28
exception Error of error
......
97 98
   but used to compute useless inputs/mems.
98 99
   a mem read var represents a mem at the beginning of a cycle  *)
99 100
  let mk_read_var id =
100
    sprintf "#%s" id
101
    Format.sprintf "#%s" id
101 102

  
102 103
(* instance vars represent node instance calls,
103 104
   they are not part of the program/schedule,
104 105
   but used to simplify causality analysis
105 106
*)
106 107
  let mk_instance_var id =
107
    incr instance_var_cpt; sprintf "!%s_%d" id !instance_var_cpt
108
    incr instance_var_cpt; Format.sprintf "!%s_%d" id !instance_var_cpt
108 109

  
109 110
  let is_read_var v = v.[0] = '#'
110 111

  
......
215 216
    (* Add mashup dependencies for a user-defined node instance [lhs] = [f]([e]) *)
216 217
    (* i.e every input is connected to every output, through a ghost var *)
217 218
      let mashup_appl_dependencies f e g =
218
	let f_var = mk_instance_var (sprintf "%s_%d" f eq.eq_loc.Location.loc_start.Lexing.pos_lnum) in
219
	let f_var = mk_instance_var (Format.sprintf "%s_%d" f eq.eq_loc.Location.loc_start.Lexing.pos_lnum) in
219 220
	List.fold_right (fun rhs -> add_dep lhs_is_mem (adjust_tuple f_var rhs) rhs)
220 221
	  (expr_list_of_expr e) (add_var lhs_is_mem lhs f_var g) 
221 222
      in
......
384 385

  
385 386
end
386 387

  
388

  
387 389
module CycleDetection = struct
388 390

  
389 391
  (* ---- Look for cycles in a dependency graph *)
......
420 422
     [Cycle partition] if the succession of dependencies [partition] forms a cycle *)
421 423
  let check_cycles g =
422 424
    let scc_l = Cycles.scc_list g in
423
    List.iter (fun partition ->
424
      if wrong_partition g partition then
425
	raise (Error (DataCycle partition))
426
      else ()
427
    ) scc_l
425
    let algebraic_loops = List.filter (wrong_partition g) scc_l in
426
    if List.length algebraic_loops > 0 then
427
      raise (Error (DataCycle algebraic_loops))
428
	(* We extract a hint to resolve the cycle: for each variable in the cycle
429
	   which is defined by a call, we return the name of the node call and
430
	   its specific id *)
428 431

  
429 432
  (* Creates the sub-graph of [g] restricted to vertices and edges in partition *)
430 433
  let copy_partition g partition =
......
562 565
    end
563 566
end
564 567

  
568
  
565 569
let pp_dep_graph fmt g =
566 570
  begin
567 571
    Format.fprintf fmt "{ /* graph */@.";
......
571 575

  
572 576
let pp_error fmt err =
573 577
  match err with
574
  | DataCycle trace ->
575
     fprintf fmt "@.Causality error, cyclic data dependencies: %a@."
576
       (fprintf_list ~sep:", " pp_print_string) trace
577 578
  | NodeCycle trace ->
578
     fprintf fmt "@.Causality error, cyclic node calls: %a@."
579
       (fprintf_list ~sep:", " pp_print_string) trace
580

  
579
     Format.fprintf fmt "Causality error, cyclic node calls:@   @[<v 0>%a@]@ "
580
       (fprintf_list ~sep:",@ " Format.pp_print_string) trace
581
  | DataCycle traces -> (
582
     Format.fprintf fmt "Causality error, cyclic data dependencies:@   @[<v 0>%a@]@ "
583
       (fprintf_list ~sep:";@ "
584
       (fun fmt trace ->
585
	 Format.fprintf fmt "@[<v 0>{%a}@]"
586
	   (fprintf_list ~sep:",@ " Format.pp_print_string)
587
	   trace
588
       )) traces
589
  )
590
     
581 591
(* Merges elements of graph [g2] into graph [g1] *)
582 592
let merge_with g1 g2 =
583 593
  begin
......
605 615
  let (g_non_mems, g_mems) = ExprDep.dependence_graph mems inputs node_vars node in
606 616
  (*Format.eprintf "g_non_mems: %a" pp_dep_graph g_non_mems;
607 617
    Format.eprintf "g_mems: %a" pp_dep_graph g_mems;*)
608
  CycleDetection.check_cycles g_non_mems;
609
  let (vdecls', eqs', g_mems') = CycleDetection.break_cycles node mems g_mems in
610
  (*Format.eprintf "g_mems': %a" pp_dep_graph g_mems';*)
611
  begin
612
    merge_with g_non_mems g_mems';
613
    add_external_dependency outputs mems g_non_mems;
614
    { node with node_stmts = List.map (fun eq -> Eq eq) eqs'; node_locals = vdecls'@node.node_locals }, 
615
    g_non_mems
616
  end
618
  try
619
    CycleDetection.check_cycles g_non_mems;
620
    let (vdecls', eqs', g_mems') = CycleDetection.break_cycles node mems g_mems in
621
    (*Format.eprintf "g_mems': %a" pp_dep_graph g_mems';*)
622
    begin
623
      merge_with g_non_mems g_mems';
624
      add_external_dependency outputs mems g_non_mems;
625
      { node with node_stmts = List.map (fun eq -> Eq eq) eqs'; node_locals = vdecls'@node.node_locals }, 
626
      g_non_mems
627
    end
628
  with Error (DataCycle _ as exc) -> (
629
      raise (Error (exc))
630
  )
617 631

  
618 632
(* Local Variables: *)
619 633
(* compile-command:"make -C .." *)
src/compiler_common.ml
17 17
let check_main () =
18 18
  if !Options.main_node = "" then
19 19
    begin
20
      eprintf "Code generation error: %a@." pp_error No_main_specified;
21
      raise (Error (Location.dummy_loc, No_main_specified))
20
      eprintf "Code generation error: %a@." Error.pp_error_msg Error.No_main_specified;
21
      raise (Error (Location.dummy_loc, Error.No_main_specified))
22 22
    end
23 23

  
24 24
let create_dest_dir () =
......
55 55
      raise exc
56 56
    | Corelang.Error (loc, err) as exc -> (
57 57
      eprintf "Parsing error: %a%a@."
58
	Corelang.pp_error err
58
	Error.pp_error_msg err
59 59
	Location.pp_loc loc;
60 60
      raise exc
61 61
    )
......
81 81
    raise exc
82 82
  | Corelang.Error (loc, err) as exc ->
83 83
    eprintf "Parsing error: %a%a@."
84
      Corelang.pp_error err
84
      Error.pp_error_msg err
85 85
      Location.pp_loc loc;
86 86
    raise exc
87 87

  
......
91 91
    Automata.expand_decls decls
92 92
  with (Corelang.Error (loc, err)) as exc ->
93 93
    eprintf "Automata error: %a%a@."
94
      Corelang.pp_error err
94
      Error.pp_error_msg err
95 95
      Location.pp_loc loc;
96 96
    raise exc
97 97

  
......
128 128
	raise exc
129 129
    end 
130 130
  in
131
  if !Options.print_types then
131
  if !Options.print_types || !Options.verbose_level > 2 then
132 132
    Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>  %a@]@ " Corelang.pp_prog_type decls);
133 133
  new_env
134 134
      
......
143 143
	raise exc
144 144
    end
145 145
  in
146
  if !Options.print_clocks then
146
  if !Options.print_clocks  || !Options.verbose_level > 2 then
147 147
    Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>  %a@]@ " Corelang.pp_prog_clock decls);
148 148
  new_env
149 149

  
......
233 233

  
234 234

  
235 235
let import_dependencies prog =
236
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 0>.. extracting dependencies@ ");
236
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 4>.. extracting dependencies");
237 237
  let dependencies = Corelang.get_dependencies prog in
238 238
  let deps =
239 239
  List.fold_left
240 240
    (fun (compilation_dep, type_env, clock_env) dep ->
241 241
      let (local, s) = Corelang.dependency_of_top dep in
242 242
      let basename = Options_management.name_dependency (local, s) in
243
      Log.report ~level:1 (fun fmt -> Format.fprintf fmt "  Library %s@ " basename);
243
      Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s" basename);
244 244
      let lusic = Modules.import_dependency dep.top_decl_loc (local, s) in
245 245
      (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "");*)
246 246
      let (lusi_type_env, lusi_clock_env) = get_envs_from_top_decls lusic.Lusic.contents in
src/corelang.ml
14 14
(*open Dimension*)
15 15

  
16 16

  
17
exception Error of Location.t * error
17
exception Error of Location.t * Error.error_kind
18 18

  
19 19
module VDeclModule =
20 20
struct (* Node module *)
......
823 823
let pp_prog_clock fmt prog =
824 824
  Utils.fprintf_list ~sep:"" pp_decl_clock fmt prog
825 825

  
826
let pp_error fmt = function
827
    Main_not_found ->
828
      fprintf fmt "Could not find the definition of main node %s.@."
829
	!Global.main_node
830
  | Main_wrong_kind ->
831
    fprintf fmt
832
      "Node %s does not correspond to a valid main node definition.@." 
833
      !Global.main_node 
834
  | No_main_specified ->
835
    fprintf fmt "No main node specified (use -node option)@."
836
  | Unbound_symbol sym ->
837
    fprintf fmt
838
      "%s is undefined.@."
839
      sym
840
  | Already_bound_symbol sym -> 
841
    fprintf fmt
842
      "%s is already defined.@."
843
      sym
844
  | Unknown_library sym ->
845
    fprintf fmt
846
      "impossible to load library %s.lusic.@.Please compile the corresponding interface or source file.@."
847
      sym
848
  | Wrong_number sym ->
849
    fprintf fmt
850
      "library %s.lusic has a different version number and may crash compiler.@.Please recompile the corresponding interface or source file.@."
851
      sym
852 826

  
853 827
(* filling node table with internal functions *)
854 828
let vdecls_of_typ_ck cpt ty =
......
1065 1039
let copy_prog top_list =
1066 1040
  List.map copy_top top_list
1067 1041

  
1042

  
1043
let rec expr_contains_expr expr_tag expr  =
1044
  let search = expr_contains_expr expr_tag in
1045
  expr.expr_tag = expr_tag ||
1046
      (
1047
	match expr.expr_desc with
1048
	| Expr_const _ -> false
1049
	| Expr_array el -> List.exists search el
1050
	| Expr_access (e1, _) 
1051
	| Expr_power (e1, _) -> search e1
1052
	| Expr_tuple el -> List.exists search el
1053
	| Expr_ite (c, t, e) -> List.exists search [c;t;e]
1054
	| Expr_arrow (e1, e2)
1055
	| Expr_fby (e1, e2) -> List.exists search [e1; e2]
1056
	| Expr_pre e' 
1057
	| Expr_when (e', _, _) -> search e'
1058
	| Expr_merge (_, hl) -> List.exists (fun (_, h) -> search h) hl
1059
	| Expr_appl (_, e', None) -> search e' 
1060
	| Expr_appl (_, e', Some e'') -> List.exists search [e'; e''] 
1061
	| Expr_ident _ -> false
1062
      )
1063

  
1068 1064
(* Local Variables: *)
1069 1065
(* compile-command:"make -C .." *)
1070 1066
(* End: *)
src/corelang.mli
12 12

  
13 13
open LustreSpec
14 14

  
15
exception Error of Location.t * error
16

  
15
exception Error of Location.t * Error.error_kind
16
module VSet: Set.S
17
  
17 18
val dummy_type_dec: type_dec
18 19
val dummy_clock_dec: clock_dec
19 20

  
......
84 85

  
85 86
val is_eq_expr: expr -> expr -> bool
86 87

  
87
val pp_error :  Format.formatter -> error -> unit
88
(* val pp_error :  Format.formatter -> error -> unit *)
88 89

  
89 90
(* Caution, returns an untyped, unclocked, etc, expression *)
90 91
val is_tuple_expr : expr -> bool
......
144 145
val update_expr_annot: ident -> expr -> expr_annot -> expr
145 146
(* val mkpredef_call: Location.t -> ident -> eexpr list -> eexpr*)
146 147

  
148
val expr_contains_expr: tag -> expr -> bool
147 149
(* Local Variables: *)
148 150
(* compile-command:"make -C .." *)
149 151
(* End: *)
src/lusic.ml
44 44
    prog []
45 45

  
46 46
let check_obsolete lusic basename =
47
  if lusic.obsolete then raise (Error (Location.dummy_loc, Wrong_number basename))
47
  if lusic.obsolete then raise (Error (Location.dummy_loc, Error.Wrong_number basename))
48 48

  
49 49
(* encode and write a header in a file *)
50 50
let write_lusic lusi (header : top_decl list) basename extension =
src/lustreSpec.ml
251 251
  | MComment of string
252 252

  
253 253

  
254
type error =
255
    Main_not_found
256
  | Main_wrong_kind
257
  | No_main_specified
258
  | Unbound_symbol of ident
259
  | Already_bound_symbol of ident
260
  | Unknown_library of ident
261
  | Wrong_number of ident
262

  
263 254
(* Local Variables: *)
264 255
(* compile-command:"make -C .." *)
265 256
(* End: *)
src/main_lustre_compiler.ml
242 242
  (* Computation of node equation scheduling. It also breaks dependency cycles
243 243
     and warns about unused input or memory variables *)
244 244
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,");
245
  let prog, node_schs = Scheduling.schedule_prog prog in
245
  let prog, node_schs =
246
    try 
247
      Scheduling.schedule_prog prog
248
    with Causality.Error _ -> (* Error is not kept. It is recomputed in a more
249
				 systemtic way in AlgebraicLoop module *)
250
      AlgebraicLoop.analyze prog
251
  in
246 252
  Log.report ~level:1 (fun fmt -> fprintf fmt "%a"              Scheduling.pp_warning_unused node_schs);
247 253
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs);
248 254
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs);
......
421 427
    Arg.parse options anonymous usage
422 428
  with
423 429
  | Parse.Error _
424
  | Types.Error (_,_) | Clocks.Error (_,_)
425
  | Corelang.Error _ (*| Task_set.Error _*)
426
  | Causality.Error _ -> exit 1
430
  | Types.Error (_,_) | Clocks.Error (_,_) -> exit 1
431
  | Corelang.Error (_ (* loc *), kind) (*| Task_set.Error _*) -> exit (Error.return_code kind)
432
  (* | Causality.Error _  -> exit (Error.return_code Error.AlgebraicLoop) *)
427 433
  | Sys_error msg -> (eprintf "Failure: %s@." msg)
428
  | exc -> (track_exception (); raise exc)
434
  | exc -> (track_exception (); raise exc) 
429 435

  
430 436
(* Local Variables: *)
431 437
(* compile-command:"make -C .." *)
src/modules.ml
15 15

  
16 16
let add_symbol loc msg hashtbl name value =
17 17
 if Hashtbl.mem hashtbl name
18
 then raise (Error (loc, Already_bound_symbol msg))
18
 then raise (Error (loc, Error.Already_bound_symbol msg))
19 19
 else Hashtbl.add hashtbl name value
20 20

  
21 21
let check_symbol loc msg hashtbl name =
22 22
 if not (Hashtbl.mem hashtbl name)
23
 then raise (Error (loc, Unbound_symbol msg))
23
 then raise (Error (loc, Error.Unbound_symbol msg))
24 24
 else ()
25 25

  
26 26
let add_imported_node name value =
......
33 33
    let itf = value.top_decl_itf in
34 34
    match value'.top_decl_desc, value.top_decl_desc with
35 35
    | Node _        , ImportedNode _  when owner = owner' && itf' && (not itf) -> Hashtbl.add node_table name value
36
    | ImportedNode _, ImportedNode _            -> raise (Error (value.top_decl_loc, Already_bound_symbol ("node " ^ name)))
36
    | ImportedNode _, ImportedNode _            -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
37 37
    | _                                         -> assert false
38 38
  with
39 39
    Not_found                                   -> Hashtbl.add node_table name value
......
48 48
    let itf = value.top_decl_itf in
49 49
    match value'.top_decl_desc, value.top_decl_desc with
50 50
    | ImportedNode _, Node _          when owner = owner' && itf' && (not itf) -> ()
51
    | Node _        , Node _                    -> raise (Error (value.top_decl_loc, Already_bound_symbol ("node " ^ name)))
51
    | Node _        , Node _                    -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
52 52
    | _                                         -> assert false
53 53
  with
54 54
    Not_found                                   -> Hashtbl.add node_table name value
......
56 56

  
57 57
let add_tag loc name typ =
58 58
  if Hashtbl.mem tag_table name then
59
    raise (Error (loc, Already_bound_symbol ("enum tag " ^ name)))
59
    raise (Error (loc, Error.Already_bound_symbol ("enum tag " ^ name)))
60 60
  else Hashtbl.add tag_table name typ
61 61

  
62 62
let add_field loc name typ =
63 63
  if Hashtbl.mem field_table name then
64
    raise (Error (loc, Already_bound_symbol ("struct field " ^ name)))
64
    raise (Error (loc, Error.Already_bound_symbol ("struct field " ^ name)))
65 65
  else Hashtbl.add field_table name typ
66 66

  
67 67
let import_typedef name tydef =
......
75 75
    | Tydec_clock ty      -> import ty
76 76
    | Tydec_const c       ->
77 77
       if not (Hashtbl.mem type_table (Tydec_const c))
78
       then raise (Error (loc, Unbound_symbol ("type " ^ c)))
78
       then raise (Error (loc, Error.Unbound_symbol ("type " ^ c)))
79 79
       else ()
80 80
    | Tydec_array (c, ty) -> import ty
81 81
    | _                   -> ()
......
91 91
    let itf = value.top_decl_itf in
92 92
    match value'.top_decl_desc, value.top_decl_desc with
93 93
    | TypeDef ty', TypeDef ty when coretype_equal ty'.tydef_desc ty.tydef_desc && owner' = owner && itf' && (not itf) -> ()
94
    | TypeDef ty', TypeDef ty -> raise (Error (value.top_decl_loc, Already_bound_symbol ("type " ^ name)))
94
    | TypeDef ty', TypeDef ty -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("type " ^ name)))
95 95
    | _       -> assert false
96 96
  with Not_found -> (import_typedef name value; Hashtbl.add type_table (Tydec_const name) value)
97 97

  
98 98
let check_type loc name =
99 99
 if not (Hashtbl.mem type_table (Tydec_const name))
100
 then raise (Error (loc, Unbound_symbol ("type " ^ name)))
100
 then raise (Error (loc, Error.Unbound_symbol ("type " ^ name)))
101 101
 else ()
102 102

  
103 103
let add_const itf name value =
......
109 109
    let itf = value.top_decl_itf in
110 110
    match value'.top_decl_desc, value.top_decl_desc with
111 111
    | Const c', Const c when c.const_value = c'.const_value && owner' = owner && itf' && (not itf) -> ()
112
    | Const c', Const c -> raise (Error (value.top_decl_loc, Already_bound_symbol ("const " ^ name)))
112
    | Const c', Const c -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("const " ^ name)))
113 113
    | _       -> assert false
114 114
  with Not_found -> Hashtbl.add consts_table name value
115 115

  
......
124 124
  | Sys_error msg ->
125 125
    begin
126 126
      (*Format.eprintf "Error: %s@." msg;*)
127
      raise (Error (loc, Unknown_library basename))
127
      raise (Error (loc, Error.Unknown_library basename))
128 128
    end
129 129
  | Corelang.Error (_, msg) -> raise (Corelang.Error (loc, msg))
130 130

  
......
134 134
  with
135 135
  | Corelang.Error (_, err) as exc -> (
136 136
    Format.eprintf "Import error: %a%a@."
137
      Corelang.pp_error err
137
      Error.pp_error_msg err
138 138
      Location.pp_loc loc;
139 139
    raise exc
140 140
  )
......
145 145
  with
146 146
  | Corelang.Error (loc, err) as exc -> (
147 147
    Format.eprintf "Import error: %a%a@."
148
      Corelang.pp_error err
148
      Error.pp_error_msg err
149 149
      Location.pp_loc loc;
150 150
    raise exc
151 151
  )
......
170 170
  with
171 171
    Corelang.Error (loc, err) as exc -> (
172 172
      Format.eprintf "Import error: %a%a@."
173
	Corelang.pp_error err
173
	Error.pp_error_msg err
174 174
	Location.pp_loc loc;
175 175
      raise exc
176 176
    );;
......
195 195
  with
196 196
    Corelang.Error (loc, err) as exc -> (
197 197
      Format.eprintf "Import error: %a%a@."
198
	Corelang.pp_error err
198
	Error.pp_error_msg err
199 199
	Location.pp_loc loc;
200 200
      raise exc
201 201
    );;
src/options.ml
15 15

  
16 16
let main_node = ref ""
17 17
let static_mem = ref true
18
let print_types = ref true
19
let print_clocks = ref true
18
let print_types = ref false
19
let print_clocks = ref false
20 20
let delay_calculus = ref true
21 21
let track_exceptions = ref true
22 22
let ansi = ref false
......
52 52
let gen_mcdc = ref false
53 53
let no_mutation_suffix = ref false
54 54

  
55

  
55
let solve_al = ref false
56 56

  
57 57
(* Local Variables: *)
58 58
(* compile-command:"make -C .." *)
src/scheduling.ml
130 130

  
131 131
let schedule_node n =
132 132
  (* let node_vars = get_node_vars n in *)
133
  try
134
    let eq_equiv = ExprDep.node_eq_equiv n in
135
    let eq_equiv v1 v2 =
136
      try
137
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
138
      with Not_found -> false in
133
  let eq_equiv = ExprDep.node_eq_equiv n in
134
  let eq_equiv v1 v2 =
135
    try
136
      Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
137
    with Not_found -> false in
139 138

  
140
    let n', g = global_dependency n in
141
    
142
    (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
139
  let n', g = global_dependency n in
140
  
141
  (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
143 142
     compute: coi predecessors of outputs
144 143
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
145
       DONE !
146
     *)
144
     DONE !
145
  *)
147 146

  
148
    let gg = IdentDepGraph.copy g in
149
    let sort = topological_sort eq_equiv g in
150
    let unused = Liveness.compute_unused_variables n gg in
151
    let fanin = Liveness.compute_fanin n gg in
152
    { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
147
  let gg = IdentDepGraph.copy g in
148
  let sort = topological_sort eq_equiv g in
149
  let unused = Liveness.compute_unused_variables n gg in
150
  let fanin = Liveness.compute_fanin n gg in
151
  { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
153 152

  
154
  with (Causality.Error err) as exc ->
155
    match err with
156
    | DataCycle vl ->
157
       let _ (*vl*) = filter_original n vl in
158
       Causality.pp_error Format.err_formatter err;
159
       raise exc
160
    | _ -> raise exc
161 153

  
162 154
let compute_node_reuse_table report =
163 155
  let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in

Also available in: Unified diff