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) = let get_state_info (it:t) (ix: string) = StringMap.find ix it.states
StringMap.find ix it.states
(* (*
*) *)
......
...@@ -193,12 +193,12 @@ let rec of_texp = ( function ...@@ -193,12 +193,12 @@ let rec of_texp = ( function
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
......
...@@ -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 diff is collapsed.
...@@ -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,13 +233,7 @@ let (gen_alice_stub_c : alice_args -> unit) = ...@@ -233,13 +233,7 @@ 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
[] -> ()
| [x] -> put x
| x::l' -> put x; put ", "; putlist l'
in
putln (Util.entete "// " ""); putln (Util.entete "// " "");
putln (gen_alice_stub args) putln (gen_alice_stub args)
......
...@@ -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 ("
/*-------- /*--------
......
...@@ -222,8 +222,8 @@ Utils.time_R "wt_list_to_cont"; ...@@ -222,8 +222,8 @@ 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
...@@ -232,7 +232,7 @@ fun t -> ...@@ -232,7 +232,7 @@ fun t ->
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 = ( let add_support mode it id = (
let nme = CoIdent.to_string id in let nme = CoIdent.to_string id in
let info = Util.hfind (Expand.support_tab source_code) id in let info = Util.StringMap.find id (Expand.support_tab source_code) in
(* Verbose.put ~flag:dbg " LutProg.add_support \"%s\"\n" nme; *) (* 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 let res = lucky_make_var it mnode nme (lucky_type_of info.Expand.si_type) mode info.Expand.si_range in
(* init ? *) (* init ? *)
...@@ -344,7 +344,7 @@ let init_vars (it: t) = ( ...@@ -344,7 +344,7 @@ let init_vars (it: t) = (
let add_alias it id = ( let add_alias it id = (
let nme = CoIdent.to_string id in let nme = CoIdent.to_string id in
Verbose.put ~flag:dbg " LutProg.add_alias \"%s\"\n" nme; Verbose.put ~flag:dbg " LutProg.add_alias \"%s\"\n" nme;
let info = Util.hfind (Expand.alias_tab source_code) id in let info = Util.StringMap.find id (Expand.alias_tab source_code) in
(* les alias sont des Local spciaux en lucky *) (* les alias sont des Local spciaux en lucky *)
let res = Var.set_alias let res = Var.set_alias
(lucky_make_var it mnode nme (lucky_type_of info.Expand.ai_type) Var.Local None) (lucky_make_var it mnode nme (lucky_type_of info.Expand.ai_type) Var.Local None)
......
(* Time-stamp: <modified the 10/04/2019 (at 10:10) by Erwan Jahier> *) (* Time-stamp: <modified the 12/04/2019 (at 11:32) by Erwan Jahier> *)
(**********************************************************************************) (**********************************************************************************)
type vars = (string * Data.t) list type vars = (string * Data.t) list
...@@ -23,6 +23,10 @@ open RdbgPlugin ...@@ -23,6 +23,10 @@ open RdbgPlugin
type ctx = Event.t type ctx = Event.t
type e = Event.t type e = Event.t
let compact str =
let str = Str.global_replace (Str.regexp "\n") ";" str in
let str = Str.global_replace (Str.regexp "[ \t]+") "" str in
str
let make argv = let make argv =
let opt = MainArg.parse argv in let opt = MainArg.parse argv in
...@@ -122,8 +126,14 @@ let make argv = ...@@ -122,8 +126,14 @@ let make argv =
match Hashtbl.find_opt ss_table i with match Hashtbl.find_opt ss_table i with
| Some (cs, ds, prgs) -> | Some (cs, ds, prgs) ->
if Verbose.level() > 0 then ( if Verbose.level() > 0 then (
Printf.eprintf "Restore state %i from Lutin (%i)\n" i Printf.eprintf
(Random.State.bits (Random.State.copy prgs)); "Restore state %i from Lutin\n\tPRGS:%i\n\tins:%s\n\touts:%s\n\tmems:%s\n" i
(Random.State.bits (Random.State.copy prgs))
(compact (Value.OfIdent.to_string "" ds.LutExe.ins))
(compact (Value.OfIdent.to_string "" ds.LutExe.outs))
(compact (Value.OfIdent.to_string "" ds.LutExe.mems))
;
flush stderr flush stderr
); );
ctrl_state := cs; data_state := ds; ctrl_state := cs; data_state := ds;
......
...@@ -340,7 +340,7 @@ let to_exe oc infile mnode opt = ( ...@@ -340,7 +340,7 @@ let to_exe oc infile mnode opt = (
Rif.flush oc Rif.flush oc
); );
try try
let pres' = LutExe.make_pre exe ins outs locs in let pres' = LutExe.make_pre ins outs locs in
let ins' = Rif.read (Verbose.level()>0) stdin let ins' = Rif.read (Verbose.level()>0) stdin
(if noo then Some oc else None) in_vars in (if noo then Some oc else None) in_vars in
MainArg.event_incr opt; MainArg.event_incr opt;
......
...@@ -588,9 +588,6 @@ let parse argv = ( ...@@ -588,9 +588,6 @@ let parse argv = (
) )
opt._others); opt._others);
opt._infile <- (List.rev opt._others); opt._infile <- (List.rev opt._others);
let prog = opt._infile
and node = opt._main_node
in
current := save_current; current := save_current;
opt opt
) with ) with
......
...@@ -909,7 +909,7 @@ let (get_io_from_lustre : string -> string option -> ...@@ -909,7 +909,7 @@ let (get_io_from_lustre : string -> string option ->
let j1 = Str.search_forward (Str.regexp ")") str i1 in let j1 = Str.search_forward (Str.regexp ")") str i1 in
let i2 = 1+Str.search_forward (Str.regexp "(") str j1 in let i2 = 1+Str.search_forward (Str.regexp "(") str j1 in
let j2 = Str.search_forward (Str.regexp ")") str i2 in let j2 = Str.search_forward (Str.regexp ")") str i2 in
let remove_comment str = let _remove_comment str =
let comment1 = Str.regexp "--[.]*\n" let comment1 = Str.regexp "--[.]*\n"
and comment2 = Str.regexp ".(\*[^\*]*\*)" and comment2 = Str.regexp ".(\*[^\*]*\*)"
in in
...@@ -918,9 +918,9 @@ let (get_io_from_lustre : string -> string option -> ...@@ -918,9 +918,9 @@ let (get_io_from_lustre : string -> string option ->
str str
in in
let input_str = String.sub str i1 (j1-i1) in let input_str = String.sub str i1 (j1-i1) in
(* let input_str = remove_comment input_str in *) (* let input_str = remove_comment input_str in *)
let output_str = String.sub str i2 (j2-i2) in let output_str = String.sub str i2 (j2-i2) in
(* let output_str = remove_comment output_str in *) (* let output_str = remove_comment output_str in *)
let get_io_from_str s = let get_io_from_str s =
let decls = Str.split (Str.regexp ";") s in let decls = Str.split (Str.regexp ";") s in
let rm_blank s = let rm_blank s =
......
...@@ -51,7 +51,7 @@ let (from_data_val : Data.v -> t) = ...@@ -51,7 +51,7 @@ let (from_data_val : Data.v -> t) =
| Data.I i -> N(I (Num.num_of_int i)) | Data.I i -> N(I (Num.num_of_int i))
| Data.F f -> N(F f) | Data.F f -> N(F f)
| Data.U -> failwith "undefined variable" | Data.U -> failwith "undefined variable"
| (E (_, _)|A _|S _) -> assert false
(* exported *) (* exported *)
let (num_value_to_string : num -> string) = let (num_value_to_string : num -> string) =
fun n -> fun n ->
...@@ -90,7 +90,8 @@ module OfIdent = struct ...@@ -90,7 +90,8 @@ module OfIdent = struct
let union (x1:t) (x2:t) = IdentMap.fold (fun n v x -> add x (n,v)) x1 x2 let union (x1:t) (x2:t) = IdentMap.fold (fun n v x -> add x (n,v)) x1 x2
let support (x:t) = IdentMap.fold (fun n v acc -> n::acc) x [] let support (x:t) = IdentMap.fold (fun n v acc -> n::acc) x []
let partition f (x:t) = IdentMap.fold let partition f (x:t) = IdentMap.fold
(fun n v (yes, no) -> if f (n,v) then (add yes (n,v), no) else (yes, add no (n,v))) x (empty,empty) (fun n v (yes, no) ->
if f (n,v) then (add yes (n,v), no) else (yes, add no (n,v))) x (empty,empty)
let content (x:t) = ( let content (x:t) = (
List.fast_sort (fun (vn1, _) (vn2, _) -> compare vn1 vn2) List.fast_sort (fun (vn1, _) (vn2, _) -> compare vn1 vn2)
(IdentMap.fold (fun n v acc -> (n,v)::acc) x []) (IdentMap.fold (fun n v acc -> (n,v)::acc) x [])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment