neoinityes

1 files changed, 128 insertions, 0 deletions

diff --git a/ocaml/lib/state.ml b/ocaml/lib/state.ml
new file mode 100644
index 0000000..ca0f4b7
--- /dev/null
+++ b/ocaml/lib/state.ml
@@ -0,0 +1,128 @@
+[@@@ocaml.warning "-32"]
+[@@@ocaml.warning "-69"]  (* Disable "unused mutable field" warning *)
+
+open Noun
+open Nock
+
+(** Runtime state storing the current Arvo kernel and event counter *)
+type t = {
+  mutable roc: noun;
+  mutable eve: int64;
+  lock: Mutex.t;
+  mutable eventlog: Eventlog_lmdb.t option;
+}
+
+let atom_int n = atom (Z.of_int n)
+
+let create ?(initial = atom_int 0) ?pier_path () =
+  let eventlog = match pier_path with
+    | None -> None
+    | Some path -> Some (Eventlog_lmdb.create path)
+  in
+  {
+    roc = initial;
+    eve = 0L;
+    lock = Mutex.create ();
+    eventlog;
+  }
+
+let event_number state =
+  Mutex.lock state.lock;
+  let eve = state.eve in
+  Mutex.unlock state.lock;
+  eve
+
+let arvo_core state =
+  Mutex.lock state.lock;
+  let core = state.roc in
+  Mutex.unlock state.lock;
+  core
+
+let boot ?(events_played = 0L) state kernel =
+  Mutex.lock state.lock;
+  state.roc <- kernel;
+  state.eve <- events_played;
+  Mutex.unlock state.lock
+
+let poke_formula_axis = Z.of_int 23
+
+let kick_formula =
+  (* [9 2 [0 1]] -- standard gate call *)
+  let axis01 = cell (atom_int 0) (atom_int 1) in
+  cell (atom_int 9) (cell (atom_int 2) axis01)
+
+let slam_on gate sample =
+  match gate with
+  | Cell (battery, payload) -> begin
+      match payload with
+      | Cell (_old_sample, context) ->
+          let new_payload = cell sample context in
+          let new_core = cell battery new_payload in
+          nock_on new_core kick_formula
+      | _ -> raise Exit
+    end
+  | Atom _ -> raise Exit
+
+let poke state event =
+  Mutex.lock state.lock;
+  try
+    let kernel = state.roc in
+    let formula = slot poke_formula_axis kernel in
+    let gate = nock_on kernel formula in
+    let result = slam_on gate event in
+    begin match result with
+    | Cell (effects, new_core) ->
+        state.roc <- new_core;
+        state.eve <- Int64.succ state.eve;
+        (* Log event to disk if eventlog is enabled *)
+        begin match state.eventlog with
+        | Some log -> ignore (Eventlog_lmdb.append log event)
+        | None -> ()
+        end;
+        Mutex.unlock state.lock;
+        effects
+    | _ ->
+        Mutex.unlock state.lock;
+        raise Exit
+    end
+  with exn ->
+    Mutex.unlock state.lock;
+    raise exn
+
+let peek_formula =
+  (* Simplified: return the subject *)
+  cell (atom_int 0) (atom_int 1)
+
+let peek state path =
+  Mutex.lock state.lock;
+  let subject = cell path state.roc in
+  try
+    let res = nock_on subject peek_formula in
+    Mutex.unlock state.lock;
+    Some res
+  with _ ->
+    Mutex.unlock state.lock;
+    None
+
+let snapshot state =
+  Mutex.lock state.lock;
+  let core = state.roc in
+  let eve = state.eve in
+  Mutex.unlock state.lock;
+  let jammed = Serial.jam core in
+  (jammed, eve)
+
+let load_snapshot state jammed eve =
+  let core = Serial.cue jammed in
+  Mutex.lock state.lock;
+  state.roc <- core;
+  state.eve <- eve;
+  Mutex.unlock state.lock
+
+let close_eventlog state =
+  Mutex.lock state.lock;
+  begin match state.eventlog with
+  | Some log -> Eventlog_lmdb.close log
+  | None -> ()
+  end;
+  Mutex.unlock state.lock