Commit 6fbc504c authored by Erwan Jahier's avatar Erwan Jahier

Fix a performance bug in Lutin due to the fact that in the main at each step,

the tables were not cleaned !

nb : to track this, i've replaced StringMap.find and Hashtbl.find by
   mfind and hfind defined in Util and used everywhere.
parent c0c3ea3a
......@@ -623,7 +623,7 @@ let (make_one : t -> LucParse.t -> t) =
(* exported *)
let (is_node_transient : LucParse.node -> t -> bool) =
fun n prog ->
try (Hashtbl.find prog.node n).node_type = Transient
try (Util.hfind prog.node n).node_type = Transient
with Not_found ->
print_string ("Node " ^ n ^ " not found.\n");
flush stdout;
......@@ -632,7 +632,7 @@ let (is_node_transient : LucParse.node -> t -> bool) =
(* exported *)
let (is_node_final : LucParse.node -> t -> bool) =
fun n prog ->
try (Hashtbl.find prog.node n).node_type = Final
try (Util.hfind prog.node n).node_type = Final
with Not_found ->
print_string ("Node " ^ n ^ " not found.\n");
flush stdout;
......
......@@ -79,7 +79,7 @@ let make
(* pour les dumps des vars support *)
(* Hashtbl.iter (print_support Local) (Expand.support_tab source_code); *)
let print_support nme = (
let info = Hashtbl.find (Expand.support_tab source_code) nme in
let info = Util.hfind (Expand.support_tab source_code) nme in
fprintf os " %s : %s"
(CoIdent.to_string nme)
(CkTypeEff.to_string info.si_type);
......@@ -104,7 +104,7 @@ let make
(* pour les dumps de la liste d'alias *)
let print_alias nme = (
let info = Hashtbl.find
let info = Util.hfind
(Expand.alias_tab source_code) nme in
fprintf os " %s : %s"
(CoIdent.to_string nme)
......
......@@ -320,10 +320,10 @@ let gentrans
N.B. on traque les rcursions ? *)
(*-------------------------------------------*)
let id2trace s = (
(Hashtbl.find (Expand.trace_tab xenv) s).ti_def_exp
(Util.hfind (Expand.trace_tab xenv) s).ti_def_exp
) in
let unalias s = (
(Hashtbl.find (Expand.alias_tab xenv) s).ai_def_exp
(Util.hfind (Expand.alias_tab xenv) s).ai_def_exp
) in
(*-------------------------------------------*)
......@@ -753,7 +753,7 @@ let new_transient_state (it: t) (father: string) (index: int) = (
(** recherche/cre une association trace/state *)
let get_stable (it:t) e = (
try (
Hashtbl.find it._trace2state e
Util.hfind it._trace2state e
) with Not_found -> (
let res = new_stable_state it e in
Verbose.exe ~level:3
......@@ -771,7 +771,7 @@ Verbose.exe ~level:3
*)
let get_sink (it:t) x = (
try (
let _ = Hashtbl.find it.states x in x
let _ = Util.hfind it.states x in x
) with Not_found -> (
Verbose.put ~level:3 "##new sink=\"%s\"\n" x ;
Hashtbl.add it.states x (SS_final x);
......@@ -800,7 +800,7 @@ let init (xenv : Expand.t) = (
todo = [];
} in
let is = Expand.main_trace xenv in
let ie = (Hashtbl.find (Expand.trace_tab xenv) is).ti_def_exp in
let ie = (Util.hfind (Expand.trace_tab xenv) is).ti_def_exp in
res.init_control <- get_stable res ie;
res.final_control <- get_sink res "vanish";
res
......@@ -829,22 +829,22 @@ let rec ttree2trans (it:t) (src: string) (tt : ttree) = (
let get_state_def (it:t) (ix: string) = (
Hashtbl.find it._state2trace ix
Util.hfind it._state2trace ix
)
let get_state_info (it:t) (ix: string) = (
Hashtbl.find it.states ix
Util.hfind it.states ix
)
(*
*)
let config2ttree (it:t) (cfg: config) = (
let ix = cfg.control in
let e = Hashtbl.find it._state2trace ix in
let e = Util.hfind it._state2trace ix in
let data = cfg.data in
(* use cash *)
let res = try (
let tt = Hashtbl.find it._config2ttree cfg in
let tt = Util.hfind it._config2ttree cfg in
Verbose.put ~level:2 "##config2ttree: \"%s\" cached\n" ix ;
if (Utils.paranoid ()) then (
let tt' = gentrans it.source_code data e in
......
......@@ -346,10 +346,10 @@ let gentrans
N.B. on traque les récursions ? *)
(*-------------------------------------------*)
let id2trace s = (
(Hashtbl.find (Expand.trace_tab xenv) s).ti_def_exp
(Util.hfind (Expand.trace_tab xenv) s).ti_def_exp
) in
let unalias s = (
(Hashtbl.find (Expand.alias_tab xenv) s).ai_def_exp
(Util.hfind (Expand.alias_tab xenv) s).ai_def_exp
) in
(*-------------------------------------------*)
......@@ -820,7 +820,7 @@ let new_transient_state (it: t) (father: string) (index: int) = (
(** recherche/crée une association trace/state *)
let get_stable (it:t) e = (
try (
Hashtbl.find it._trace2state e
Util.hfind it._trace2state e
) with Not_found -> (
let res = new_stable_state it e in
Verbose.exe ~level:3 (fun () -> Printf.printf "##new state=\"%s\" exp=%s\n" res (CoTraceExp.dumps e));
......@@ -837,7 +837,7 @@ Verbose.exe ~level:3 (fun () -> Printf.printf "##new state=\"%s\" exp=%s\n" res
*)
let get_sink (it:t) x = (
try (
let _ = Hashtbl.find it.states x in x
let _ = Util.hfind it.states x in x
) with Not_found -> (
Verbose.put ~level:3 "##new sink=\"%s\"\n" x ;
Hashtbl.add it.states x (SS_final x);
......@@ -866,7 +866,7 @@ let init (xenv : Expand.t) = (
todo = [];
} in
let is = Expand.main_trace xenv in
let ie = (Hashtbl.find (Expand.trace_tab xenv) is).ti_def_exp in
let ie = (Util.hfind (Expand.trace_tab xenv) is).ti_def_exp in
res.init_control <- get_stable res ie;
res.final_control <- get_sink res "vanish";
res
......@@ -895,22 +895,22 @@ let rec ttree2trans (it:t) (src: string) (tt : ttree) = (
let get_state_def (it:t) (ix: string) = (
Hashtbl.find it._state2trace ix
Util.hfind it._state2trace ix
)
let get_state_info (it:t) (ix: string) = (
Hashtbl.find it.states ix
Util.hfind it.states ix
)
(*
*)
let config2ttree (it:t) (cfg: config) = (
let ix = cfg.control in
let e = Hashtbl.find it._state2trace ix in
let e = Util.hfind it._state2trace ix in
let data = cfg.data in
(* use cash *)
let res = try (
let tt = Hashtbl.find it._config2ttree cfg in
let tt = Util.hfind it._config2ttree cfg in
Verbose.put ~level:2 "##config2ttree: \"%s\" cached\n" ix ;
if (Utils.paranoid ()) then (
let tt' = gentrans it.source_code data e in
......
......@@ -125,7 +125,7 @@ let get_exp_type (env : t) (e : Syntaxe.val_exp)
(* -> CkTypeEff.t *)
= (
try (
Hashtbl.find env.ce_typing e.src
Util.hfind env.ce_typing e.src
) with Not_found -> (
raise (Internal_error
("CheckEnv.get_exp_type", "untyped exp"))
......@@ -142,7 +142,7 @@ distribuee sur plusieurs vars !
let set_exp_type (env : t) (ve: Syntaxe.val_exp) (tf: CkTypeEff.t) = (
(* assert (not (Hashtbl.mem env.ce_typing ve.src)); *)
try (
let t1 = Hashtbl.find env.ce_typing ve.src in
let t1 = Util.hfind env.ce_typing ve.src in
if (t1 <> tf) then (
let msg = Printf.sprintf "can't assign type '%s' to exp '%s', already typed with '%s'"
(CkTypeEff.to_string tf)
......@@ -168,7 +168,7 @@ let get_binding (env : t) (id : Syntaxe.ident)
(* -> CkIdentInfo.t *)
= (
try (
Hashtbl.find env.ce_binding id
Util.hfind env.ce_binding id
) with Not_found -> (
raise (Internal_error
("CheckEnv.get_binding",
......@@ -191,7 +191,7 @@ let get_binding (env : t) (id : Syntaxe.ident)
*)
let put_in_scope (env: t) (id : Syntaxe.ident) (ii : CkIdentInfo.t) = (
( try (
let ifo = Hashtbl.find env.ce_scope id.it in
let ifo = Util.hfind env.ce_scope id.it in
if (CkIdentInfo.is_hideable ifo) then (
Hashtbl.add env.ce_scope id.it ii ;
) else (
......@@ -203,7 +203,7 @@ let put_in_scope (env: t) (id : Syntaxe.ident) (ii : CkIdentInfo.t) = (
Hashtbl.add env.ce_scope id.it ii
));
(*
let bdgs = Hashtbl.find_all env.ce_scope id.it in
let bdgs = Util.hfind_all env.ce_scope id.it in
let pii ii = (printf " %s\n" (CkIdentInfo.to_string ii)) in
printf "CURRENT SCOPE: %s = \n" id.it ;
List.iter pii bdgs
......@@ -459,13 +459,13 @@ let get_ident_info (env : t) (id : Syntaxe.ident) = (
(* printf "add_binding: ref=%s\n" (Lexeme.to_string id.src); *)
let s = id.it in
let res = try (
Hashtbl.find env.ce_scope s
Util.hfind env.ce_scope s
) with Not_found -> (
raise (Compile_error (id.src,"undeclared identifier"))
) in
(* INSERTION/VERIF DU BINDING *)
(try
let expected = Hashtbl.find env.ce_binding id in
let expected = Util.hfind env.ce_binding id in
if (expected != res) then
let msg = Printf.sprintf "binding error for lexeme %s\n %s\n %s"
(Lexeme.to_string id.src)
......
......@@ -555,34 +555,34 @@ let check_pack
en dmarrant avec Predef.lutin_env
let env = CheckEnv.create () in
*)
let env0 = CheckEnv.copy Predef.lutin_env in
let env = match libs with
| None -> env0
| Some ll -> CheckEnv.add_libs env0 ll
in
let check_def_item =
function
LetDef s -> (
let m = (Hashtbl.find p.pck_lettab s.it) in
let tres = check_let env m in
ignore (CheckEnv.add_let env m tres m.lti_ident)
)
| ExternDef x -> (
let m = (Hashtbl.find p.pck_lettab x.it) in
let tres = check_extern env m in
ignore (CheckEnv.add_extern env m tres m.lti_ident)
)
| NodeDef s -> (
let n = (Hashtbl.find p.pck_nodetab s.it) in
let nprof = check_node env n in
ignore (CheckEnv.add_node env n nprof n.ndi_ident)
)
| ExceptDef s -> (
let env0 = CheckEnv.copy Predef.lutin_env in
let env = match libs with
| None -> env0
| Some ll -> CheckEnv.add_libs env0 ll
in
let check_def_item =
function
LetDef s -> (
let m = (Util.hfind p.pck_lettab s.it) in
let tres = check_let env m in
ignore (CheckEnv.add_let env m tres m.lti_ident)
)
| ExternDef x -> (
let m = (Util.hfind p.pck_lettab x.it) in
let tres = check_extern env m in
ignore (CheckEnv.add_extern env m tres m.lti_ident)
)
| NodeDef s -> (
let n = (Util.hfind p.pck_nodetab s.it) in
let nprof = check_node env n in
ignore (CheckEnv.add_node env n nprof n.ndi_ident)
)
| ExceptDef s -> (
(* quivalent une constante
abstraite GLOBALE de type except *)
ignore (CheckEnv.add_global_cst env s (CkTypeEff.except))
)
in
List.iter check_def_item p.pck_deflist ;
env
)
ignore (CheckEnv.add_global_cst env s (CkTypeEff.except))
)
in
List.iter check_def_item p.pck_deflist ;
env
)
......@@ -239,7 +239,7 @@ and match_in_type anytab tobtd texptd = (
match (tobtd, texptd) with
(_ , TEFF_any (k, cond)) -> (
try (
let tprev = Hashtbl.find anytab k in
let tprev = Util.hfind anytab k in
match_in_type anytab tobtd tprev
) with Not_found -> (
match (cond tobtd) with
......@@ -260,7 +260,7 @@ and match_in_type anytab tobtd texptd = (
match tres with
TEFF_any (k, _) -> (
try (
Hashtbl.find anytab k
Util.hfind anytab k
) with Not_found -> (
failwith "uncompatible types"
)
......
......@@ -240,7 +240,7 @@ type t = {
}
(* get a run def *)
let get_run_expanded_code it rid = Hashtbl.find it.runtab rid
let get_run_expanded_code it rid = Util.hfind it.runtab rid
(*
Initialize with global infos
......@@ -280,11 +280,11 @@ let add_run_instance: t -> string -> t -> string =
)
let src_decl_to_target_info (zeres:t) id = (
Hashtbl.find zeres.src2target id
Util.hfind zeres.src2target id
)
let src_decl_to_target_id (zeres:t) id = (
snd (Hashtbl.find zeres.src2target id)
snd (Util.hfind zeres.src2target id)
)
(* L'utilitaire suivant enchaîne les étapes,
......@@ -379,7 +379,7 @@ Table des variables support
(* Utilitaires : renvoient une CoAlgExp.t adéquate *)
let alg_exp_of_support_ref (zeres:t) tgtid = (
(Hashtbl.find zeres.stab tgtid).si_ref_exp
(Util.hfind zeres.stab tgtid).si_ref_exp
)
(** Déclaration d'une entrée *)
......@@ -394,7 +394,7 @@ let new_support_input
(
let tgtid = CoIdent.get i.it in
let _ = try (
let oldinfo = Hashtbl.find zeres.stab tgtid in
let oldinfo = Util.hfind zeres.stab tgtid in
let oldlxm = CoIdent.head_of_src_stack oldinfo.si_src in
let msg = "input ident already used at " ^
(lexeme_line_col oldlxm)
......@@ -436,7 +436,7 @@ let new_support_output
(
let tgtid = CoIdent.get i.it in
let _ = try (
let oldinfo = Hashtbl.find zeres.stab tgtid in
let oldinfo = Util.hfind zeres.stab tgtid in
let oldlxm = CoIdent.head_of_src_stack oldinfo.si_src in
let msg = "output ident already used at " ^
(lexeme_line_col oldlxm)
......@@ -524,7 +524,7 @@ Table des alias
(* Utilitaire, renvoie une CoAlgExp.t adéquate *)
let alg_exp_of_alias_ref zeres tgtid = (
(Hashtbl.find zeres.atab tgtid).ai_ref_exp
(Util.hfind zeres.atab tgtid).ai_ref_exp
)
(* Unicité des idents target d'alias *)
......@@ -601,7 +601,7 @@ let new_pre_handler
)
let alg_exp_of_support_pre_ref (zeres: t) tgtid = (
let zevar = Hashtbl.find zeres.stab tgtid in
let zevar = Util.hfind zeres.stab tgtid in
match zevar.si_pre_ref_exp with
| Some pe -> pe
| None -> (
......@@ -1537,7 +1537,7 @@ and
let id_decl = CkIdentInfo.def_ident info in
let res = match (src_decl_to_target_info zeres id_decl) with
| (TN_support, tgtid) -> (
let curbinding = Hashtbl.find zeres.stab tgtid in
let curbinding = Util.hfind zeres.stab tgtid in
let _ = if (not (CoAlgExp.is_controlable curbinding.si_ref_exp)) then (
raise ( Compile_error (id.src, "run result must be controllable"))
) in
......@@ -1547,7 +1547,7 @@ and
(* curbinding.si_init curbinding.si_range id curbinding.si_type sstack; *)
(Some init) None id curbinding.si_type sstack
in
let newbinding = Hashtbl.find zeres.stab tgtid' in
let newbinding = Util.hfind zeres.stab tgtid' in
CoAlgExp.of_eq curbinding.si_ref_exp newbinding.si_ref_exp
)
| _ -> assert false
......@@ -1859,7 +1859,7 @@ let main_trace (x:t) = x.mtrace
let ident_space (x:t) = x.idspace
let get_trace_info it id = (
Hashtbl.find it.ttab id
Util.hfind it.ttab id
)
let make (env : CheckEnv.t) (p : Syntaxe.package) (n : string) = (
......
This diff is collapsed.
......@@ -60,7 +60,7 @@ let lucky_exp_var_ref (x:lucky_var) = (
let lucky_ref_of ?(where="") tab nme = (
try (
lucky_exp_var_ref (Hashtbl.find tab nme)
lucky_exp_var_ref (Util.hfind tab nme)
) with Not_found -> (
raise (
Errors.Internal_error (
......@@ -254,7 +254,7 @@ let add_pre (it:t) (x:lucky_var) = (
let nme = Var.name x in
(* Verbose.put ~flag:dbg " LutProg.add_pre \"%s\"\n" nme; *)
try (
Hashtbl.find it.lucky_prevar_tab nme
Util.hfind it.lucky_prevar_tab nme
) with Not_found -> (
let prex = Var.make_pre x in
Hashtbl.add it.lucky_prevar_tab nme prex;
......@@ -319,7 +319,7 @@ let init_vars (it: t) = (
(***********************************************************)
let add_support mode id = (
let nme = CoIdent.to_string id in
let info = Hashtbl.find (Expand.support_tab source_code) id in
let info = Util.hfind (Expand.support_tab source_code) id in
(* Verbose.put ~flag:dbg " LutProg.add_support \"%s\"\n" nme; *)
let res = lucky_make_var it mnode nme (lucky_type_of info.Expand.si_type) mode info.Expand.si_range in
(* init ? *)
......@@ -343,7 +343,7 @@ let init_vars (it: t) = (
let add_alias id = (
let nme = CoIdent.to_string id in
Verbose.put ~flag:dbg " LutProg.add_alias \"%s\"\n" nme;
let info = Hashtbl.find (Expand.alias_tab source_code) id in
let info = Util.hfind (Expand.alias_tab source_code) id in
(* les alias sont des Local spciaux en lucky *)
let res = Var.set_alias
(lucky_make_var it mnode nme (lucky_type_of info.Expand.ai_type) Var.Local None)
......@@ -447,7 +447,7 @@ let make_pre_env (zelut:t) ins outs locs = (
let dopre nme lucvar acc = (
Verbose.put ~flag:dbg "%% make_pre_ena/dopre \"%s\"" nme;
try (
let zevar = Hashtbl.find zelut.lucky_var_tab nme in
let zevar = Util.hfind zelut.lucky_var_tab nme in
let tab = match (Var.mode zevar) with
| Var.Input -> ins
| Var.Output -> outs
......@@ -473,15 +473,16 @@ let lut_get_wtl (zelut:t) (input:Var.env_in) (st:Prog.state) (ctrlst:Prog.ctrl_s
(* let zecfg = AutoGen.make_config (Some (input, zepres)) zesrc in *)
let zecfg = AutoGen.make_config zesrc in
Verbose.exe ~flag:dbg (fun _ ->
let memory = Prog.memory_of_state st in
Verbose.put ~flag:dbg "++lut_get_wtl input = %s" (Value.OfIdent.to_string "" input);
Verbose.put ~flag:dbg "++lut_get_wtl last_input = %s" (Value.OfIdent.to_string "" li);
Verbose.put ~flag:dbg "++lut_get_wtl last_output = %s" (Value.OfIdent.to_string "" lo);
Verbose.put ~flag:dbg "++lut_get_wtl last_local = %s" (Value.OfIdent.to_string "" ll);
Verbose.put ~flag:dbg "++lut_get_wtl memory = %s" (Value.OfIdent.to_string "" memory);
Verbose.put ~flag:dbg "++lut_get_wtl pre's = %s" (Value.OfIdent.to_string "" zepres);
);
Verbose.exe ~flag:dbg
(fun _ ->
let memory = Prog.memory_of_state st in
Verbose.put ~flag:dbg "++lut_get_wtl input = %s" (Value.OfIdent.to_string "" input);
Verbose.put ~flag:dbg "++lut_get_wtl last_input = %s" (Value.OfIdent.to_string "" li);
Verbose.put ~flag:dbg "++lut_get_wtl last_output = %s" (Value.OfIdent.to_string "" lo);
Verbose.put ~flag:dbg "++lut_get_wtl last_local = %s" (Value.OfIdent.to_string "" ll);
Verbose.put ~flag:dbg "++lut_get_wtl memory = %s" (Value.OfIdent.to_string "" memory);
Verbose.put ~flag:dbg "++lut_get_wtl pre's = %s" (Value.OfIdent.to_string "" zepres);
);
(* Appele AutoGen.state2gtree -> AutoGen.gtree *)
Verbose.exe ~level:2 (fun () -> Verbose.put "# -> state2gtree\n");
......@@ -544,20 +545,18 @@ let lut_get_wtl (zelut:t) (input:Var.env_in) (st:Prog.state) (ctrlst:Prog.ctrl_s
ze_wt := Util.StringMap.add s v !ze_wt
)
) in
Verbose.exe ~level:2 (fun () -> Verbose.put "# -> treat_gtree\n");
Utils.time_C "treat_gtree";
let _ = treat_gtree gt in
Utils.time_R "treat_gtree";
Verbose.exe ~level:2 (fun () -> Verbose.put "# <- treat_gtree, done\n");
Verbose.exe ~level:3 ( fun () ->
Printf.printf "lut_get_wtl ->\n";
Prog.print_wt (!ze_wt, zesrc);
);
[ (!ze_wt, zesrc) ]
Verbose.exe ~level:2 (fun () -> Verbose.put "# -> treat_gtree\n");
Utils.time_C "treat_gtree";
let _ = treat_gtree gt in
Utils.time_R "treat_gtree";
Verbose.exe ~level:2 (fun () -> Verbose.put "# <- treat_gtree, done\n");
Verbose.exe ~level:3 ( fun () ->
Printf.printf "lut_get_wtl ->\n";
Prog.print_wt (!ze_wt, zesrc);
);
[ (!ze_wt, zesrc) ]
)
let make ?(libs: string list option = None) infile mnode = (
......@@ -601,7 +600,7 @@ let make ?(libs: string list option = None) infile mnode = (
let _ = init_vars zelut in
let id2var (id: CoIdent.t) =
let nme = CoIdent.to_string id in
Hashtbl.find zelut.lucky_var_tab nme
Util.hfind zelut.lucky_var_tab nme
in
let sort_bool_num k v (blin, nlin) =
(* Verbose.exe ~level:3 (fun () -> Printf.fprintf stderr "sort_bool_num %s=%s\n" k (Var.to_string v)); *)
......@@ -619,7 +618,7 @@ let make ?(libs: string list option = None) infile mnode = (
let (bl,nl) = Hashtbl.fold sort_bool_num zelut.lucky_var_tab ([],[]) in
(* let get_all_mems n ve a = (n,ve)::a in *)
(* let get_all_mems n ve a = (Prevar.get_pre_var_name n, ve)::a in *)
let get_all_mems n ve a = (Var.name ve, Hashtbl.find zelut.lucky_var_tab n)::a in
let get_all_mems n ve a = (Var.name ve, Util.hfind zelut.lucky_var_tab n)::a in
(* la fonction qui dit si c'est final *)
let is_final s =
match AutoGen.get_state_info zelut.auto s with
......
......@@ -255,6 +255,10 @@ let to_exe oc infile mnode opt = (
let noo = not (MainArg.only_outputs opt) in
let rec do_step cpt ctrl ins pres = (
(* Clean-up cached info that depend on pre or inputs *)
Formula_to_bdd.clear_step ();
!Solver.clear_snt ();
Verbose.put "#Main.to_exe: step %d\n" cpt;
let bg = LutExe.get_behavior_gen exe ins pres ctrl in
match bg () with
......
......@@ -23,10 +23,10 @@ let lutin_env = CheckEnv.create ()
let (infixed_tab : (string, string list) Hashtbl.t) = Hashtbl.create 50
let as_infixed_syntax (op: string) = (
try (
Some (Hashtbl.find infixed_tab op)
) with Not_found -> None
try (
Some (Util.hfind infixed_tab op)
) with Not_found -> None
)
(* poids prdef *)
......
......@@ -135,11 +135,11 @@ let pack_node_list p = (
)
let pack_get_node p s = (
(Hashtbl.find p.pck_nodetab s)
(Util.hfind p.pck_nodetab s)
)
let pack_get_let p s = (
(Hashtbl.find p.pck_lettab s)
(Util.hfind p.pck_lettab s)
)
let pack_except_list p =
......
......@@ -32,14 +32,14 @@ let _flag_tab : (string, flag) Hashtbl.t = Hashtbl.create 10
let _flag_list : string list ref = ref []
let get_flag s = (
try (
Hashtbl.find _flag_tab s
) with Not_found -> (
let res = ref false in
Hashtbl.add _flag_tab s res;
_flag_list := s::!_flag_list;
res
)
try (
Util.hfind _flag_tab s
) with Not_found -> (
let res = ref false in
Hashtbl.add _flag_tab s res;
_flag_list := s::!_flag_list;
res
)
)
let set_flag f = (f := true)
let flag_list () = !_flag_list
......
......@@ -324,6 +324,12 @@ lutin_debug:$(OBJDIR)
lutinp:$(OBJDIR)
cd $(OBJDIR) && $(MAKE) -k ln -f ../*/Makefile.lutin && $(MAKE) -k pnc -f ../*/Makefile.lutin
lutinpbc:$(OBJDIR)
cd $(OBJDIR) && $(MAKE) -k ln -f ../*/Makefile.lutin && $(MAKE) -k pbc -f ../*/Makefile.lutin
lutinbc:$(OBJDIR)
cd $(OBJDIR) && $(MAKE) -k ln -f ../*/Makefile.lutin && $(MAKE) -k bc -f ../*/Makefile.lutin
lutin_clean:$(OBJDIR)
cd $(OBJDIR) && $(MAKE) -f ../*/Makefile.lutin clean
......@@ -760,4 +766,4 @@ time:
cd ../test && $(MAKE) time
cp-www:
cp ../pre_release/$(HOSTTYPE)/bin/lurettetop_exe ~/public_html/lurette/
\ No newline at end of file
cp ../pre_release/$(HOSTTYPE)/bin/lurettetop_exe ~/public_html/lurette/
......@@ -39,7 +39,7 @@ let snt_build = ref false
let (sol_number_snt : snt -> Bdd.t -> sol_nb * sol_nb) =
fun snt bdd ->
Hashtbl.find snt bdd
hfindl "bddd.sol_number_snt: " snt bdd
let (sol_number : Bdd.t -> sol_nb * sol_nb) =
(sol_number_snt !snt_ref)
......@@ -435,9 +435,9 @@ and (draw_in_bdd_rec_ineq: Var.env_in -> Var.env -> int -> string -> Constraint.
else
(cstr_neg, (Bdd.delse bdd), m, cstr, (Bdd.dthen bdd), n)
in
(* let bddi = try Hashtbl.find bdd_to_int bdd with _ -> -1 *)
(* and bdd1i = try Hashtbl.find bdd_to_int bdd1 with _ -> -1 *)
(* and bdd2i = try Hashtbl.find bdd_to_int bdd2 with _ -> -1 in *)
(* let bddi = try hfindl "bddd: " bdd_to_int bdd with _ -> -1 *)
(* and bdd1i = try hfindl "bddd: " bdd_to_int bdd1 with _ -> -1 *)
(* and bdd2i = try hfindl "bddd: " bdd_to_int bdd2 with _ -> -1 in *)
let store1 = add_constraint store (Ineq cstr1) in
(* A solution will be found in this branch iff there exists
......@@ -492,7 +492,7 @@ and (draw_in_bdd_rec_eq: Var.env_in -> Var.env -> int -> string ->
third store first is (fairly) tossed up.
*)
let (n, m) = sol_number_snt snt bdd in
(* let bddi = try Hashtbl.find bdd_to_int bdd with _ -> -1 in *)
(* let bddi = try hfindl "bddd: " bdd_to_int bdd with _ -> -1 in *)
let _ =
if ((eq_sol_nb n zero_sol) && (eq_sol_nb m zero_sol))
then (
......@@ -551,9 +551,9 @@ and (draw_in_bdd_rec_eq: Var.env_in -> Var.env -> int -> string ->
cstr, (Bdd.dthen bdd), n,
not_cstr, (Bdd.delse bdd), m)
in
(* let bddi1 = try Hashtbl.find bdd_to_int bdd1 with _ -> -1 in *)
(* let bddi2 = try Hashtbl.find bdd_to_int bdd2 with _ -> -1 in *)
(* let bddi3 = try Hashtbl.find bdd_to_int bdd3 with _ -> -1 in *)
(* let bddi1 = try hfindl "bddd: " bdd_to_int bdd1 with _ -> -1 in *)
(* let bddi2 = try hfindl "bddd: " bdd_to_int bdd2 with _ -> -1 in *)
(* let bddi3 = try hfindl "bddd: " bdd_to_int bdd3 with _ -> -1 in *)
let store1 = add_constraint store cstr1 in
(*
A solution will be found in this branch iff there exists
......
......@@ -92,7 +92,7 @@ let (dump_oracle_io : Data.subst list -> Data.subst list -> t -> string) =
let true_bools, false_bools = List.partition (fun (vn,vv) -> Data.B true = vv) bools in
let true_other, true_first =
List.partition
(fun (vn,vv) -> try StringMap.find vn cov.tab with _ -> true) true_bools
(fun (vn,vv) -> try mfind vn cov.tab with _ -> true) true_bools
in
let pn (vn,_vv) = Printf.sprintf "%s" vn in
let pv (vn,vv) = Printf.sprintf "%s=%s" vn (Data.val_to_string vv) in
......
......@@ -176,7 +176,7 @@ let type_num_tbl = Hashtbl.create 100
let rec (num_is_an_int : num -> bool) =
fun e ->
try
Hashtbl.find type_num_tbl e
Util.hfind type_num_tbl e
with Not_found ->
let res =
match e with
......
......@@ -146,7 +146,7 @@ let rec (build_sol_nb_table_rec: Bdd.t -> Bdd.t -> Store.t -> snt -> sol_nb) =
let sol_nb =
try
(* either it has already been computed ... *)
let (nt, ne) = Hashtbl.find snt (bdd, store) in
let (nt, ne) = hfind snt (bdd, store) in
(* solutions numbers in the table are absolute *)
(add_one_or_two nt ne)
......@@ -461,7 +461,7 @@ and (draw_in_bdd_rec_bool: Var.env_in -> Var.env -> int -> string -> var ->
else
(* bddvar = combvar *)
let (n, m) =
match Hashtbl.find snt (bdd, store) with
match hfind snt (bdd, store) with
(n, One m) -> n, m
| (_, Two _) -> assert false
in
......@@ -540,7 +540,7 @@ and (draw_in_bdd_rec_ineq: Var.env_in -> Var.env -> int -> string -> Constraint.
branch with the other store is tried.
*)
let (n, m) =
match Hashtbl.find snt (bdd, store) with