From 0ca55c93a7c21f81c8f21048889d1c9608a961c7 Mon Sep 17 00:00:00 2001 From: polwex Date: Mon, 6 Oct 2025 12:02:02 +0700 Subject: pretty good actually --- AGENTS.md | 32 +++++++ NOTES.md | 4 + ocaml/lib/bitstream.ml | 66 ++++++++++++- ocaml/lib/serial.ml | 181 ++++++++++++++++++++++++++++------- ocaml/solid.noun | Bin 0 -> 11839038 bytes ocaml/test/bench_cue_pill.ml | 218 +++++++++++++++++++++++++++++++++++++++++++ ocaml/test/cache_solid.ml | 39 +++++++- ocaml/test/dune | 5 + 8 files changed, 508 insertions(+), 37 deletions(-) create mode 100644 AGENTS.md create mode 100644 ocaml/solid.noun create mode 100644 ocaml/test/bench_cue_pill.ml diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..8d38734 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,32 @@ +# Repository Guidelines + +## Project Structure & Module Organization +- `ocaml/` contains the OCaml Nock interpreter: core modules in `lib/`, tests in `test/`, benchmarks in `bench_*`, plus pills and scripts for experiments. +- `vere/` hosts the Zig runtime: `pkg/` implements packages such as `noun` and `vere`, `ext/` bundles C dependencies, and `doc/`/`docker/` provide references and tooling. +- Root `flake.nix` defines the shared Nix dev shell; keep repo-level scripts executable and language-agnostic so both stacks can reuse them. + +## Build, Test, and Development Commands +- `nix develop` seeds an environment with OCaml 5.3, Zig 0.14, dune, sqlite, and the tooling pinned in `flake.nix`. +- `dune build` (from `ocaml/`) compiles the interpreter; `dune exec ./test_nock.exe` or `make -C ocaml test` runs the opcode regression tests with logs. +- `make -C ocaml bench` benchmarks the OCaml implementation; capture the output when tuning performance-sensitive code. +- `zig build` (inside `vere/`) produces a debug `urbit`; append `-Doptimize=ReleaseFast` for release-grade binaries or `-Dall` for cross compilation. +- `zig build nock-test ames-test --summary all` exercises the key runtime suites; invoke additional named targets when modifying other packages. + +## Coding Style & Naming Conventions +- OCaml files use two-space indentation, modules in `Camel_case`, values/functions `snake_case`; run `dune fmt --auto-promote` (ocamlformat) before committing. +- Zig sources rely on `zig fmt`; keep functions `lower_snake_case`, types `UpperCamelCase`, and mirror existing spacing in `vere/pkg/*`. +- Bench C helpers under `ocaml/bench_*` should stick to the supplied `gcc` flags and simple `snake_case` utilities. + +## Testing Guidelines +- Extend OCaml coverage under `ocaml/test/`, mirroring the `test_` functions already in `test_nock.ml`; ensure failures exit non-zero for CI scripts. +- Add Zig tests next to the package being touched (e.g., `vere/pkg/noun/test_*.zig`) and register them in `build.zig` so `zig build ` exposes them. +- When altering benchmarks or runtime behavior, include before/after metrics from `make -C ocaml bench` or the relevant `zig build` target. + +## Commit & Pull Request Guidelines +- Commits follow the repository’s short, lowercase subject line pattern (`moar docs`, `iris and dill`); keep them under ~60 characters and expand detail in the body when necessary. +- Name branches `i//` consistent with `vere/CONTRIBUTING.md`; open PRs with `Resolves #` plus the commands and fake-ship steps used for validation. +- PRs should flag test coverage, benchmark deltas, and pill or configuration updates; attach screenshots only when developer UX changes are visible. + + + +codex resume 0199b79c-dc49-7563-8dc4-bf017dbf45a6 diff --git a/NOTES.md b/NOTES.md index 487c068..a9ae5a4 100644 --- a/NOTES.md +++ b/NOTES.md @@ -6,3 +6,7 @@ fucking ivory pill syntax is ```hoon .ivory/pill +pill/ivory /=base=/sys ``` + + + +can we try a multicore implementation? write it at ocaml/lib/serial_parallel.ml . Come on having a single process take 10+minutes while not using the computer just feels wrong diff --git a/ocaml/lib/bitstream.ml b/ocaml/lib/bitstream.ml index 39bfd6a..e758c2a 100644 --- a/ocaml/lib/bitstream.ml +++ b/ocaml/lib/bitstream.ml @@ -67,6 +67,18 @@ let reader_create buf = len = Bytes.length buf * 8; } +(* Lookup table for trailing zero counts within a byte. Value for 0 is 8 so + callers can detect the "no one-bit present" case. *) +let trailing_zeros = + let tbl = Array.make 256 8 in + for i = 1 to 255 do + let rec count n value = + if value land 1 = 1 then n else count (n + 1) (value lsr 1) + in + tbl.(i) <- count 0 i + done; + tbl + (** Read a single bit *) let read_bit r = if r.bit_pos >= r.len then @@ -80,7 +92,36 @@ let read_bit r = (** Read multiple bits as a Z.t - optimized for bulk reads *) let read_bits r nbits = if nbits = 0 then Z.zero - else if nbits <= 64 && (r.bit_pos mod 8 = 0) && nbits mod 8 = 0 then begin + else if nbits > 4096 then begin + (* Bulk path: copy bytes then convert to Z. *) + let byte_len = (nbits + 7) / 8 in + let buf = Bytes.make byte_len '\x00' in + let bits_done = ref 0 in + + while !bits_done < nbits do + if (!bits_done land 7) = 0 && (r.bit_pos land 7) = 0 then begin + let rem_bits = nbits - !bits_done in + let bytes_to_copy = rem_bits / 8 in + if bytes_to_copy > 0 then begin + Bytes.blit r.buf (r.bit_pos / 8) buf (!bits_done / 8) bytes_to_copy; + r.bit_pos <- r.bit_pos + (bytes_to_copy * 8); + bits_done := !bits_done + (bytes_to_copy * 8) + end + end; + + if !bits_done < nbits then begin + if read_bit r then begin + let byte_idx = !bits_done / 8 in + let bit_idx = !bits_done mod 8 in + let existing = Bytes.get_uint8 buf byte_idx in + Bytes.set_uint8 buf byte_idx (existing lor (1 lsl bit_idx)) + end; + incr bits_done + end + done; + + Z.of_bits (Bytes.unsafe_to_string buf) + end else if nbits <= 64 && (r.bit_pos mod 8 = 0) && nbits mod 8 = 0 then begin (* Fast path: byte-aligned, <= 8 bytes *) let byte_pos = r.bit_pos / 8 in let num_bytes = nbits / 8 in @@ -144,3 +185,26 @@ let reader_pos r = r.bit_pos (** Check if at end of stream *) let reader_at_end r = r.bit_pos >= r.len + +let count_zero_bits_until_one r = + let buf = r.buf in + let len_bits = r.len in + let rec scan count bit_pos = + if bit_pos >= len_bits then + raise (Invalid_argument "count_zero_bits_until_one: end of stream") + else begin + let byte_idx = bit_pos lsr 3 in + let bit_off = bit_pos land 7 in + let byte = Bytes.get_uint8 buf byte_idx in + let masked = byte lsr bit_off in + if masked <> 0 then begin + let tz = trailing_zeros.(masked land 0xff) in + let zeros = count + tz in + r.bit_pos <- bit_pos + tz + 1; (* skip zeros and the terminating 1 bit *) + zeros + end else + let remaining = 8 - bit_off in + scan (count + remaining) (bit_pos + remaining) + end + in + scan 0 r.bit_pos diff --git a/ocaml/lib/serial.ml b/ocaml/lib/serial.ml index 9ededf1..ac97421 100644 --- a/ocaml/lib/serial.ml +++ b/ocaml/lib/serial.ml @@ -18,6 +18,15 @@ open Noun open Bitstream +type cue_progress = + nouns:int -> bits:int -> depth:int -> max_depth:int -> unit + +type cue_event = + | Cue_atom_begin of { position : int; value_bits : int } + | Cue_atom_end of { position : int; total_bits : int; value_bits : int } + | Cue_backref of { position : int; ref_pos : int } + | Cue_emit of { nouns : int; depth : int; max_depth : int } + (** Mat-encode a number into the bitstream Mat encoding is a variable-length integer encoding: @@ -50,28 +59,26 @@ let mat_encode w n = end (** Mat-decode from bitstream, returns (value, bits_read) *) -let mat_decode r = +let mat_decode ?on_value_bits r = let start_pos = reader_pos r in - (* Count leading 0 bits until we hit a 1 bit *) - let b = ref 0 in - while not (read_bit r) do - b := !b + 1 - done; - - let b = !b in + (* Count leading 0 bits until we hit the terminating 1 bit. *) + let b = Bitstream.count_zero_bits_until_one r in if b = 0 then (* Just a single 1 bit means 0 *) - (Z.zero, reader_pos r - start_pos) + (Option.iter (fun f -> f 0) on_value_bits; + (Z.zero, reader_pos r - start_pos, 0)) else begin (* Read the length bits and compute a = 2^(b-1) + bits_read *) let bits_val = read_bits r (b - 1) in let a = Z.to_int (Z.add (Z.shift_left Z.one (b - 1)) bits_val) in + Option.iter (fun f -> f a) on_value_bits; + (* Read n in a bits *) let n = read_bits r a in - (n, reader_pos r - start_pos) + (n, reader_pos r - start_pos, a) end (** Jam: serialize a noun to bytes @@ -137,45 +144,151 @@ let jam noun = Uses a hash table to store nouns by bit position for backreferences. *) -let cue bytes = +module IntTable = Hashtbl.Make (struct + type t = int + + let equal = Int.equal + let hash x = x land max_int +end) + +let cue ?progress ?(progress_interval = 200_000) ?inspect bytes = let r = reader_create bytes in - let backref_table = Hashtbl.create 256 in (* bit position -> noun *) - let rec cue_noun () = - let pos = reader_pos r in + (* Pre-size the backref table based on payload size to minimise rehashing. *) + let estimated_nouns = + let approx = Bytes.length bytes / 8 in + if approx < 1024 then 1024 else approx + in + let backref_table = IntTable.create estimated_nouns in + + (* Manual stack used to eliminate recursion while tracking unfinished cells. *) + let initial_stack_capacity = 1024 in + let stack_pos = ref (Array.make initial_stack_capacity 0) in + let stack_head = ref (Array.make initial_stack_capacity None) in + let stack_size = ref 0 in + let max_depth = ref 0 in + + (* Noun counter is used for periodic progress callbacks. *) + let nouns_processed = ref 0 in + + let report_tick, report_final = + match progress with + | None -> ( (fun ~nouns:_ -> ()), (fun ~nouns:_ -> ()) ) + | Some callback -> + let interval = if progress_interval <= 0 then 1 else progress_interval in + let next_report = ref interval in + + let call_callback nouns = + callback + ~nouns + ~bits:(reader_pos r) + ~depth:!stack_size + ~max_depth:!max_depth + in + + let tick ~nouns = + if nouns >= !next_report then begin + call_callback nouns; + next_report := nouns + interval + end + in + + let final ~nouns = + if nouns < !next_report then call_callback nouns + in + + (tick, final) + in - (* Read tag bit *) + let inspect_event = match inspect with Some f -> f | None -> fun _ -> () 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; + if !stack_size > !max_depth then max_depth := !stack_size + in + + let result = ref None in + + let rec emit noun = + incr nouns_processed; + report_tick ~nouns:!nouns_processed; + inspect_event (Cue_emit { nouns = !nouns_processed; depth = !stack_size; max_depth = !max_depth }); + + 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 + IntTable.replace backref_table cell_pos cell; + emit cell + end + in + + while Option.is_none !result do + let pos = reader_pos r in let tag0 = read_bit r in if not tag0 then begin (* Atom: tag bit 0 *) - let (value, _width) = mat_decode r in - let result = Atom value in - Hashtbl.add backref_table pos result; - result + let on_value_bits bits = + inspect_event (Cue_atom_begin { position = pos; value_bits = bits }) + in + let (value, total_bits, value_bits) = mat_decode ~on_value_bits r in + let atom = Atom value in + IntTable.replace backref_table pos atom; + inspect_event (Cue_atom_end { position = pos; total_bits; value_bits }); + emit atom end else begin - (* Read second tag bit *) let tag1 = read_bit r in - if tag1 then begin (* Backref: tag bits 11 *) - let (ref_pos, _width) = mat_decode r in - let ref_pos = Z.to_int ref_pos in - match Hashtbl.find_opt backref_table ref_pos with - | Some noun -> noun - | None -> raise (Invalid_argument (Printf.sprintf "cue: invalid backref to position %d" ref_pos)) + let (ref_pos, _width, _value_bits) = mat_decode r in + let ref_int = Z.to_int ref_pos in + inspect_event (Cue_backref { position = pos; ref_pos = ref_int }); + match IntTable.find_opt backref_table ref_int with + | Some noun -> emit noun + | None -> + raise + (Invalid_argument + (Printf.sprintf "cue: invalid backref to position %d" ref_int)) end else begin - (* Cell: tag bits 01 *) - let head = cue_noun () in - let tail = cue_noun () in - let result = Cell (head, tail) in - Hashtbl.add backref_table pos result; - result + (* Cell: tag bits 01 – push frame and continue decoding head. *) + push_frame pos end end - in + done; + + report_final ~nouns:!nouns_processed; - cue_noun () + Option.get !result (** Convert bytes to a hex string for debugging *) let bytes_to_hex bytes = diff --git a/ocaml/solid.noun b/ocaml/solid.noun new file mode 100644 index 0000000..aefb4af Binary files /dev/null and b/ocaml/solid.noun differ diff --git a/ocaml/test/bench_cue_pill.ml b/ocaml/test/bench_cue_pill.ml new file mode 100644 index 0000000..064f0c5 --- /dev/null +++ b/ocaml/test/bench_cue_pill.ml @@ -0,0 +1,218 @@ +open Nock_lib + +exception Stop of string + +type limits = { + max_nouns : int; + max_bytes : int option; + progress_interval : int; + pill_path : string; + verbose : bool; + stop_atom_bits : int option; +} + +let read_file_bytes 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; + Bytes.of_string data + +let mib_of_bytes bytes = float_of_int bytes /. (1024. *. 1024.) + +let run limits = + let pill_bytes = read_file_bytes limits.pill_path in + let total_bytes = Bytes.length pill_bytes in + + Printf.printf "Benchmarking cue on %s (%.2f MiB)\n" limits.pill_path + (mib_of_bytes total_bytes); + Stdlib.flush Stdlib.stdout; + + let start = Unix.gettimeofday () in + let last_print = ref start in + let processed_nouns = ref 0 in + let processed_bytes = ref 0 in + let current_depth = ref 0 in + let peak_depth = ref 0 in + let stop_reason = ref None in + let largest_atom_bits = ref 0 in + let largest_atom_total = ref 0 in + let longest_emit_gap = ref 0.0 in + let last_emit_time = ref start in + + let needs_inspect = limits.verbose || Option.is_some limits.stop_atom_bits in + let maybe_inspect = + if not needs_inspect then None + else + let atom_log_threshold_bits = 1024 in + Some + (fun event -> + match event with + | Serial.Cue_atom_begin { position; value_bits } -> + (match limits.stop_atom_bits with + | Some threshold when value_bits >= threshold -> + stop_reason := + Some + (Printf.sprintf + "encountered large atom (%d bits) at position %d" + value_bits position); + raise (Stop "atom limit") + | _ -> ()); + if limits.verbose && value_bits >= atom_log_threshold_bits then + Printf.printf + " [atom-start] pos=%d value_bits=%d (~%.2f KiB)\n%!" + position value_bits + (float_of_int value_bits /. 8. /. 1024.) + | Serial.Cue_atom_end { position; total_bits; value_bits } -> + if value_bits > !largest_atom_bits then begin + largest_atom_bits := value_bits; + largest_atom_total := total_bits; + if limits.verbose then + Printf.printf + " [atom-end] pos=%d value_bits=%d total_bits=%d (~%.2f KiB)\n%!" + position value_bits total_bits + (float_of_int value_bits /. 8. /. 1024.) + end; + | Serial.Cue_emit { nouns; depth; max_depth } -> + let now = Unix.gettimeofday () in + let gap = now -. !last_emit_time in + if gap > !longest_emit_gap then longest_emit_gap := gap; + if limits.verbose && gap > 0.2 then + Printf.printf + " [emit] gap %.3fs before noun %d (depth=%d peak=%d)\n%!" + gap nouns depth max_depth; + last_emit_time := now + | Serial.Cue_backref _ -> ()) + in + + let progress ~nouns ~bits ~depth ~max_depth = + processed_nouns := nouns; + processed_bytes := bits / 8; + current_depth := depth; + peak_depth := max_depth; + + let now = Unix.gettimeofday () in + if now -. !last_print >= 0.5 then begin + let elapsed = now -. start in + let mib = mib_of_bytes !processed_bytes in + let nouns_rate = float_of_int nouns /. elapsed in + let mib_rate = mib /. elapsed in + Printf.printf + " %.1fs | nouns=%d (%.0f/s) | %.2f MiB (%.2f MiB/s) | depth=%d/%d\n%!" + elapsed nouns nouns_rate mib mib_rate depth max_depth; + last_print := now + end; + + if limits.max_nouns > 0 && nouns >= limits.max_nouns then begin + stop_reason := Some (Printf.sprintf "reached noun limit %d" limits.max_nouns); + raise (Stop "noun limit") + end; + + begin + match limits.max_bytes with + | None -> () + | Some byte_limit -> + if !processed_bytes >= byte_limit then begin + stop_reason := + Some + (Printf.sprintf "reached byte limit %.2f MiB" + (mib_of_bytes byte_limit)); + raise (Stop "byte limit") + end + end + in + + let result = + try + let _ = + Serial.cue ~progress + ~progress_interval:limits.progress_interval + ?inspect:maybe_inspect + pill_bytes + in + `Finished + with + | Stop _ -> `Stopped + in + + let elapsed = Unix.gettimeofday () -. start in + let nouns = !processed_nouns in + let bytes = !processed_bytes in + let mib = mib_of_bytes bytes in + let nouns_rate = float_of_int nouns /. elapsed in + let mib_rate = mib /. elapsed in + let depth_now = !current_depth in + let depth_max = !peak_depth in + + begin + match result with + | `Finished -> Printf.printf "Completed full cue.\n" + | `Stopped -> + Printf.printf "Stopped early (%s).\n" + (Option.value ~default:"manual stop" !stop_reason) + end; + + Printf.printf + "Processed %d nouns in %.2fs (%.2f MiB) \n -> %.0f nouns/s, %.2f MiB/s\n Depth: current=%d peak=%d\n" + nouns elapsed mib nouns_rate mib_rate depth_now depth_max; + if limits.verbose then + Printf.printf + " Largest atom: value_bits=%d (~%.2f KiB), total_bits=%d\n Longest emit gap: %.3fs\n" + !largest_atom_bits + (float_of_int !largest_atom_bits /. 8. /. 1024.) + !largest_atom_total + !longest_emit_gap; + Stdlib.flush Stdlib.stdout + +let parse_limits () = + let pill_path = ref "solid.pill" in + let noun_limit = ref 200_000 in + let mib_limit = ref 0.0 in + let progress_interval = ref 50_000 in + let verbose = ref false in + let stop_atom_bits = ref 0 in + + let spec = + [ ( "--pill", + Arg.String (fun s -> pill_path := s), + "Path to pill (default: solid.pill)" ); + ( "--limit-nouns", + Arg.Int (fun n -> noun_limit := n), + "Stop after decoding at least this many nouns (default 200000, 0 to disable)" + ); + ( "--limit-mib", + Arg.Float (fun f -> mib_limit := f), + "Stop after reading this many MiB of data (default 0 = disable)" ); + ( "--progress-interval", + Arg.Int (fun i -> progress_interval := i), + "Number of nouns between progress callbacks (default 50000)" ) + ; ( "--verbose", + Arg.Unit (fun () -> verbose := true), + "Enable detailed logging of atoms and emit gaps" ) + ; ( "--stop-atom-bits", + Arg.Int (fun b -> stop_atom_bits := b), + "Abort when encountering an atom with this many value bits or more" ) + ] + in + + let usage = "bench_cue_pill [options]" in + Arg.parse spec (fun _ -> ()) usage; + + let max_nouns = if !noun_limit <= 0 then 0 else !noun_limit in + let max_bytes = + if !mib_limit <= 0. then None + else + let bytes = int_of_float (!mib_limit *. 1024. *. 1024.) in + Some bytes + in + + { + max_nouns; + max_bytes; + progress_interval = if !progress_interval <= 0 then 1 else !progress_interval; + pill_path = !pill_path; + verbose = !verbose; + stop_atom_bits = if !stop_atom_bits <= 0 then None else Some !stop_atom_bits; + } + +let () = run (parse_limits ()) diff --git a/ocaml/test/cache_solid.ml b/ocaml/test/cache_solid.ml index f82e0b8..7ad7df0 100644 --- a/ocaml/test/cache_solid.ml +++ b/ocaml/test/cache_solid.ml @@ -20,9 +20,44 @@ let cache_solid env = Printf.printf "Step 2: Cuing (this will take several minutes)...\n"; let start = Unix.gettimeofday () in - let pill = Serial.cue pill_bytes in + let last_tick = ref start in + let last_nouns = ref 0 in + let last_depth = ref 0 in + let last_peak = ref 0 in + let bytes_seen = ref 0 in + + let total_bytes = Bytes.length pill_bytes in + + let progress ~nouns ~bits ~depth ~max_depth = + last_nouns := nouns; + last_depth := depth; + last_peak := max_depth; + bytes_seen := bits / 8; + + let now = Unix.gettimeofday () in + if now -. !last_tick >= 1.0 then begin + let mb = float_of_int !bytes_seen /. (1024. *. 1024.) in + let pct = (float_of_int !bytes_seen /. float_of_int total_bytes) *. 100. in + Printf.printf " %.1fs | %.2f MiB (%.1f%%) | nouns=%d depth=%d/%d\n%!" + (now -. start) mb pct !last_nouns !last_depth !last_peak; + last_tick := now + end + in + + let pill = + Serial.cue + ~progress + ~progress_interval:50_000 + pill_bytes + in + let elapsed = Unix.gettimeofday () -. start in - Printf.printf " ✓ Cued in %.1fs\n\n" elapsed; + Printf.printf + " ✓ Cued in %.1fs (%.2f MiB, nouns=%d, max depth=%d)\n\n" + elapsed + (float_of_int total_bytes /. (1024. *. 1024.)) + !last_nouns + !last_peak; Printf.printf "Step 3: Marshalling noun to solid.noun...\n"; let out_channel = open_out_bin "solid.noun" in diff --git a/ocaml/test/dune b/ocaml/test/dune index 787672b..98c3ad4 100644 --- a/ocaml/test/dune +++ b/ocaml/test/dune @@ -23,6 +23,11 @@ (modules bench_serial) (libraries nock_lib zarith unix)) +(executable + (name bench_cue_pill) + (modules bench_cue_pill) + (libraries nock_lib unix)) + (executable (name test_roundtrip) (modules test_roundtrip) -- cgit v1.2.3