diff --git a/bin/process.ml b/bin/process.ml index df86eab56eed26b9ab3aa989e98c3870f1ccb4f9..cfd73e5ff7f99fcacefa1535e22175a6ba00cacc 100644 --- a/bin/process.ml +++ b/bin/process.ml @@ -1,9 +1,9 @@ -(* Time-stamp: <modified the 21/02/2019 (at 11:29) by Erwan Jahier> *) +(* Time-stamp: <modified the 09/03/2019 (at 11:41) by Erwan Jahier> *) type t = { pid : string; variables : Algo.vars; - init : Algo.local_env; + init : Algo.neighbor list -> Algo.local_env; enable : Algo.enable_fun; step : Algo.step_fun ; (* le demon choisi quelle action activer *) @@ -19,20 +19,25 @@ let (make: Topology.node -> t) = (* TODO: should I prevent the same cmxs to be loaded twice? Not clear. *) Dynlink.loadfile cmxs; let vars = Algo.get_vars id in - let init_env = Algo.get_init_vars id vars in - (* let (string_to_value: string -> Algo.value) = *) - let init_env v = + let user_init_env = Algo.get_init_vars id vars in + (* let (string_to_value: string -> Algo.value) = *) + let init_env nl v = match List.assoc_opt v n.Topology.init with - None -> init_env v + None -> + if !Algo.verbose_level > 1 then + Printf.eprintf "No init value for '%s' found in the graph.\n" v; + user_init_env nl v | Some x -> ( - match List.assoc_opt v vars with - | Some(Algo.It) - | Some(Algo.Nt) -> I (int_of_string x) - | Some(Algo.Bt) -> B (bool_of_string x) - | Some(Algo.Ft) -> F (float_of_string x) - | Some(Algo.Et _i) -> I (int_of_string x) - | None -> failwith (Printf.sprintf "%s is not a variable of program %s" v cmxs) - ) + match List.assoc_opt v vars with + | Some(Algo.Neighbor) + | Some(Algo.It) + | Some(Algo.Nt) -> I (int_of_string x) + | Some(Algo.Bt) -> B (bool_of_string x) + | Some(Algo.Ft) -> F (float_of_string x) + | Some(Algo.Et _i) -> I (int_of_string x) + | None -> + failwith (Printf.sprintf "%s is not a variable of program %s" v cmxs) + ) in let process = { pid = pid; diff --git a/bin/process.mli b/bin/process.mli index b1982d7494dc32320b37dcf904d5cd6ae181f97b..9d0237b95898c0c603f7094658885636904a0045 100644 --- a/bin/process.mli +++ b/bin/process.mli @@ -1,9 +1,9 @@ -(* Time-stamp: <modified the 18/02/2019 (at 15:39) by Erwan Jahier> *) +(* Time-stamp: <modified the 08/03/2019 (at 17:53) by Erwan Jahier> *) type t = { pid : string; (* unique *) variables : Algo.vars; - init : Algo.local_env; + init : Algo.neighbor list -> Algo.local_env; enable : Algo.enable_fun; step : Algo.step_fun ; } diff --git a/bin/sasa.ml b/bin/sasa.ml index 8110aa9613e2e3b72f6c0da25b18005a9f5f75ad..47865f5e9d6f13f5fcbf09964d8280f3d9793cd0 100644 --- a/bin/sasa.ml +++ b/bin/sasa.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 08/03/2019 (at 16:44) by Erwan Jahier> *) +(* Time-stamp: <modified the 09/03/2019 (at 12:39) by Erwan Jahier> *) (* XXX Je pourrais utiliser Lwt pour rendre step non-bloquant, ce qui permettrait d'accelerer la simu sur les machines qui ont plusieurs @@ -8,33 +8,22 @@ *) open Algo - -let (to_process: Env.t -> Topology.node -> Env.t * Process.t) = - fun e n -> - let p = Process.make n in - let e = List.fold_left - (fun e (n,_t) -> Env.set e p.pid n (p.init n)) - e - p.variables + +let (update_env_with_init : Env.t -> Process.t list -> Algo.neighbor list list -> Env.t) = + fun e pl neighbors -> + let (aux: Env.t -> Process.t -> Algo.neighbor list -> Env.t) = + fun e p nl -> + List.fold_left + (fun e (n,_t) -> Env.set e p.pid n (p.init nl n)) + e + p.variables in - e, p - -let (to_process_list : Env.t -> Topology.node list -> Env.t * Process.t list) = - fun e nl -> - List.fold_left - (fun (e,pl) n -> let e,p= to_process e n in e,p::pl) - (e,[]) nl + List.fold_left2 aux e pl neighbors - -(* Should be called after [to_process] has been called on all - Topology.nodes, which is ensured by the [process_are_created] ref -*) -let process_are_created = ref false let (get_neighors: Process.t -> Topology.neighbor list) = fun p -> - assert (!process_are_created); let id = p.Process.pid in - let idl = try Hashtbl.find Topology.node_succ id with Not_found -> [] in + let idl = try Hashtbl.find Topology.node_succ id with Not_found -> [] in List.map (fun id -> let node = @@ -133,13 +122,14 @@ let () = try Algo.verbose_level := SasArg.args.verbose; Random.self_init(); - Printf.printf "nodes: %s\nedges:\n" nstr; + if !Algo.verbose_level > 0 then Printf.printf "nodes: %s\nedges:\n" nstr; let e = Env.init () in - let e, pl = to_process_list e nl in - process_are_created := true; + let pl = List.map Process.make nl in let neighors = List.map get_neighors pl in + let algo_neighors = List.map (List.map (to_algo_neighbor e)) neighors in + let e = update_env_with_init e pl algo_neighors in let pl_n = List.combine pl neighors in - List.iter dump_process pl_n; + if !Algo.verbose_level > 0 then List.iter dump_process pl_n; let n = SasArg.args.length in simu n n pl pl_n e with diff --git a/bin/stringOf.ml b/bin/stringOf.ml index fc3a05b51fab790c3bc0ed3d6021aaa16f826d76..aaad4356e804ee43d6db0dda79c40e0eb231da75 100644 --- a/bin/stringOf.ml +++ b/bin/stringOf.ml @@ -6,6 +6,7 @@ let (algo_varT: Algo.varT -> string) = function | Ft -> "float" | Bt -> "bool" | Et i -> Printf.sprintf "enum(%d)" i + | Neighbor -> "Neighbor" let (algo_vars : Algo.vars -> string) = fun vars -> String.concat "," (List.map (fun (n,t) -> Printf.sprintf "%s:%s" n (algo_varT t)) vars) diff --git a/doc/README.md b/doc/README.md index 9ba3e1851472c86c250397ac0ef31f9113b191ee..0b64cd6f2655e2ec8e4d5ae9097f95c9a6c133d7 100644 --- a/doc/README.md +++ b/doc/README.md @@ -1,7 +1,7 @@ -- [Dot files](#orga1a97e0) -- [Algorithms](#orgf52cd3e) -- [Simulation](#orgbe2dc00) -- [Installation (not yet working)](#orgdeec637) +- [Dot files](#org2f54426) +- [Algorithms](#org5c3306f) +- [Simulation](#org087d55e) +- [Installation (not yet working)](#org8ba7b3c) Basically, one needs to provide @@ -9,7 +9,7 @@ Basically, one needs to provide 2. the algorithms mentionned in the dot file -<a id="orga1a97e0"></a> +<a id="org2f54426"></a> # Dot files @@ -33,7 +33,7 @@ graph ring { ``` -<a id="orgf52cd3e"></a> +<a id="org5c3306f"></a> # Algorithms @@ -51,16 +51,32 @@ More precisely, each algorithm should provide 3 functions that must be registred which profiles is defined in [algo.mli](https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa/blob/master/lib/algo/algo.mli) +One can also register a function that provides initial values to local variables (`reg_init`). If not such registration is done, local variables will be set according to `init` annotations in the dot file. If no such annotations exists, initial values will be chosen at random. + +```dot +graph ring { + p1 [algo="some_algo.cmxs" init="v=1" init="x=3"] + p2 [algo="some_algo.cmxs"] + p3 [algo="some_algo.cmxs"] + p4 [algo="some_algo.cmxs"] + p5 [algo="some_algo.cmxs"] + p6 [algo="some_algo.cmxs"] + p7 [algo="some_algo.cmxs"] + + p1 -- p2 -- p3 -- p4 -- p5 -- p6 -- p7 -- p1 +} +``` + Algorithms must then be compiled with `ocamlopt -shared` to produce the cmxs files mentionned in the dot file algo fields. ```sh ocamlopt -shared -I +sasa some_algo.ml -o some_algo.cmxs ``` -Some examples can be found in the <./test/> directory. +Some examples can be found in the [test](https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa/tree/master/test) directory. -<a id="orgbe2dc00"></a> +<a id="org087d55e"></a> # Simulation @@ -70,7 +86,7 @@ sasa --help ``` -<a id="orgdeec637"></a> +<a id="org8ba7b3c"></a> # Installation (not yet working) diff --git a/doc/README.org b/doc/README.org index edda1b73f92a7198c06a22db825046696cc0ed29..a1350e31b9e7f2ffe2301f3b21038ebd299c97a6 100644 --- a/doc/README.org +++ b/doc/README.org @@ -41,6 +41,26 @@ registred using the string used in dot file algo fields with: which profiles is defined in [[https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa/blob/master/lib/algo/algo.mli][algo.mli]] +One can also register a function that provides initial values to local +variables (=reg_init=). If not such registration is done, local +variables will be set according to =init= annotations in the dot +file. If no such annotations exists, initial values will be chosen at +random. + +#+BEGIN_SRC dot +graph ring { + p1 [algo="some_algo.cmxs" init="v=1" init="x=3"] + p2 [algo="some_algo.cmxs"] + p3 [algo="some_algo.cmxs"] + p4 [algo="some_algo.cmxs"] + p5 [algo="some_algo.cmxs"] + p6 [algo="some_algo.cmxs"] + p7 [algo="some_algo.cmxs"] + + p1 -- p2 -- p3 -- p4 -- p5 -- p6 -- p7 -- p1 +} +#+END_SRC + Algorithms must then be compiled with =ocamlopt -shared= to produce the cmxs files mentionned in the dot file algo fields. @@ -48,7 +68,7 @@ the cmxs files mentionned in the dot file algo fields. ocamlopt -shared -I +sasa some_algo.ml -o some_algo.cmxs #+END_SRC -Some examples can be found in the [[file:./test/]] directory. +Some examples can be found in the [[https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa/tree/master/test][test]] directory. * Simulation diff --git a/lib/algo/algo.ml b/lib/algo/algo.ml index b3fdf62042a63a9244901105c7c8f8a396ca2fbe..1793000cd3151224afc8a536b2bf4f145a50e6a7 100644 --- a/lib/algo/algo.ml +++ b/lib/algo/algo.ml @@ -1,9 +1,9 @@ -(* Time-stamp: <modified the 06/03/2019 (at 17:17) by Erwan Jahier> *) +(* Time-stamp: <modified the 09/03/2019 (at 12:09) by Erwan Jahier> *) (** Process programmer API *) -type varT = It | Nt | Ft | Bt | Et of int +type varT = It | Nt | Ft | Bt | Et of int | Neighbor type action = string (* juste un label *) -type value = I of int | F of float | B of bool | S of string +type value = I of int | F of float | B of bool | S of string | N of int type local_env = string -> value type vars = (string * varT) list @@ -18,7 +18,7 @@ type step_fun = neighbor list -> local_env -> action -> local_env type int_tables = { vars: (string, vars) Hashtbl.t; - init_vars: (string, local_env) Hashtbl.t; + init_vars: (string, neighbor list -> local_env) Hashtbl.t; enable: (string, enable_fun) Hashtbl.t; step: (string, step_fun) Hashtbl.t; } @@ -35,7 +35,8 @@ let tbls = { let verbose_level = ref 0 let value_to_string = function - | I i -> string_of_int i + | I i + | N i -> string_of_int i | F f -> string_of_float f | B true -> "t" | B false -> "f" @@ -50,7 +51,8 @@ let print_table lbl tbl = type algo_id = string -let (reg_vars : algo_id -> (string * varT) list -> unit) = fun algo_id x -> +let (reg_vars : algo_id -> (string * varT) list -> unit) = + fun algo_id x -> if !verbose_level > 0 then Printf.printf "Registering %s vars\n" algo_id; flush stdout; Hashtbl.replace tbls.vars algo_id x @@ -60,28 +62,45 @@ let (get_vars : string -> (string * varT) list) = fun algo_id -> print_table "vars" tbls.vars; raise (Unregistred ("variable", algo_id)) -let (reg_init_vars : algo_id -> local_env -> unit) = fun algo_id x -> +let (reg_init_vars : algo_id -> (neighbor list -> local_env) -> unit) = fun algo_id x -> if !verbose_level > 0 then Printf.printf "Registering %s init_vars\n" algo_id; flush stdout; Hashtbl.replace tbls.init_vars algo_id x -let (get_init_vars : algo_id -> (string * varT) list -> local_env) = - fun algo_id vars -> - try Hashtbl.find tbls.init_vars algo_id - with Not_found -> - (fun v -> - match List.find_opt (fun (x,_t) -> x=v) vars with - None -> failwith (v^" unknown var") - | Some(_,It) - | Some(_,Nt) -> I (Random.int 100000) - | Some(_,Bt) -> B (Random.bool ()) - | Some(_,Ft) -> F (Random.float max_float) - | Some(_,Et i) -> I (Random.int i) - ) +let (get_init_vars : algo_id -> (string * varT) list -> (neighbor list -> local_env)) = + fun algo_id vars -> + let default_env = + (fun nl v -> + match List.find_opt (fun (x,_t) -> x=v) vars with + None -> failwith (v^" unknown var") + | Some(_,Neighbor) -> + assert (nl <> []); + N (Random.int ((List.length nl)-1)) + | Some(_,It) + | Some(_,Nt) -> I (Random.int 100000) + | Some(_,Bt) -> B (Random.bool ()) + | Some(_,Ft) -> F (Random.float max_float) + | Some(_,Et i) -> I (Random.int i) + ) + in + try + let user_env = Hashtbl.find tbls.init_vars algo_id in + (fun nl v -> + try user_env nl v + with e -> + if !verbose_level > 1 then + Printf.eprintf "No init value for '%s' in user init function (%s).\n" v + (Printexc.to_string e); + default_env nl v) + with Not_found -> + if !verbose_level > 1 then + Printf.eprintf "No user init function is provided.\n"; + default_env + let (reg_enable : algo_id -> enable_fun -> unit) = fun algo_id x -> - if !verbose_level > 0 then Printf.printf "Registering %s enable\n" algo_id; - flush stdout; - Hashtbl.replace tbls.enable algo_id x + if !verbose_level > 0 then Printf.printf "Registering %s enable\n" algo_id; + flush stdout; + Hashtbl.replace tbls.enable algo_id x let (get_enable : algo_id -> enable_fun) = fun algo_id -> try Hashtbl.find tbls.enable algo_id with Not_found -> diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli index 04080a305464e002e2971fb2f55b39266f06461d..600a360528354cc9b41f60af13dcd2f65996907d 100644 --- a/lib/algo/algo.mli +++ b/lib/algo/algo.mli @@ -1,11 +1,12 @@ -(* Time-stamp: <modified the 06/03/2019 (at 17:05) by Erwan Jahier> *) +(* Time-stamp: <modified the 08/03/2019 (at 17:51) by Erwan Jahier> *) (** Process programmer API *) type value = I of int | F of float | B of bool | S of string + | N of int (* neighbor canal number *) type local_env = string -> value (* XXX assez efficace ? *) type action = string (* label? *) -type varT = It | Nt | Ft | Bt | Et of int (* XXX what else ? *) +type varT = It | Nt | Ft | Bt | Et of int | Neighbor type vars = (string * varT) list type neighbor = { @@ -24,7 +25,7 @@ val reg_enable : algo_id -> enable_fun -> unit val reg_step : algo_id -> step_fun -> unit (** nb: The initialisation done in the dot file have priority over this one *) -val reg_init_vars : algo_id -> local_env -> unit +val reg_init_vars : algo_id -> (neighbor list -> local_env) -> unit (** util(s) *) val value_to_string : value -> string @@ -41,7 +42,7 @@ exception Unregistred of string * string (** the following functions are used by sasa *) val get_vars : algo_id -> vars -val get_init_vars : algo_id -> (string * varT) list -> local_env +val get_init_vars : algo_id -> (string * varT) list -> (neighbor list -> local_env) val get_enable : algo_id -> enable_fun val get_step : algo_id -> step_fun diff --git a/test/Makefile b/test/Makefile index 3036707f6a008ec1938fa566b003427fd0135995..51004cabf7d84279f22b8fd9d4138a2a6743136c 100644 --- a/test/Makefile +++ b/test/Makefile @@ -3,8 +3,10 @@ test: cd dijkstra-ring/ && make cd unison/ && make cd coloring/ && make + cd bfs-spanning-tree/ && make clean: cd dijkstra-ring/ && make clean cd unison/ && make clean cd coloring/ && make clean + cd bfs-spanning-tree/ && make clean diff --git a/test/Makefile.inc b/test/Makefile.inc index 628964fad3c35164a33bf51e751c1c5f76992d67..4bbae8998c8b7381cd23ba17ed3965d13c4e6de0 100644 --- a/test/Makefile.inc +++ b/test/Makefile.inc @@ -1,4 +1,4 @@ -# Time-stamp: <modified the 07/03/2019 (at 14:27) by Erwan> +# Time-stamp: <modified the 09/03/2019 (at 14:32) by Erwan Jahier> DIR=~/sasa/_build/install/default @@ -14,4 +14,4 @@ MLI=-I $(DIR)/lib/algo ocamlopt -shared $(MLI) $^ -o $@ clean: - rm -f *.cmxs sasa *.cmi *.o *.cmx *.pdf + rm -f *.cmxs sasa *.cmi *.o *.cmx *.pdf diff --git a/test/bfs-spanning-tree/Makefile b/test/bfs-spanning-tree/Makefile index a111c0b5e268b080fdb775db8128d5a3ed19bca3..74c2b83568794618b55671b516fabca0fe71040e 100644 --- a/test/bfs-spanning-tree/Makefile +++ b/test/bfs-spanning-tree/Makefile @@ -1,7 +1,10 @@ -# Time-stamp: <modified the 08/03/2019 (at 16:12) by Erwan Jahier> +# Time-stamp: <modified the 09/03/2019 (at 12:03) by Erwan Jahier> test: root.cmxs p.cmxs + $(sasa) -l 200 fig5.1-noinit.dot -sd + +test2: root.cmxs p.cmxs $(sasa) -l 200 fig5.1.dot -sd -include ../Makefile.inc diff --git a/test/bfs-spanning-tree/fig5.1-noinit.dot b/test/bfs-spanning-tree/fig5.1-noinit.dot new file mode 100644 index 0000000000000000000000000000000000000000..3ad5d0c9b45b27395ebe0c3e885be6797996a3aa --- /dev/null +++ b/test/bfs-spanning-tree/fig5.1-noinit.dot @@ -0,0 +1,14 @@ +graph fig4_1 { + + p1 [algo="root.cmxs" ] + p2 [algo="p.cmxs"] + p3 [algo="p.cmxs"] + p4 [algo="p.cmxs"] + p5 [algo="p.cmxs"] + p6 [algo="p.cmxs"] + p7 [algo="p.cmxs"] + p8 [algo="p.cmxs"] + + p1 -- p2 -- p3 -- p4 -- p5 -- p6 -- p7 -- p8 -- p1 + p3 -- p7 +} diff --git a/test/bfs-spanning-tree/p.ml b/test/bfs-spanning-tree/p.ml index 31ed9d7c6e05dd8a31c813f33e1867f77882766a..ba4e5b982e99c1d4a466f0b48e392f668e485ab2 100644 --- a/test/bfs-spanning-tree/p.ml +++ b/test/bfs-spanning-tree/p.ml @@ -1,19 +1,20 @@ -(* Time-stamp: <modified the 08/03/2019 (at 16:50) by Erwan Jahier> *) +(* Time-stamp: <modified the 09/03/2019 (at 12:45) by Erwan Jahier> *) (* This is algo 5.4 in the book *) open Algo -let vars = ["d",It; "par",It; ] +let vars = ["d",It; "par",Neighbor ] let d=10 -let init_vars = function +let (init_vars: neighbor list -> local_env) = + fun nl -> function | "d" -> I (Random.int d) - | "par" -> I (0) (* the init should be done the graph *) - | _ -> assert false - + | "par" -> N (Random.int ((List.length nl)-1)) + | _ -> raise Not_found + (* casting *) -let i v = match v with I i -> i | _ -> assert false +let i v = match v with I i | N i -> i | _ -> assert false let (dist: neighbor list -> int) = fun nl -> let dl = List.map (fun n -> i (n.lenv "d")) nl in @@ -25,11 +26,18 @@ let (dist_ok: neighbor list -> local_env -> bool) = let md = List.fold_left min (List.hd dl) (List.tl dl) in i (e "d") - 1 = md -let enable_f nl e = - let par = List.nth nl (i (e "par")) in - let par_env = par.lenv in - (if i (e "d") <> dist nl then ["CD"] else []) @ - (if (dist_ok nl e) && (i (par_env "d") <> i (e "d") -1) then ["CP"] else []) +let (get_parent: neighbor list -> local_env -> neighbor) = + fun nl e -> + let canal = i (e "par") in + try List.nth nl canal + with Failure _ -> failwith (Printf.sprintf "Canal %i does not exist (canal in [0..%i])\n" canal ((List.length nl)-1)) + +let (enable_f:neighbor list -> local_env -> action list) = + fun nl e -> + let par = get_parent nl e in + let par_env = par.lenv in + (if i (e "d") <> dist nl then ["CD"] else []) @ + (if (dist_ok nl e) && (i (par_env "d") <> i (e "d") -1) then ["CP"] else []) let (index_of_first_true : bool list -> int) = fun bl -> @@ -41,19 +49,20 @@ let (index_of_first_true : bool list -> int) = fun bl -> in f 0 bl -let step_f nl e = - function - | "CD" -> (function "d" -> I (dist nl) | o -> e o) - | "CP" -> ( - function - | "par" -> - let d = i (e "d") in - let ok_l = List.map (fun n -> i (n.lenv "d") = d-1) nl in - let q = index_of_first_true ok_l in - I q - | o -> e o - ) - | _ -> assert false +let (step_f : neighbor list -> local_env -> action -> local_env) = + fun nl e -> + function + | "CD" -> (function "d" -> I (dist nl) | o -> e o) + | "CP" -> ( + function + | "par" -> + let d = i (e "d") in + let ok_l = List.map (fun n -> i (n.lenv "d") = d-1) nl in + let q = index_of_first_true ok_l in + I q + | o -> e o + ) + | _ -> assert false let () = let algo_id = "p" in diff --git a/test/bfs-spanning-tree/root.ml b/test/bfs-spanning-tree/root.ml index ef7e0f7b7f5ae9e10a489667cf49e42213d53a5c..0faefc0cdbd9f93270d2c51d04067a230bd7906d 100644 --- a/test/bfs-spanning-tree/root.ml +++ b/test/bfs-spanning-tree/root.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 08/03/2019 (at 13:54) by Erwan Jahier> *) +(* Time-stamp: <modified the 09/03/2019 (at 12:47) by Erwan Jahier> *) (* This is algo 5.3 in the book *) @@ -7,12 +7,17 @@ open Algo let vars = ["d",It] let d=10 -let init_vars = function _ -> I (Random.int d) +let (init_vars: neighbor list -> local_env) = + fun _nl -> + function _ -> I (Random.int d) -let enable_f nl e = if (e "d") <> I 0 then ["CD"] else [] +let (enable_f:neighbor list -> local_env -> action list) = + fun nl e -> + if (e "d") <> I 0 then ["CD"] else [] -let step_f nl e = function | _ -> (function "d" -> I 0 | _ -> assert false) - +let (step_f : neighbor list -> local_env -> action -> local_env) = + fun nl e -> + function | _ -> (function "d" -> I 0 | _ -> assert false) let () = let algo_id = "root" in diff --git a/test/coloring/p.ml b/test/coloring/p.ml index 28c69540b8a1538902c038eb503db95f21d4fb31..de016aef32c96a6cdd824b60100b9786836063af 100644 --- a/test/coloring/p.ml +++ b/test/coloring/p.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 07/03/2019 (at 16:25) by Erwan> *) +(* Time-stamp: <modified the 09/03/2019 (at 14:22) by Erwan Jahier> *) (* This is algo 3.1 in the book *) @@ -7,7 +7,9 @@ open Algo let vars = ["c",It] let k=3 -let init_vars = function _ -> I (Random.int k) +let (init_vars: neighbor list -> local_env) = + fun _nl -> + function _ -> I (Random.int k) let (used : neighbor list -> Algo.value list) = fun nl -> @@ -26,11 +28,13 @@ let (free : neighbor list -> Algo.value list) = fun nl -> let res = aux [] used_list 0 in List.rev res -let enable_f nl e = if List.mem (e "c") (used nl) then ["conflict"] else [] +let (enable_f:neighbor list -> local_env -> action list) = + fun nl e -> + if List.mem (e "c") (used nl) then ["conflict"] else [] -let step_f nl e = - function | _ -> (function "c" -> List.hd (free nl) | _ -> assert false) - +let (step_f : neighbor list -> local_env -> action -> local_env) = + fun nl e -> + function | _ -> (function "c" -> List.hd (free nl) | _ -> assert false) let () = let algo_id = "p" in diff --git a/test/dijkstra-ring/ring.ml b/test/dijkstra-ring/ring.ml index 6a24289604ea350b388b068b4cc4d5e112ea0ee4..80ee18a868c0b7cef3ff070c362043b92d3ac170 100644 --- a/test/dijkstra-ring/ring.ml +++ b/test/dijkstra-ring/ring.ml @@ -1,25 +1,25 @@ -(* Time-stamp: <modified the 21/02/2019 (at 14:56) by Erwan Jahier> *) +(* Time-stamp: <modified the 09/03/2019 (at 14:19) by Erwan Jahier> *) open Algo let vars = ["v",It] let k=42 -let init_vars = function _ -> I (Random.int k) +let (init_vars: neighbor list -> local_env) = + fun _nl -> + function _ -> I (Random.int k) -(* XXX comment donner des valeurs initiales differentes selon les - instances ??? Le faire au niveau du dot ? -*) - -let enable_f nl e = - let pred = List.hd nl in - if e "v" <> pred.lenv "v" then ["g"] else [] - -let step_f nl e = - function - | _ -> +let (enable_f:neighbor list -> local_env -> action list) = + fun nl e -> let pred = List.hd nl in - (function "v" -> pred.lenv "v" | _ -> assert false) + if e "v" <> pred.lenv "v" then ["g"] else [] + +let (step_f : neighbor list -> local_env -> action -> local_env) = + fun nl e -> + function + | _ -> + let pred = List.hd nl in + (function "v" -> pred.lenv "v" | _ -> assert false) let () = diff --git a/test/dijkstra-ring/ringroot.ml b/test/dijkstra-ring/ringroot.ml index 5e1f24a1ce76bdc0c7040c00e0e7b823be0c23cf..499295061a7d2dbc5ce2eecc67150dae80d03c40 100644 --- a/test/dijkstra-ring/ringroot.ml +++ b/test/dijkstra-ring/ringroot.ml @@ -1,28 +1,30 @@ +(* Time-stamp: <modified the 09/03/2019 (at 14:20) by Erwan Jahier> *) open Algo let vars = ["v",It] let k=42 +let (init_vars: neighbor list -> local_env) = + fun _nl -> + function _ -> I (Random.int k) -let init_vars = function _ -> I (Random.int k) - - -let enable_f nl e = - let pred = List.hd nl in - if e "v" = pred.lenv "v" then ["g"] else [] +let (enable_f:neighbor list -> local_env -> action list) = + fun nl e -> + let pred = List.hd nl in + if e "v" = pred.lenv "v" then ["g"] else [] let i e v = match e v with I i -> i | _ -> failwith "type error" -let step_f nl e = - function - | _ -> - let vv = i e "v" in - (function "v" -> I ((vv +1) mod k) | _ -> assert false) - +let (step_f : neighbor list -> local_env -> action -> local_env) = + fun nl e -> + function + | _ -> + let vv = i e "v" in + (function "v" -> I ((vv +1) mod k) | _ -> assert false) let () = - let algo_id = "ringroot" in (* XXX comment automatiser ca ??? *) + let algo_id = "ringroot" in Algo.reg_vars algo_id vars; Algo.reg_init_vars algo_id init_vars; Algo.reg_enable algo_id enable_f; diff --git a/test/unison/unison.ml b/test/unison/unison.ml index a4ef3ce2561155cdd11c23e19fe83ec23de83dd6..d2eda26054bb86417417b49eef93846f3a3277f9 100644 --- a/test/unison/unison.ml +++ b/test/unison/unison.ml @@ -1,11 +1,13 @@ -(* Time-stamp: <modified the 07/03/2019 (at 16:42) by Erwan> *) +(* Time-stamp: <modified the 09/03/2019 (at 14:23) by Erwan Jahier> *) open Algo let vars = ["clock",It] let m=10 -let init_vars = function _ -> I (Random.int m) +let (init_vars: neighbor list -> local_env) = + fun _nl -> + function _ -> I (Random.int m) let list_min l = match l with @@ -20,12 +22,13 @@ let new_clock_value nl e = let min_clock = List.fold_left min (i e "clock") cl in (min_clock + 1) mod m -let enable_f nl e = - if I (new_clock_value nl e) <> e "clock" then ["incr"] else [] +let (enable_f:neighbor list -> local_env -> action list) = + fun nl e -> + if I (new_clock_value nl e) <> e "clock" then ["incr"] else [] -let step_f nl e = - function | _ -> (function "clock" -> I (new_clock_value nl e) | _ -> assert false) - +let (step_f : neighbor list -> local_env -> action -> local_env) = + fun nl e -> + function | _ -> (function "clock" -> I (new_clock_value nl e) | _ -> assert false) let () = let algo_id = "unison" in