process.ml

(* Time-stamp: <modified the 30/04/2019 (at 16:02) by Erwan Jahier> *)

type t = {
  pid : string;
  variables : Algo.vars;
  actions: Algo.action list;
  init : Algo.neighbor list -> Algo.local_env;
  enable : Algo.enable_fun;
  step : Algo.step_fun ;
}

let (make: bool -> bool -> Topology.node -> t) =
  fun dynlink custom_mode n ->
    let pid = n.Topology.id in
    let cmxs = n.Topology.file in
    let id = Filename.chop_suffix cmxs ".cmxs" in
    if !Algo.verbose_level > 0 then Printf.printf "Loading %s...\n" cmxs;
    (* XXX TODO: should I prevent the same cmxs to be loaded twice? Not clear. *)
    if dynlink then Dynlink.loadfile (Dynlink.adapt_filename cmxs);
    let vars = Algo.get_vars id in
    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 ->
        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)
            | Some(Algo.St) -> S "dummy"
            | Some(Algo.At(_t,_i)) -> assert false (* A (Array.make i *)
                                    
            | None ->
              failwith (Printf.sprintf "%s is not a variable of program %s" v cmxs)
          )
    in
    let actions =
      try Algo.get_actions id
      with _ ->
        if custom_mode then
          failwith
            "Registering actions is mandatory in algorithms when using custom demon!"
        else ["a"]
    in
    let process = {
      pid = pid; 
      variables = vars ;
      init = init_env ;
      actions = actions;
      enable = Algo.get_enable id; 
      step = Algo.get_step id;
    }
    in
    process