Commit 9d0c853a authored by erwan's avatar erwan

Update: monadisation of Lutin, part 4.

Rationale: make rdbg time traveling work.
parent 7a6ac267
...@@ -27,7 +27,7 @@ Executable lutin ...@@ -27,7 +27,7 @@ Executable lutin
Path: lutin/src Path: lutin/src
MainIs: main.ml MainIs: main.ml
BuildDepends: str,unix,num,rdbg-plugin (>= 1.177),lutin-utils,ezdl,gbddml,polka,camlp4,camlidl,gmp BuildDepends: str,unix,num,rdbg-plugin (>= 1.177),lutin-utils,ezdl,gbddml,polka,camlp4,camlidl,gmp
NativeOpt: -package num # XXX turn around a bug in oasis/ocamlbuild/ocamlfind? NativeOpt: -warn-error "+26" -package num # XXX turn around a bug in oasis/ocamlbuild/ocamlfind?
Build: true Build: true
Install:true Install:true
CompiledObject: native CompiledObject: native
......
...@@ -73,7 +73,7 @@ let main_read_arg () = ...@@ -73,7 +73,7 @@ let main_read_arg () =
args.tmp_dir <- lurette_tmp_dir; args.tmp_dir <- lurette_tmp_dir;
Unix.putenv "TMPDIR" (String.escaped lurette_tmp_dir) ; Unix.putenv "TMPDIR" (String.escaped lurette_tmp_dir) ;
in in
let source_dir = (Filename.concat (ExtTools.lurette_path()) "source") in let _source_dir = (Filename.concat (ExtTools.lurette_path()) "source") in
match args.sut_compiler with match args.sut_compiler with
| Scade -> assert false | Scade -> assert false
| VerimagV4 | VerimagV4
......
...@@ -89,7 +89,7 @@ let (make_rp_list : reactive_program list -> ...@@ -89,7 +89,7 @@ let (make_rp_list : reactive_program list ->
(Data.subst list -> ctx -> (Data.subst list -> ctx -> Event.t) -> (Data.subst list -> ctx -> (Data.subst list -> ctx -> Event.t) ->
Event.t) list * Data.subst list list * Data.subst list list) = Event.t) list * Data.subst list list * Data.subst list list) =
fun rpl -> fun rpl ->
let add_init init (a,b,c,d,e) = (a,b,c,d,e,init,init) in let _add_init init (a,b,c,d,e) = (a,b,c,d,e,init,init) in
let aux rp = let aux rp =
let plugin = let plugin =
match rp with match rp with
......
(* Time-stamp: <modified the 29/03/2019 (at 14:53) by Erwan Jahier> *) (* Time-stamp: <modified the 11/04/2019 (at 14:56) by Erwan Jahier> *)
(* Mimick the behavior of 'rdbg -lurette', but without the dependency (* Mimick the behavior of 'rdbg -lurette', but without the dependency
on ocaml *) on ocaml *)
open Event open Event
...@@ -77,11 +77,11 @@ let _ = ...@@ -77,11 +77,11 @@ let _ =
args.verbose <- if !verbose then 1 else 0 ; args.verbose <- if !verbose then 1 else 0 ;
args.output <- !output_file ; args.output <- !output_file ;
args.overwrite_output = !overwrite_output; args.overwrite_output <- !overwrite_output;
args.stop_on_oracle_error = not !dont_stop_on_oracle_error; args.stop_on_oracle_error <- not !dont_stop_on_oracle_error;
args.log = !log; args.log <- !log;
args.cov_file = !cov_file; args.cov_file <- !cov_file;
args.reset_cov_file = !reset_cov_file; args.reset_cov_file <- !reset_cov_file;
args.debug_rdbg <- !drdbg; args.debug_rdbg <- !drdbg;
args.rdbg <- false; args.rdbg <- false;
......
...@@ -42,13 +42,13 @@ let print_header ...@@ -42,13 +42,13 @@ let print_header
) )
open Util
let make let make
(srcname: string) (srcname: string)
(mnode : string) (mnode : string)
(auto : AutoGen.t) (auto : AutoGen.t)
(os : Pervasives.out_channel) = (os : Pervasives.out_channel) =
( (
(* le source au cas ou ... *) (* le source au cas ou ... *)
let source_code = AutoGen.source auto in let source_code = AutoGen.source auto in
...@@ -61,8 +61,7 @@ let make ...@@ -61,8 +61,7 @@ let make
let etab2prof s xi acc = ( let etab2prof s xi acc = (
(s, xi.xi_prof)::acc (s, xi.xi_prof)::acc
) in ) in
let xlist = Hashtbl.fold etab2prof let xlist = Util.StringMap.fold etab2prof (Expand.extern_tab source_code) [] in
(Expand.extern_tab source_code) [] in
if (xlist = []) then () if (xlist = []) then ()
else ( else (
fprintf os "\nfunctions {\n"; fprintf os "\nfunctions {\n";
...@@ -79,7 +78,7 @@ let make ...@@ -79,7 +78,7 @@ let make
(* pour les dumps des vars support *) (* pour les dumps des vars support *)
(* Hashtbl.iter (print_support Local) (Expand.support_tab source_code); *) (* Hashtbl.iter (print_support Local) (Expand.support_tab source_code); *)
let print_support nme = ( let print_support nme = (
let info = Util.hfind (Expand.support_tab source_code) nme in let info = Util.StringMap.find nme (Expand.support_tab source_code) in
fprintf os " %s : %s" fprintf os " %s : %s"
(CoIdent.to_string nme) (CoIdent.to_string nme)
(CkTypeEff.to_string info.si_type); (CkTypeEff.to_string info.si_type);
...@@ -104,8 +103,7 @@ let make ...@@ -104,8 +103,7 @@ let make
(* pour les dumps de la liste d'alias *) (* pour les dumps de la liste d'alias *)
let print_alias nme = ( let print_alias nme = (
let info = Util.hfind let info = StringMap.find nme (Expand.alias_tab source_code) in
(Expand.alias_tab source_code) nme in
fprintf os " %s : %s" fprintf os " %s : %s"
(CoIdent.to_string nme) (CoIdent.to_string nme)
(CkTypeEff.to_string info.ai_type); (CkTypeEff.to_string info.ai_type);
......
This diff is collapsed.
...@@ -354,12 +354,8 @@ let gentrans ...@@ -354,12 +354,8 @@ let gentrans
(* Correspondance id de trace -> trace exp (* Correspondance id de trace -> trace exp
N.B. on traque les récursions ? *) N.B. on traque les récursions ? *)
(*-------------------------------------------*) (*-------------------------------------------*)
let id2trace s = ( let id2trace s = (StringMap.find s (Expand.trace_tab xenv)).ti_def_exp in
(Util.hfind (Expand.trace_tab xenv) s).ti_def_exp let unalias s = (StringMap.find s (Expand.alias_tab xenv)).ai_def_exp in
) in
let unalias s = (
(Util.hfind (Expand.alias_tab xenv) s).ai_def_exp
) in
(*-------------------------------------------*) (*-------------------------------------------*)
(* LA FONCTION RÉCURSIVE *) (* LA FONCTION RÉCURSIVE *)
...@@ -891,7 +887,7 @@ let init (xenv : Expand.t) = ...@@ -891,7 +887,7 @@ let init (xenv : Expand.t) =
} }
in in
let is = Expand.main_trace xenv in let is = Expand.main_trace xenv in
let ie = (Util.hfind (Expand.trace_tab xenv) is).ti_def_exp in let ie = (Util.StringMap.find is (Expand.trace_tab xenv)).ti_def_exp in
let init_control, res = get_stable res ie in let init_control, res = get_stable res ie in
let final_control, res = get_sink res "vanish" in let final_control, res = get_sink res "vanish" in
{ res with { res with
...@@ -924,12 +920,9 @@ let rec ttree2trans (it:t) (src: string) (tt : ttree) = ( ...@@ -924,12 +920,9 @@ let rec ttree2trans (it:t) (src: string) (tt : ttree) = (
) )
let get_state_def (it:t) (ix: string) = let get_state_def (it:t) (ix: string) = StringMap.find ix it._state2trace
StringMap.find ix it._state2trace
let get_state_info (it:t) (ix: string) = StringMap.find ix it.states
let get_state_info (it:t) (ix: string) =
StringMap.find ix it.states
(* (*
*) *)
......
...@@ -191,20 +191,20 @@ let rec of_texp = ( function ...@@ -191,20 +191,20 @@ let rec of_texp = ( function
x ref -> x x ref -> x
*) *)
let lifts_to t1 t2 = ( let lifts_to t1 t2 = (
let res = let res =
(t1 = t2) (t1 = t2)
or ((t1 = boolref) && (t2 = boolean)) || ((t1 = boolref) && (t2 = boolean))
or ((t1 = boolean) && (t2 = trace)) || ((t1 = boolean) && (t2 = trace))
or ((t1 = boolref) && (t2 = trace)) || ((t1 = boolref) && (t2 = trace))
or ((t1 = integer) && (t2 = weight)) || ((t1 = integer) && (t2 = weight))
or ((t1 = intref) && (t2 = weight)) || ((t1 = intref) && (t2 = weight))
or ( || (
match (t1,t2) with match (t1,t2) with
(TEFF_ref x, TEFF_data y) -> (x = y) (TEFF_ref x, TEFF_data y) -> (x = y)
| _ -> false | _ -> false
) )
in in
res res
) )
(* compatibilit d'un profil avec une liste de types de params (* compatibilit d'un profil avec une liste de types de params
Renvoie le type eff du rsultat ou lve une exception : Renvoie le type eff du rsultat ou lve une exception :
......
...@@ -95,7 +95,7 @@ let of_alias i t c = ...@@ -95,7 +95,7 @@ let of_alias i t c =
{ ae_type = t; ae_ctrl = c; ae_val = AE_alias i } { ae_type = t; ae_ctrl = c; ae_val = AE_alias i }
let of_call i t args = ( let of_call i t args = (
let f b ae = (b or ae.ae_ctrl) in let f b ae = (b || ae.ae_ctrl) in
let c = List.fold_left f false args in let c = List.fold_left f false args in
{ ae_type = t; ae_ctrl = c; ae_val = AE_call (i, args)} { ae_type = t; ae_ctrl = c; ae_val = AE_call (i, args)}
) )
......
...@@ -238,7 +238,7 @@ let rec (simplifie_a_little : formula -> formula) = ...@@ -238,7 +238,7 @@ let rec (simplifie_a_little : formula -> formula) =
let f1' = simplifie_a_little f1 let f1' = simplifie_a_little f1
and f2' = simplifie_a_little f2 and f2' = simplifie_a_little f2
in in
if f1 <> f1' or f2 <> f2' then if f1 <> f1' || f2 <> f2' then
simplifie_a_little (And(f1', f2')) simplifie_a_little (And(f1', f2'))
else else
And(f1', f2') And(f1', f2')
...@@ -246,7 +246,7 @@ let rec (simplifie_a_little : formula -> formula) = ...@@ -246,7 +246,7 @@ let rec (simplifie_a_little : formula -> formula) =
let f1' = simplifie_a_little f1 let f1' = simplifie_a_little f1
and f2' = simplifie_a_little f2 in and f2' = simplifie_a_little f2 in
let f12' = Or(f1', f2') in let f12' = Or(f1', f2') in
if f1 <> f1' or f2 <> f2' then if f1 <> f1' || f2 <> f2' then
simplifie_a_little f12' simplifie_a_little f12'
else else
f12' f12'
......
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -49,26 +49,28 @@ val make : CheckEnv.t -> Syntaxe.package -> string -> t ...@@ -49,26 +49,28 @@ val make : CheckEnv.t -> Syntaxe.package -> string -> t
type support_scope type support_scope
type support_nature = type support_nature =
Input | Input
| Output | Output
| LocalIn | LocalIn
| LocalOut | LocalOut
and support_info = {
type support_info = {
si_ident : CoIdent.t ; si_ident : CoIdent.t ;
si_nature : support_nature ; si_nature : support_nature ;
si_type : CkTypeEff.t ; si_type : CkTypeEff.t ;
si_ref_exp : CoAlgExp.t ; si_ref_exp : CoAlgExp.t ;
si_src : CoIdent.src_stack; si_src : CoIdent.src_stack;
(* on ne la crée qu'à la demande *) (* on ne la crée qu'à la demande *)
mutable si_pre_ref_exp : CoAlgExp.t option ; si_pre_ref_exp : CoAlgExp.t option ;
si_default : CoAlgExp.t option ; si_default : CoAlgExp.t option ;
si_scope : support_scope option ; si_scope : support_scope option ;
si_init : CoAlgExp.t option ; si_init : CoAlgExp.t option ;
si_range : (CoAlgExp.t *CoAlgExp.t) option ; si_range : (CoAlgExp.t *CoAlgExp.t) option ;
} }
open Util
(* support_info that are actually used in pre's *) (* support_info that are actually used in pre's *)
val support_tab : t -> (CoIdent.t, support_info) Hashtbl.t val support_tab : t -> support_info StringMap.t
(* support_info that are actually used in pre's *) (* support_info that are actually used in pre's *)
val support_pres : t -> (CoIdent.t * support_info) list val support_pres : t -> (CoIdent.t * support_info) list
...@@ -91,12 +93,12 @@ type alias_info = { ...@@ -91,12 +93,12 @@ type alias_info = {
ai_src : CoIdent.src_stack ai_src : CoIdent.src_stack
} }
val alias_tab : t -> (CoIdent.t, alias_info) Hashtbl.t val alias_tab : t -> alias_info StringMap.t
val alias_list : t -> CoIdent.t list val alias_list : t -> CoIdent.t list
(* Run tab *) (* Run tab *)
(* not necessary ? (* not necessary ?
val run_tab : t -> (CoIdent.t, t) Hashtbl.t val run_tab : t -> (CoIdent.t, t) StringMap.t
*) *)
val get_run_expanded_code : t -> CoIdent.t -> t val get_run_expanded_code : t -> CoIdent.t -> t
...@@ -108,7 +110,7 @@ type trace_info = { ...@@ -108,7 +110,7 @@ type trace_info = {
ti_src : CoIdent.src_stack ; ti_src : CoIdent.src_stack ;
} }
val trace_tab : t -> (CoIdent.t, trace_info) Hashtbl.t val trace_tab : t -> trace_info StringMap.t
val get_trace_info : t -> CoIdent.t -> trace_info val get_trace_info : t -> CoIdent.t -> trace_info
...@@ -124,7 +126,7 @@ type extern_info = { ...@@ -124,7 +126,7 @@ type extern_info = {
xi_src : Lexeme.t xi_src : Lexeme.t
} }
val extern_tab : t -> (string, extern_info) Hashtbl.t val extern_tab : t -> extern_info StringMap.t
(** Identificateur (target) de la trace principale *) (** Identificateur (target) de la trace principale *)
val main_trace : t -> CoIdent.t val main_trace : t -> CoIdent.t
......
...@@ -233,15 +233,9 @@ let (gen_alice_stub_c : alice_args -> unit) = ...@@ -233,15 +233,9 @@ let (gen_alice_stub_c : alice_args -> unit) =
fun args -> fun args ->
let amn = Filename.basename args.alice_module_name in let amn = Filename.basename args.alice_module_name in
let oc = my_open_out (Filename.concat args.output_dir (amn ^ ".cpp")) in let oc = my_open_out (Filename.concat args.output_dir (amn ^ ".cpp")) in
let put s = output_string oc s in
let putln s = output_string oc (s^"\n") in let putln s = output_string oc (s^"\n") in
let rec putlist = function putln (Util.entete "// " "");
[] -> () putln (gen_alice_stub args)
| [x] -> put x
| x::l' -> put x; put ", "; putlist l'
in
putln (Util.entete "// " "");
putln (gen_alice_stub args)
let (gen_alice_stub_h : alice_args -> unit) = let (gen_alice_stub_h : alice_args -> unit) =
......
...@@ -480,7 +480,7 @@ Input procedures must be used: ...@@ -480,7 +480,7 @@ Input procedures must be used:
) )
in_vars; in_vars;
let lut_file = (List.hd option.env) (* only work with lutin XXX fixme? *) in let _lut_file = (List.hd option.env) (* only work with lutin XXX fixme? *) in
(* let lut_dir = Filename.dirname lut_file in *) (* let lut_dir = Filename.dirname lut_file in *)
putln (" putln ("
/*-------- /*--------
......
...@@ -83,119 +83,119 @@ let (get_all_formula: t -> formula list) = ...@@ -83,119 +83,119 @@ let (get_all_formula: t -> formula list) =
fun a -> fun a ->
let rec aux a acc = let rec aux a acc =
let (a', f, _nl) = choose_one_formula a in let (a', f, _nl) = choose_one_formula a in
if no_more_formula a' then acc else (aux a' (f::acc)) if no_more_formula a' then acc else (aux a' (f::acc))
in in
aux a [] aux a []
(****************************************************************************) (****************************************************************************)
let rec (wt_list_to_cont : Var.env_in -> Prog.state -> wt_cont list -> let rec (wt_list_to_cont : Var.env_in -> Prog.state -> wt_cont list ->
formula -> node list -> t -> t) = formula -> node list -> t -> t) =
fun input state wtl facc nl fgen -> fun input state wtl facc nl fgen ->
(* [nl] is the list of nodes that correspond to [facc] *) (* [nl] is the list of nodes that correspond to [facc] *)
let _ = if debug then (print_string "XXX wt_list_to_cont\n"; flush stdout) in let _ = if debug then (print_string "XXX wt_list_to_cont\n"; flush stdout) in
match wtl with match wtl with
| [] -> Cont (fun () -> (fgen, facc, nl)) | [] -> Cont (fun () -> (fgen, facc, nl))
| wt::wtl' -> | wt::wtl' ->
if wt = WFinish then if wt = WFinish then
fgen fgen
else else
match choose_one_formula_atomic input state facc wt with match choose_one_formula_atomic input state facc wt with
| WFinish, False, "" -> | WFinish, False, "" ->
fgen fgen
| WStop str, _, "" -> | WStop str, _, "" ->
RStop str RStop str
| wt2, f2, n -> | wt2, f2, n ->
let fgen' = let fgen' =
Cont (fun () -> Cont (fun () ->
call_cont (wt_list_to_cont input state (wt2::wtl') facc nl fgen)) call_cont (wt_list_to_cont input state (wt2::wtl') facc nl fgen))
in in
wt_list_to_cont input state wtl' f2 (n::nl) fgen' wt_list_to_cont input state wtl' f2 (n::nl) fgen'
and and
(choose_one_formula_atomic : Var.env_in -> Prog.state -> (choose_one_formula_atomic : Var.env_in -> Prog.state ->
Exp.formula -> wt_cont -> wt_cont * formula * node) = Exp.formula -> wt_cont -> wt_cont * formula * node) =
fun input state facc cont -> fun input state facc cont ->
let _ = if debug then (print_string "XXX choose_one_formula_atomic\n"; flush stdout) in let _ = if debug then (print_string "XXX choose_one_formula_atomic\n"; flush stdout) in
match cont with match cont with
| WFinish -> WFinish, False, "" | WFinish -> WFinish, False, ""
| WStop _ -> cont, True, "" | WStop _ -> cont, True, ""
| WCont _ -> | WCont _ ->
let (cont', f, n) = call_wt_cont cont in let (cont', f, n) = call_wt_cont cont in
let _ = if debug then (print_string ("XXX "^ n ^ "\n"); flush stdout) in let _ = if debug then (print_string ("XXX "^ n ^ "\n"); flush stdout) in
let facc' = let facc' =
match f,facc with match f,facc with
True, True -> True True, True -> True
| True, f -> f | True, f -> f
| f, True -> f | f, True -> f
| _,_ -> And(f,facc) | _,_ -> And(f,facc)
in in
let ctx_msg = Prog.ctrl_state_to_string_long state.d.ctrl_state in let ctx_msg = Prog.ctrl_state_to_string_long state.d.ctrl_state in
Utils.time_C "is_sat"; Utils.time_C "is_sat";
let sat = (Solver.is_satisfiable input state.d.memory state.d.verbose ctx_msg facc' "") in let sat = (Solver.is_satisfiable input state.d.memory state.d.verbose ctx_msg facc' "") in
Utils.time_R "is_sat"; Utils.time_R "is_sat";
if sat then (cont', facc', n) if sat then (cont', facc', n)
else choose_one_formula_atomic input state facc cont' else choose_one_formula_atomic input state facc cont'
and (wt_to_cont : Var.env_in -> Prog.state -> wt -> wt_cont -> wt_cont) = and (wt_to_cont : Var.env_in -> Prog.state -> wt -> wt_cont -> wt_cont) =
fun input state (tbl, n) cont -> fun input state (tbl, n) cont ->
let _ = if debug then (print_string ("XXX wt_to_cont "^ n ^"\n"); flush stdout) in let _ = if debug then (print_string ("XXX wt_to_cont "^ n ^"\n"); flush stdout) in
let children = Util.StringMap.find n tbl in let children = Util.StringMap.find n tbl in
match children with match children with
| Prog.Stop str -> WStop str | Prog.Stop str -> WStop str
| Leave (f,nstate) -> WCont(fun () -> (cont, f, nstate)) | Leave (f,nstate) -> WCont(fun () -> (cont, f, nstate))
| Children l -> | Children l ->
if l = [] then if l = [] then
cont cont
else else
let (l1, l2) = List.partition (fun (dw,_) -> dw = Infin) l in let (l1, l2) = List.partition (fun (dw,_) -> dw = Infin) l in
(match l1 with (match l1 with
| [] -> | [] ->
let get_weigth dw = let get_weigth dw =
match dw with match dw with
| V i -> if i < 0 then 0 else i (* a negative weight means null weigth *) | V i -> if i < 0 then 0 else i (* a negative weight means null weigth *)
| Infin -> assert false | Infin -> assert false
in in
let w_sum = let w_sum =
List.fold_left (fun acc (dw,_) -> acc+(get_weigth dw)) 0 l2 List.fold_left (fun acc (dw,_) -> acc+(get_weigth dw)) 0 l2
in in
if w_sum = 0 then cont else if w_sum = 0 then cont else
let j = 1 + Random.int w_sum in let j = 1 + Random.int w_sum in
let rec get_jth_trans j list acc = let rec get_jth_trans j list acc =
match list with match list with
[] -> assert false [] -> assert false
| (dw,nt)::tail -> | (dw,nt)::tail ->
let newj = j - (get_weigth dw) in let newj = j - (get_weigth dw) in
if (newj < 1) then if (newj < 1) then
nt, (rev_append acc tail) nt, (rev_append acc tail)
else else
get_jth_trans newj tail ((dw,nt)::acc) get_jth_trans newj tail ((dw,nt)::acc)
in in
let (nt,l2') = get_jth_trans j l2 [] in let (nt,l2') = get_jth_trans j l2 [] in
let tbl' = Util.StringMap.add n (Children l2') tbl in let tbl' = Util.StringMap.add n (Children l2') tbl in
let tbl'' = Util.StringMap.remove n tbl in (* to optimize mem *) let tbl'' = Util.StringMap.remove n tbl in (* to optimize mem *)
let cont' = WCont(fun () -> let cont' = WCont(fun () ->
call_wt_cont (wt_to_cont input state (tbl', n) cont) call_wt_cont (wt_to_cont input state (tbl', n) cont)
) )
in in
wt_to_cont input state (tbl'', nt) cont' wt_to_cont input state (tbl'', nt) cont'
| [(_,nt)] -> | [(_,nt)] ->
let tbl' = Util.StringMap.add n (Children l2) tbl in let tbl' = Util.StringMap.add n (Children l2) tbl in
let tbl'' = Util.StringMap.remove n tbl in let tbl'' = Util.StringMap.remove n tbl in
let cont' = WCont(fun () -> let cont' = WCont(fun () ->
call_wt_cont (wt_to_cont input state (tbl', n) cont) call_wt_cont (wt_to_cont input state (tbl', n) cont)
) )
in in
wt_to_cont input state (tbl'', nt) cont' wt_to_cont input state (tbl'', nt) cont'
| _::_ -> | _::_ ->
failwith failwith
"Only one transition with a infinite weigth is allowed" "Only one transition with a infinite weigth is allowed"
) )
(****************************************************************************) (****************************************************************************)
(* NO LONGER EXPORTED *) (* NO LONGER EXPORTED *)
let (_internal_get : Var.env_in -> Prog.state -> t list) = let (_internal_get : Var.env_in -> Prog.state -> t list) =
...@@ -214,7 +214,7 @@ Utils.time_R "wt_to_cont"; ...@@ -214,7 +214,7 @@ Utils.time_R "wt_to_cont";
Utils.time_C "wt_list_to_cont"; Utils.time_C "wt_list_to_cont";
let res = wt_list_to_cont input state wt_cont_l True [] Finish in let res = wt_list_to_cont input state wt_cont_l True [] Finish in
Utils.time_R "wt_list_to_cont"; Utils.time_R "wt_list_to_cont";
res res
) )
nll nll
...@@ -222,17 +222,17 @@ Utils.time_R "wt_list_to_cont"; ...@@ -222,17 +222,17 @@ Utils.time_R "wt_list_to_cont";
(* EXPORTED *) (* EXPORTED *)
let rec (fgen_of_t : t -> FGen.t) = let rec (fgen_of_t : t -> FGen.t) =
fun t -> fun t ->
{ {
FGen.choose_one_formula = ( FGen.choose_one_formula = (
fun () -> fun () ->
let (t',s,f) = choose_one_formula t in let (t',s,f) = choose_one_formula t in
(fgen_of_t t',s,f) (fgen_of_t t',s,f)
) ; ) ;
FGen.get_all_formula = ( FGen.get_all_formula = (
fun () -> get_all_formula t fun () -> get_all_formula t
) )
} }
let get i s = List.map fgen_of_t (_internal_get i s) let get i s = List.map fgen_of_t (_internal_get i s)
This diff is collapsed.
...@@ -81,8 +81,7 @@ val find_some_sols : t -> Thickness.formula_draw_nb -> Thickness.numeric -> guar ...@@ -81,8 +81,7 @@ val find_some_sols : t -> Thickness.formula_draw_nb -> Thickness.numeric -> guar
val find_one_sol : t -> guard -> (Var.env_out * Var.env_loc) val find_one_sol : t -> guard -> (Var.env_out * Var.env_loc)
(* the "t" is given in order to filter necessary pres, not really necessary *) val make_pre : Var.env_in -> Var.env_out -> Var.env_loc -> Var.env
val make_pre : t -> Var.env_in -> Var.env_out -> Var.env_loc -> Var.env
(* (*
May raise Deadlock (or Event.Error ("deadlock",event)) May raise Deadlock (or Event.Error ("deadlock",event))
......
...@@ -320,7 +320,7 @@ let init_vars (it: t) = ( ...@@ -320,7 +320,7 @@ let init_vars (it: t) = (
(***********************************************************) (***********************************************************)
let add_support mode it id = (