Hide DAG implementation from protocol specification

experiments/simulate-topology/igraph.ml

@@ -34,11 +34,11 @@ let run ~activations ~srcfile ~protocol =
   let* g = GraphML.load_graph srcfile in
   let* net, to_graphml = Network.of_graphml g in
   let clock = Mtime_clock.counter () in
-  let env = Simulator.(init protocol net) in
-  let (module Ref) = env.referee in
-  let () = Simulator.loop ~activations env in
+  let sim = Simulator.(init protocol net) in
+  let (module Ref) = sim.referee in
+  let () = Simulator.loop ~activations sim in
   let machine_duration = Mtime_clock.count clock |> Mtime.Span.to_s in
-  let head = Simulator.head env in
+  let head = Simulator.head sim in
   let headd = Dag.data head in
   let name, ext = Fpath.(split_ext (base srcfile)) in
   let dstfile = Fpath.(outdir / strf "%a-%s-%s" pp name P.key ext) in
@@ -56,7 +56,7 @@ let run ~activations ~srcfile ~protocol =
   in
   let node_data i =
     [ "reward", float (Float.Array.get headd.rewards i)
-    ; "activations", int env.activations.(i)
+    ; "activations", int sim.activations.(i)
     ]
   in
   let g = to_graphml ~node_data ~graph_data () in

experiments/simulate/csv_runner.ml

