summaryrefslogtreecommitdiff
path: root/ocaml/lib
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/lib')
-rw-r--r--ocaml/lib/bitstream.ml118
-rw-r--r--ocaml/lib/bitstream.mli14
-rw-r--r--ocaml/lib/boot.ml419
-rw-r--r--ocaml/lib/boot.mli12
-rw-r--r--ocaml/lib/dill.ml146
-rw-r--r--ocaml/lib/dill.mli30
-rw-r--r--ocaml/lib/dune4
-rw-r--r--ocaml/lib/effects.ml148
-rw-r--r--ocaml/lib/effects.mli35
-rw-r--r--ocaml/lib/eventlog.ml195
-rw-r--r--ocaml/lib/eventlog.mli41
-rw-r--r--ocaml/lib/eventlog_lmdb.ml229
-rw-r--r--ocaml/lib/eventlog_lmdb.mli35
-rw-r--r--ocaml/lib/mug.ml17
-rw-r--r--ocaml/lib/nock.ml93
-rw-r--r--ocaml/lib/nock.mli2
-rw-r--r--ocaml/lib/nock_lib.ml9
-rw-r--r--ocaml/lib/nock_lib.mli9
-rw-r--r--ocaml/lib/noun.ml67
-rw-r--r--ocaml/lib/noun.mli23
-rw-r--r--ocaml/lib/serial.ml225
-rw-r--r--ocaml/lib/serial.mli2
-rw-r--r--ocaml/lib/state.ml128
-rw-r--r--ocaml/lib/state.mli13
24 files changed, 2014 insertions, 0 deletions
diff --git a/ocaml/lib/bitstream.ml b/ocaml/lib/bitstream.ml
new file mode 100644
index 0000000..748e204
--- /dev/null
+++ b/ocaml/lib/bitstream.ml
@@ -0,0 +1,118 @@
+type writer = {
+ buf_ref : Bytes.t Stdlib.ref;
+ mutable bit_pos : int;
+}
+
+type reader = {
+ buf: bytes;
+ mutable bit_pos: int;
+ len: int;
+}
+
+let writer_create () =
+ { buf_ref = ref (Bytes.make 1024 '\x00'); bit_pos = 0 }
+
+let writer_ensure (w : writer) bits_needed =
+ let bytes_needed = (w.bit_pos + bits_needed + 7) / 8 in
+ let buf = !(w.buf_ref) in
+ if bytes_needed > Bytes.length buf then begin
+ let new_size = max (bytes_needed * 2) (Bytes.length buf * 2) in
+ let new_buf = Bytes.make new_size '\x00' in
+ Bytes.blit buf 0 new_buf 0 (Bytes.length buf);
+ w.buf_ref := new_buf
+ end
+
+let write_bit (w : writer) bit =
+ writer_ensure w 1;
+ let byte_pos = w.bit_pos / 8 in
+ let bit_off = w.bit_pos mod 8 in
+ if bit then begin
+ let buf = !(w.buf_ref) in
+ let old_byte = Bytes.get_uint8 buf byte_pos in
+ Bytes.set_uint8 buf byte_pos (old_byte lor (1 lsl bit_off))
+ end;
+ w.bit_pos <- w.bit_pos + 1
+
+let write_bits (w : writer) value nbits =
+ writer_ensure w nbits;
+ for i = 0 to nbits - 1 do
+ let bit = Z.testbit value i in
+ write_bit w bit
+ done
+
+let writer_to_bytes (w : writer) =
+ let byte_len = (w.bit_pos + 7) / 8 in
+ Bytes.sub !(w.buf_ref) 0 byte_len
+
+let writer_pos (w : writer) = w.bit_pos
+
+let reader_create buf =
+ { buf; bit_pos = 0; len = Bytes.length buf * 8 }
+
+let read_bit r =
+ if r.bit_pos >= r.len then
+ raise (Invalid_argument "read_bit: end of stream");
+ let byte_pos = r.bit_pos / 8 in
+ let bit_off = r.bit_pos mod 8 in
+ let byte_val = Bytes.get_uint8 r.buf byte_pos in
+ r.bit_pos <- r.bit_pos + 1;
+ (byte_val lsr bit_off) land 1 = 1
+
+let read_bits r nbits =
+ if nbits = 0 then Z.zero
+ else if nbits >= 64 then begin
+ (* For large reads, align to byte boundary then use fast path *)
+ let bit_offset = r.bit_pos mod 8 in
+ let result = ref Z.zero in
+ let bits_read = ref 0 in
+
+ (* Read initial unaligned bits to reach byte boundary *)
+ if bit_offset <> 0 then begin
+ let align_bits = 8 - bit_offset in
+ let to_read = min align_bits nbits in
+ for i = 0 to to_read - 1 do
+ if read_bit r then
+ result := Z.logor !result (Z.shift_left Z.one i)
+ done;
+ bits_read := to_read
+ end;
+
+ (* Now we're byte-aligned, read full bytes directly *)
+ if !bits_read < nbits then begin
+ let remaining = nbits - !bits_read in
+ let full_bytes = remaining / 8 in
+
+ if full_bytes > 0 then begin
+ let byte_pos = r.bit_pos / 8 in
+ let bytes_data = Bytes.sub r.buf byte_pos full_bytes in
+ let bytes_value = Z.of_bits (Bytes.to_string bytes_data) in
+ result := Z.logor !result (Z.shift_left bytes_value !bits_read);
+ r.bit_pos <- r.bit_pos + (full_bytes * 8);
+ bits_read := !bits_read + (full_bytes * 8)
+ end;
+
+ (* Read final partial byte *)
+ let final_bits = nbits - !bits_read in
+ for i = 0 to final_bits - 1 do
+ if read_bit r then
+ result := Z.logor !result (Z.shift_left Z.one (!bits_read + i))
+ done
+ end;
+ !result
+ end else begin
+ (* Small read: bit by bit is fine *)
+ let result = ref Z.zero in
+ for i = 0 to nbits - 1 do
+ if read_bit r then
+ result := Z.logor !result (Z.shift_left Z.one i)
+ done;
+ !result
+ end
+
+let reader_pos r = r.bit_pos
+
+let count_zero_bits_until_one r =
+ let rec loop count =
+ if read_bit r then count else loop (count + 1)
+ in
+ loop 0
diff --git a/ocaml/lib/bitstream.mli b/ocaml/lib/bitstream.mli
new file mode 100644
index 0000000..1a54aa5
--- /dev/null
+++ b/ocaml/lib/bitstream.mli
@@ -0,0 +1,14 @@
+type writer
+type reader
+
+val writer_create : unit -> writer
+val write_bit : writer -> bool -> unit
+val write_bits : writer -> Z.t -> int -> unit
+val writer_to_bytes : writer -> bytes
+val writer_pos : writer -> int
+
+val reader_create : bytes -> reader
+val read_bit : reader -> bool
+val read_bits : reader -> int -> Z.t
+val reader_pos : reader -> int
+val count_zero_bits_until_one : reader -> int
diff --git a/ocaml/lib/boot.ml b/ocaml/lib/boot.ml
new file mode 100644
index 0000000..34b7746
--- /dev/null
+++ b/ocaml/lib/boot.ml
@@ -0,0 +1,419 @@
+open Noun
+open Nock
+open Serial
+open State
+
+let debug_enabled () =
+ match Sys.getenv_opt "NEOVERE_BOOT_DEBUG" with
+ | None -> false
+ | Some value ->
+ let v = String.lowercase_ascii value in
+ not (v = "0" || v = "false" || v = "off")
+
+let log fmt =
+ if debug_enabled () then
+ Printf.ksprintf (fun msg -> Printf.printf "[boot] %s\n%!" msg) fmt
+ else
+ Printf.ksprintf (fun _ -> ()) fmt
+
+let count_list noun =
+ let rec loop acc current =
+ match current with
+ | Atom z when Z.equal z Z.zero -> acc
+ | Cell (_, t) -> loop (acc + 1) t
+ | _ -> acc
+ in
+ loop 0 noun
+
+type error =
+ | Invalid_pill of string
+ | Unsupported of string
+
+let cue_file ?(verbose=false) path =
+ let ic = open_in_bin path in
+ let len = in_channel_length ic in
+ let data = really_input_string ic len in
+ close_in ic;
+ cue ~verbose (Bytes.of_string data)
+
+let atom_int n = atom (Z.of_int n)
+
+let lifecycle_formula =
+ (* [2 [0 3] [0 2]] *)
+ let axis03 = cell (atom_int 0) (atom_int 3) in
+ let axis02 = cell (atom_int 0) (atom_int 2) in
+ cell (atom_int 2) (cell axis03 axis02)
+
+let run_lifecycle events =
+ log "running lifecycle formula [2 [0 3] [0 2]] on event list";
+ let gate = nock_on events lifecycle_formula in
+ log "lifecycle formula succeeded, extracting kernel from slot 7";
+ let kernel = slot (Z.of_int 7) gate in
+ log "kernel extracted, is_cell=%b" (Noun.is_cell kernel);
+ kernel
+
+let parse_ivory noun =
+ match noun with
+ | Cell (_tag, events) -> Ok events
+ | _ -> Error (Invalid_pill "ivory pill must be a cell")
+
+let boot_ivory state path =
+ log "loading ivory pill: %s" path;
+ let cue_start = Sys.time () in
+ let noun = cue_file ~verbose:(debug_enabled ()) path in
+ let cue_elapsed = Sys.time () -. cue_start in
+ log "cue complete in %.3fs" cue_elapsed;
+ match parse_ivory noun with
+ | Error e -> Error e
+ | Ok events ->
+ let event_count = count_list events in
+ log "ivory event count=%d" event_count;
+ log "running lifecycle formula";
+ let life_start = Sys.time () in
+ let result =
+ try Ok (run_lifecycle events) with
+ | Exit -> Error (Invalid_pill "ivory lifecycle failed (Exit)")
+ | exn -> Error (Invalid_pill (Printexc.to_string exn))
+ in
+ begin match result with
+ | Error err ->
+ log "lifecycle failed";
+ Error err
+ | Ok kernel ->
+ let life_elapsed = Sys.time () -. life_start in
+ log "lifecycle complete in %.3fs" life_elapsed;
+ log "kernel is_cell=%b" (Noun.is_cell kernel);
+ let events_played = Int64.of_int event_count in
+ boot ~events_played state kernel;
+ Ok ()
+ end
+
+let parse_solid noun =
+ match noun with
+ | Cell (tag, rest) ->
+ let pill_tag = Z.of_int 0x6c6c6970 in
+ begin match tag with
+ | Atom z when Z.equal z pill_tag ->
+ (* Structure is flat 4-tuple: [%pill typ bot mod use] *)
+ begin match rest with
+ | Cell (typ, Cell (bot, Cell (mod_, use_))) ->
+ (* Check typ is %solid (0x64696c6f73) or %olid (0x64696c6f) *)
+ begin match typ with
+ | Atom z when Z.equal z (Z.of_int 0x64696c6f73) || Z.equal z (Z.of_int 0x64696c6f) ->
+ Ok (bot, mod_, use_)
+ | Atom z ->
+ let typ_hex = Z.format "%x" z in
+ log "got pill type tag: 0x%s (expected 'solid' = 0x64696c6f73)" typ_hex;
+ Error (Unsupported (Printf.sprintf "unsupported pill type: 0x%s" typ_hex))
+ | _ -> Error (Unsupported "pill type must be atom")
+ end
+ | _ -> Error (Invalid_pill "expected flat 4-tuple [%pill typ bot mod use]")
+ end
+ | _ -> Error (Invalid_pill "missing %pill tag")
+ end
+ | _ -> Error (Invalid_pill "pill must be a cell")
+
+let rec list_fold noun acc =
+ match noun with
+ | Atom z when Z.equal z Z.zero -> List.rev acc
+ | Cell (h, t) -> list_fold t (h :: acc)
+ | _ -> raise Exit
+
+let rec take n lst =
+ if n <= 0 then []
+ else match lst with
+ | [] -> []
+ | x :: xs -> x :: take (n - 1) xs
+
+(* Convert ASCII string to atom (bytes in little-endian order) *)
+let atom_of_string s =
+ if String.length s = 0 then atom Z.zero
+ else
+ let bytes = Bytes.of_string s in
+ atom (Z.of_bits (Bytes.to_string bytes))
+
+(* Urbit time functions matching vere/pkg/vere/time.c *)
+
+(* Convert Unix seconds to Urbit seconds *)
+let urbit_sec_of_unix_sec unix_sec =
+ (* Urbit epoch offset: 0x8000000cce9e0d80 *)
+ let urbit_epoch = Z.of_string "0x8000000cce9e0d80" in
+ Z.add urbit_epoch (Z.of_int unix_sec)
+
+(* Convert microseconds to Urbit fracto-seconds *)
+let urbit_fsc_of_usec usec =
+ (* (usec * 65536 / 1000000) << 48 *)
+ let usec_z = Z.of_int usec in
+ let scaled = Z.div (Z.mul usec_z (Z.of_int 65536)) (Z.of_int 1000000) in
+ Z.shift_left scaled 48
+
+(* Get current Urbit time as 128-bit atom [low_64 high_64] *)
+let urbit_time_now () =
+ let time_f = Unix.gettimeofday () in
+ let unix_sec = int_of_float time_f in
+ let usec = int_of_float ((time_f -. float_of_int unix_sec) *. 1_000_000.0) in
+
+ let urbit_sec = urbit_sec_of_unix_sec unix_sec in
+ let urbit_fsc = urbit_fsc_of_usec usec in
+
+ (* Combine into 128-bit atom:
+ - Bits 0-63: fractional seconds (urbit_fsc)
+ - Bits 64-127: seconds (urbit_sec shifted left 64 bits) *)
+ let time_128 = Z.logor urbit_fsc (Z.shift_left urbit_sec 64) in
+ atom time_128
+
+let boot_solid_lifecycle state path =
+ log "loading solid pill: %s" path;
+ let cue_start = Sys.time () in
+ let noun = cue_file ~verbose:(debug_enabled ()) path in
+ let cue_elapsed = Sys.time () -. cue_start in
+ log "cue complete in %.3fs" cue_elapsed;
+
+ match parse_solid noun with
+ | Error e -> Error e
+ | Ok (bot, mod_, use_) ->
+ log "parsing event lists...";
+ let bot_list = list_fold bot [] in
+ let mod_list = list_fold mod_ [] in
+ let use_list = list_fold use_ [] in
+ log "bot events: %d, mod events: %d, use events: %d"
+ (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+ (* Add system events like mars.c lines 1741-1767 *)
+ let arvo_wire =
+ (* [/~/ %arvo ~] - wire for system events *)
+ cell (cell (atom (Z.of_int 0)) (atom_of_string "arvo")) (atom Z.zero)
+ in
+
+ (* Add 4 system events to mod list (prepended in reverse order) *)
+ let mod_list =
+ (* 1. wack - entropy (16 words of 0xdeadbeef) *)
+ let eny_bytes = Bytes.create (16 * 4) in
+ for i = 0 to 15 do
+ Bytes.set_int32_le eny_bytes (i * 4) (Int32.of_int 0xdeadbeef)
+ done;
+ let eny_atom = atom (Z.of_bits (Bytes.to_string eny_bytes)) in
+ let wack_card = cell (atom_of_string "wack") eny_atom in
+ let wack = cell arvo_wire wack_card in
+
+ (* 2. whom - identity (fake ship ~zod = 0) *)
+ let whom_card = cell (atom_of_string "whom") (atom Z.zero) in
+ let whom = cell arvo_wire whom_card in
+
+ (* 3. verb - verbosity (verbose = no) *)
+ let verb_card = cell (atom_of_string "verb") (cell (atom Z.zero) (atom Z.zero)) in
+ let verb = cell arvo_wire verb_card in
+
+ (* 4. wyrd - version negotiation *)
+ let sen = atom_of_string "0v1s.vu178" in
+ let ver = cell (atom_of_string "vere")
+ (cell (atom_of_string "live")
+ (cell (atom_of_string "3.5") (atom Z.zero))) in
+ let kel =
+ cell (cell (atom_of_string "zuse") (atom (Z.of_int 409)))
+ (cell (cell (atom_of_string "lull") (atom (Z.of_int 321)))
+ (cell (cell (atom_of_string "arvo") (atom (Z.of_int 235)))
+ (cell (cell (atom_of_string "hoon") (atom (Z.of_int 136)))
+ (cell (cell (atom_of_string "nock") (atom (Z.of_int 4)))
+ (atom Z.zero)))))
+ in
+ let wyrd_card = cell (atom_of_string "wyrd") (cell (cell sen ver) kel) in
+ let wyrd = cell arvo_wire wyrd_card in
+
+ wack :: whom :: verb :: wyrd :: mod_list
+ in
+
+ (* Add boot event to use list *)
+ let use_list =
+ (* [/d/term/1 [%boot lit venue]] where venue = [%fake ~zod] *)
+ let boot_wire =
+ cell (atom_of_string "d")
+ (cell (atom_of_string "term")
+ (cell (atom (Z.of_int 1)) (atom Z.zero)))
+ in
+ let venue = cell (atom_of_string "fake") (atom Z.zero) in
+ let boot_card = cell (atom_of_string "boot") (cell (atom Z.zero) venue) in
+ let boot_event = cell boot_wire boot_card in
+ boot_event :: use_list
+ in
+
+ log "after adding system events:";
+ log " bot events: %d, mod events: %d, use events: %d"
+ (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+ (* Build event list like mars.c:1815-1835 *)
+ (* Bot events are NOT timestamped, mod/use events ARE timestamped *)
+ log "building event list (bot bare, mod/use timestamped)...";
+ let now = urbit_time_now () in
+ let bit = atom (Z.shift_left Z.one 48) in (* 2^48 = 1/2^16 seconds increment *)
+
+ (* Start with bot events (bare, not timestamped) *)
+ let event_list = List.rev bot_list in
+
+ (* Add mod+use events (timestamped) *)
+ let mod_use = mod_list @ use_list in
+ let rec timestamp_and_add events current_time acc =
+ match events with
+ | [] -> List.rev acc
+ | event :: rest ->
+ let timestamped = cell current_time event in
+ let next_time = match (current_time, bit) with
+ | (Atom t, Atom b) -> atom (Z.add t b)
+ | _ -> failwith "time must be atoms"
+ in
+ timestamp_and_add rest next_time (timestamped :: acc)
+ in
+ let timestamped_mod_use = timestamp_and_add mod_use now [] in
+ let full_event_list = event_list @ timestamped_mod_use in
+
+ log "built event list with %d events" (List.length full_event_list);
+ log " %d bot (bare) + %d mod/use (timestamped)"
+ (List.length bot_list) (List.length timestamped_mod_use);
+
+ (* Convert to noun list structure *)
+ let rec build_noun_list = function
+ | [] -> atom Z.zero
+ | h :: t -> cell h (build_noun_list t)
+ in
+ let event_noun = build_noun_list full_event_list in
+
+ (* Run lifecycle formula on full event list *)
+ log "running lifecycle formula on full event list...";
+ let life_start = Sys.time () in
+ let result =
+ try Ok (run_lifecycle event_noun) with
+ | Exit -> Error (Invalid_pill "lifecycle formula failed (Exit)")
+ | exn -> Error (Invalid_pill (Printexc.to_string exn))
+ in
+ begin match result with
+ | Error err ->
+ log "lifecycle failed: %s" (match err with Invalid_pill s | Unsupported s -> s);
+ Error err
+ | Ok kernel ->
+ let life_elapsed = Sys.time () -. life_start in
+ log "lifecycle complete in %.3fs" life_elapsed;
+ let events_played = Int64.of_int (List.length full_event_list) in
+ boot ~events_played state kernel;
+ Ok ()
+ end
+
+let boot_solid ?limit ?(apply = poke) state path =
+ log "loading solid pill: %s" path;
+ let cue_start = Sys.time () in
+ let noun = cue_file ~verbose:(debug_enabled ()) path in
+ let cue_elapsed = Sys.time () -. cue_start in
+ log "cue complete in %.3fs" cue_elapsed;
+
+ match parse_solid noun with
+ | Error e -> Error e
+ | Ok (bot, mod_, use_) ->
+ log "parsing event lists...";
+ let bot_list = list_fold bot [] in
+ let mod_list = list_fold mod_ [] in
+ let use_list = list_fold use_ [] in
+ log "bot events: %d, mod events: %d, use events: %d"
+ (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+ (* Add system events like mars.c lines 1741-1767 *)
+ let arvo_wire =
+ (* [/~/ %arvo ~] - wire for system events *)
+ cell (cell (atom (Z.of_int 0)) (atom_of_string "arvo")) (atom Z.zero)
+ in
+
+ (* Add 4 system events to mod list (prepended in reverse order) *)
+ (* Each event is [wire card] *)
+ let mod_list =
+ (* 1. wack - entropy (16 words of 0xdeadbeef) *)
+ let eny_bytes = Bytes.create (16 * 4) in
+ for i = 0 to 15 do
+ Bytes.set_int32_le eny_bytes (i * 4) (Int32.of_int 0xdeadbeef)
+ done;
+ let eny_atom = atom (Z.of_bits (Bytes.to_string eny_bytes)) in
+ let wack_card = cell (atom_of_string "wack") eny_atom in
+ let wack = cell arvo_wire wack_card in
+
+ (* 2. whom - identity (fake ship ~zod = 0) *)
+ let whom_card = cell (atom_of_string "whom") (atom Z.zero) in
+ let whom = cell arvo_wire whom_card in
+
+ (* 3. verb - verbosity (verbose = no) *)
+ let verb_card = cell (atom_of_string "verb") (cell (atom Z.zero) (atom Z.zero)) in
+ let verb = cell arvo_wire verb_card in
+
+ (* 4. wyrd - version negotiation *)
+ let sen = atom_of_string "0v1s.vu178" in
+ let ver = cell (atom_of_string "vere")
+ (cell (atom_of_string "live")
+ (cell (atom_of_string "3.5") (atom Z.zero))) in
+ let kel =
+ cell (cell (atom_of_string "zuse") (atom (Z.of_int 409)))
+ (cell (cell (atom_of_string "lull") (atom (Z.of_int 321)))
+ (cell (cell (atom_of_string "arvo") (atom (Z.of_int 235)))
+ (cell (cell (atom_of_string "hoon") (atom (Z.of_int 136)))
+ (cell (cell (atom_of_string "nock") (atom (Z.of_int 4)))
+ (atom Z.zero)))))
+ in
+ let wyrd_card = cell (atom_of_string "wyrd") (cell (cell sen ver) kel) in
+ let wyrd = cell arvo_wire wyrd_card in
+
+ wack :: whom :: verb :: wyrd :: mod_list
+ in
+
+ (* Add boot event to use list *)
+ let use_list =
+ (* [/d/term/1 [%boot lit venue]] where venue = [%fake ~zod] *)
+ let boot_wire =
+ cell (atom_of_string "d")
+ (cell (atom_of_string "term")
+ (cell (atom (Z.of_int 1)) (atom Z.zero)))
+ in
+ let venue = cell (atom_of_string "fake") (atom Z.zero) in
+ let boot_card = cell (atom_of_string "boot") (cell (atom Z.zero) venue) in
+ let boot_event = cell boot_wire boot_card in
+ boot_event :: use_list
+ in
+
+ log "after adding system events:";
+ log " bot events: %d, mod events: %d, use events: %d"
+ (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+ let all_events = List.concat [ bot_list; mod_list; use_list ] in
+ let all_events = match limit with
+ | None -> all_events
+ | Some n ->
+ log "limiting to first %d events" n;
+ take n all_events
+ in
+
+ (* Timestamp events like mars.c lines 1815-1836 *)
+ log "timestamping %d events..." (List.length all_events);
+ let now = urbit_time_now () in
+ let bit = atom (Z.shift_left Z.one 48) in (* 2^48 = 1/2^16 seconds increment *)
+
+ let timestamped_events =
+ let rec timestamp_loop remaining current_time acc =
+ match remaining with
+ | [] -> List.rev acc
+ | event :: rest ->
+ (* Each event becomes [timestamp event] *)
+ let timestamped = cell current_time event in
+ (* Increment time by bit (2^48) *)
+ let next_time = match (current_time, bit) with
+ | (Atom t, Atom b) -> atom (Z.add t b)
+ | _ -> failwith "time must be atoms"
+ in
+ timestamp_loop rest next_time (timestamped :: acc)
+ in
+ timestamp_loop all_events now []
+ in
+
+ log "processing %d timestamped events..." (List.length timestamped_events);
+ let counter = ref 0 in
+ List.iter (fun event ->
+ incr counter;
+ if !counter mod 10 = 0 then
+ log "processed %d/%d events" !counter (List.length timestamped_events);
+ ignore (apply state event)
+ ) timestamped_events;
+ log "all events processed";
+ Ok ()
diff --git a/ocaml/lib/boot.mli b/ocaml/lib/boot.mli
new file mode 100644
index 0000000..fbe70da
--- /dev/null
+++ b/ocaml/lib/boot.mli
@@ -0,0 +1,12 @@
+type error =
+ | Invalid_pill of string
+ | Unsupported of string
+
+val boot_ivory : State.t -> string -> (unit, error) result
+val boot_solid : ?limit:int -> ?apply:(State.t -> Noun.noun -> Noun.noun) -> State.t -> string -> (unit, error) result
+val boot_solid_lifecycle : State.t -> string -> (unit, error) result
+
+(* Utility functions *)
+val cue_file : ?verbose:bool -> string -> Noun.noun
+val parse_solid : Noun.noun -> (Noun.noun * Noun.noun * Noun.noun, error) result
+val run_lifecycle : Noun.noun -> Noun.noun
diff --git a/ocaml/lib/dill.ml b/ocaml/lib/dill.ml
new file mode 100644
index 0000000..1384af9
--- /dev/null
+++ b/ocaml/lib/dill.ml
@@ -0,0 +1,146 @@
+(** Dill - Terminal I/O driver using Eio *)
+
+open Noun
+
+(** Belt event types (keyboard input) *)
+type belt =
+ | Aro of [`d | `l | `r | `u] (* Arrow keys *)
+ | Bac (* Backspace *)
+ | Ctl of char (* Control-X *)
+ | Del (* Delete *)
+ | Met of char (* Meta/Alt-X *)
+ | Ret (* Return/Enter *)
+ | Txt of string list (* Text input *)
+
+(** Blit event types (terminal output) *)
+type blit =
+ | Lin of string (* Line of text *)
+ | Klr of noun (* Styled text *)
+ | Mor of blit list (* Multiple blits *)
+ | Hop of int (* Cursor hop *)
+ | Clr (* Clear screen *)
+
+type effect = {
+ wire: noun;
+ blit: blit;
+}
+
+(** Render a blit to the terminal using Eio *)
+let rec render_blit ~stdout = function
+ | Lin text ->
+ Eio.Flow.copy_string (text ^ "\n") stdout
+ | Klr _styled ->
+ (* TODO: Parse styled text and convert to ANSI codes *)
+ Eio.Flow.copy_string "<styled text>\n" stdout
+ | Mor blits ->
+ List.iter (render_blit ~stdout) blits
+ | Hop n ->
+ (* ANSI cursor movement *)
+ let ansi = Printf.sprintf "\x1b[%dC" n in
+ Eio.Flow.copy_string ansi stdout
+ | Clr ->
+ (* ANSI clear screen and home cursor *)
+ Eio.Flow.copy_string "\x1b[2J\x1b[H" stdout
+
+(** Create a belt event noun from keyboard input *)
+let make_belt_event wire belt_type =
+ let belt_atom = match belt_type with
+ | Ret -> atom_of_string "ret"
+ | Bac -> atom_of_string "bac"
+ | Del -> atom_of_string "del"
+ | Aro `u -> cell (atom_of_string "aro") (atom_of_string "u")
+ | Aro `d -> cell (atom_of_string "aro") (atom_of_string "d")
+ | Aro `l -> cell (atom_of_string "aro") (atom_of_string "l")
+ | Aro `r -> cell (atom_of_string "aro") (atom_of_string "r")
+ | Ctl c -> cell (atom_of_string "ctl") (atom (Z.of_int (Char.code c)))
+ | Met c -> cell (atom_of_string "met") (atom (Z.of_int (Char.code c)))
+ | Txt strs ->
+ let rec build_list = function
+ | [] -> atom Z.zero
+ | s :: rest ->
+ (* Each string in the list becomes a character code *)
+ let code = if String.length s > 0 then Char.code s.[0] else 0 in
+ cell (atom (Z.of_int code)) (build_list rest)
+ in
+ cell (atom_of_string "txt") (build_list strs)
+ in
+ let card = cell (atom_of_string "belt") belt_atom in
+ cell wire card
+
+(** Parse line input into belt event *)
+let parse_input line =
+ if String.length line = 0 then
+ Ret
+ else if line = "\x7f" || line = "\x08" then
+ Bac
+ else if String.length line = 1 && Char.code line.[0] < 32 then
+ Ctl line.[0]
+ else
+ let char_list = String.to_seq line |> List.of_seq in
+ let str_list = List.map (String.make 1) char_list in
+ Txt str_list
+
+(** Run terminal input loop using Eio *)
+let input_loop ~stdin ~state ~wire process_effects =
+ let buf_read = Eio.Buf_read.of_flow stdin ~max_size:4096 in
+ let rec loop () =
+ (* Read a line from terminal *)
+ try
+ let line = Eio.Buf_read.line buf_read in
+ let belt = parse_input (String.trim line) in
+ let ovum = make_belt_event wire belt in
+
+ (* Poke Arvo with belt event *)
+ let result = State.poke state ovum in
+
+ (* Process effects *)
+ process_effects result;
+
+ loop ()
+ with End_of_file -> ()
+ in
+ loop ()
+
+(** Render effects to terminal *)
+let render_effects ~stdout effects_noun =
+
+ (* Parse effects and filter for Dill *)
+ let rec parse_effects_list = function
+ | Atom z when Z.equal z Z.zero -> []
+ | Cell (Cell (wire, card), rest) ->
+ (* Check if this is a Dill effect *)
+ let is_dill = match wire with
+ | Cell (Atom d, Cell (Atom term, _)) ->
+ Z.equal d (Z.of_int (Char.code 'd')) &&
+ Z.equal term (Z.of_string "0x6d726574") (* 'term' *)
+ | _ -> false
+ in
+ if is_dill then
+ (wire, card) :: parse_effects_list rest
+ else
+ parse_effects_list rest
+ | _ -> []
+ in
+
+ let dill_effects = parse_effects_list effects_noun in
+
+ (* Render each blit *)
+ List.iter (fun (_wire, card) ->
+ match card with
+ | Cell (Atom tag, blit_noun) when Z.equal tag (Z.of_string "0x74696c62") (* 'blit' *) ->
+ (* Parse and render blit *)
+ let blit = match blit_noun with
+ | Cell (Atom lin_tag, Cell (Cell (_, text), _))
+ when Z.equal lin_tag (Z.of_string "0x6e696c") -> (* 'lin' *)
+ let str = match text with
+ | Atom z ->
+ if Z.equal z Z.zero then ""
+ else Z.to_bits z
+ | _ -> "(complex text)"
+ in
+ Lin str
+ | _ -> Lin "(unparsed blit)"
+ in
+ render_blit ~stdout blit
+ | _ -> ()
+ ) dill_effects
diff --git a/ocaml/lib/dill.mli b/ocaml/lib/dill.mli
new file mode 100644
index 0000000..f78bba8
--- /dev/null
+++ b/ocaml/lib/dill.mli
@@ -0,0 +1,30 @@
+(** Dill - Terminal I/O driver using Eio *)
+
+open Noun
+
+type belt =
+ | Aro of [`d | `l | `r | `u]
+ | Bac
+ | Ctl of char
+ | Del
+ | Met of char
+ | Ret
+ | Txt of string list
+
+type blit =
+ | Lin of string
+ | Klr of noun
+ | Mor of blit list
+ | Hop of int
+ | Clr
+
+type effect = {
+ wire: noun;
+ blit: blit;
+}
+
+val render_blit : stdout:_ Eio.Flow.sink -> blit -> unit
+val make_belt_event : noun -> belt -> noun
+val parse_input : string -> belt
+val input_loop : stdin:_ Eio.Flow.source -> state:State.t -> wire:noun -> (noun -> unit) -> unit
+val render_effects : stdout:_ Eio.Flow.sink -> noun -> unit
diff --git a/ocaml/lib/dune b/ocaml/lib/dune
new file mode 100644
index 0000000..b624239
--- /dev/null
+++ b/ocaml/lib/dune
@@ -0,0 +1,4 @@
+(library
+ (name nock_lib)
+ (public_name overe.nock)
+ (libraries zarith unix lmdb murmur3 eio eio.core))
diff --git a/ocaml/lib/effects.ml b/ocaml/lib/effects.ml
new file mode 100644
index 0000000..1206201
--- /dev/null
+++ b/ocaml/lib/effects.ml
@@ -0,0 +1,148 @@
+open Noun
+
+(** Effect parsing and routing *)
+
+type blit =
+ | Lin of string (* Simple line of text *)
+ | Klr of noun (* Styled/colored text (TODO: parse structure) *)
+ | Mor of blit list (* Multiple blits *)
+ | Hop of int (* Cursor hop *)
+ | Clr (* Clear screen *)
+ | Unknown of noun (* Unparsed blit *)
+
+type card =
+ | Blit of blit (* Terminal output *)
+ | Logo (* Show logo *)
+ | HttpResponse of noun (* HTTP response (TODO) *)
+ | Send of noun (* Network send (TODO) *)
+ | Unknown of noun (* Unknown card type *)
+
+type effect = {
+ wire: noun;
+ card: card;
+}
+
+(** Convert atom to string if possible *)
+let atom_to_string = function
+ | Atom z ->
+ if Z.equal z Z.zero then ""
+ else
+ let bits = Z.numbits z in
+ let bytes = (bits + 7) / 8 in
+ let buf = Bytes.create bytes in
+ let z_ref = ref z in
+ for i = 0 to bytes - 1 do
+ let byte = Z.to_int (Z.logand !z_ref (Z.of_int 0xFF)) in
+ Bytes.set buf i (Char.chr byte);
+ z_ref := Z.shift_right !z_ref 8
+ done;
+ Bytes.to_string buf
+ | Cell _ -> ""
+
+(** Parse a blit from noun *)
+let rec parse_blit = function
+ | Cell (tag, rest) -> begin
+ match tag with
+ | Atom z when Z.equal z (Z.of_string "0x6e696c") -> (* 'lin' *)
+ (* %lin format: [%lin text] where text is [flag styled] *)
+ begin match rest with
+ | Cell (Cell (_, text), _) ->
+ let str = atom_to_string text in
+ Lin str
+ | _ -> Unknown rest
+ end
+ | Atom z when Z.equal z (Z.of_string "0x726c6b") -> (* 'klr' *)
+ Klr rest
+ | Atom z when Z.equal z (Z.of_string "0x726f6d") -> (* 'mor' *)
+ (* %mor is a list of blits *)
+ let rec parse_list acc = function
+ | Atom z when Z.equal z Z.zero -> List.rev acc
+ | Cell (h, t) -> parse_list (parse_blit h :: acc) t
+ | _ -> List.rev acc
+ in
+ Mor (parse_list [] rest)
+ | Atom z when Z.equal z (Z.of_string "0x706f68") -> (* 'hop' *)
+ begin match rest with
+ | Atom n -> Hop (Z.to_int n)
+ | _ -> Unknown rest
+ end
+ | Atom z when Z.equal z (Z.of_string "0x726c63") -> (* 'clr' *)
+ Clr
+ | _ -> Unknown (Cell (tag, rest))
+ end
+ | Atom _ as a -> Unknown a
+
+(** Parse a card from noun *)
+let parse_card = function
+ | Cell (tag, rest) -> begin
+ match tag with
+ | Atom z when Z.equal z (Z.of_string "0x74696c62") -> (* 'blit' *)
+ Blit (parse_blit rest)
+ | Atom z when Z.equal z (Z.of_string "0x6f676f6c") -> (* 'logo' *)
+ Logo
+ | Atom z when Z.equal z (Z.of_string "0x65736e6f7073657220707474682d") -> (* 'http-response' (partial) *)
+ HttpResponse rest
+ | Atom z when Z.equal z (Z.of_string "0x646e6573") -> (* 'send' *)
+ Send rest
+ | _ -> Unknown (Cell (tag, rest))
+ end
+ | Atom _ as a -> Unknown a
+
+(** Parse a single effect [wire card] *)
+let parse_effect = function
+ | Cell (wire, card_noun) ->
+ Some { wire; card = parse_card card_noun }
+ | _ -> None
+
+(** Parse effects list from noun *)
+let rec parse_effects = function
+ | Atom z when Z.equal z Z.zero -> []
+ | Cell (h, t) ->
+ begin match parse_effect h with
+ | Some eff -> eff :: parse_effects t
+ | None -> parse_effects t
+ end
+ | _ -> []
+
+(** Show wire for debugging *)
+let rec show_wire = function
+ | Atom z when Z.equal z Z.zero -> "~"
+ | Cell (Atom a, rest) ->
+ "/" ^ atom_to_string (Atom a) ^ show_wire rest
+ | Cell (h, t) ->
+ "/" ^ show_noun h ^ show_wire t
+ | Atom a -> "/" ^ atom_to_string (Atom a)
+
+and show_noun = function
+ | Atom z -> Z.to_string z
+ | Cell (h, t) -> "[" ^ show_noun h ^ " " ^ show_noun t ^ "]"
+
+(** Show card for debugging *)
+let show_card = function
+ | Blit (Lin s) -> Printf.sprintf "%%blit %%lin %S" s
+ | Blit (Mor bs) -> Printf.sprintf "%%blit %%mor (%d blits)" (List.length bs)
+ | Blit Clr -> "%blit %clr"
+ | Blit (Hop n) -> Printf.sprintf "%%blit %%hop %d" n
+ | Blit (Klr _) -> "%blit %klr (...)"
+ | Blit (Unknown _) -> "%blit (unknown)"
+ | Logo -> "%logo"
+ | HttpResponse _ -> "%http-response"
+ | Send _ -> "%send"
+ | Unknown _ -> "(unknown card)"
+
+(** Filter effects by wire pattern *)
+let is_dill_wire = function
+ | Cell (Atom d, Cell (Atom term, _)) ->
+ Z.equal d (Z.of_int (Char.code 'd')) &&
+ Z.equal term (Z.of_string "0x6d726574") (* 'term' *)
+ | _ -> false
+
+let is_http_wire = function
+ | Cell (Atom g, _) ->
+ Z.equal g (Z.of_int (Char.code 'g'))
+ | _ -> false
+
+let is_ames_wire = function
+ | Cell (Atom a, _) ->
+ Z.equal a (Z.of_int (Char.code 'a'))
+ | _ -> false
diff --git a/ocaml/lib/effects.mli b/ocaml/lib/effects.mli
new file mode 100644
index 0000000..67e9215
--- /dev/null
+++ b/ocaml/lib/effects.mli
@@ -0,0 +1,35 @@
+open Noun
+
+(** Effect types and parsing *)
+
+type blit =
+ | Lin of string (* Simple line of text *)
+ | Klr of noun (* Styled/colored text *)
+ | Mor of blit list (* Multiple blits *)
+ | Hop of int (* Cursor hop *)
+ | Clr (* Clear screen *)
+ | Unknown of noun (* Unparsed blit *)
+
+type card =
+ | Blit of blit (* Terminal output *)
+ | Logo (* Show logo *)
+ | HttpResponse of noun (* HTTP response *)
+ | Send of noun (* Network send *)
+ | Unknown of noun (* Unknown card type *)
+
+type effect = {
+ wire: noun;
+ card: card;
+}
+
+val parse_blit : noun -> blit
+val parse_card : noun -> card
+val parse_effect : noun -> effect option
+val parse_effects : noun -> effect list
+
+val show_wire : noun -> string
+val show_card : card -> string
+
+val is_dill_wire : noun -> bool
+val is_http_wire : noun -> bool
+val is_ames_wire : noun -> bool
diff --git a/ocaml/lib/eventlog.ml b/ocaml/lib/eventlog.ml
new file mode 100644
index 0000000..b0c5993
--- /dev/null
+++ b/ocaml/lib/eventlog.ml
@@ -0,0 +1,195 @@
+(* Event Log - Persistent event storage
+ *
+ * This module provides an append-only event log with:
+ * - Synchronous append for simplicity
+ * - Sequential replay
+ * - Crash recovery via event replay
+ *
+ * Event format (matches Vere):
+ * - 4 bytes: mug (murmur3 hash of jammed event)
+ * - N bytes: jammed noun
+ *
+ * Storage:
+ * - Simple file-based initially (one file per event)
+ * - Files named: event-NNNNNNNNNNNNNNNNNNNN.jam (20-digit zero-padded)
+ * - Stored in <pier>/.urb/log/
+ * - Will migrate to LMDB later for better performance
+ *)
+
+open Noun
+
+(* Event number (0-indexed) *)
+type event_num = int64
+
+(* Event metadata *)
+type event_meta = {
+ num: event_num;
+ mug: int32; (* murmur3 hash *)
+ size: int; (* size of jammed data *)
+}
+
+(* Event log state *)
+type t = {
+ log_dir: string; (* .urb/log directory *)
+ mutable last_event: event_num; (* last committed event *)
+ mutable enabled: bool; (* whether logging is enabled *)
+}
+
+let debug_enabled () =
+ match Sys.getenv_opt "NEOVERE_EVENTLOG_DEBUG" with
+ | None -> false
+ | Some value ->
+ let v = String.lowercase_ascii value in
+ not (v = "0" || v = "false" || v = "off")
+
+let debug fmt =
+ if debug_enabled () then
+ Printf.ksprintf (fun msg -> Printf.printf "[eventlog] %s\n%!" msg) fmt
+ else
+ Printf.ksprintf (fun _ -> ()) fmt
+
+(* Create event log directory structure *)
+let create ?(enabled=true) pier_path =
+ let urb_dir = Filename.concat pier_path ".urb" in
+ let log_dir = Filename.concat urb_dir "log" in
+
+ (* Create directories if they don't exist *)
+ if not (Sys.file_exists urb_dir) then begin
+ debug "creating directory: %s" urb_dir;
+ Unix.mkdir urb_dir 0o755
+ end;
+
+ if not (Sys.file_exists log_dir) then begin
+ debug "creating directory: %s" log_dir;
+ Unix.mkdir log_dir 0o755
+ end;
+
+ debug "event log initialized at: %s" log_dir;
+ { log_dir; last_event = -1L; enabled }
+
+(* Get event filename *)
+let event_file log num =
+ let filename = Printf.sprintf "event-%020Ld.jam" num in
+ Filename.concat log.log_dir filename
+
+(* Compute murmur3 hash *)
+(* TODO: Use proper murmur3 implementation - for now using OCaml's Hashtbl.hash *)
+let compute_mug (noun : noun) : int32 =
+ Int32.of_int (Hashtbl.hash noun land 0x7FFFFFFF)
+
+(* Serialize event: 4-byte mug + jammed noun *)
+let serialize_event ?(verbose=false) (noun : noun) : bytes =
+ let jam_bytes = Serial.jam ~verbose noun in
+ let mug = compute_mug noun in
+ let jam_len = Bytes.length jam_bytes in
+
+ (* Create output buffer: 4 bytes (mug) + jam data *)
+ let total_len = 4 + jam_len in
+ let result = Bytes.create total_len in
+
+ (* Write mug (little-endian) *)
+ Bytes.set_int32_le result 0 mug;
+
+ (* Copy jammed data *)
+ Bytes.blit jam_bytes 0 result 4 jam_len;
+
+ result
+
+(* Deserialize event: parse mug + unjam noun *)
+let deserialize_event ?(verbose=false) (data : bytes) : event_meta * noun =
+ if Bytes.length data < 4 then
+ failwith "Event data too short (missing mug)";
+
+ (* Read mug (little-endian) *)
+ let mug = Bytes.get_int32_le data 0 in
+
+ (* Extract jam data *)
+ let jam_len = Bytes.length data - 4 in
+ let jam_bytes = Bytes.sub data 4 jam_len in
+
+ (* Cue the noun *)
+ let noun = Serial.cue ~verbose jam_bytes in
+
+ (* Verify mug *)
+ let computed_mug = compute_mug noun in
+ if computed_mug <> mug then
+ failwith (Printf.sprintf "Mug mismatch: expected %ld, got %ld" mug computed_mug);
+
+ let meta = { num = -1L; mug; size = jam_len } in
+ (meta, noun)
+
+(* Append event to log *)
+let append ?(verbose=false) log (noun : noun) : event_num =
+ if not log.enabled then begin
+ log.last_event <- Int64.succ log.last_event;
+ log.last_event
+ end else begin
+ let event_num = Int64.succ log.last_event in
+ let serialized = serialize_event ~verbose noun in
+ let file_path = event_file log event_num in
+
+ debug "appending event %Ld to %s (%d bytes)" event_num file_path (Bytes.length serialized);
+
+ (* Write to file *)
+ let oc = open_out_bin file_path in
+ output_bytes oc serialized;
+ close_out oc;
+
+ log.last_event <- event_num;
+ event_num
+ end
+
+(* Read single event from log *)
+let read_event ?(verbose=false) log event_num : noun =
+ let file_path = event_file log event_num in
+ debug "reading event %Ld from %s" event_num file_path;
+
+ let ic = open_in_bin file_path in
+ let len = in_channel_length ic in
+ let data = really_input_string ic len in
+ close_in ic;
+
+ let (_meta, noun) = deserialize_event ~verbose (Bytes.of_string data) in
+ noun
+
+(* Replay all events sequentially *)
+let replay ?(verbose=false) log (callback : event_num -> noun -> unit) : unit =
+ debug "starting replay...";
+
+ (* Find all event files by trying to read sequentially *)
+ let rec replay_from num =
+ let file_path = event_file log num in
+ if Sys.file_exists file_path then begin
+ debug "replaying event %Ld" num;
+ let noun = read_event ~verbose log num in
+ callback num noun;
+ replay_from (Int64.succ num)
+ end else begin
+ debug "replay complete at event %Ld" num;
+ (* Update last_event to reflect what we found *)
+ if num > 0L then
+ log.last_event <- Int64.pred num
+ else
+ log.last_event <- -1L
+ end
+ in
+
+ replay_from 0L
+
+(* Get the number of events in the log *)
+let event_count log =
+ Int64.to_int (Int64.succ log.last_event)
+
+(* Get last event number *)
+let last_event_num log =
+ log.last_event
+
+(* Disable logging (for testing or special modes) *)
+let disable log =
+ log.enabled <- false;
+ debug "event logging disabled"
+
+(* Enable logging *)
+let enable log =
+ log.enabled <- true;
+ debug "event logging enabled"
diff --git a/ocaml/lib/eventlog.mli b/ocaml/lib/eventlog.mli
new file mode 100644
index 0000000..8be010f
--- /dev/null
+++ b/ocaml/lib/eventlog.mli
@@ -0,0 +1,41 @@
+(* Event Log - Persistent event storage
+ *
+ * Provides append-only event log with replay capability.
+ *)
+
+(* Event number (0-indexed) *)
+type event_num = int64
+
+(* Event metadata *)
+type event_meta = {
+ num: event_num;
+ mug: int32; (* murmur3 hash *)
+ size: int; (* size of jammed data *)
+}
+
+(* Event log handle *)
+type t
+
+(* Create event log at pier path
+ * Creates .urb/log directory structure if needed
+ * enabled=false disables actual file writes (useful for testing) *)
+val create : ?enabled:bool -> string -> t
+
+(* Append event to log, returns event number *)
+val append : ?verbose:bool -> t -> Noun.noun -> event_num
+
+(* Read single event from log *)
+val read_event : ?verbose:bool -> t -> event_num -> Noun.noun
+
+(* Replay all events sequentially, calling callback for each *)
+val replay : ?verbose:bool -> t -> (event_num -> Noun.noun -> unit) -> unit
+
+(* Get count of events in log *)
+val event_count : t -> int
+
+(* Get last event number (or -1 if empty) *)
+val last_event_num : t -> event_num
+
+(* Disable/enable logging *)
+val disable : t -> unit
+val enable : t -> unit
diff --git a/ocaml/lib/eventlog_lmdb.ml b/ocaml/lib/eventlog_lmdb.ml
new file mode 100644
index 0000000..256a662
--- /dev/null
+++ b/ocaml/lib/eventlog_lmdb.ml
@@ -0,0 +1,229 @@
+[@@@ocaml.warning "-69"]
+
+open Noun
+
+(* Event log using LMDB backend to match Vere's implementation *)
+
+type event_num = int64
+
+external murmur3_hash32 : string -> int32 = "caml_murmur3_hash32"
+
+let debug_enabled () =
+ match Sys.getenv_opt "NEOVERE_EVENTLOG_DEBUG" with
+ | None -> false
+ | Some value ->
+ let v = String.lowercase_ascii value in
+ not (v = "0" || v = "false" || v = "off")
+
+let debug fmt =
+ if debug_enabled () then
+ Printf.ksprintf (fun msg -> Printf.printf "[eventlog_lmdb] %s\n%!" msg) fmt
+ else
+ Printf.ksprintf (fun _ -> ()) fmt
+
+(* LMDB environment and databases *)
+type t = {
+ env: Lmdb.Env.t;
+ events_map: (int64, string, [`Uni]) Lmdb.Map.t; (* event_num -> serialized bytes *)
+ meta_map: (string, string, [`Uni]) Lmdb.Map.t; (* metadata key-value *)
+ mutable last_event: event_num;
+ mutable enabled: bool;
+}
+
+(* Serialize event: 4-byte mug + jammed noun (matches Vere) *)
+let serialize_event ?(verbose=false) (noun : noun) : string =
+ let jam_bytes = Serial.jam ~verbose noun in
+ (* Compute mug from jammed bytes instead of traversing the noun tree
+ This is much faster for large nouns (3M+ nodes) and avoids stack overflow *)
+ let mug = murmur3_hash32 (Bytes.to_string jam_bytes) in
+ let jam_len = Bytes.length jam_bytes in
+ let total_len = 4 + jam_len in
+ let result = Bytes.create total_len in
+ Bytes.set_int32_le result 0 mug;
+ Bytes.blit jam_bytes 0 result 4 jam_len;
+ Bytes.to_string result
+
+(* Deserialize event: extract mug and cue the noun *)
+let deserialize_event ?(verbose=false) (data : string) : noun =
+ if String.length data < 4 then
+ failwith "Event data too short (< 4 bytes)";
+ let _mug = String.get_int32_le data 0 in
+ let jam_data = String.sub data 4 (String.length data - 4) in
+ Serial.cue ~verbose (Bytes.of_string jam_data)
+
+(* Create or open event log *)
+let create ?(enabled=true) (pier_path : string) : t =
+ debug "opening LMDB event log at: %s" pier_path;
+
+ (* Create .urb/log directory if it doesn't exist *)
+ let urb_dir = Filename.concat pier_path ".urb" in
+ let log_dir = Filename.concat urb_dir "log" in
+
+ if not (Sys.file_exists urb_dir) then
+ Unix.mkdir urb_dir 0o755;
+ if not (Sys.file_exists log_dir) then
+ Unix.mkdir log_dir 0o755;
+
+ (* Open LMDB environment - match Vere's default of 1TB (0x10000000000) *)
+ let env = Lmdb.Env.create Lmdb.Rw
+ ~max_maps:2
+ ~map_size:0x10000000000 (* 1TB - matches Vere's default *)
+ ~flags:Lmdb.Env.Flags.no_subdir
+ (Filename.concat log_dir "data.mdb")
+ in
+
+ (* Open or create the two databases *)
+ let events_map =
+ try
+ Lmdb.Map.open_existing Lmdb.Map.Nodup
+ ~name:"EVENTS"
+ ~key:Lmdb.Conv.int64_le
+ ~value:Lmdb.Conv.string
+ env
+ with Not_found ->
+ Lmdb.Map.create Lmdb.Map.Nodup
+ ~name:"EVENTS"
+ ~key:Lmdb.Conv.int64_le
+ ~value:Lmdb.Conv.string
+ env
+ in
+
+ let meta_map =
+ try
+ Lmdb.Map.open_existing Lmdb.Map.Nodup
+ ~name:"META"
+ ~key:Lmdb.Conv.string
+ ~value:Lmdb.Conv.string
+ env
+ with Not_found ->
+ Lmdb.Map.create Lmdb.Map.Nodup
+ ~name:"META"
+ ~key:Lmdb.Conv.string
+ ~value:Lmdb.Conv.string
+ env
+ in
+
+ (* Read last event number from metadata or find highest event *)
+ let last_event =
+ try
+ let last_str = Lmdb.Map.get meta_map "last_event" in
+ Int64.of_string last_str
+ with Not_found ->
+ (* Find highest event number by iterating backwards *)
+ try
+ match Lmdb.Txn.go Lmdb.Ro env (fun txn ->
+ Lmdb.Cursor.go Lmdb.Ro ~txn events_map (fun cursor ->
+ let (event_num, _) = Lmdb.Cursor.last cursor in
+ debug "found last event: %Ld" event_num;
+ event_num
+ )
+ ) with
+ | Some event_num -> event_num
+ | None -> 0L
+ with Not_found ->
+ 0L
+ in
+
+ debug "last event number: %Ld" last_event;
+
+ { env; events_map; meta_map; last_event; enabled }
+
+(* Close the event log *)
+let close (log : t) : unit =
+ debug "closing event log";
+ Lmdb.Env.sync log.env;
+ Lmdb.Env.close log.env
+
+(* Append a new event to the log *)
+let append ?(verbose=false) (log : t) (noun : noun) : event_num =
+ if not log.enabled then begin
+ log.last_event <- Int64.succ log.last_event;
+ log.last_event
+ end else begin
+ let event_num = Int64.succ log.last_event in
+ debug "appending event %Ld" event_num;
+
+ debug "serializing event %Ld..." event_num;
+ let serialized = serialize_event ~verbose noun in
+ debug "serialized event %Ld: %d bytes" event_num (String.length serialized);
+
+ (* Write event in a transaction *)
+ debug "starting LMDB transaction for event %Ld" event_num;
+ Lmdb.Txn.go Lmdb.Rw log.env (fun txn ->
+ debug "writing event %Ld to EVENTS map" event_num;
+ Lmdb.Map.set log.events_map ~txn event_num serialized;
+ debug "writing metadata for event %Ld" event_num;
+ Lmdb.Map.set log.meta_map ~txn "last_event" (Int64.to_string event_num);
+ debug "transaction complete for event %Ld" event_num;
+ Some ()
+ ) |> ignore;
+
+ log.last_event <- event_num;
+ debug "wrote event %Ld (%d bytes)" event_num (String.length serialized);
+ event_num
+ end
+
+(* Read a specific event from the log *)
+let read_event ?(verbose=false) (log : t) (event_num : event_num) : noun =
+ debug "reading event %Ld" event_num;
+
+ try
+ let serialized = Lmdb.Map.get log.events_map event_num in
+ debug "read event %Ld (%d bytes)" event_num (String.length serialized);
+ deserialize_event ~verbose serialized
+ with Not_found ->
+ failwith (Printf.sprintf "Event %Ld not found" event_num)
+
+(* Get the range of events in the log (first, last) *)
+let gulf (log : t) : (event_num * event_num) option =
+ try
+ Lmdb.Txn.go Lmdb.Ro log.env (fun txn ->
+ Lmdb.Cursor.go Lmdb.Ro ~txn log.events_map (fun cursor ->
+ let (first_num, _) = Lmdb.Cursor.first cursor in
+ let (last_num, _) = Lmdb.Cursor.last cursor in
+ (first_num, last_num)
+ )
+ )
+ with Not_found ->
+ None
+
+(* Replay all events in the log *)
+let replay ?(verbose=false) (log : t) (callback : event_num -> noun -> unit) : unit =
+ debug "starting replay";
+
+ match gulf log with
+ | None ->
+ debug "no events to replay";
+ ()
+ | Some (first, last) ->
+ debug "replaying events %Ld to %Ld" first last;
+
+ Lmdb.Txn.go Lmdb.Ro log.env (fun txn ->
+ Lmdb.Cursor.go Lmdb.Ro ~txn log.events_map (fun cursor ->
+ let rec replay_loop () =
+ try
+ let (event_num, serialized) = Lmdb.Cursor.current cursor in
+ debug "replaying event %Ld" event_num;
+ let noun = deserialize_event ~verbose serialized in
+ callback event_num noun;
+ ignore (Lmdb.Cursor.next cursor);
+ replay_loop ()
+ with Not_found ->
+ () (* End of cursor *)
+ in
+ (* Start from first event *)
+ ignore (Lmdb.Cursor.first cursor);
+ replay_loop ();
+ Some ()
+ )
+ ) |> ignore;
+
+ debug "replay complete"
+
+(* Get last event number *)
+let last_event (log : t) : event_num =
+ log.last_event
+
+(* Sync to disk *)
+let sync (log : t) : unit =
+ Lmdb.Env.sync log.env
diff --git a/ocaml/lib/eventlog_lmdb.mli b/ocaml/lib/eventlog_lmdb.mli
new file mode 100644
index 0000000..1369ed6
--- /dev/null
+++ b/ocaml/lib/eventlog_lmdb.mli
@@ -0,0 +1,35 @@
+(** LMDB-based event log (matches Vere's implementation) *)
+
+type event_num = int64
+(** Event number (1-indexed) *)
+
+type t
+(** Event log handle *)
+
+val create : ?enabled:bool -> string -> t
+(** [create ?enabled pier_path] opens or creates an event log at [pier_path/.urb/log].
+ If [enabled] is false, events are not persisted (default: true).
+ Uses LMDB with two databases: "EVENTS" and "META". *)
+
+val close : t -> unit
+(** [close log] syncs and closes the event log *)
+
+val append : ?verbose:bool -> t -> Noun.noun -> event_num
+(** [append ?verbose log noun] appends [noun] to the log and returns its event number.
+ Events are serialized as: 4-byte mug + jammed noun. *)
+
+val read_event : ?verbose:bool -> t -> event_num -> Noun.noun
+(** [read_event ?verbose log event_num] reads event [event_num] from the log *)
+
+val gulf : t -> (event_num * event_num) option
+(** [gulf log] returns [(first, last)] event numbers in the log, or None if empty *)
+
+val replay : ?verbose:bool -> t -> (event_num -> Noun.noun -> unit) -> unit
+(** [replay ?verbose log callback] replays all events in the log, calling
+ [callback event_num noun] for each event *)
+
+val last_event : t -> event_num
+(** [last_event log] returns the last event number in the log *)
+
+val sync : t -> unit
+(** [sync log] syncs the log to disk *)
diff --git a/ocaml/lib/mug.ml b/ocaml/lib/mug.ml
new file mode 100644
index 0000000..bf5eb32
--- /dev/null
+++ b/ocaml/lib/mug.ml
@@ -0,0 +1,17 @@
+
+
+ (* Compute murmur3 hash of a noun *)
+ (* let compute_mug (noun : noun) : int32 = *)
+ (* let rec hash_noun n = *)
+ (* match n with *)
+ (* | Atom z -> *)
+ (* let bytes = Z.to_bits z in *)
+ (* murmur3_hash32 bytes *)
+ (* | Cell (h, t) -> *)
+ (* let h_mug = hash_noun h in *)
+ (* let t_mug = hash_noun t in *)
+ (* Combine hashes - simplified version *)
+ (* Int32.logxor h_mug t_mug *)
+ (* in *)
+ (* hash_noun noun *)
+
diff --git a/ocaml/lib/nock.ml b/ocaml/lib/nock.ml
new file mode 100644
index 0000000..5a51a92
--- /dev/null
+++ b/ocaml/lib/nock.ml
@@ -0,0 +1,93 @@
+open Noun
+
+let rec nock subject formula =
+ match formula with
+ | Atom _ -> raise Exit
+ | Cell (head_node, tail_node) -> (
+ match head_node with
+ | Atom op when Z.fits_int op ->
+ let opcode = Z.to_int op in
+ begin match opcode with
+ | 0 ->
+ let axis = match tail_node with
+ | Atom z -> z
+ | _ -> raise Exit
+ in
+ slot axis subject
+ | 1 ->
+ tail_node
+ | 2 ->
+ if not (is_cell tail_node) then raise Exit;
+ let b = head tail_node in
+ let c = tail tail_node in
+ let new_subject = nock subject b in
+ let new_formula = nock subject c in
+ nock new_subject new_formula
+ | 3 ->
+ let res = nock subject tail_node in
+ if is_cell res then zero else one
+ | 4 ->
+ let res = nock subject tail_node in
+ inc res
+ | 5 ->
+ let res = nock subject tail_node in
+ if not (is_cell res) then raise Exit;
+ let a = head res in
+ let b = tail res in
+ if equal a b then zero else one
+ | 6 ->
+ if not (is_cell tail_node) then raise Exit;
+ let b = head tail_node in
+ let rest = tail tail_node in
+ if not (is_cell rest) then raise Exit;
+ let c = head rest in
+ let d = tail rest in
+ let test = nock subject b in
+ begin match test with
+ | Atom z when Z.equal z Z.zero -> nock subject c
+ | Atom z when Z.equal z Z.one -> nock subject d
+ | _ -> raise Exit
+ end
+ | 7 ->
+ if not (is_cell tail_node) then raise Exit;
+ let b = head tail_node in
+ let c = tail tail_node in
+ let new_subject = nock subject b in
+ nock new_subject c
+ | 8 ->
+ if not (is_cell tail_node) then raise Exit;
+ let b = head tail_node in
+ let c = tail tail_node in
+ let value = nock subject b in
+ let new_subject = cell value subject in
+ nock new_subject c
+ | 9 ->
+ if not (is_cell tail_node) then raise Exit;
+ let b = head tail_node in
+ let c = tail tail_node in
+ let axis = match b with
+ | Atom z -> z
+ | _ -> raise Exit
+ in
+ let core = nock subject c in
+ let target = slot axis core in
+ nock core target
+ | 10 ->
+ if not (is_cell tail_node) then raise Exit;
+ let _p = head tail_node in
+ let q = tail tail_node in
+ nock subject q
+ | 11 ->
+ if not (is_cell tail_node) then raise Exit;
+ let _p = head tail_node in
+ let q = tail tail_node in
+ nock subject q
+ | _ ->
+ raise Exit
+ end
+ | _ ->
+ let left = nock subject head_node in
+ let right = nock subject tail_node in
+ cell left right)
+
+let nock_on subject formula = nock subject formula
diff --git a/ocaml/lib/nock.mli b/ocaml/lib/nock.mli
new file mode 100644
index 0000000..4bc6e3c
--- /dev/null
+++ b/ocaml/lib/nock.mli
@@ -0,0 +1,2 @@
+val nock : Noun.noun -> Noun.noun -> Noun.noun
+val nock_on : Noun.noun -> Noun.noun -> Noun.noun
diff --git a/ocaml/lib/nock_lib.ml b/ocaml/lib/nock_lib.ml
new file mode 100644
index 0000000..0c6101e
--- /dev/null
+++ b/ocaml/lib/nock_lib.ml
@@ -0,0 +1,9 @@
+module Noun = Noun
+module Nock = Nock
+module Serial = Serial
+module State = State
+module Boot = Boot
+module Eventlog = Eventlog
+module Eventlog_lmdb = Eventlog_lmdb
+module Effects = Effects
+module Dill = Dill
diff --git a/ocaml/lib/nock_lib.mli b/ocaml/lib/nock_lib.mli
new file mode 100644
index 0000000..1f86dc7
--- /dev/null
+++ b/ocaml/lib/nock_lib.mli
@@ -0,0 +1,9 @@
+module Noun : module type of Noun
+module Nock : module type of Nock
+module Serial : module type of Serial
+module State : module type of State
+module Boot : module type of Boot
+module Eventlog : module type of Eventlog
+module Eventlog_lmdb : module type of Eventlog_lmdb
+module Effects : module type of Effects
+module Dill : module type of Dill
diff --git a/ocaml/lib/noun.ml b/ocaml/lib/noun.ml
new file mode 100644
index 0000000..eb477db
--- /dev/null
+++ b/ocaml/lib/noun.ml
@@ -0,0 +1,67 @@
+type noun =
+ | Atom of Z.t
+ | Cell of noun * noun
+
+exception Exit
+
+let ensure_non_negative z =
+ if Z.sign z < 0 then raise Exit else z
+
+let atom z =
+ Atom (ensure_non_negative z)
+
+let atom_of_int n =
+ if n < 0 then raise Exit else Atom (Z.of_int n)
+
+(* Convert ASCII string to atom (bytes in little-endian order) *)
+let atom_of_string s =
+ if String.length s = 0 then atom Z.zero
+ else
+ let bytes = Bytes.of_string s in
+ atom (Z.of_bits (Bytes.to_string bytes))
+
+let cell h t = Cell (h, t)
+
+let zero = atom_of_int 0
+let one = atom_of_int 1
+
+let is_atom = function
+ | Atom _ -> true
+ | Cell _ -> false
+
+let is_cell = function
+ | Cell _ -> true
+ | Atom _ -> false
+
+let rec equal a b =
+ match a, b with
+ | Atom x, Atom y -> Z.equal x y
+ | Cell (ah, at), Cell (bh, bt) -> equal ah bh && equal at bt
+ | _ -> false
+
+let inc = function
+ | Atom z -> Atom (Z.succ z)
+ | Cell _ -> raise Exit
+
+let head = function
+ | Cell (h, _) -> h
+ | Atom _ -> raise Exit
+
+let tail = function
+ | Cell (_, t) -> t
+ | Atom _ -> raise Exit
+
+let rec slot axis noun =
+ if Z.equal axis Z.one then noun
+ else if Z.equal axis Z.zero then raise Exit
+ else
+ let bit = Z.testbit axis 0 in
+ let parent = Z.shift_right axis 1 in
+ let sub = slot parent noun in
+ if bit then tail sub else head sub
+
+let rec to_list noun =
+ match noun with
+ | Atom z when Z.equal z Z.zero -> []
+ | Cell (h, t) -> h :: to_list t
+ | _ -> raise Exit
diff --git a/ocaml/lib/noun.mli b/ocaml/lib/noun.mli
new file mode 100644
index 0000000..3cec58d
--- /dev/null
+++ b/ocaml/lib/noun.mli
@@ -0,0 +1,23 @@
+type noun =
+ | Atom of Z.t
+ | Cell of noun * noun
+
+exception Exit
+
+val atom : Z.t -> noun
+val atom_of_int : int -> noun
+val atom_of_string : string -> noun
+val cell : noun -> noun -> noun
+
+val zero : noun
+val one : noun
+
+val is_atom : noun -> bool
+val is_cell : noun -> bool
+val equal : noun -> noun -> bool
+
+val slot : Z.t -> noun -> noun
+val inc : noun -> noun
+val head : noun -> noun
+val tail : noun -> noun
+val to_list : noun -> noun list
diff --git a/ocaml/lib/serial.ml b/ocaml/lib/serial.ml
new file mode 100644
index 0000000..47e04d1
--- /dev/null
+++ b/ocaml/lib/serial.ml
@@ -0,0 +1,225 @@
+open Noun
+open Bitstream
+
+(* Jam hashtable: use physical equality first (fast path),
+ then fall back to structural equality for correctness.
+ Hash based on pointer value for O(1) performance. *)
+module NounTbl = Hashtbl.Make (struct
+ type t = noun
+ let equal a b = (a == b) || Noun.equal a b
+ let hash noun = Hashtbl.hash (Obj.magic noun : int)
+end)
+
+let mat_encode writer n =
+ if Z.equal n Z.zero then
+ write_bit writer true
+ else begin
+ let a = Z.numbits n in
+ let b = Z.numbits (Z.of_int a) in
+ for _ = 1 to b do
+ write_bit writer false
+ done;
+ write_bit writer true;
+ if b > 1 then
+ write_bits writer (Z.of_int a) (b - 1);
+ write_bits writer n a
+ end
+
+let mat_decode ?(verbose=false) reader =
+ let zeros = count_zero_bits_until_one reader in
+ if zeros = 0 then Z.zero
+ else
+ let len_bits =
+ if zeros = 1 then Z.zero else read_bits reader (zeros - 1)
+ in
+ let width_z = Z.add (Z.shift_left Z.one (zeros - 1)) len_bits in
+ let width =
+ try
+ let w = Z.to_int width_z in
+ if verbose && w > 1000000 then
+ Printf.eprintf "\nmat_decode: reading large atom with %d bits\n%!" w;
+ w
+ with Z.Overflow ->
+ Printf.eprintf "\nmat_decode: width overflow! zeros=%d\n%!" zeros;
+ raise Exit
+ in
+ read_bits reader width
+
+let jam ?(verbose=false) noun =
+ let writer = writer_create () in
+ (* Use polymorphic Hashtbl with custom hash/equal like ocaml-old *)
+ let positions = Hashtbl.create 1024 in
+ let counter = ref 0 in
+
+ let rec encode noun =
+ incr counter;
+ if verbose && !counter mod 10000 = 0 then
+ Printf.eprintf "jam: processed %d nodes, table size %d, bits written %d\r%!"
+ !counter (Hashtbl.length positions) (writer_pos writer);
+
+ match Hashtbl.find_opt positions noun with
+ | Some bit_pos ->
+ begin match noun with
+ | Atom z ->
+ (* if atom is smaller than backref, encode atom directly *)
+ let atom_bits = Z.numbits z in
+ let backref_bits = Z.numbits (Z.of_int bit_pos) in
+ if atom_bits <= backref_bits then begin
+ write_bit writer false;
+ mat_encode writer z
+ end else begin
+ write_bit writer true;
+ write_bit writer true;
+ mat_encode writer (Z.of_int bit_pos)
+ end
+ | Cell _ ->
+ (* always use backref for cells *)
+ write_bit writer true;
+ write_bit writer true;
+ mat_encode writer (Z.of_int bit_pos)
+ end
+ | None ->
+ let current_pos = writer_pos writer in
+ Hashtbl.add positions noun current_pos;
+ begin match noun with
+ | Atom z ->
+ write_bit writer false;
+ mat_encode writer z
+ | Cell (h, t) ->
+ write_bit writer true;
+ write_bit writer false;
+ encode h;
+ encode t
+ end
+ in
+
+ if verbose then Printf.eprintf "jam: starting...\n%!";
+ encode noun;
+ if verbose then Printf.eprintf "\njam: done! processed %d nodes\n%!" !counter;
+ writer_to_bytes writer
+
+module IntTbl = Hashtbl.Make (struct
+ type t = int
+ let equal = Int.equal
+ let hash = Hashtbl.hash
+end)
+
+let cue ?(verbose=false) bytes =
+ let reader = reader_create bytes in
+
+ (* Pre-size the backref table based on payload size to minimize rehashing *)
+ let estimated_nouns =
+ let approx = Bytes.length bytes / 8 in
+ if approx < 1024 then 1024 else approx
+ in
+ let backrefs = IntTbl.create estimated_nouns in
+
+ (* Manual stack to eliminate recursion and track unfinished cells *)
+ let stack_pos = ref (Array.make 1024 0) in
+ let stack_head = ref (Array.make 1024 None) in
+ let stack_size = ref 0 in
+
+ (* Progress tracking *)
+ let nouns_processed = ref 0 in
+ let next_report = ref 10000 in
+
+ let grow_stack () =
+ let old_pos = !stack_pos in
+ let old_head = !stack_head in
+ let old_len = Array.length old_pos in
+ let new_len = old_len * 2 in
+ let new_pos = Array.make new_len 0 in
+ let new_head = Array.make new_len None in
+ Array.blit old_pos 0 new_pos 0 old_len;
+ Array.blit old_head 0 new_head 0 old_len;
+ stack_pos := new_pos;
+ stack_head := new_head
+ in
+
+ let push_frame pos =
+ if !stack_size = Array.length !stack_pos then grow_stack ();
+ let idx = !stack_size in
+ let pos_arr = !stack_pos in
+ let head_arr = !stack_head in
+ pos_arr.(idx) <- pos;
+ head_arr.(idx) <- None;
+ stack_size := idx + 1
+ in
+
+ let result = ref None in
+
+ let rec emit noun =
+ incr nouns_processed;
+ if verbose && !nouns_processed >= !next_report then begin
+ Printf.eprintf "cue: processed %d nouns, bits read %d, stack depth %d\r%!"
+ !nouns_processed (reader_pos reader) !stack_size;
+ next_report := !nouns_processed + 10000
+ end;
+
+ if !stack_size = 0 then
+ result := Some noun
+ else begin
+ let idx = !stack_size - 1 in
+ let head_arr = !stack_head in
+ match head_arr.(idx) with
+ | None ->
+ head_arr.(idx) <- Some noun
+ | Some head ->
+ let pos_arr = !stack_pos in
+ let cell_pos = pos_arr.(idx) in
+ head_arr.(idx) <- None;
+ stack_size := idx;
+ let cell = cell head noun in
+ IntTbl.replace backrefs cell_pos cell;
+ emit cell
+ end
+ in
+
+ if verbose then Printf.eprintf "cue: starting, input size %d bytes\n%!" (Bytes.length bytes);
+
+ let last_progress = ref 0 in
+ let iterations = ref 0 in
+
+ while Option.is_none !result do
+ incr iterations;
+ let pos = reader_pos reader in
+
+ (* Check if we're stuck *)
+ if verbose && !iterations mod 100000 = 0 then begin
+ if pos = !last_progress then
+ Printf.eprintf "\nWARNING: no progress in last 100k iterations at bit %d\n%!" pos
+ else
+ last_progress := pos
+ end;
+
+ let tag0 = read_bit reader in
+
+ if not tag0 then begin
+ (* Atom: tag bit 0 *)
+ let value = mat_decode ~verbose reader in
+ let atom = atom value in
+ IntTbl.replace backrefs pos atom;
+ emit atom
+ end else begin
+ let tag1 = read_bit reader in
+ if tag1 then begin
+ (* Backref: tag bits 11 *)
+ let ref_pos = mat_decode ~verbose reader in
+ let ref_int =
+ if Z.fits_int ref_pos then Z.to_int ref_pos else raise Exit
+ in
+ match IntTbl.find_opt backrefs ref_int with
+ | Some noun -> emit noun
+ | None ->
+ Printf.eprintf "cue: invalid backref to position %d\n%!" ref_int;
+ raise Exit
+ end else begin
+ (* Cell: tag bits 10 - push frame and continue decoding head *)
+ push_frame pos
+ end
+ end
+ done;
+
+ if verbose then Printf.eprintf "\ncue: done! processed %d nouns\n%!" !nouns_processed;
+
+ Option.get !result
diff --git a/ocaml/lib/serial.mli b/ocaml/lib/serial.mli
new file mode 100644
index 0000000..da95180
--- /dev/null
+++ b/ocaml/lib/serial.mli
@@ -0,0 +1,2 @@
+val cue : ?verbose:bool -> bytes -> Noun.noun
+val jam : ?verbose:bool -> Noun.noun -> bytes
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
diff --git a/ocaml/lib/state.mli b/ocaml/lib/state.mli
new file mode 100644
index 0000000..0669fb8
--- /dev/null
+++ b/ocaml/lib/state.mli
@@ -0,0 +1,13 @@
+open Noun
+
+type t
+
+val create : ?initial:noun -> ?pier_path:string -> unit -> t
+val event_number : t -> int64
+val arvo_core : t -> noun
+val boot : ?events_played:int64 -> t -> noun -> unit
+val poke : t -> noun -> noun
+val peek : t -> noun -> noun option
+val snapshot : t -> bytes * int64
+val load_snapshot : t -> bytes -> int64 -> unit
+val close_eventlog : t -> unit
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-15 10:02:15 +0000