[@@@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