@@ -4,13 +4,12 @@ type task =
   | Task :
       { activations : int
       ; network : Network.t
-      ; protocol : (module Protocol with type data = 'dag_data)
+      ; protocol : (module Protocol with type data = 'a)
       ; attack :
-          (('dag_data Simulator.env, 'dag_data) local_view
-           -> ('dag_data Simulator.env, 'dag_data) node)
+          (('a Simulator.block, 'a) view -> ('a Simulator.block, 'a) node)
           Collection.entry
           option
-      ; sim : (unit -> 'dag_data Simulator.state) Collection.entry
+      ; sim : (unit -> 'a Simulator.state) Collection.entry
       }
       -> task
 

experiments/simulate/visualize.ml

@@ -144,7 +144,7 @@ let tasks =
     ]
 ;;
 
-let print_dag oc (sim, confirmed, rewards, legend, vtx_info) =
+let print_dag (type a) oc (sim, confirmed, rewards, legend, vtx_info) =
   let open Simulator in
   let reward n = List.fold_left (fun s (_, x) -> s +. x) 0. rewards.(Dag.id n) in
   let node_attr n =
@@ -158,26 +158,23 @@ let print_dag oc (sim, confirmed, rewards, legend, vtx_info) =
     ; ("color", if confirmed.(Dag.id n) then "black" else "red")
     ]
   in
-  Dag.dot
-    (Format.formatter_of_out_channel oc)
-    ~legend
-    sim.global_view
-    ~node_attr
-    (Dag.roots sim.dag)
+  let (module Ref : Referee with type block = _ and type data = a) = sim.referee in
+  let module Tools = Dagtools.Make (Ref.Block) in
+  Tools.dot (Format.formatter_of_out_channel oc) ~legend ~node_attr (Dag.roots sim.dag)
   |> Result.ok
 ;;
 
 let run (Csv_runner.Task t) =
   (* simulate *)
   let open Simulator in
   let (module Protocol) = t.protocol in
-  let env = t.sim.it () in
-  let (module Ref) = env.referee in
-  loop ~activations:t.activations env;
-  let confirmed = Array.make (Dag.size env.dag) false in
-  let rewards = Array.make (Dag.size env.dag) [] in
+  let sim = t.sim.it () in
+  let (module Ref) = sim.referee in
+  loop ~activations:t.activations sim;
+  let confirmed = Array.make (Dag.size sim.dag) false in
+  let rewards = Array.make (Dag.size sim.dag) [] in
   let () =
-    Simulator.history env
+    Simulator.history sim
     |> Seq.iter (fun vtx ->
            confirmed.(Dag.id vtx) <- true;
            rewards.(Dag.id vtx) <- Ref.reward vtx)
@@ -189,7 +186,7 @@ let run (Csv_runner.Task t) =
   let open Bos.OS in
   let d = Dir.create ~path:true (Fpath.parent path) in
   Result.bind d (fun _ ->
-      File.with_oc path print_dag (env, confirmed, rewards, legend (Task t), Ref.info))
+      File.with_oc path print_dag (sim, confirmed, rewards, legend (Task t), Ref.info))
   |> Result.join
   |> Rresult.R.failwith_error_msg
 ;;

simulator/bin/graphml_runner.ml

@@ -17,12 +17,12 @@ let run g =
   let (Protocol protocol) = protocol in
   let (module P) = protocol in
   let clock = Mtime_clock.counter () in
-  let env = Simulator.(init protocol net) in
-  let (module Ref) = env.referee in
-  let () = Simulator.loop ~activations env in
+  let sim = Simulator.(init protocol net) in
+  let (module Ref) = sim.referee in
+  let () = Simulator.loop ~activations sim in
   let machine_duration = Mtime_clock.count clock |> Mtime.Span.to_s in
   let head =
-    Array.to_list env.nodes
+    Array.to_list sim.nodes
     |> List.map (fun (Simulator.Node x) -> x.preferred x.state)
     |> Ref.winner
   in
@@ -39,7 +39,7 @@ let run g =
   in
   let node_data i =
     [ "reward", float (Float.Array.get headd.rewards i)
-    ; "activations", int env.activations.(i)
+    ; "activations", int sim.activations.(i)
     ]
   in
   Ok (to_graphml ~node_data ~graph_data ())

simulator/gym/engine.ml

@@ -50,13 +50,13 @@ end
 
 type 'data agent =
   | Agent :
-      { preferred : 'state -> 'data Simulator.env Dag.vertex
-      ; puzzle_payload : 'state -> ('data Simulator.env, 'data) draft_vertex
-      ; init : roots:'data Simulator.env Dag.vertex list -> 'state
-      ; prepare : 'state -> 'data Simulator.env event -> 'observable
+      { preferred : 'state -> 'data Simulator.block
+      ; puzzle_payload : 'state -> ('data Simulator.block, 'data) block_draft
+      ; init : roots:'data Simulator.block list -> 'state
+      ; prepare : 'state -> 'data Simulator.block event -> 'observable
       ; observe : 'observable -> floatarray
       ; observe_hum : 'observable -> string
-      ; apply : 'observable -> int -> ('data Simulator.env, 'data, 'state) action
+      ; apply : 'observable -> int -> ('data Simulator.block, 'data, 'state) action
       ; mutable state : 'observable
       }
       -> 'data agent
@@ -77,10 +77,10 @@ type instance =
       -> instance
 
 let dummy_node
-    (type env data)
+    (type block data)
     (module P : Protocol with type data = data)
-    (view : (env, data) local_view)
-    : (env, data) node
+    (view : (block, data) view)
+    : (block, data) node
   =
   let (Node (module Honest)) = P.honest view in
   Node
@@ -126,10 +126,8 @@ let of_module ?(logger = Log.dummy_logger) (AttackSpace (module M)) (p : Paramet
     let agent =
       let (Node node) = sim.nodes.(0) in
       let _ = node.view in
-      let (module LocalView : LocalView with type env = _ and type data = _) =
-        node.view
-      in
-      let open M.Agent (LocalView) in
+      let (module View : View with type block = _ and type data = _) = node.view in
+      let open M.Agent (View) in
       let observe s = observe s |> M.Observation.to_floatarray
       and observe_hum s = observe s |> M.Observation.to_string
       and apply s i = apply s (M.Action.of_int i)

simulator/lib/cpr_lib.ml

@@ -4,6 +4,7 @@ include Intf
 module Collection = Collection
 module Compare = Compare
 module Dag = Dag
+module Dagtools = Dagtools
 module Distributions = Distributions
 module GraphML = GraphML
 module Info = Info