From 196914a31f29b1ebabae08ac5426824865f1d323 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Wed, 3 Feb 2016 14:41:27 +0100
Subject: [PATCH] Use topoSort to sort the list of vars in LicTab.sort_vars.
I was re-implementing an inneficient topological sort there (using a
linear list instead of logarithmic map). I win 1s on tri.ec (~8000
locals).
---
.gitignore | 54 +++
_oasis | 2 +-
src/lic2soc.ml | 6 +-
src/licTab.ml | 825 ++++++++++++++++++++++++----------------------
src/lv6Compile.ml | 6 +-
src/lv6version.ml | 4 +-
src/topoSort.ml | 6 +-
src/unifyClock.ml | 7 +-
test/lus2lic.sum | 24 +-
9 files changed, 505 insertions(+), 429 deletions(-)
diff --git a/.gitignore b/.gitignore
index 6b2cfd2d..50ce9492 100644
--- a/.gitignore
+++ b/.gitignore
@@ -71,3 +71,57 @@ linux
src/lus4ocaml.mllib
META
committed
+ALIRE-pascal
+Makefile.common
+Makefile.local
+Notes-pascal/
+linux64/
+lustre-v6.xml
+lv6-ref-man/manuel_nicolas
+lv6-ref-man/tokens
+pasteur-tableau-lctes12.pdf
+slides-Pascal/
+src/._d/
+src/._ncdi/
+src/gaoDeps.ml
+src/gaoDeps.mli
+src/genlex.ml
+src/hide/
+src/mli/
+test/call-via-socket
+test/ecexe
+test/extern_files/
+test/lurettetop
+test/lus2ec
+test/lus2lic-test
+test/lus2lic.quick_time
+test/lus2lic.ref_time
+test/lus2lic.tests/kcg.test
+test/lus2lic.tests/xxx.exp
+test/lus2lic.time
+test/lutin
+test/myec2ec
+test/patch_ecexe
+test/pollux
+test/rdbg-batch
+test/should_work/Makefile
+test/should_work/PCOND1.sh
+test/should_work/amaury.lus
+test/should_work/call-via-socket
+test/should_work/ck2.sh
+test/should_work/ecexe
+test/should_work/lurettetop
+test/should_work/lutin
+test/should_work/patch_ecexe
+test/should_work/rdbg-batch
+test/should_work/result
+test/should_work/result.org
+test/tmp1
+test/tmp2
+test/wwwwwww/
+todo-R1.org
+todo-R1.org_archive
+utils/test_lustrequiv/
+w7/
+willy.org
+
diff --git a/_oasis b/_oasis
index 1c0f1d4f..1eedf72c 100644
--- a/_oasis
+++ b/_oasis
@@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: lustre-v6
-Version: 1.640
+Version: 1.641
Synopsis: The Lustre V6 Verimag compiler
Description: This package contains:
- lus2lic: the (current) name of the compiler (and interpreter via -exec).
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 966f71e2..eac353b8 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/02/2016 (at 15:10) by Erwan Jahier> *)
+(** Time-stamp: <modified the 02/02/2016 (at 15:40) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -510,7 +510,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
)
fl
in
- ctx, actions@al, iol, ml, deps
+ ctx, List.rev_append actions al, iol, ml, deps
)
| Merge(mclk, cl) -> (
(* Merge (like when) does not generate any soc, but states when
@@ -813,7 +813,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
List.fold_left
(fun (c, a, i, d) eq ->
let nc, na, ni, nd = actions_of_equation eq.src soc_tbl c eq.it in
- nc, List.rev_append na a , List.rev_append ni i ,
+ nc, List.rev_append na a, List.rev_append ni i,
(ActionsDeps.concat nd d)
)
(ctx, [], [], ActionsDeps.empty)
diff --git a/src/licTab.ml b/src/licTab.ml
index fc2c523c..eb26d014 100644
--- a/src/licTab.ml
+++ b/src/licTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/01/2016 (at 10:42) by Erwan Jahier> *)
+(* Time-stamp: <modified the 03/02/2016 (at 14:18) by Erwan Jahier> *)
open Lxm
@@ -13,6 +13,10 @@ let dbg = (Lv6Verbose.get_flag "lazyc")
let finish_me msg = print_string ("\n\tXXX licTab:"^msg^" -> finish me!\n")
+let info msg =
+ let t = Sys.time() in
+ Lv6Verbose.exe ~level:1 (fun () -> Printf.eprintf "%4.4f: %s%!" t msg)
+
(******************************************************************************)
(** Returns the ident on which the recursion was detected, plus an execution
stack description.
@@ -59,7 +63,9 @@ let (create : AstTab.t -> t) =
List.iter
(fun op ->
let op_str = AstPredef.op2string op in
- let op_eff = LicEvalType.make_simple_node_exp_eff None true op (Lxm.dummy op_str) in
+ let op_eff = LicEvalType.make_simple_node_exp_eff None true op
+ (Lxm.dummy op_str)
+ in
let op_key = AstPredef.op_to_long op, [] in
Hashtbl.add nodes_tbl op_key (Lic.Checked op_eff);
Hashtbl.add prov_nodes_tbl op_key (Lic.Checked op_eff)
@@ -163,17 +169,22 @@ let (create : AstTab.t -> t) =
let x_check
(* tab find_x x_check_do lookup_x_eff pack_of_x_key name_of_x_key this x_key lxm = *)
(tab : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t)
- (find_x : AstTabSymbol.t -> Lv6Id.t -> Lxm.t -> ('x_info Lxm.srcflagged) AstTabSymbol.elt)
- (x_check_do : t -> 'x_key -> Lxm.t -> AstTabSymbol.t -> bool -> Lv6Id.pack_name -> 'x_info srcflagged -> 'x_eff)
+ (find_x : AstTabSymbol.t -> Lv6Id.t -> Lxm.t ->
+ ('x_info Lxm.srcflagged) AstTabSymbol.elt)
+ (x_check_do : t -> 'x_key -> Lxm.t -> AstTabSymbol.t -> bool ->
+ Lv6Id.pack_name -> 'x_info srcflagged -> 'x_eff)
(x_builtin : t -> 'x_key -> Lxm.t -> 'x_eff)
- (lookup_x_eff : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t -> 'x_key -> Lxm.t -> 'x_eff)
+ (lookup_x_eff : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t -> 'x_key ->
+ Lxm.t -> 'x_eff)
(pack_of_x_key : 'x_key -> string )
(name_of_x_key : 'x_key -> string)
(this : t)
(x_key : 'x_key)
(lxm : Lxm.t)
: 'x_eff =
- Lv6Verbose.exe ~flag:dbg (fun () -> Printf.printf "#DBG: licTab.x_check '%s'\n" (Lxm.details lxm));
+ Lv6Verbose.exe ~flag:dbg
+ (fun () -> Printf.printf "#DBG: licTab.x_check '%s'\n"
+ (Lxm.details lxm));
try lookup_x_eff tab x_key lxm
with Not_found -> (
let res = try x_builtin this x_key lxm
@@ -195,29 +206,29 @@ let x_check
)
let x_check_interface
- tab find_x x_check x_check_interface_do x_builtin lookup_x_eff
- pack_of_x_key name_of_x_key this x_key lxm =
+ tab find_x x_check x_check_interface_do x_builtin lookup_x_eff
+ pack_of_x_key name_of_x_key this x_key lxm =
try lookup_x_eff tab x_key lxm
with Not_found ->
- let res = (
+ let res = (
try x_builtin this x_key lxm
with Not_found ->
- Hashtbl.add tab x_key Lic.Checking;
- let (xp,xn) = (pack_of_x_key x_key, name_of_x_key x_key) in
- let xp_prov_symbols_opt = AstTab.pack_prov_env ~lxm:lxm this.src_tab xp in
- match xp_prov_symbols_opt with
- | None ->
- (* if [xp] have no provided symbol table, the whole package is exported. *)
- x_check this x_key lxm
- | Some xp_prov_symbols ->
- let x_def = match find_x xp_prov_symbols xn lxm with
- | AstTabSymbol.Local x -> x
- | AstTabSymbol.Imported _ -> assert false (* should not occur *)
- in
- x_check_interface_do this x_key lxm xp_prov_symbols xp x_def
- ) in
- Hashtbl.replace tab x_key (Lic.Checked res);
- res
+ Hashtbl.add tab x_key Lic.Checking;
+ let (xp,xn) = (pack_of_x_key x_key, name_of_x_key x_key) in
+ let xp_prov_symbols_opt = AstTab.pack_prov_env ~lxm:lxm this.src_tab xp in
+ match xp_prov_symbols_opt with
+ | None ->
+ (* if [xp] have no provided symbol table, the whole package is exported. *)
+ x_check this x_key lxm
+ | Some xp_prov_symbols ->
+ let x_def = match find_x xp_prov_symbols xn lxm with
+ | AstTabSymbol.Local x -> x
+ | AstTabSymbol.Imported _ -> assert false (* should not occur *)
+ in
+ x_check_interface_do this x_key lxm xp_prov_symbols xp x_def
+ ) in
+ Hashtbl.replace tab x_key (Lic.Checked res);
+ res
(* Returns the tabulated [type] or [const], if it has already been computed;
otherwise, raise [Not_found] otherwise. *)
@@ -263,7 +274,8 @@ let lookup_node_exp_eff
with Not_found -> (
Lv6Verbose.exe ~flag:dbg (
fun () ->
- Printf.fprintf stderr "#DBG: licTab.lookup_node_exp_eff: node key '%s' NOT FOUND\n"
+ Printf.fprintf
+ stderr "#DBG: licTab.lookup_node_exp_eff: node key '%s' NOT FOUND\n"
(Lic.string_of_node_key key);
flush stderr
);
@@ -329,19 +341,57 @@ let solve_x_idref
with Not_found ->
(raise (Compile_error(lxm,"unbounded " ^ x_label ^ " ident")))
-
-
-
(******************************************************************************)
-
+(* topologically sort vars wrt their clock dependecency *)
let find_var_info lxm vars id =
try Hashtbl.find vars.vartable id
with Not_found ->
raise (Compile_error (lxm,"\n*** Unknown ident: " ^ (Lv6Id.to_string id)))
+let find_direct_dep lxm v vars =
+ match (find_var_info lxm vars v).it.var_clock with
+ | Base -> None
+ | NamedClock({it=(_,vclk)}) -> Some vclk
+
+let dep_star lxm vl vars =
+ let tbl = Hashtbl.create (List.length vl) in
+ let rec find_deps v =
+ if Hashtbl.mem tbl v then Hashtbl.find tbl v else
+ match find_direct_dep lxm v vars with
+ | None -> []
+ | Some v2 ->
+ let v2_deps = find_deps v2 in
+ let v_deps = v2::v2_deps in
+ Hashtbl.add tbl v v_deps;
+ v_deps
+ in
+ List.iter
+ (fun v ->
+ match find_deps v with
+ | [] -> Hashtbl.remove tbl v (* cleaning *)
+ | _::_ -> ()
+ )
+ vl;
+ tbl
+
+module TopoSortVars =
+ TopoSort.Make(
+ struct
+ type elt = Lv6Id.t
+ type store = (Lv6Id.t, Lv6Id.t list) Hashtbl.t
+ let find_dep tbl x = try Hashtbl.find tbl x with Not_found -> []
+ let have_dep tbl x = try Hashtbl.find tbl x <> [] with Not_found -> false
+ let remove_dep tbl x = Hashtbl.remove tbl x; tbl
+ end
+ )
+let (sort_vars : Lxm.t -> AstCore.node_vars-> Lv6Id.t list -> Lv6Id.t list) =
+ fun lxm vars l -> (* we sort vars according to their clock deps *)
+ info "LicTab.sort_vars\n";
+ let tbl = dep_star lxm l vars in
+ TopoSortVars.f tbl l
-
+(******************************************************************************)
(* And now we can start the big mutually recursive definition... *)
(** Tabulated version of [type_check_do]. *)
@@ -364,7 +414,8 @@ and const_check
: Lic.const =
Lv6Verbose.exe ~flag:dbg (fun() -> Printf.printf
"#DBG: licTab.const_check '%s'\n" (Lv6Id.string_of_long2 key));
- x_check this.consts AstTabSymbol.find_const const_check_do const_builtin lookup_const_eff
+ x_check this.consts AstTabSymbol.find_const const_check_do const_builtin
+ lookup_const_eff
Lv6Id.pack_of_long Lv6Id.of_long this
key lxm
@@ -497,7 +548,8 @@ and (const_check_interface_do: t -> Lv6Id.long -> Lxm.t -> AstTabSymbol.t ->
const_def.src,
"\n*** provided constant does not match with its definition."))
| Lic.Tuple_const_eff _, _ ->
- print_internal_error "licTab.const_check_interface_do" "should not have been called for a tuple";
+ print_internal_error "licTab.const_check_interface_do"
+ "should not have been called for a tuple";
assert false
@@ -618,7 +670,8 @@ and (const_check_do : t -> Lv6Id.long -> Lxm.t -> AstTabSymbol.t -> bool ->
(* indeed, how can a body constant be extern and have a value? *)
)
| EnumConst (id, texp) ->
- Enum_const_eff ((Lv6Id.make_long currpack id), Ast2lic.of_type id_solver texp)
+ Enum_const_eff ((Lv6Id.make_long currpack id),
+ Ast2lic.of_type id_solver texp)
| DefinedConst (id, texp_opt, vexp ) -> (
match (EvalConst.f id_solver vexp) with
@@ -727,13 +780,15 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
else
match prov_node_exp_eff.def_eff, body_node_exp_eff.def_eff with
| AbstractLic None, BodyLic node_body ->
- { prov_node_exp_eff with def_eff = AbstractLic (Some body_node_exp_eff) }
+ { prov_node_exp_eff with def_eff =
+ AbstractLic (Some body_node_exp_eff) }
| _,_ ->
prov_node_exp_eff
(*
LE GROS DU BOULOT
- - suivant "provide_flag" : check d'interface (provide) ou le check de la définition
+ - suivant "provide_flag" : check d'interface (provide) ou le check
+ de la définition
(n.b. provide_flag influence la résolution des idents dans l'env local de check)
*)
and node_check_do
@@ -745,47 +800,48 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(pack_name: Lv6Id.pack_name)
(node_def: AstCore.node_info srcflagged)
: Lic.node_exp =
- (* START node_check_do *)
- (
- Lv6Verbose.exe ~flag:dbg (fun () -> Printf.printf
+ (* START node_check_do *)
+ info "node_check_do\n";
+ (
+ Lv6Verbose.exe ~flag:dbg (fun () -> Printf.printf
"#DBG: ENTERING node_check_do '%s'\n (%s)\n"
(Lic.string_of_node_key nk)
(Lxm.details lxm)
- );
- let lxm = node_def.src in
- (* Creates a local_env with just the global bindings,
+ );
+ let lxm = node_def.src in
+ (* Creates a local_env with just the global bindings,
local bindinds will be added later (side effect)
- *)
- let local_env = make_local_env nk in
- let _ =
- Lv6Verbose.exe ~flag:dbg (fun () ->
+ *)
+ let local_env = make_local_env nk in
+ let _ =
+ Lv6Verbose.exe ~flag:dbg (fun () ->
Printf.printf "# local_env while entering (node_check_do %s):\n"
- (Lic.string_of_node_key nk);
+ (Lic.string_of_node_key nk);
IdSolver.dump_local_env stderr local_env;
flush stdout
- )
- in
- let node_id_solver = {
- (* a [node_id_solver] is a [id_solver] where we begin to look
+ )
+ in
+ let node_id_solver = {
+ (* a [node_id_solver] is a [id_solver] where we begin to look
into the local environement before looking at the global
one. *)
- id2var = (* var can only be local to the node *)
- (fun id lxm ->
- try IdSolver.lookup_var local_env id lxm
- with Not_found ->
- raise (Unknown_var(lxm,id))
- );
- id2const =
- (fun id lxm ->
- try IdSolver.lookup_const local_env id lxm
- with Not_found ->
- solve_const_idref this symbols provide_flag pack_name id lxm
- );
- id2type =
- (fun id lxm ->
- try IdSolver.lookup_type local_env id lxm
- with Not_found ->
- Lv6Verbose.exe ~level:3 (
+ id2var = (* var can only be local to the node *)
+ (fun id lxm ->
+ try IdSolver.lookup_var local_env id lxm
+ with Not_found ->
+ raise (Unknown_var(lxm,id))
+ );
+ id2const =
+ (fun id lxm ->
+ try IdSolver.lookup_const local_env id lxm
+ with Not_found ->
+ solve_const_idref this symbols provide_flag pack_name id lxm
+ );
+ id2type =
+ (fun id lxm ->
+ try IdSolver.lookup_type local_env id lxm
+ with Not_found ->
+ Lv6Verbose.exe ~level:3 (
fun () ->
Printf.printf "*** Dont find type %s in local_env\n"
(Lv6Id.string_of_idref id);
@@ -797,343 +853,307 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
Printf.printf "\n";
flush stdout);
solve_type_idref this symbols provide_flag pack_name id lxm);
- id2node =
- (fun id sargs lxm ->
- (try
- let (node_id,sargs) = IdSolver.lookup_node local_env id lxm in
- let node_id = Lv6Id.idref_of_long node_id in
- solve_node_idref this symbols provide_flag pack_name node_id sargs lxm
- (* node_check this (node_id,[]) lxm *)
-
- with
- Not_found ->
- solve_node_idref this symbols provide_flag pack_name id sargs lxm
- | _ -> assert false)
- );
-
- (* ATTENTION EN SE SERVANT DE CA !
+ id2node =
+ (fun id sargs lxm ->
+ (try
+ let (node_id,sargs) = IdSolver.lookup_node local_env id lxm in
+ let node_id = Lv6Id.idref_of_long node_id in
+ solve_node_idref this symbols provide_flag pack_name node_id sargs lxm
+ (* node_check this (node_id,[]) lxm *)
+
+ with
+ Not_found ->
+ solve_node_idref this symbols provide_flag pack_name id sargs lxm
+ | _ -> assert false)
+ );
+
+ (* ATTENTION EN SE SERVANT DE CA !
ne tient pas compte des params statiques du noeud ! *)
- global_symbols = symbols;
- all_srcs = this.src_tab;
- }
- in
- let make_node_eff id node_def_eff = (
- (* building not aliased nodes *)
- Lv6Verbose.exe ~level:3
- (fun () -> Printf.printf
- "*** local_env while entering (make_node_eff %s):\n" (Lv6Id.to_string id);
- IdSolver.dump_local_env stderr local_env
- );
- (********************************************************)
- (* LOCAL CONSTANTS are evaluated and added to local_env *)
- (********************************************************)
- (* init intermediate table *)
- let sz = List.length node_def.it.loc_consts in
- let temp_const_eff_tab : (Lv6Id.long, Lic.const Lic.check_flag) Hashtbl.t =
- Hashtbl.create sz
- in
- let temp_const_def_tab :
- (Lv6Id.t,(Lxm.t * AstCore.type_exp option * AstCore.val_exp)) Hashtbl.t =
- Hashtbl.create sz
- in
- let init_local_const (lxm, cinfo) = (
- match cinfo with
- | DefinedConst (i,topt,ve) -> (
- Lv6Verbose.printf ~level:3 " * local const %s will be treated\n" i;
- Hashtbl.add temp_const_def_tab i (lxm,topt,ve)
- )
- | ExternalConst _
- | EnumConst _ -> (
- let msg = "*** abstract constant bot allowed within node "
- in
- raise (Compile_error(lxm, msg))
- )
- ) in
- List.iter init_local_const node_def.it.loc_consts ;
- (* differs from node_id_solver only on id2const *)
- let rec local_id_solver = {
- id2var = node_id_solver.id2var;
- id2const = local_id2const;
- id2type = node_id_solver.id2type;
- id2node = node_id_solver.id2node;
- global_symbols = node_id_solver.global_symbols;
- all_srcs = node_id_solver.all_srcs;
- }
- and treat_local_const id = (
- Lv6Verbose.printf ~level:3 " * call treat_local_const %s\n" id;
- let id_key = ("", id) in
- try (
- let ce = lookup_const_eff temp_const_eff_tab id_key lxm in
- Lv6Verbose.exe ~level:3 (fun() -> Printf.printf " * const %s already treated = %s\n"
- id (LicDump.string_of_const_eff ce));
- ce
- ) with Not_found -> (
- let (lxmdef, toptdef, vedef) = Hashtbl.find temp_const_def_tab id in
- Lv6Verbose.printf ~level:3 " * const %s not yet treated ...\n" id ;
- (* yes, not yet checked *)
- Hashtbl.add temp_const_eff_tab id_key Checking ;
- (* computes the value with EvalConst.f id_solver ve ... *)
- let ce = match (EvalConst.f local_id_solver vedef) with
- | [ceff] -> (
- match toptdef with
- | None -> ceff
- | Some texp -> (
- let tdecl = Ast2lic.of_type local_id_solver texp in
- let teff = Lic.type_of_const ceff in
- if (tdecl = teff ) then ceff else
- raise (Compile_error (
- lxmdef, Printf.sprintf
- " this constant is declared as '%s' but evaluated as '%s'"
+ global_symbols = symbols;
+ all_srcs = this.src_tab;
+ }
+ in
+ let make_node_eff id node_def_eff = (
+ (* building not aliased nodes *)
+ Lv6Verbose.exe ~level:3
+ (fun () -> Printf.printf
+ "*** local_env while entering (make_node_eff %s):\n" (Lv6Id.to_string id);
+ IdSolver.dump_local_env stderr local_env
+ );
+ (********************************************************)
+ (* LOCAL CONSTANTS are evaluated and added to local_env *)
+ (********************************************************)
+ (* init intermediate table *)
+ let sz = List.length node_def.it.loc_consts in
+ let temp_const_eff_tab : (Lv6Id.long, Lic.const Lic.check_flag) Hashtbl.t =
+ Hashtbl.create sz
+ in
+ let temp_const_def_tab :
+ (Lv6Id.t,(Lxm.t * AstCore.type_exp option * AstCore.val_exp)) Hashtbl.t =
+ Hashtbl.create sz
+ in
+ let init_local_const (lxm, cinfo) = (
+ match cinfo with
+ | DefinedConst (i,topt,ve) -> (
+ Lv6Verbose.printf ~level:3 " * local const %s will be treated\n" i;
+ Hashtbl.add temp_const_def_tab i (lxm,topt,ve)
+ )
+ | ExternalConst _
+ | EnumConst _ -> (
+ let msg = "*** abstract constant bot allowed within node "
+ in
+ raise (Compile_error(lxm, msg))
+ )
+ ) in
+ List.iter init_local_const node_def.it.loc_consts ;
+ (* differs from node_id_solver only on id2const *)
+ let rec local_id_solver = {
+ id2var = node_id_solver.id2var;
+ id2const = local_id2const;
+ id2type = node_id_solver.id2type;
+ id2node = node_id_solver.id2node;
+ global_symbols = node_id_solver.global_symbols;
+ all_srcs = node_id_solver.all_srcs;
+ }
+ and treat_local_const id = (
+ Lv6Verbose.printf ~level:3 " * call treat_local_const %s\n" id;
+ let id_key = ("", id) in
+ try (
+ let ce = lookup_const_eff temp_const_eff_tab id_key lxm in
+ Lv6Verbose.exe ~level:3 (fun() -> Printf.printf
+ " * const %s already treated = %s\n"
+ id (LicDump.string_of_const_eff ce));
+ ce
+ ) with Not_found -> (
+ let (lxmdef, toptdef, vedef) = Hashtbl.find temp_const_def_tab id in
+ Lv6Verbose.printf ~level:3 " * const %s not yet treated ...\n" id ;
+ (* yes, not yet checked *)
+ Hashtbl.add temp_const_eff_tab id_key Checking ;
+ (* computes the value with EvalConst.f id_solver ve ... *)
+ let ce = match (EvalConst.f local_id_solver vedef) with
+ | [ceff] -> (
+ match toptdef with
+ | None -> ceff
+ | Some texp -> (
+ let tdecl = Ast2lic.of_type local_id_solver texp in
+ let teff = Lic.type_of_const ceff in
+ if (tdecl = teff ) then ceff else
+ raise (Compile_error (
+ lxmdef, Printf.sprintf " this constant is declared as '%s' but evaluated as '%s'"
(Lic.string_of_type tdecl)
(Lic.string_of_type teff)
- )))
- )
- | [] -> assert false (* should not occur *)
- | _::_ -> raise (Compile_error(lxmdef, "bad constant value: tuple not allowed"))
- in
- Lv6Verbose.exe ~level:3 (fun() -> Printf.printf " * const %s evaluated to %s\n"
+ )))
+ )
+ | [] -> assert false (* should not occur *)
+ | _::_ -> raise (Compile_error(lxmdef, "bad constant value: tuple not allowed"))
+ in
+ Lv6Verbose.exe ~level:3 (fun() -> Printf.printf " * const %s evaluated to %s\n"
id (LicDump.string_of_const_eff ce));
- Hashtbl.replace temp_const_eff_tab id_key (Checked ce) ;
- ce
- )
- )
- and local_id2const idrf lxm = (
- (* is id a local const ? *)
- try (
- (* certainly NOT if id has a pack *)
- let id = if (Lv6Id.pack_of_idref idrf = None)
- then Lv6Id.name_of_idref idrf
- else raise Not_found
- in
- let ce = treat_local_const id in
- ce
- ) with Not_found -> (
- (* not a local constant -> search in global env *)
- Lv6Verbose.printf ~level:3
- " * %s not a local const, should be global ?" (Lv6Id.string_of_idref idrf);
- let ce = node_id_solver.id2const idrf lxm in
- Lv6Verbose.exe ~level:3 (fun() -> Printf.printf
+ Hashtbl.replace temp_const_eff_tab id_key (Checked ce) ;
+ ce
+ )
+ )
+ and local_id2const idrf lxm = (
+ (* is id a local const ? *)
+ try (
+ (* certainly NOT if id has a pack *)
+ let id = if (Lv6Id.pack_of_idref idrf = None)
+ then Lv6Id.name_of_idref idrf
+ else raise Not_found
+ in
+ let ce = treat_local_const id in
+ ce
+ ) with Not_found -> (
+ (* not a local constant -> search in global env *)
+ Lv6Verbose.printf ~level:3
+ " * %s not a local const, should be global ?"
+ (Lv6Id.string_of_idref idrf);
+ let ce = node_id_solver.id2const idrf lxm in
+ Lv6Verbose.exe ~level:3 (fun() -> Printf.printf
" YES -> %s\n" (LicDump.string_of_const_eff ce));
ce
- )
- ) in
- (* iters local_id2const n eeach declared constant *)
- Hashtbl.iter (fun id _ -> let _ = treat_local_const id in ()) temp_const_def_tab ;
- (* Finally, adds each local const to ICI *)
- let add_local_const idref ceck = (
- Lv6Verbose.exe ~level:3 (fun() -> Printf.printf
- " * add_local_const %s = %s\n"
- (snd idref)
- (match ceck with
- | Checking -> "Checking"
- | Checked ce -> (LicDump.string_of_const_eff ce)
- | Incorrect -> "Incorrect"
- ));
- match ceck with
- | Checked ce -> Hashtbl.add local_env.lenv_const (snd idref) ce
- | _ -> assert false
- ) in
- Hashtbl.iter add_local_const temp_const_eff_tab ;
+ )
+ ) in
+ (* iters local_id2const n eeach declared constant *)
+ Hashtbl.iter (fun id _ -> let _ = treat_local_const id in ())
+ temp_const_def_tab ;
+ (* Finally, adds each local const to ICI *)
+ let add_local_const idref ceck = (
+ Lv6Verbose.exe ~level:3
+ (fun() -> Printf.printf
+ " * add_local_const %s = %s\n"
+ (snd idref)
+ (match ceck with
+ | Checking -> "Checking"
+ | Checked ce -> (LicDump.string_of_const_eff ce)
+ | Incorrect -> "Incorrect"
+ ));
+ match ceck with
+ | Checked ce -> Hashtbl.add local_env.lenv_const (snd idref) ce
+ | _ -> assert false
+ ) in
+ Hashtbl.iter add_local_const temp_const_eff_tab ;
- (********************************************************)
- (* LOCAL FLOWS are added to local_env *)
- (********************************************************)
- (* (i.e. ins,outs,locs) *)
- match node_def.it.vars with
- | None -> assert false (* a node with a body should have a profile *)
- | Some vars ->
- (* let is_polymorphic = ref false in *)
- let type_args id =
- let vi = find_var_info lxm vars id in
- let t_eff = Ast2lic.of_type node_id_solver vi.it.var_type in
- (* let _ = if Lic.is_polymorphic t_eff then is_polymorphic := true in *)
- let c_eff = Ast2lic.of_clock node_id_solver vi.it in
- let vi_eff = {
- var_name_eff = vi.it.var_name;
- var_nature_eff = vi.it.var_nature;
- var_number_eff = vi.it.var_number;
- var_type_eff = t_eff;
- var_clock_eff = c_eff;
- }
- in
- Hashtbl.add local_env.lenv_types id t_eff;
- Hashtbl.add local_env.lenv_vars id vi_eff;
- vi_eff
- in
- let (sort_vars : Lv6Id.t list -> Lv6Id.t list) =
- fun l ->
- (* I cannot use List.sort as I only have a partial order on vars
- -> hence I perform a topological sort *)
- let rec depends_on v1 v2 =
- match (find_var_info lxm vars v1).it.var_clock with
- | Base -> false
- | NamedClock({it=(_,v1clk)}) -> v1clk = v2 || depends_on v1clk v2
- in
- let rec aux acc l = match l with
- | [] -> acc
- | v::tail -> (
- match (find_var_info lxm vars v).it.var_clock with
- | Base ->
- if List.mem v acc then
- aux acc tail
- else
- aux (v::acc) tail
- | NamedClock( { it=(_,v2) ; src=lxm }) ->
- if List.mem v2 acc then
- aux (v::acc) tail
- else if
- depends_on v2 v
- then
- raise (
- Compile_error (
- lxm,
- "\n*** Clock dependency loop: " ^
- (Lv6Id.to_string v) ^ " depends on " ^
- (Lv6Id.to_string v2) ^ ", which depends on " ^
- (Lv6Id.to_string v))
- )
- else
- let l1,l2 = List.partition (fun v -> v=v2) l in
- if l1 = [] then
- (* v depends on a clock not in l *)
- aux (v::acc) tail
- else
- aux acc (v2::l2)
- )
- in
- List.rev(aux [] l)
- in
- let vars_in_sorted = sort_vars vars.inlist
- and vars_out_sorted = sort_vars vars.outlist in
- let inlist = List.map type_args vars_in_sorted
- and outlist = List.map type_args vars_out_sorted
- and loclist =
- match vars.loclist with
- | None -> None
- | Some loclist ->
- let vars_loc_sorted = sort_vars loclist in
- Some (List.map type_args vars_loc_sorted)
- in
- let unsort l_id l_vi =
- let tab = List.map (fun vi -> vi.var_name_eff, vi) l_vi in
- try List.map (fun id -> List.assoc id tab) l_id
- with Not_found -> assert false
- in
- let inlist2 = unsort vars.inlist inlist
- and outlist2 = unsort vars.outlist outlist in
- {
- node_key_eff = nk;
- inlist_eff = inlist2;
- outlist_eff = outlist2;
- loclist_eff = loclist;
- def_eff = node_def_eff ();
- has_mem_eff = node_def.it.has_mem;
- is_safe_eff = node_def.it.is_safe;
- lxm = node_def.src;
- (* is_polym_eff = !is_polymorphic *)
- }
- ) in
- (* let's go *)
- let res =
- match node_def.it.def with
- | Abstract -> make_node_eff node_def.it.name (fun () -> AbstractLic None)
- | Extern -> make_node_eff node_def.it.name (fun () -> ExternLic)
- | Body nb ->
- make_node_eff node_def.it.name (
- (fun () -> (* trick to force to delay this evaluation
+ (********************************************************)
+ (* LOCAL FLOWS are added to local_env *)
+ (********************************************************)
+ (* (i.e. ins,outs,locs) *)
+ match node_def.it.vars with
+ | None -> assert false (* a node with a body should have a profile *)
+ | Some vars ->
+ (* let is_polymorphic = ref false in *)
+ let type_args id =
+ let vi = find_var_info lxm vars id in
+ let t_eff = Ast2lic.of_type node_id_solver vi.it.var_type in
+ (* let _ = if Lic.is_polymorphic t_eff then is_polymorphic := true in *)
+ let c_eff = Ast2lic.of_clock node_id_solver vi.it in
+ let vi_eff = {
+ var_name_eff = vi.it.var_name;
+ var_nature_eff = vi.it.var_nature;
+ var_number_eff = vi.it.var_number;
+ var_type_eff = t_eff;
+ var_clock_eff = c_eff;
+ }
+ in
+ Hashtbl.add local_env.lenv_types id t_eff;
+ Hashtbl.add local_env.lenv_vars id vi_eff;
+ vi_eff
+ in
+ let vars_in_sorted = sort_vars lxm vars vars.inlist
+ and vars_out_sorted = sort_vars lxm vars vars.outlist in
+ let inlist = List.map type_args vars_in_sorted
+ and outlist = List.map type_args vars_out_sorted
+ and loclist =
+ match vars.loclist with
+ | None -> None
+ | Some loclist ->
+ let vars_loc_sorted = sort_vars lxm vars loclist in
+ Some (List.map type_args vars_loc_sorted)
+ in
+ let unsort l_id l_vi =
+ let tab = List.map (fun vi -> vi.var_name_eff, vi) l_vi in
+ try List.map (fun id -> List.assoc id tab) l_id
+ with Not_found -> assert false
+ in
+ info "LicTab.unsort\n";
+ let inlist2 = unsort vars.inlist inlist
+ and outlist2 = unsort vars.outlist outlist in
+ {
+ node_key_eff = nk;
+ inlist_eff = inlist2;
+ outlist_eff = outlist2;
+ loclist_eff = loclist;
+ def_eff = node_def_eff ();
+ has_mem_eff = node_def.it.has_mem;
+ is_safe_eff = node_def.it.is_safe;
+ lxm = node_def.src;
+ (* is_polym_eff = !is_polymorphic *)
+ }
+ ) in
+ (* let's go *)
+ let res =
+ match node_def.it.def with
+ | Abstract -> make_node_eff node_def.it.name (fun () -> AbstractLic None)
+ | Extern -> make_node_eff node_def.it.name (fun () -> ExternLic)
+ | Body nb ->
+ make_node_eff node_def.it.name (
+ (fun () -> (* trick to force to delay this evaluation
after the local_env.lenv_vars has been
filled
*)
- let eq_eff = List.map (Ast2lic.of_eq node_id_solver) nb.eqs in
- BodyLic {
- asserts_eff =
- List.map (Ast2lic.of_assertion node_id_solver) nb.asserts;
- eqs_eff = eq_eff;
- }
- )
- )
-
- | Alias({it= alias;src=lxm}) -> (
- let aliased_node =
- match alias with
- (* 12/07 SOLUTION INTERMEDIAIRE
+ let eq_eff = List.map (Ast2lic.of_eq node_id_solver) nb.eqs in
+ BodyLic {
+ asserts_eff =
+ List.map (Ast2lic.of_assertion node_id_solver) nb.asserts;
+ eqs_eff = eq_eff;
+ }
+ )
+ )
+
+ | Alias({it= alias;src=lxm}) -> (
+ let aliased_node =
+ match alias with
+ (* 12/07 SOLUTION INTERMEDIAIRE
- les macros predefs sont traitées comme des call
- *)
- | Predef_n(op) ->
- let predef_op = op.it in
- let _ = match predef_op with
- | AstPredef.NOR_n | AstPredef.DIESE_n ->
- raise (Compile_error (lxm, "Can not alias 'nor' nor '#', sorry"))
- | _ -> ()
- in
- let predef_op_eff =
- LicEvalType.make_node_exp_eff node_id_solver
- (Some node_def.it.has_mem) true predef_op lxm
- in
- predef_op_eff
-
- | CALL_n(node_alias) ->
- Ast2lic.of_node node_id_solver node_alias
- | (ARRAY_SLICE_n _|ARRAY_ACCES_n _|STRUCT_ACCESS_n _
- |IDENT_n _|ARRAY_n|HAT_n|CONCAT_n|WITH_n(_)|TUPLE_n|WHEN_n _
- |CURRENT_n|FBY_n|ARROW_n|PRE_n)
- ->
- raise (Compile_error (lxm, "can not alias this operator, sorry"))
- (* does it make sense to alias when, pre, etc? *)
+ *)
+ | Predef_n(op) ->
+ let predef_op = op.it in
+ let _ = match predef_op with
+ | AstPredef.NOR_n
+ | AstPredef.DIESE_n ->
+ raise (Compile_error (lxm, "Can not alias 'nor' nor '#', sorry"))
+ | _ -> ()
+ in
+ let predef_op_eff = LicEvalType.make_node_exp_eff
+ node_id_solver (Some node_def.it.has_mem)
+ true predef_op lxm
+ in
+ predef_op_eff
+
+ | CALL_n(node_alias) ->
+ Ast2lic.of_node node_id_solver node_alias
+ | (ARRAY_SLICE_n _|ARRAY_ACCES_n _|STRUCT_ACCESS_n _
+ |IDENT_n _|ARRAY_n|HAT_n|CONCAT_n|WITH_n(_)|TUPLE_n|WHEN_n _
+ |CURRENT_n|FBY_n|ARROW_n|PRE_n)
+ ->
+ raise (Compile_error (lxm, "can not alias this operator, sorry"))
+ (* does it make sense to alias when, pre, etc? *)
+ in
+ let (vil, vol) =
+ match node_def.it.vars with
+ | None -> aliased_node.inlist_eff, aliased_node.outlist_eff
+ | Some (vars) ->
+ (* a type profile is declared; let's check there are compatible *)
+ let (il,ol) = profile_of_node_exp aliased_node in
+ let (il_decl, ol_decl) =
+ let vi_il, vi_ol =
+ List.map (fun id -> find_var_info lxm vars id) vars.AstCore.inlist,
+ List.map (fun id -> find_var_info lxm vars id) vars.AstCore.outlist
in
- let (vil, vol) =
- match node_def.it.vars with
- | None -> aliased_node.inlist_eff, aliased_node.outlist_eff
- | Some (vars) ->
- (* a type profile is declared; let's check there are compatible *)
- let (il,ol) = profile_of_node_exp aliased_node in
- let (il_decl, ol_decl) =
- let vi_il, vi_ol =
- List.map (fun id -> find_var_info lxm vars id) vars.AstCore.inlist,
- List.map (fun id -> find_var_info lxm vars id) vars.AstCore.outlist
- in
- let aux vi = Ast2lic.of_type node_id_solver vi.it.var_type in
- let (il_decl, ol_decl) = List.map aux vi_il, List.map aux vi_ol in
- let i_unif_res = UnifyType.f il_decl il
- and o_unif_res = UnifyType.f ol_decl ol
- in
- (match i_unif_res with
- | UnifyType.Ko msg -> raise(Compile_error(lxm, msg))
- | UnifyType.Equal -> ()
- | UnifyType.Unif t -> ()
- (* Ast2lic.dump_polymorphic_nodes t *)
- );
- (match o_unif_res with
- | UnifyType.Ko msg -> raise(Compile_error (lxm, msg))
- | UnifyType.Equal -> ()
- | UnifyType.Unif t -> ()
- (* Ast2lic.dump_polymorphic_nodes t *)
- );
- (* ok, there are compatible. We use the declared profile. *)
- (il_decl, ol_decl)
- in
- let instanciate_var_info vi t = { vi with var_type_eff = t } in
- let vil = List.map2 instanciate_var_info aliased_node.inlist_eff il_decl
- and vol = List.map2 instanciate_var_info aliased_node.outlist_eff ol_decl in
- vil,vol
+ let aux vi = Ast2lic.of_type node_id_solver vi.it.var_type in
+ let (il_decl, ol_decl) = List.map aux vi_il, List.map aux vi_ol in
+ let i_unif_res = UnifyType.f il_decl il
+ and o_unif_res = UnifyType.f ol_decl ol
in
- let (alias_node : Lic.node_exp) =
- try make_alias_node aliased_node nk local_env node_id_solver
- vil vol node_def.src
+ (match i_unif_res with
+ | UnifyType.Ko msg -> raise(Compile_error(lxm, msg))
+ | UnifyType.Equal -> ()
+ | UnifyType.Unif t -> ()
+ (* Ast2lic.dump_polymorphic_nodes t *)
+ );
+ (match o_unif_res with
+ | UnifyType.Ko msg -> raise(Compile_error (lxm, msg))
+ | UnifyType.Equal -> ()
+ | UnifyType.Unif t -> ()
+ (* Ast2lic.dump_polymorphic_nodes t *)
+ );
+ (* ok, there are compatible. We use the declared profile. *)
+ (il_decl, ol_decl)
+ in
+ let instanciate_var_info vi t = { vi with var_type_eff = t } in
+ let vil = List.map2 instanciate_var_info aliased_node.inlist_eff
+ il_decl
+ and vol = List.map2 instanciate_var_info aliased_node.outlist_eff
+ ol_decl in
+ vil,vol
+ in
+ let (alias_node : Lic.node_exp) =
+ try make_alias_node aliased_node nk local_env node_id_solver
+ vil vol node_def.src
with Not_found -> assert false (* defense against List.assoc *)
in
alias_node
- )
- (* End Alias *)
- in
- L2lCheckOutputs.check_node res;
+ )
+ (* End Alias *)
+ in
+ L2lCheckOutputs.check_node res;
(* gen_code provide_flag current_env res; *)
- Lv6Verbose.exe ~flag:dbg (fun() -> Printf.printf
- "#DBG: EXITING node_check_do '%s'\n"
- (Lic.string_of_node_key nk)
- );
- res
- )
+ Lv6Verbose.exe ~flag:dbg (fun() -> Printf.printf
+ "#DBG: EXITING node_check_do '%s'\n"
+ (Lic.string_of_node_key nk)
+ );
+ res
+ )
(*END node_check_do *)
(*
@@ -1200,7 +1220,8 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
{ asserts_eff = [];
eqs_eff = [Lxm.flagit (outs, aliased_node_call) lxm]
});
- (* is_polym_eff = List.exists is_polymorphic (List.map (fun vi -> vi.var_type_eff) (vil@vol)); *)
+ (* is_polym_eff = List.exists is_polymorphic (List.map (fun vi
+ -> vi.var_type_eff) (vil@vol)); *)
}
in
(* update the local_env table *)
@@ -1237,23 +1258,21 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
)
this symbols provide_flag currpack idr sargs lxm
- and node_check
- (this: t)
- (nk: Lic.node_key)
- (lxm: Lxm.t)
- : Lic.node_exp =
-
- Lv6Verbose.printf ~flag:dbg "#DBG: licTab.node_check '%s'\n" (Lic.string_of_node_key nk);
+ and node_check (this: t) (nk: Lic.node_key) (lxm: Lxm.t) : Lic.node_exp =
+ Lv6Verbose.printf ~flag:dbg
+ "#DBG: licTab.node_check '%s'\n" (Lic.string_of_node_key nk);
try (
let pack_of_x_key = fun nk -> Lv6Id.pack_of_long (fst nk) in
let name_of_x_key = fun nk -> Lv6Id.of_long (fst nk) in
- x_check this.nodes AstTabSymbol.find_node node_check_do node_builtin lookup_node_exp_eff
- pack_of_x_key
- name_of_x_key
- this nk lxm
+ x_check this.nodes AstTabSymbol.find_node node_check_do
+ node_builtin lookup_node_exp_eff
+ pack_of_x_key
+ name_of_x_key
+ this nk lxm
) with
Recursion_error (n, stack) ->
- let msg = "Recursion loop detected in node " ^ (Lv6Id.string_of_long2 (fst nk)) in
+ let msg = "Recursion loop detected in node " ^
+ (Lv6Id.string_of_long2 (fst nk)) in
let msg = msg ^ "\n*** "^ (Lv6Id.string_of_long2 n) ^ " depends on itself\n "
^ (String.concat "\n*****" stack) in
raise (Compile_error (lxm, msg))
@@ -1263,7 +1282,8 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(nk: Lic.node_key)
(lxm: Lxm.t)
: Lic.node_exp =
- Lv6Verbose.printf ~flag:dbg "#DBG: licTab.node_check_interface '%s'\n" (Lic.string_of_node_key nk);
+ Lv6Verbose.printf ~flag:dbg "#DBG: licTab.node_check_interface '%s'\n"
+ (Lic.string_of_node_key nk);
x_check_interface this.prov_nodes AstTabSymbol.find_node node_check
node_check_interface_do node_builtin lookup_node_exp_eff
(fun nk -> Lv6Id.pack_of_long (fst nk))
@@ -1379,6 +1399,7 @@ let compile_all (this:t) : t =
let compile_node (this:t) (main_node:Lv6Id.idref) : t =
(* la clée "absolue" du main node (pas d'args statiques) *)
let main_node_key = node_key_of_idref main_node in
+ info "LicTab.compile_node\n";
Lv6Verbose.printf
"-- MAIN NODE: \"%s\"\n"
(LicDump.string_of_node_key_rec false main_node_key);
diff --git a/src/lv6Compile.ml b/src/lv6Compile.ml
index d631f970..9aa33fc3 100644
--- a/src/lv6Compile.ml
+++ b/src/lv6Compile.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/01/2016 (at 10:42) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/02/2016 (at 15:44) by Erwan Jahier> *)
open Lxm
open Lv6errors
@@ -15,7 +15,7 @@ let info msg =
let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> LicPrg.t) =
fun opt srclist main_node ->
(* let t0 = Sys.time() in *)
- info "Start compiling to lic...\n";
+ info "Lv6Compile: Start!\n";
let syntax_tab = AstTab.create srclist in
(* Pour chaque package, on a un solveur de références
globales, pour les types, const et node :
@@ -31,7 +31,7 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> L
let lic_tab = LicTab.create syntax_tab in
Lv6Verbose.exe ~flag:dbg (fun () -> AstTab.dump syntax_tab);
- info "Compiling into lic...\n";
+ info "Lv6Compile: Compiling into lic\n";
let lic_tab = match main_node with
| None -> LicTab.compile_all lic_tab
| Some main_node ->
diff --git a/src/lv6version.ml b/src/lv6version.ml
index 4913c107..bce7e483 100644
--- a/src/lv6version.ml
+++ b/src/lv6version.ml
@@ -1,7 +1,7 @@
(** Automatically generated from Makefile *)
let tool = "lus2lic"
let branch = "master"
-let commit = "640"
-let sha_1 = "ed60151225485eeab12d7f347632e47f99e47eee"
+let commit = "641"
+let sha_1 = "b57372e15caf72a8958ade4e74927fd97f890766"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "jahier@imag.fr"
diff --git a/src/topoSort.ml b/src/topoSort.ml
index da11bfdc..b8d87757 100644
--- a/src/topoSort.ml
+++ b/src/topoSort.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 03/02/2016 (at 10:05) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/02/2016 (at 14:40) by Erwan Jahier> *)
module type PartialOrder =
@@ -74,7 +74,9 @@ let (f : store -> elt list -> elt list) =
match l with
| [] -> List.rev acc
| x::tail ->
- if (try Mapt.find x visited with Not_found -> assert false)
+ if (try Mapt.find x visited
+ with Not_found ->
+ true (* migth occur if a dep is not the list to be sorted *))
then
aux store acc tail visited
else
diff --git a/src/unifyClock.ml b/src/unifyClock.ml
index c0eeb5be..2fe959e6 100644
--- a/src/unifyClock.ml
+++ b/src/unifyClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/01/2016 (at 10:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/02/2016 (at 15:47) by Erwan Jahier> *)
(* XXX a revoir et faire comme expliqué ici :
http://www.cs.cornell.edu/courses/cs3110/2011sp/lectures/lec26-type-inference/type-inference.htm
@@ -274,9 +274,10 @@ let (f : subst -> Lxm.t -> Lic.clock -> Lic.clock -> subst) =
in
if compatible then (
if s <> (s1,s2) then
- Lv6Verbose.print_string ~flag:dbg (
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ print_string (
"# clock checking ("^(Lxm.position lxm)^"), unifying '" ^ (ci2str arg) ^
- "' and '" ^ (ci2str par) ^ "': "^ (subst_to_string s) ^"\n");
+ "' and '" ^ (ci2str par) ^ "': "^ (subst_to_string s) ^"\n"));
s
)
else
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 9b4bcf1e..7abaf730 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test Run By jahier on Wed Feb 3 09:55:09
+Test Run By jahier on Wed Feb 3 14:35:34
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic0 tests ===
@@ -64,7 +64,7 @@ XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/lecte
XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/s.lus
==> lus2lic1.sum <==
-Test Run By jahier on Wed Feb 3 09:55:10
+Test Run By jahier on Wed Feb 3 14:35:34
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic1 tests ===
@@ -396,7 +396,7 @@ PASS: gcc -o multipar.exec multipar_multipar.c multipar_multipar_loop.c
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus {}
==> lus2lic2.sum <==
-Test Run By jahier on Wed Feb 3 09:55:25
+Test Run By jahier on Wed Feb 3 14:35:36
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic2 tests ===
@@ -741,7 +741,7 @@ PASS: gcc -o zzz2.exec zzz2_zzz2.c zzz2_zzz2_loop.c
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c zzz2.lus {}
==> lus2lic3.sum <==
-Test Run By jahier on Wed Feb 3 09:56:12
+Test Run By jahier on Wed Feb 3 14:35:36
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic3 tests ===
@@ -1243,7 +1243,7 @@ PASS: ./myec2c {-o multipar.c multipar.ec}
PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node multipar.lus {}
==> lus2lic4.sum <==
-Test Run By jahier on Wed Feb 3 09:56:26
+Test Run By jahier on Wed Feb 3 14:35:38
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic4 tests ===
@@ -1765,13 +1765,11 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
===============================
# Total number of failures: 23
lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 1 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 15 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 47 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 14 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 49 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 21 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 50 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 18 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 54 seconds
* Ref time:
-0.04user 0.03system 2:05.33elapsed 0%CPU (0avgtext+0avgdata 5208maxresident)k
-0inputs+0outputs (0major+5552minor)pagefaults 0swaps
* Quick time (-j 4):
-0.05user 0.01system 0:53.79elapsed 0%CPU (0avgtext+0avgdata 5220maxresident)k
-32inputs+0outputs (0major+5577minor)pagefaults 0swaps
+0.03user 0.02system 0:57.63elapsed 0%CPU (0avgtext+0avgdata 5140maxresident)k
+0inputs+0outputs (0major+5592minor)pagefaults 0swaps
--
GitLab