From e7cc51860b11daad1cc545754434b4f17b4f9539 Mon Sep 17 00:00:00 2001
From: ploc <ploc@garoche.net>
Date: Mon, 17 Jul 2017 15:03:08 -0700
Subject: [PATCH] Refactor error printing.
---
src/backends/C/c_backend.ml | 8 ++--
src/backends/C/c_backend_main.ml | 4 +-
src/causality.ml | 64 +++++++++++++++++++-------------
src/compiler_common.ml | 18 ++++-----
src/corelang.ml | 50 ++++++++++++-------------
src/corelang.mli | 8 ++--
src/lusic.ml | 2 +-
src/lustreSpec.ml | 9 -----
src/main_lustre_compiler.ml | 16 +++++---
src/modules.ml | 30 +++++++--------
src/options.ml | 6 +--
src/scheduling.ml | 38 ++++++++-----------
12 files changed, 127 insertions(+), 126 deletions(-)
diff --git a/src/backends/C/c_backend.ml b/src/backends/C/c_backend.ml
index 3a9f1e91..b8c3664c 100644
--- a/src/backends/C/c_backend.ml
+++ b/src/backends/C/c_backend.ml
@@ -51,8 +51,8 @@ let gen_files funs basename prog machines dependencies =
match Machine_code.get_machine_opt main_node machines with
| None -> begin
Global.main_node := main_node;
- Format.eprintf "Code generation error: %a@." Corelang.pp_error LustreSpec.Main_not_found;
- raise (Corelang.Error (Location.dummy_loc, LustreSpec.Main_not_found))
+ Format.eprintf "Code generation error: %a@." Error.pp_error_msg Error.Main_not_found;
+ raise (Corelang.Error (Location.dummy_loc, Error.Main_not_found))
end
| Some m -> begin
let source_main_file = (if !Options.cpp then destname ^ "_main.cpp" else destname ^ "_main.c") in (* Could be changed *)
@@ -73,8 +73,8 @@ let gen_files funs basename prog machines dependencies =
match Machine_code.get_machine_opt mauve machines with
| None -> begin
Global.main_node := mauve;
- Format.eprintf "Code generation error: %a@." Corelang.pp_error LustreSpec.Main_not_found;
- raise (Corelang.Error (Location.dummy_loc, LustreSpec.Main_not_found))
+ Format.eprintf "Code generation error: %a@." Error.pp_error_msg Error.Main_not_found;
+ raise (Corelang.Error (Location.dummy_loc, Error.Main_not_found))
end
| Some m -> begin
let source_mauve_file = destname ^ "_mauve.hpp" in
diff --git a/src/backends/C/c_backend_main.ml b/src/backends/C/c_backend_main.ml
index 426cb24d..d6521734 100644
--- a/src/backends/C/c_backend_main.ml
+++ b/src/backends/C/c_backend_main.ml
@@ -42,9 +42,9 @@ let print_get_inputs fmt m =
begin
Global.main_node := !Options.main_node;
Format.eprintf "Code generation error: %a%a@."
- pp_error Main_wrong_kind
+ Error.pp_error_msg Error.Main_wrong_kind
Location.pp_loc v'.var_loc;
- raise (Error (v'.var_loc, Main_wrong_kind))
+ raise (Error (v'.var_loc, Error.Main_wrong_kind))
end
in
List.iteri2 (fun idx v' v ->
diff --git a/src/causality.ml b/src/causality.ml
index ac28345b..447b464e 100644
--- a/src/causality.ml
+++ b/src/causality.ml
@@ -18,10 +18,11 @@ open Utils
open LustreSpec
open Corelang
open Graph
-open Format
+
+type identified_call = eq * tag
type error =
- | DataCycle of ident list
+ | DataCycle of ident list list (* multiple failed partitions at once *)
| NodeCycle of ident list
exception Error of error
@@ -97,14 +98,14 @@ module ExprDep = struct
but used to compute useless inputs/mems.
a mem read var represents a mem at the beginning of a cycle *)
let mk_read_var id =
- sprintf "#%s" id
+ Format.sprintf "#%s" id
(* instance vars represent node instance calls,
they are not part of the program/schedule,
but used to simplify causality analysis
*)
let mk_instance_var id =
- incr instance_var_cpt; sprintf "!%s_%d" id !instance_var_cpt
+ incr instance_var_cpt; Format.sprintf "!%s_%d" id !instance_var_cpt
let is_read_var v = v.[0] = '#'
@@ -215,7 +216,7 @@ module ExprDep = struct
(* Add mashup dependencies for a user-defined node instance [lhs] = [f]([e]) *)
(* i.e every input is connected to every output, through a ghost var *)
let mashup_appl_dependencies f e g =
- let f_var = mk_instance_var (sprintf "%s_%d" f eq.eq_loc.Location.loc_start.Lexing.pos_lnum) in
+ let f_var = mk_instance_var (Format.sprintf "%s_%d" f eq.eq_loc.Location.loc_start.Lexing.pos_lnum) in
List.fold_right (fun rhs -> add_dep lhs_is_mem (adjust_tuple f_var rhs) rhs)
(expr_list_of_expr e) (add_var lhs_is_mem lhs f_var g)
in
@@ -384,6 +385,7 @@ module NodeDep = struct
end
+
module CycleDetection = struct
(* ---- Look for cycles in a dependency graph *)
@@ -420,11 +422,12 @@ module CycleDetection = struct
[Cycle partition] if the succession of dependencies [partition] forms a cycle *)
let check_cycles g =
let scc_l = Cycles.scc_list g in
- List.iter (fun partition ->
- if wrong_partition g partition then
- raise (Error (DataCycle partition))
- else ()
- ) scc_l
+ let algebraic_loops = List.filter (wrong_partition g) scc_l in
+ if List.length algebraic_loops > 0 then
+ raise (Error (DataCycle algebraic_loops))
+ (* We extract a hint to resolve the cycle: for each variable in the cycle
+ which is defined by a call, we return the name of the node call and
+ its specific id *)
(* Creates the sub-graph of [g] restricted to vertices and edges in partition *)
let copy_partition g partition =
@@ -562,6 +565,7 @@ struct
end
end
+
let pp_dep_graph fmt g =
begin
Format.fprintf fmt "{ /* graph */@.";
@@ -571,13 +575,19 @@ let pp_dep_graph fmt g =
let pp_error fmt err =
match err with
- | DataCycle trace ->
- fprintf fmt "@.Causality error, cyclic data dependencies: %a@."
- (fprintf_list ~sep:", " pp_print_string) trace
| NodeCycle trace ->
- fprintf fmt "@.Causality error, cyclic node calls: %a@."
- (fprintf_list ~sep:", " pp_print_string) trace
-
+ Format.fprintf fmt "Causality error, cyclic node calls:@ @[<v 0>%a@]@ "
+ (fprintf_list ~sep:",@ " Format.pp_print_string) trace
+ | DataCycle traces -> (
+ Format.fprintf fmt "Causality error, cyclic data dependencies:@ @[<v 0>%a@]@ "
+ (fprintf_list ~sep:";@ "
+ (fun fmt trace ->
+ Format.fprintf fmt "@[<v 0>{%a}@]"
+ (fprintf_list ~sep:",@ " Format.pp_print_string)
+ trace
+ )) traces
+ )
+
(* Merges elements of graph [g2] into graph [g1] *)
let merge_with g1 g2 =
begin
@@ -605,15 +615,19 @@ let global_dependency node =
let (g_non_mems, g_mems) = ExprDep.dependence_graph mems inputs node_vars node in
(*Format.eprintf "g_non_mems: %a" pp_dep_graph g_non_mems;
Format.eprintf "g_mems: %a" pp_dep_graph g_mems;*)
- CycleDetection.check_cycles g_non_mems;
- let (vdecls', eqs', g_mems') = CycleDetection.break_cycles node mems g_mems in
- (*Format.eprintf "g_mems': %a" pp_dep_graph g_mems';*)
- begin
- merge_with g_non_mems g_mems';
- add_external_dependency outputs mems g_non_mems;
- { node with node_stmts = List.map (fun eq -> Eq eq) eqs'; node_locals = vdecls'@node.node_locals },
- g_non_mems
- end
+ try
+ CycleDetection.check_cycles g_non_mems;
+ let (vdecls', eqs', g_mems') = CycleDetection.break_cycles node mems g_mems in
+ (*Format.eprintf "g_mems': %a" pp_dep_graph g_mems';*)
+ begin
+ merge_with g_non_mems g_mems';
+ add_external_dependency outputs mems g_non_mems;
+ { node with node_stmts = List.map (fun eq -> Eq eq) eqs'; node_locals = vdecls'@node.node_locals },
+ g_non_mems
+ end
+ with Error (DataCycle _ as exc) -> (
+ raise (Error (exc))
+ )
(* Local Variables: *)
(* compile-command:"make -C .." *)
diff --git a/src/compiler_common.ml b/src/compiler_common.ml
index 8dbf81c3..4eeb238c 100644
--- a/src/compiler_common.ml
+++ b/src/compiler_common.ml
@@ -17,8 +17,8 @@ open Corelang
let check_main () =
if !Options.main_node = "" then
begin
- eprintf "Code generation error: %a@." pp_error No_main_specified;
- raise (Error (Location.dummy_loc, No_main_specified))
+ eprintf "Code generation error: %a@." Error.pp_error_msg Error.No_main_specified;
+ raise (Error (Location.dummy_loc, Error.No_main_specified))
end
let create_dest_dir () =
@@ -55,7 +55,7 @@ let parse_header own filename =
raise exc
| Corelang.Error (loc, err) as exc -> (
eprintf "Parsing error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
)
@@ -81,7 +81,7 @@ let parse_source source_name =
raise exc
| Corelang.Error (loc, err) as exc ->
eprintf "Parsing error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
@@ -91,7 +91,7 @@ let expand_automata decls =
Automata.expand_decls decls
with (Corelang.Error (loc, err)) as exc ->
eprintf "Automata error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
@@ -128,7 +128,7 @@ let type_decls env decls =
raise exc
end
in
- if !Options.print_types then
+ if !Options.print_types || !Options.verbose_level > 2 then
Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2> %a@]@ " Corelang.pp_prog_type decls);
new_env
@@ -143,7 +143,7 @@ let clock_decls env decls =
raise exc
end
in
- if !Options.print_clocks then
+ if !Options.print_clocks || !Options.verbose_level > 2 then
Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2> %a@]@ " Corelang.pp_prog_clock decls);
new_env
@@ -233,14 +233,14 @@ let is_stateful topdecl =
let import_dependencies prog =
- Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 0>.. extracting dependencies@ ");
+ Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 4>.. extracting dependencies");
let dependencies = Corelang.get_dependencies prog in
let deps =
List.fold_left
(fun (compilation_dep, type_env, clock_env) dep ->
let (local, s) = Corelang.dependency_of_top dep in
let basename = Options_management.name_dependency (local, s) in
- Log.report ~level:1 (fun fmt -> Format.fprintf fmt " Library %s@ " basename);
+ Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s" basename);
let lusic = Modules.import_dependency dep.top_decl_loc (local, s) in
(*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "");*)
let (lusi_type_env, lusi_clock_env) = get_envs_from_top_decls lusic.Lusic.contents in
diff --git a/src/corelang.ml b/src/corelang.ml
index 00cd8f48..67c7030a 100755
--- a/src/corelang.ml
+++ b/src/corelang.ml
@@ -14,7 +14,7 @@ open LustreSpec
(*open Dimension*)
-exception Error of Location.t * error
+exception Error of Location.t * Error.error_kind
module VDeclModule =
struct (* Node module *)
@@ -823,32 +823,6 @@ let pp_decl_clock fmt cdecl =
let pp_prog_clock fmt prog =
Utils.fprintf_list ~sep:"" pp_decl_clock fmt prog
-let pp_error fmt = function
- Main_not_found ->
- fprintf fmt "Could not find the definition of main node %s.@."
- !Global.main_node
- | Main_wrong_kind ->
- fprintf fmt
- "Node %s does not correspond to a valid main node definition.@."
- !Global.main_node
- | No_main_specified ->
- fprintf fmt "No main node specified (use -node option)@."
- | Unbound_symbol sym ->
- fprintf fmt
- "%s is undefined.@."
- sym
- | Already_bound_symbol sym ->
- fprintf fmt
- "%s is already defined.@."
- sym
- | Unknown_library sym ->
- fprintf fmt
- "impossible to load library %s.lusic.@.Please compile the corresponding interface or source file.@."
- sym
- | Wrong_number sym ->
- fprintf fmt
- "library %s.lusic has a different version number and may crash compiler.@.Please recompile the corresponding interface or source file.@."
- sym
(* filling node table with internal functions *)
let vdecls_of_typ_ck cpt ty =
@@ -1065,6 +1039,28 @@ let copy_top top =
let copy_prog top_list =
List.map copy_top top_list
+
+let rec expr_contains_expr expr_tag expr =
+ let search = expr_contains_expr expr_tag in
+ expr.expr_tag = expr_tag ||
+ (
+ match expr.expr_desc with
+ | Expr_const _ -> false
+ | Expr_array el -> List.exists search el
+ | Expr_access (e1, _)
+ | Expr_power (e1, _) -> search e1
+ | Expr_tuple el -> List.exists search el
+ | Expr_ite (c, t, e) -> List.exists search [c;t;e]
+ | Expr_arrow (e1, e2)
+ | Expr_fby (e1, e2) -> List.exists search [e1; e2]
+ | Expr_pre e'
+ | Expr_when (e', _, _) -> search e'
+ | Expr_merge (_, hl) -> List.exists (fun (_, h) -> search h) hl
+ | Expr_appl (_, e', None) -> search e'
+ | Expr_appl (_, e', Some e'') -> List.exists search [e'; e'']
+ | Expr_ident _ -> false
+ )
+
(* Local Variables: *)
(* compile-command:"make -C .." *)
(* End: *)
diff --git a/src/corelang.mli b/src/corelang.mli
index 73bef972..20bb6786 100755
--- a/src/corelang.mli
+++ b/src/corelang.mli
@@ -12,8 +12,9 @@
open LustreSpec
-exception Error of Location.t * error
-
+exception Error of Location.t * Error.error_kind
+module VSet: Set.S
+
val dummy_type_dec: type_dec
val dummy_clock_dec: clock_dec
@@ -84,7 +85,7 @@ val sort_handlers : (label * 'a) list -> (label * 'a) list
val is_eq_expr: expr -> expr -> bool
-val pp_error : Format.formatter -> error -> unit
+(* val pp_error : Format.formatter -> error -> unit *)
(* Caution, returns an untyped, unclocked, etc, expression *)
val is_tuple_expr : expr -> bool
@@ -144,6 +145,7 @@ val extend_eexpr: (quantifier_type * var_decl list) list -> eexpr -> eexpr
val update_expr_annot: ident -> expr -> expr_annot -> expr
(* val mkpredef_call: Location.t -> ident -> eexpr list -> eexpr*)
+val expr_contains_expr: tag -> expr -> bool
(* Local Variables: *)
(* compile-command:"make -C .." *)
(* End: *)
diff --git a/src/lusic.ml b/src/lusic.ml
index 72506aec..1859333b 100644
--- a/src/lusic.ml
+++ b/src/lusic.ml
@@ -44,7 +44,7 @@ let extract_header dirname basename prog =
prog []
let check_obsolete lusic basename =
- if lusic.obsolete then raise (Error (Location.dummy_loc, Wrong_number basename))
+ if lusic.obsolete then raise (Error (Location.dummy_loc, Error.Wrong_number basename))
(* encode and write a header in a file *)
let write_lusic lusi (header : top_decl list) basename extension =
diff --git a/src/lustreSpec.ml b/src/lustreSpec.ml
index 445b8831..3051b4d0 100644
--- a/src/lustreSpec.ml
+++ b/src/lustreSpec.ml
@@ -251,15 +251,6 @@ and instr_t_desc =
| MComment of string
-type error =
- Main_not_found
- | Main_wrong_kind
- | No_main_specified
- | Unbound_symbol of ident
- | Already_bound_symbol of ident
- | Unknown_library of ident
- | Wrong_number of ident
-
(* Local Variables: *)
(* compile-command:"make -C .." *)
(* End: *)
diff --git a/src/main_lustre_compiler.ml b/src/main_lustre_compiler.ml
index f9176183..3b78406e 100644
--- a/src/main_lustre_compiler.ml
+++ b/src/main_lustre_compiler.ml
@@ -242,7 +242,13 @@ let stage2 prog =
(* Computation of node equation scheduling. It also breaks dependency cycles
and warns about unused input or memory variables *)
Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,");
- let prog, node_schs = Scheduling.schedule_prog prog in
+ let prog, node_schs =
+ try
+ Scheduling.schedule_prog prog
+ with Causality.Error _ -> (* Error is not kept. It is recomputed in a more
+ systemtic way in AlgebraicLoop module *)
+ AlgebraicLoop.analyze prog
+ in
Log.report ~level:1 (fun fmt -> fprintf fmt "%a" Scheduling.pp_warning_unused node_schs);
Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs);
Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs);
@@ -421,11 +427,11 @@ let _ =
Arg.parse options anonymous usage
with
| Parse.Error _
- | Types.Error (_,_) | Clocks.Error (_,_)
- | Corelang.Error _ (*| Task_set.Error _*)
- | Causality.Error _ -> exit 1
+ | Types.Error (_,_) | Clocks.Error (_,_) -> exit 1
+ | Corelang.Error (_ (* loc *), kind) (*| Task_set.Error _*) -> exit (Error.return_code kind)
+ (* | Causality.Error _ -> exit (Error.return_code Error.AlgebraicLoop) *)
| Sys_error msg -> (eprintf "Failure: %s@." msg)
- | exc -> (track_exception (); raise exc)
+ | exc -> (track_exception (); raise exc)
(* Local Variables: *)
(* compile-command:"make -C .." *)
diff --git a/src/modules.ml b/src/modules.ml
index 59c60aee..eee6a26b 100644
--- a/src/modules.ml
+++ b/src/modules.ml
@@ -15,12 +15,12 @@ open Corelang
let add_symbol loc msg hashtbl name value =
if Hashtbl.mem hashtbl name
- then raise (Error (loc, Already_bound_symbol msg))
+ then raise (Error (loc, Error.Already_bound_symbol msg))
else Hashtbl.add hashtbl name value
let check_symbol loc msg hashtbl name =
if not (Hashtbl.mem hashtbl name)
- then raise (Error (loc, Unbound_symbol msg))
+ then raise (Error (loc, Error.Unbound_symbol msg))
else ()
let add_imported_node name value =
@@ -33,7 +33,7 @@ let add_imported_node name value =
let itf = value.top_decl_itf in
match value'.top_decl_desc, value.top_decl_desc with
| Node _ , ImportedNode _ when owner = owner' && itf' && (not itf) -> Hashtbl.add node_table name value
- | ImportedNode _, ImportedNode _ -> raise (Error (value.top_decl_loc, Already_bound_symbol ("node " ^ name)))
+ | ImportedNode _, ImportedNode _ -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
| _ -> assert false
with
Not_found -> Hashtbl.add node_table name value
@@ -48,7 +48,7 @@ let add_node name value =
let itf = value.top_decl_itf in
match value'.top_decl_desc, value.top_decl_desc with
| ImportedNode _, Node _ when owner = owner' && itf' && (not itf) -> ()
- | Node _ , Node _ -> raise (Error (value.top_decl_loc, Already_bound_symbol ("node " ^ name)))
+ | Node _ , Node _ -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
| _ -> assert false
with
Not_found -> Hashtbl.add node_table name value
@@ -56,12 +56,12 @@ let add_node name value =
let add_tag loc name typ =
if Hashtbl.mem tag_table name then
- raise (Error (loc, Already_bound_symbol ("enum tag " ^ name)))
+ raise (Error (loc, Error.Already_bound_symbol ("enum tag " ^ name)))
else Hashtbl.add tag_table name typ
let add_field loc name typ =
if Hashtbl.mem field_table name then
- raise (Error (loc, Already_bound_symbol ("struct field " ^ name)))
+ raise (Error (loc, Error.Already_bound_symbol ("struct field " ^ name)))
else Hashtbl.add field_table name typ
let import_typedef name tydef =
@@ -75,7 +75,7 @@ let import_typedef name tydef =
| Tydec_clock ty -> import ty
| Tydec_const c ->
if not (Hashtbl.mem type_table (Tydec_const c))
- then raise (Error (loc, Unbound_symbol ("type " ^ c)))
+ then raise (Error (loc, Error.Unbound_symbol ("type " ^ c)))
else ()
| Tydec_array (c, ty) -> import ty
| _ -> ()
@@ -91,13 +91,13 @@ let add_type itf name value =
let itf = value.top_decl_itf in
match value'.top_decl_desc, value.top_decl_desc with
| TypeDef ty', TypeDef ty when coretype_equal ty'.tydef_desc ty.tydef_desc && owner' = owner && itf' && (not itf) -> ()
- | TypeDef ty', TypeDef ty -> raise (Error (value.top_decl_loc, Already_bound_symbol ("type " ^ name)))
+ | TypeDef ty', TypeDef ty -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("type " ^ name)))
| _ -> assert false
with Not_found -> (import_typedef name value; Hashtbl.add type_table (Tydec_const name) value)
let check_type loc name =
if not (Hashtbl.mem type_table (Tydec_const name))
- then raise (Error (loc, Unbound_symbol ("type " ^ name)))
+ then raise (Error (loc, Error.Unbound_symbol ("type " ^ name)))
else ()
let add_const itf name value =
@@ -109,7 +109,7 @@ let add_const itf name value =
let itf = value.top_decl_itf in
match value'.top_decl_desc, value.top_decl_desc with
| Const c', Const c when c.const_value = c'.const_value && owner' = owner && itf' && (not itf) -> ()
- | Const c', Const c -> raise (Error (value.top_decl_loc, Already_bound_symbol ("const " ^ name)))
+ | Const c', Const c -> raise (Error (value.top_decl_loc, Error.Already_bound_symbol ("const " ^ name)))
| _ -> assert false
with Not_found -> Hashtbl.add consts_table name value
@@ -124,7 +124,7 @@ let import_dependency_aux loc (local, dep) =
| Sys_error msg ->
begin
(*Format.eprintf "Error: %s@." msg;*)
- raise (Error (loc, Unknown_library basename))
+ raise (Error (loc, Error.Unknown_library basename))
end
| Corelang.Error (_, msg) -> raise (Corelang.Error (loc, msg))
@@ -134,7 +134,7 @@ let import_dependency loc (local, dep) =
with
| Corelang.Error (_, err) as exc -> (
Format.eprintf "Import error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
)
@@ -145,7 +145,7 @@ let check_dependency lusic basename =
with
| Corelang.Error (loc, err) as exc -> (
Format.eprintf "Import error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
)
@@ -170,7 +170,7 @@ let load_header imported header =
with
Corelang.Error (loc, err) as exc -> (
Format.eprintf "Import error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
);;
@@ -195,7 +195,7 @@ let load_program imported program =
with
Corelang.Error (loc, err) as exc -> (
Format.eprintf "Import error: %a%a@."
- Corelang.pp_error err
+ Error.pp_error_msg err
Location.pp_loc loc;
raise exc
);;
diff --git a/src/options.ml b/src/options.ml
index 6893bcc6..91a2261f 100755
--- a/src/options.ml
+++ b/src/options.ml
@@ -15,8 +15,8 @@ let include_dirs = ref ["."]
let main_node = ref ""
let static_mem = ref true
-let print_types = ref true
-let print_clocks = ref true
+let print_types = ref false
+let print_clocks = ref false
let delay_calculus = ref true
let track_exceptions = ref true
let ansi = ref false
@@ -52,7 +52,7 @@ let nb_mutants = ref 1000
let gen_mcdc = ref false
let no_mutation_suffix = ref false
-
+let solve_al = ref false
(* Local Variables: *)
(* compile-command:"make -C .." *)
diff --git a/src/scheduling.ml b/src/scheduling.ml
index 3ecc950c..c6263f73 100644
--- a/src/scheduling.ml
+++ b/src/scheduling.ml
@@ -130,34 +130,26 @@ let filter_original n vl =
let schedule_node n =
(* let node_vars = get_node_vars n in *)
- try
- let eq_equiv = ExprDep.node_eq_equiv n in
- let eq_equiv v1 v2 =
- try
- Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
- with Not_found -> false in
+ let eq_equiv = ExprDep.node_eq_equiv n in
+ let eq_equiv v1 v2 =
+ try
+ Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
+ with Not_found -> false in
- let n', g = global_dependency n in
-
- (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
+ let n', g = global_dependency n in
+
+ (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
compute: coi predecessors of outputs
warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
- DONE !
- *)
+ DONE !
+ *)
- let gg = IdentDepGraph.copy g in
- let sort = topological_sort eq_equiv g in
- let unused = Liveness.compute_unused_variables n gg in
- let fanin = Liveness.compute_fanin n gg in
- { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
+ let gg = IdentDepGraph.copy g in
+ let sort = topological_sort eq_equiv g in
+ let unused = Liveness.compute_unused_variables n gg in
+ let fanin = Liveness.compute_fanin n gg in
+ { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
- with (Causality.Error err) as exc ->
- match err with
- | DataCycle vl ->
- let _ (*vl*) = filter_original n vl in
- Causality.pp_error Format.err_formatter err;
- raise exc
- | _ -> raise exc
let compute_node_reuse_table report =
let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
--
GitLab