Commit 41200721 authored by erwan's avatar erwan
Browse files

Update: Call the user-provided state parser.

parent e2c98267
Pipeline #25776 passed with stages
in 8 minutes and 57 seconds
(* Time-stamp: <modified the 21/06/2019 (at 17:22) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/06/2019 (at 18:21) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
......@@ -107,12 +107,9 @@ let (reg_value_of_string : (string -> 's) -> unit) =
if !verbose_level > 0 then Printf.printf "Registering value_of_string\n";
flush stdout;
Hashtbl.replace tbls.value_of_string "_global" (Obj.repr f)
let (get_value_of_string : unit -> string -> 's) = fun () ->
try Obj.obj (Hashtbl.find tbls.value_of_string "_global")
with Not_found ->
print_table "value_of_string" tbls.value_of_string;
raise (Unregistred ("value_of_string", "_global"))
let (get_value_of_string : unit -> (string -> 's) option) = fun () ->
try Some (Obj.obj (Hashtbl.find tbls.value_of_string "_global"))
with Not_found -> None
let (reg_copy_value : ('s -> 's) -> unit) =
......
(* Time-stamp: <modified the 21/06/2019 (at 17:23) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/06/2019 (at 18:21) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
......@@ -28,7 +28,7 @@ val get_step : algo_id -> 's step_fun
val get_init_state : algo_id -> int -> 's
val get_actions : algo_id -> action list
val get_value_to_string : unit -> 's -> string
val get_value_of_string : unit -> string -> 's
val get_value_of_string : unit -> (string -> 's) option
val get_copy_value : unit -> ('s -> 's)
val to_string : 's -> string
val set_card : int -> unit
......
(* Time-stamp: <modified the 21/06/2019 (at 16:55) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/06/2019 (at 18:17) by Erwan Jahier> *)
open Register
open Sasacore
......@@ -177,7 +177,14 @@ let (make : bool -> string array -> 'v t) =
let initl = List.map (fun n ->
let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
Register.get_init_state algo_id (List.length (g.succ n.id)))
let value_of_string_opt = Register.get_value_of_string () in
if value_of_string_opt = None || n.Topology.init = "" then
Register.get_init_state algo_id (List.length (g.succ n.id))
else
match value_of_string_opt with
| None -> assert false (* sno *)
| Some f -> f n.Topology.init
)
nl
in
......
(* Time-stamp: <modified the 21/06/2019 (at 14:52) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/06/2019 (at 18:14) by Erwan Jahier> *)
open Graph
open Graph.Dot_ast
......@@ -7,7 +7,7 @@ type node_id = string
type node = {
id: node_id;
file: string;
init: (string * string) list;
init: string;
}
......@@ -42,7 +42,7 @@ let (get_file: Dot_ast.node_id -> Dot_ast.attr list -> string) =
)
with Not_found -> failwith ((of_node_id node_id)^" should have an algo attribute")
let (get_init: Dot_ast.attr list -> (string * string) list ) =
let (get_init: Dot_ast.attr list -> string) =
fun attrs ->
let attrs = List.flatten attrs in (* XXX why a list of list ? *)
let init_list =
......@@ -50,17 +50,10 @@ let (get_init: Dot_ast.attr list -> (string * string) list ) =
(fun acc (id,idopt) ->
if id <> Ident "init" then acc else
match idopt with
| Some (String id) -> (
try
let i = String.index id '=' in
let l = String.length id in
(String.sub id 0 i, String.sub id (i+1) (l-i-1))::acc
with
Not_found -> acc
)
| Some (String id) -> id
| _ -> acc
)
[]
""
attrs
in
init_list
......
(* Time-stamp: <modified the 21/06/2019 (at 11:30) by Erwan Jahier> *)
(* Time-stamp: <modified the 21/06/2019 (at 18:13) by Erwan Jahier> *)
type node_id = string
type node = {
id: node_id; (* The id of the node as stated in the dot file *)
file: string; (* the content of the algo field (a cxms file) *)
init: (string * string) list; (* store the content of the init field *)
init: string; (* store the content of the init field *)
}
......
Supports Markdown
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