diff options
| -rw-r--r-- | ocaml/NOCK_FIXES_IDEAS.md | 55 | ||||
| -rw-r--r-- | ocaml/lib/nock.ml | 325 | ||||
| -rw-r--r-- | ocaml/lib/nock_alt.ml | 159 | ||||
| -rw-r--r-- | ocaml/lib/noun.ml | 48 | ||||
| -rw-r--r-- | ocaml/test/test_two_stage_boot.ml | 249 |
5 files changed, 532 insertions, 304 deletions
diff --git a/ocaml/NOCK_FIXES_IDEAS.md b/ocaml/NOCK_FIXES_IDEAS.md new file mode 100644 index 0000000..1811c21 --- /dev/null +++ b/ocaml/NOCK_FIXES_IDEAS.md @@ -0,0 +1,55 @@ + +C: call #1 is opcode 8 (extend)OCaml: call #1 is opcode 0 (slot), call #2 is opcode 0 (slot), call #3 is opcode 7 (compose) + + This means for the same input formula [2 [0 3] [0 2]], C is directly executing opcode 8, while OCaml is executing the slot lookups [0 3] and [0 2] as separate Nock calls, then getting opcode 7. + + The problem is likely that OCaml is treating slot lookups as full recursive Nock evaluations, when they should be internal operations. Let me check the OCaml Nock 2 implementation: + + | 2 -> + (* Nock 2: *[subject formula new_subject] - evaluate with new subject *) + (* C evaluates tail first, then head - must match this order! *) + if not (is_cell gal) then raise Exit; + let c_gal = tail gal in + let b_gal = head gal in + let nex = nock_on bus c_gal in (* Tail first like C *) + let seb = nock_on bus b_gal in (* Head second like C *) + nock_on seb nex + + The issue is that when c_gal = [0 2] and b_gal = [0 3], we're calling nock_on recursively, which logs and increments the call counter. But maybe C handles slot lookups differently—perhaps as an internal + operation without logging? + + Let me check what C does when it encounters [0 axis] - does it call u3n_nock_on recursively, or does it handle it inline? + + Should I investigate the C _n_nock_on or _n_burn implementation to see how it handles Nock 0 (slot) operations? + + + -- + + + + C logs: + >>> ENTER call #0 depth=0 opcode=2 bus=cell + >>> ENTER call #1 depth=1 opcode=8 bus=cell ← Goes directly to opcode 8! + + OCaml logs: + >>> ENTER call #0 depth=0 opcode=2(eval) bus=cell + >>> ENTER call #1 depth=1 opcode=0(slot) bus=cell ← Evaluates [0 3] + <<< EXIT call #1 depth=1 returns=cell + >>> ENTER call #2 depth=1 opcode=0(slot) bus=cell ← Evaluates [0 2] + <<< EXIT call #2 depth=1 returns=cell + >>> ENTER call #3 depth=1 opcode=7(compose) bus=cell ← Result is opcode 7 + + The problem is clear: C doesn't call u3n_nock_on recursively for simple operations like [0 axis]. Instead, C compiles the Nock formula to bytecode first, and the bytecode handles slot lookups inline without + recursive nock calls. + + This is why C shows opcode 8 directly - the bytecode compiler has already evaluated [0 3] and [0 2] internally and determined that the next operation is opcode 8. + + OCaml, on the other hand, is a pure interpreter - every Nock formula, even simple ones like [0 3], goes through nock_on recursively. + + This is not a bug in OCaml - it's the correct interpreter behavior! C's bytecode is an optimization. To make OCaml match C's log output, we'd need to either: + + 1. Add bytecode compilation to OCaml (major work) + 2. Inline simple operations like slot lookup in Nock 2 (quick fix but changes the interpreter structure) + 3. Accept that the logs will differ at this level but verify the final results match + + Would you like me to inline slot lookups in Nock 2 to reduce the logging noise, or should we focus on verifying that despite the different execution paths, both C and OCaml produce the same final results? diff --git a/ocaml/lib/nock.ml b/ocaml/lib/nock.ml index 28cecf9..97a1d71 100644 --- a/ocaml/lib/nock.ml +++ b/ocaml/lib/nock.ml @@ -19,9 +19,43 @@ open Noun - 11: scry (errors in reference implementation) *) -(* Trace depth counter - only log first 20 levels *) -let trace_depth = ref 0 -let max_trace_depth = 20 +(* Trace tracking - matches C logging style + - call_count: global counter for all nock calls + - depth: current recursion depth + - max_calls: how many calls to log (like C's limit) + - max_mug_depth: only compute mugs at shallow depths (expensive!) +*) +let call_count = ref 0 +let depth = ref 0 +let max_calls = 100 +let max_mug_depth = 3 (* Only log mugs for depth <= 3 to avoid performance hit *) + +(* Helper to generate indentation based on depth *) +let indent () = + match !depth with + | 0 -> "" + | 1 -> " " + | 2 -> " " + | 3 -> " " + | 4 -> " " + | _ -> " " + +(* Helper to get opcode name/description *) +let opcode_name op = + match op with + | 0 -> "0(slot)" + | 1 -> "1(const)" + | 2 -> "2(eval)" + | 3 -> "3(cell?)" + | 4 -> "4(inc)" + | 5 -> "5(eq)" + | 6 -> "6(if)" + | 7 -> "7(compose)" + | 8 -> "8(extend)" + | 9 -> "9(invoke)" + | 10 -> "10(edit)" + | 11 -> "11(hint)" + | n -> Printf.sprintf "%d(?)" n (** Main nock evaluation function: nock(subject, formula) @@ -30,267 +64,198 @@ let max_trace_depth = 20 This is a direct port of _n_nock_on from nock.c:157-396 *) let rec nock_on bus fol = - let should_trace = !trace_depth < max_trace_depth in - if should_trace then incr trace_depth; + (* Capture current call number in local variable (like C's my_call) + This ensures ENTER and EXIT logs show the same call number even after recursion *) + let my_call = !call_count in + let should_log = my_call < max_calls in + + (* Log entry - shows opcode, depth, subject type, and mug at shallow depths *) + if should_log then begin + let opcode_str = match fol with + | Cell (Atom op, _) when Z.fits_int op -> opcode_name (Z.to_int op) + | Cell (Cell _, _) -> "CELL(dist)" + | _ -> "?" + in + (* Only compute mugs at shallow depths to avoid performance penalty *) + if !depth <= max_mug_depth then begin + let bus_mug = mug bus in + Printf.eprintf "%s>>> ENTER call #%d depth=%d opcode=%s bus=%s[mug=0x%lx]\n%!" + (indent ()) my_call !depth opcode_str + (if is_cell bus then "cell" else "atom") + bus_mug + end else begin + Printf.eprintf "%s>>> ENTER call #%d depth=%d opcode=%s bus=%s\n%!" + (indent ()) my_call !depth opcode_str + (if is_cell bus then "cell" else "atom") + end; + incr call_count + end; + + (* Increment depth for recursive calls *) + incr depth; + try let result = match fol with | Cell (hib, gal) when is_cell hib -> - (* [a b] -> compute both sides and cons *) - if should_trace then Printf.eprintf "[Nock:%d] Cell-cell formula\n%!" !trace_depth; + (* Distribution: [a b] -> compute both sides and cons *) let poz = nock_on bus hib in let riv = nock_on bus gal in cell poz riv | Cell (Atom op, gal) -> (* Check if opcode fits in int *) - if Z.compare op (Z.of_int max_int) > 0 then ( - if should_trace then Printf.eprintf "[Nock:%d] Opcode too large: %s\n%!" !trace_depth (Z.to_string op); - raise Exit - ); + if Z.compare op (Z.of_int max_int) > 0 then raise Exit; let opcode = Z.to_int op in - if should_trace then Printf.eprintf "[Nock:%d] Opcode %d\n%!" !trace_depth opcode; + (match opcode with | 0 -> - (* /[axis subject] - slot/fragment lookup *) - if not (is_atom gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op0: gal not atom\n%!" !trace_depth; - raise Exit - ) + (* Nock 0: /[axis subject] - slot/fragment lookup *) + if not (is_atom gal) then raise Exit else slot (match gal with Atom n -> n | _ -> raise Exit) bus | 1 -> - (* =[constant subject] - return constant *) + (* Nock 1: constant - return gal as-is *) gal | 2 -> - (* *[subject formula new_subject] - evaluate with new subject *) + (* Nock 2: *[subject formula new_subject] - evaluate with new subject *) (* C evaluates tail first, then head - must match this order! *) - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op2: gal not cell\n%!" !trace_depth; - raise Exit - ); + if not (is_cell gal) then raise Exit; let c_gal = tail gal in let b_gal = head gal in - - (* Debug: log what formulas we're evaluating *) - if should_trace && !trace_depth <= 2 then begin - Printf.eprintf "[Nock:%d-DEBUG] Op2 about to evaluate:\n%!" !trace_depth; - Printf.eprintf " b_gal (for subject): %s\n%!" - (if is_cell b_gal then - let h = head b_gal in - if is_atom h then - (match h with Atom n -> "[" ^ Z.to_string n ^ " ...]" | _ -> "[?]") - else "[cell ...]" - else "not-cell"); - Printf.eprintf " c_gal (for formula): %s\n%!" - (if is_cell c_gal then - let h = head c_gal in - if is_atom h then - (match h with Atom n -> "[" ^ Z.to_string n ^ " ...]" | _ -> "[?]") - else "[cell ...]" - else "not-cell") - end; - let nex = nock_on bus c_gal in (* Tail first like C *) - - if should_trace && !trace_depth <= 2 then begin - Printf.eprintf "[Nock:%d-DEBUG] Op2 computed formula:\n%!" !trace_depth; - Printf.eprintf " nex opcode: %s\n%!" - (if is_cell nex then - let h = head nex in - if is_atom h then - (match h with Atom n -> Z.to_string n | _ -> "?") - else "cell" - else "atom") - end; - let seb = nock_on bus b_gal in (* Head second like C *) - - if should_trace && !trace_depth <= 2 then begin - Printf.eprintf "[Nock:%d-DEBUG] Op2 FINAL CHECK:\n%!" !trace_depth; - Printf.eprintf " seb (subject) from b_gal=[0 %s]\n%!" - (match b_gal with - | Cell (Atom _, Atom n) -> Z.to_string n - | _ -> "?"); - Printf.eprintf " nex (formula) from c_gal=[0 %s], nex opcode = %s\n%!" - (match c_gal with - | Cell (Atom _, Atom n) -> Z.to_string n - | _ -> "?") - (if is_cell nex then - let h = head nex in - if is_atom h then (match h with Atom n -> Z.to_string n | _ -> "?") - else "cell" - else "NOT-A-CELL!") - end; - nock_on seb nex | 3 -> - (* ?[subject formula] - is-cell test *) + (* Nock 3: ?[subject formula] - is-cell test *) let gof = nock_on bus gal in if is_cell gof then atom 0 else atom 1 | 4 -> - (* +[subject formula] - increment *) + (* Nock 4: +[subject formula] - increment *) let gof = nock_on bus gal in inc gof | 5 -> - (* =[subject formula] - equality test *) + (* Nock 5: =[subject formula] - equality test *) let wim = nock_on bus gal in - if not (is_cell wim) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op5: wim not cell\n%!" !trace_depth; - raise Exit - ); + if not (is_cell wim) then raise Exit; let a = head wim in let b = tail wim in if equal a b then atom 0 else atom 1 | 6 -> - (* if-then-else *) - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op6: gal not cell\n%!" !trace_depth; - raise Exit - ); + (* Nock 6: if-then-else *) + if not (is_cell gal) then raise Exit; let b_gal = head gal in let cd_gal = tail gal in - if not (is_cell cd_gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op6: cd_gal not cell\n%!" !trace_depth; - raise Exit - ); + if not (is_cell cd_gal) then raise Exit; let c_gal = head cd_gal in let d_gal = tail cd_gal in - let tys = nock_on bus b_gal in let nex = match tys with | Atom n when Z.equal n Z.zero -> c_gal | Atom n when Z.equal n Z.one -> d_gal - | _ -> - if should_trace then Printf.eprintf "[Nock:%d] Op6: tys not 0 or 1\n%!" !trace_depth; - raise Exit + | _ -> raise Exit in nock_on bus nex | 7 -> - (* composition: *[*[subject b] c] *) - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op7: gal not cell\n%!" !trace_depth; - raise Exit - ); + (* Nock 7: composition - *[*[subject b] c] *) + if not (is_cell gal) then raise Exit; let b_gal = head gal in let c_gal = tail gal in let bod = nock_on bus b_gal in nock_on bod c_gal | 8 -> - (* push: *[[*[subject b] subject] c] *) - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op8: gal not cell\n%!" !trace_depth; - raise Exit - ); + (* Nock 8: extend - *[[*[subject b] subject] c] *) + if not (is_cell gal) then raise Exit; let b_gal = head gal in let c_gal = tail gal in - if should_trace then Printf.eprintf "[Nock:%d] Op8: computing b_gal...\n%!" !trace_depth; let heb = nock_on bus b_gal in - if should_trace then Printf.eprintf "[Nock:%d] Op8: creating new subject [heb bus]...\n%!" !trace_depth; let bod = cell heb bus in - if should_trace then Printf.eprintf "[Nock:%d] Op8: computing c_gal on new subject...\n%!" !trace_depth; nock_on bod c_gal | 9 -> - (* call: *[*[subject c] axis] *) - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op9: gal not cell\n%!" !trace_depth; - raise Exit - ); + (* Nock 9: invoke - *[*[subject c] 2 [0 1] 0 axis] *) + if not (is_cell gal) then raise Exit; let b_gal = head gal in let c_gal = tail gal in - if not (is_atom b_gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op9: b_gal not atom\n%!" !trace_depth; - raise Exit - ); - + if not (is_atom b_gal) then raise Exit; let seb = nock_on bus c_gal in let nex = slot (match b_gal with Atom n -> n | _ -> raise Exit) seb in nock_on seb nex | 10 -> - (* hint - in reference implementation, hints are mostly ignored *) - (* Two forms: [10 [[b c] d]] and [10 [b c]] *) - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op10: gal not cell\n%!" !trace_depth; - raise Exit - ); - let p_gal = head gal in (* First part: hint tag or [tag value] *) - let q_gal = tail gal in (* Second part: formula *) - - (* Determine which form we have *) - let nex = - if is_cell p_gal then begin - (* Form 1: [10 [[b c] d]] - full hint with value *) - (* p_gal = [b c], q_gal = d (formula) *) - if should_trace then Printf.eprintf "[Nock:%d] Op10: full hint, formula is %s\n%!" !trace_depth - (if is_cell q_gal then "cell" else "atom"); - q_gal (* Execute the formula, ignore hint *) - end else begin - (* Form 2: [10 [b c]] - hint with implicit value *) - (* p_gal = b (hint tag), q_gal = c (formula) *) - if should_trace then Printf.eprintf "[Nock:%d] Op10: simple hint, formula is %s\n%!" !trace_depth - (if is_cell q_gal then "cell" else "atom"); - q_gal (* Execute the formula, ignore hint *) - end - in - nock_on bus nex + (* Nock 10: edit/hint - replace at slot + Two forms: + - *[a 10 [b c] d]: edit mode, replace slot b in result of d with result of c + - *[a 10 b c]: hint mode, just evaluate c (ignore hint b) + *) + if not (is_cell gal) then raise Exit; + let _p_gal = head gal in (* Unused: hint tag/edit slot *) + let q_gal = tail gal in + (* For now, treat both forms as hints - just evaluate the formula *) + nock_on bus q_gal | 11 -> - (* scry - static scry *) - if should_trace then Printf.eprintf "[Nock:%d] Op11: scry (gal is %s)\n%!" !trace_depth - (if is_cell gal then "cell" else "atom"); - if not (is_cell gal) then ( - if should_trace then Printf.eprintf "[Nock:%d] Op11: gal not cell\n%!" !trace_depth; - raise Exit - ); - let ref_formula = head gal in - let gof_formula = tail gal in - - if should_trace then Printf.eprintf "[Nock:%d] Op11: ref_formula is %s, gof_formula is %s\n%!" !trace_depth - (if is_cell ref_formula then "cell" else "atom") - (if is_cell gof_formula then "cell" else "atom"); - - (* Check if ref_formula looks valid *) - (match ref_formula with - | Cell (Atom op, _) when Z.to_int op > 11 -> - if should_trace then Printf.eprintf "[Nock:%d] Op11: WARNING ref_formula has invalid opcode %d\n%!" !trace_depth (Z.to_int op) - | _ -> ()); - - (* Evaluate both formulas *) - if should_trace then Printf.eprintf "[Nock:%d] Op11: evaluating ref...\n%!" !trace_depth; - let _ref = nock_on bus ref_formula in - if should_trace then Printf.eprintf "[Nock:%d] Op11: evaluating gof...\n%!" !trace_depth; - let _gof = nock_on bus gof_formula in - - (* For now, scry always fails (returns block) - * In real Urbit, this would call into the scry handler - * C Vere calls u3m_soft_esc which can fail - * We'll return a crash for now *) - if should_trace then Printf.eprintf "[Nock:%d] Op11: scry not supported, crashing\n%!" !trace_depth; - raise Exit - - | n -> + (* Nock 11: hint (two forms) + - *[a 11 [b c] d] → *[[*[a c] *[a d]] 0 3] (dynamic hint) + - *[a 11 b c] → *[a c] (static hint) + + The key insight: b is HINT DATA, not a formula! + Don't try to evaluate it as Nock code. + *) + if not (is_cell gal) then raise Exit; + let p_gal = head gal in (* b or [b c] - hint tag/data *) + let q_gal = tail gal in (* c or d - formula to evaluate *) + + if is_cell p_gal then begin + (* Dynamic hint: *[a 11 [b c] d] + Spec: *[[*[a c] *[a d]] 0 3] + This evaluates both c and d, conses them, then returns slot 3 (= d's result). + Since we just want d's result, we can skip the hint evaluation. *) + nock_on bus q_gal + end else begin + (* Static hint: *[a 11 b c] + Spec: *[a c] + Just evaluate c, ignore the hint atom b. *) + nock_on bus q_gal + end + + | _ -> (* Invalid opcode *) - if should_trace then Printf.eprintf "[Nock:%d] Invalid opcode: %d\n%!" !trace_depth n; raise Exit ) | _ -> (* Invalid formula structure *) - if should_trace then Printf.eprintf "[Nock:%d] Invalid formula (not [atom cell] or [cell cell])\n%!" !trace_depth; raise Exit in - if should_trace then decr trace_depth; + + (* Restore depth and log exit before returning *) + decr depth; + if should_log then begin + (* Only compute mugs at shallow depths to avoid performance penalty *) + if !depth <= max_mug_depth then begin + let result_mug = mug result in + Printf.eprintf "%s<<< EXIT call #%d depth=%d returns=%s[mug=0x%lx]\n%!" + (indent ()) my_call !depth + (if is_cell result then "cell" else "atom") + result_mug + end else begin + Printf.eprintf "%s<<< EXIT call #%d depth=%d returns=%s\n%!" + (indent ()) my_call !depth + (if is_cell result then "cell" else "atom") + end + end; result + with e -> - if should_trace then decr trace_depth; + (* Restore depth even on exception *) + decr depth; raise e (** Convenience function: nock(subject, formula) *) diff --git a/ocaml/lib/nock_alt.ml b/ocaml/lib/nock_alt.ml new file mode 100644 index 0000000..037c0d0 --- /dev/null +++ b/ocaml/lib/nock_alt.ml @@ -0,0 +1,159 @@ +open Noun + +(** Nock interpreter + + Based on the reference implementation from vere/pkg/noun/nock.c + + The Nock spec has 12 opcodes (0-11): + - 0: slot/fragment lookup + - 1: constant + - 2: nock (recursion) + - 3: is-cell test + - 4: increment + - 5: equality test + - 6: if-then-else + - 7: composition + - 8: push + - 9: call with axis + - 10: hint (ignored in reference implementation) + - 11: scry (errors in reference implementation) +*) + +(** Main nock evaluation function: nock(subject, formula) + + In Nock notation: *[subject formula] + + This is a direct port of _n_nock_on from nock.c:157-396 +*) +let rec nock_on bus fol = + match fol with + | Cell (hib, gal) when is_cell hib -> + (* [a b] -> compute both sides and cons *) + let poz = nock_on bus hib in + let riv = nock_on bus gal in + cell poz riv + + | Cell (Atom op, gal) -> + (match Z.to_int op with + | 0 -> + (* /[axis subject] - slot/fragment lookup *) + if not (is_atom gal) then raise Exit + else slot (match gal with Atom n -> n | _ -> raise Exit) bus + + | 1 -> + (* =[constant subject] - return constant *) + gal + + | 2 -> + (* *[subject formula new_subject] - evaluate with new subject *) + if not (is_cell gal) then raise Exit; + let b_gal = head gal in + let c_gal = tail gal in + let seb = nock_on bus b_gal in + let nex = nock_on bus c_gal in + nock_on seb nex + + | 3 -> + (* ?[subject formula] - is-cell test *) + let gof = nock_on bus gal in + if is_cell gof then atom 0 else atom 1 + + | 4 -> + (* +[subject formula] - increment *) + let gof = nock_on bus gal in + inc gof + + | 5 -> + (* =[subject formula] - equality test *) + let wim = nock_on bus gal in + if not (is_cell wim) then raise Exit; + let a = head wim in + let b = tail wim in + if equal a b then atom 0 else atom 1 + + | 6 -> + (* if-then-else *) + if not (is_cell gal) then raise Exit; + let b_gal = head gal in + let cd_gal = tail gal in + if not (is_cell cd_gal) then raise Exit; + let c_gal = head cd_gal in + let d_gal = tail cd_gal in + + let tys = nock_on bus b_gal in + let nex = match tys with + | Atom n when Z.equal n Z.zero -> c_gal + | Atom n when Z.equal n Z.one -> d_gal + | _ -> raise Exit + in + nock_on bus nex + + | 7 -> + (* composition: *[*[subject b] c] *) + if not (is_cell gal) then raise Exit; + let b_gal = head gal in + let c_gal = tail gal in + let bod = nock_on bus b_gal in + nock_on bod c_gal + + | 8 -> + (* push: *[[*[subject b] subject] c] *) + if not (is_cell gal) then raise Exit; + let b_gal = head gal in + let c_gal = tail gal in + let heb = nock_on bus b_gal in + let bod = cell heb bus in + nock_on bod c_gal + + | 9 -> + (* call: *[*[subject c] axis] *) + if not (is_cell gal) then raise Exit; + let b_gal = head gal in + let c_gal = tail gal in + if not (is_atom b_gal) then raise Exit; + + let seb = nock_on bus c_gal in + let nex = slot (match b_gal with Atom n -> n | _ -> raise Exit) seb in + nock_on seb nex + + | 10 -> + (* hint - in reference implementation, hints are mostly ignored *) + (* gal must be a cell: [hint-spec formula] *) + if not (is_cell gal) then raise Exit; + let nex = tail gal in + nock_on bus nex + + | 11 -> + (* scry - not implemented in reference nock, raises error *) + raise Exit + + | _ -> + (* Invalid opcode *) + raise Exit + ) + + | _ -> + (* Invalid formula structure *) + raise Exit + +(** Convenience function: nock(subject, formula) *) +let nock subject formula = + nock_on subject formula + +(** slam: apply gate to sample + slam(gate, sample) = *[gate [9 2 [0 1] [0 6] [1 sample] [0 7]]] + + In practice this evaluates the gate (which is a core with a formula at axis 2) + with a modified sample (at axis 6). +*) +let slam gat sam = + let cor = cell (head gat) (cell sam (tail (tail gat))) in + let formula = slot (Z.of_int 2) cor in + nock_on cor formula + +(** kick: fire gate without changing sample + kick(gate) = *[gate 9 2 0 1] +*) +let kick gat = + let formula = slot (Z.of_int 2) gat in + nock_on gat formula diff --git a/ocaml/lib/noun.ml b/ocaml/lib/noun.ml index 9be65b7..f706dca 100644 --- a/ocaml/lib/noun.ml +++ b/ocaml/lib/noun.ml @@ -86,6 +86,54 @@ let inc = function | Atom n -> Atom (Z.succ n) | Cell _ -> raise Exit +(** Compute mug (31-bit hash) of a noun + + This implements Urbit's mug hash function using FNV-1a. + The mug is cached in the C implementation but we compute it fresh each time. + + For atoms: hash the bytes of the integer representation + For cells: mix the mugs of head and tail +*) +let rec mug noun = + (* FNV-1a constants - using hex to avoid signed int32 overflow *) + let fnv_prime = 16777619l in + let fnv_basis = 0x811c9dc5l in (* 2166136261 in decimal *) + + (* Mask to 31 bits (Urbit uses 31-bit mugs) *) + let mask31 x = Int32.logand x 0x7fffffffl in + + (* Hash bytes using FNV-1a *) + let hash_bytes bytes = + let len = Bytes.length bytes in + let rec loop i hash = + if i >= len then hash + else + let byte = Int32.of_int (Bytes.get_uint8 bytes i) in + let hash' = Int32.mul (Int32.logxor hash byte) fnv_prime in + loop (i + 1) hash' + in + mask31 (loop 0 fnv_basis) + in + + (* Mix two mugs together (for cells) *) + let mix_mugs a_mug b_mug = + (* Mix by XOR and multiply, then mask *) + let mixed = Int32.mul (Int32.logxor a_mug b_mug) fnv_prime in + mask31 mixed + in + + match noun with + | Atom z -> + (* Convert atom to bytes and hash *) + let bytes = Z.to_bits z in + hash_bytes (Bytes.of_string bytes) + + | Cell (h, t) -> + (* Mix the mugs of head and tail *) + let h_mug = mug h in + let t_mug = mug t in + mix_mugs h_mug t_mug + (** Pretty-print a noun *) let rec pp_noun fmt = function | Atom n -> Format.fprintf fmt "%s" (Z.to_string n) diff --git a/ocaml/test/test_two_stage_boot.ml b/ocaml/test/test_two_stage_boot.ml index f8311b5..7986b1d 100644 --- a/ocaml/test/test_two_stage_boot.ml +++ b/ocaml/test/test_two_stage_boot.ml @@ -87,150 +87,151 @@ let stage1_ivory_boot env = None (* Stage 2: Boot solid pill events *) -let stage2_solid_boot env _ivory_kernel = - Printf.printf "\n╔═══════════════════════════════════════╗\n"; - Printf.printf "║ STAGE 2: Solid Pill Events ║\n"; - Printf.printf "╚═══════════════════════════════════════╝\n\n"; +(* let stage2_solid_boot env _ivory_kernel = *) + (* Printf.printf "\n╔═══════════════════════════════════════╗\n"; *) + (* Printf.printf "║ STAGE 2: Solid Pill Events ║\n"; *) + (* Printf.printf "╚═══════════════════════════════════════╝\n\n"; *) (* Load solid pill *) - Printf.printf "[1] Loading solid.pill...\n%!"; - let fs = Eio.Stdenv.fs env in - let pill_bytes = Eio.Path.(load (fs / "solid.pill")) |> Bytes.of_string in - Printf.printf " Size: %d bytes (%.1f MB)\n%!" - (Bytes.length pill_bytes) - (float_of_int (Bytes.length pill_bytes) /. 1024.0 /. 1024.0); - - Printf.printf "[2] Cuing solid pill...\n%!"; - let start = Unix.gettimeofday () in - let pill = Serial.cue pill_bytes in - let elapsed = Unix.gettimeofday () -. start in - Printf.printf " ✓ Cued in %.2fs\n\n%!" elapsed; + (* Printf.printf "[1] Loading solid.pill...\n%!"; *) + (* let fs = Eio.Stdenv.fs env in *) + (* let pill_bytes = Eio.Path.(load (fs / "solid.pill")) |> Bytes.of_string in *) + (* Printf.printf " Size: %d bytes (%.1f MB)\n%!" *) + (* (Bytes.length pill_bytes) *) + (* (float_of_int (Bytes.length pill_bytes) /. 1024.0 /. 1024.0); *) + + (* Printf.printf "[2] Cuing solid pill...\n%!"; *) + (* let start = Unix.gettimeofday () in *) + (* let pill = Serial.cue pill_bytes in *) + (* let elapsed = Unix.gettimeofday () -. start in *) + (* Printf.printf " ✓ Cued in %.2fs\n\n%!" elapsed; *) (* Parse structure: [%pill %solid [bot mod use]] *) - Printf.printf "[3] Parsing solid pill structure...\n%!"; - match pill with - | Noun.Cell (_tag, rest) -> - begin match rest with - | Noun.Cell (_typ, rest2) -> - Printf.printf " Tag: pill\n"; - Printf.printf " Type: solid\n"; - - begin match rest2 with - | Noun.Cell (bot, rest3) -> + (* Printf.printf "[3] Parsing solid pill structure...\n%!"; *) + (* match pill with *) + (* | Noun.Cell (_tag, rest) -> *) + (* begin match rest with *) + (* | Noun.Cell (_typ, rest2) -> *) + (* Printf.printf " Tag: pill\n"; *) + (* Printf.printf " Type: solid\n"; *) + + (* begin match rest2 with *) + (* | Noun.Cell (bot, rest3) -> *) (* Count bot events *) - let rec count_list acc n = - match n with - | Noun.Atom _ -> acc - | Noun.Cell (_, rest) -> count_list (acc + 1) rest - in - let bot_count = count_list 0 bot in - Printf.printf " Bot events: %d\n" bot_count; - - begin match rest3 with - | Noun.Cell (mod_, rest4) -> - let mod_count = count_list 0 mod_ in - Printf.printf " Mod events: %d\n" mod_count; - - begin match rest4 with - | Noun.Cell (use, _) -> - let use_count = count_list 0 use in - Printf.printf " Use events: %d\n" use_count; - - let total = bot_count + mod_count + use_count in - Printf.printf " Total: %d events\n\n" total; + (* let rec count_list acc n = *) + (* match n with *) + (* | Noun.Atom _ -> acc *) + (* | Noun.Cell (_, rest) -> count_list (acc + 1) rest *) + (* in *) + (* let bot_count = count_list 0 bot in *) + (* Printf.printf " Bot events: %d\n" bot_count; *) + + (* begin match rest3 with *) + (* | Noun.Cell (mod_, rest4) -> *) + (* let mod_count = count_list 0 mod_ in *) + (* Printf.printf " Mod events: %d\n" mod_count; *) + + (* begin match rest4 with *) + (* | Noun.Cell (use, _) -> *) + (* let use_count = count_list 0 use in *) + (* Printf.printf " Use events: %d\n" use_count; *) + + (* let total = bot_count + mod_count + use_count in *) + (* Printf.printf " Total: %d events\n\n" total; *) (* Concatenate all events into a single list *) - Printf.printf "[4] Concatenating all events...\n%!"; - let rec append_lists l1 l2 = - match l1 with - | Noun.Atom _ -> l2 - | Noun.Cell (h, t) -> Noun.cell h (append_lists t l2) - in - let all_events = append_lists bot (append_lists mod_ use) in - Printf.printf " ✓ Event list built\n\n"; + (* Printf.printf "[4] Concatenating all events...\n%!"; *) + (* let rec append_lists l1 l2 = *) + (* match l1 with *) + (* | Noun.Atom _ -> l2 *) + (* | Noun.Cell (h, t) -> Noun.cell h (append_lists t l2) *) + (* in *) + (* let all_events = append_lists bot (append_lists mod_ use) in *) + (* Printf.printf " ✓ Event list built\n\n"; *) (* Now run u3v_boot on all events *) - Printf.printf "[5] Running u3v_boot() on %d events...\n%!" total; - Printf.printf " This will call u3v_life() with the event list\n%!"; + (* Printf.printf "[5] Running u3v_boot() on %d events...\n%!" total; *) + (* Printf.printf " This will call u3v_life() with the event list\n%!"; *) - begin try - let start = Unix.gettimeofday () in + (* begin try *) + (* let start = Unix.gettimeofday () in *) (* Call the lifecycle formula on the event list *) - Printf.printf " Running [2 [0 3] [0 2]] on event list...\n%!"; - let kernel = Boot.life all_events in + (* Printf.printf " Running [2 [0 3] [0 2]] on event list...\n%!"; *) + (* let kernel = Boot.life all_events in *) - let elapsed = Unix.gettimeofday () -. start in - Printf.printf " ✓ SUCCESS! Kernel updated in %.4fs\n\n" elapsed; + (* let elapsed = Unix.gettimeofday () -. start in *) + (* Printf.printf " ✓ SUCCESS! Kernel updated in %.4fs\n\n" elapsed; *) (* Verify kernel *) - Printf.printf "[6] Verifying updated kernel...\n%!"; - begin try - let _poke = Noun.slot (Z.of_int 23) kernel in - Printf.printf " ✓ Has poke gate at slot 23\n\n"; - - Printf.printf "╔═══════════════════════════════════════╗\n"; - Printf.printf "║ 🎉🎉🎉 FULL BOOT SUCCESS! 🎉🎉🎉 ║\n"; - Printf.printf "╚═══════════════════════════════════════╝\n\n"; - - Printf.printf "Boot sequence complete:\n"; - Printf.printf " 1. Stage 1: Ivory pill with null → Initial kernel\n"; - Printf.printf " 2. Stage 2: Solid pill %d events → Updated kernel\n" total; - Printf.printf " 3. Kernel is ready to receive pokes!\n\n"; - - true - - with _ -> - Printf.printf " ✗ No slot 23 in updated kernel\n\n"; - false - end - - with - | Noun.Exit -> - Printf.printf " ✗ FAILED: Nock Exit during lifecycle\n\n"; - false - - | e -> - Printf.printf " ✗ FAILED: %s\n\n" (Printexc.to_string e); - false - end - - | Noun.Atom _ -> - Printf.printf " ✗ rest4 is atom (expected use)\n"; - false - end - - | Noun.Atom _ -> - Printf.printf " ✗ rest3 is atom (expected [mod use])\n"; - false - end - - | Noun.Atom _ -> - Printf.printf " ✗ rest2 is atom (expected [bot mod use])\n"; - false - end - - | Noun.Atom _ -> - Printf.printf " ✗ rest is atom (expected [type ...])\n"; - false - end - - | Noun.Atom _ -> - Printf.printf " ✗ Pill is atom (expected cell)\n"; - false + (* Printf.printf "[6] Verifying updated kernel...\n%!"; *) + (* begin try *) + (* let _poke = Noun.slot (Z.of_int 23) kernel in *) + (* Printf.printf " ✓ Has poke gate at slot 23\n\n"; *) + + (* Printf.printf "╔═══════════════════════════════════════╗\n"; *) + (* Printf.printf "║ 🎉🎉🎉 FULL BOOT SUCCESS! 🎉🎉🎉 ║\n"; *) + (* Printf.printf "╚═══════════════════════════════════════╝\n\n"; *) + + (* Printf.printf "Boot sequence complete:\n"; *) + (* Printf.printf " 1. Stage 1: Ivory pill with null → Initial kernel\n"; *) + (* Printf.printf " 2. Stage 2: Solid pill %d events → Updated kernel\n" total; *) + (* Printf.printf " 3. Kernel is ready to receive pokes!\n\n"; *) + + (* true *) + + (* with _ -> *) + (* Printf.printf " ✗ No slot 23 in updated kernel\n\n"; *) + (* false *) + (* end *) + + (* with *) + (* | Noun.Exit -> *) + (* Printf.printf " ✗ FAILED: Nock Exit during lifecycle\n\n"; *) + (* false *) + + (* | e -> *) + (* Printf.printf " ✗ FAILED: %s\n\n" (Printexc.to_string e); *) + (* false *) + (* end *) + + (* | Noun.Atom _ -> *) + (* Printf.printf " ✗ rest4 is atom (expected use)\n"; *) + (* false *) + (* end *) + + (* | Noun.Atom _ -> *) + (* Printf.printf " ✗ rest3 is atom (expected [mod use])\n"; *) + (* false *) + (* end *) + + (* | Noun.Atom _ -> *) + (* Printf.printf " ✗ rest2 is atom (expected [bot mod use])\n"; *) + (* false *) + (* end *) + + (* | Noun.Atom _ -> *) + (* Printf.printf " ✗ rest is atom (expected [type ...])\n"; *) + (* false *) + (* end *) + + (* | Noun.Atom _ -> *) + (* Printf.printf " ✗ Pill is atom (expected cell)\n"; *) + (* false *) (* Main test *) let main env = (* Stage 1: Ivory *) - match stage1_ivory_boot env with - | Some ivory_kernel -> + let _success = stage1_ivory_boot env in () + (* match stage1_ivory_boot env with *) + (* | Some ivory_kernel -> *) (* Stage 2: Solid *) - let _success = stage2_solid_boot env ivory_kernel in - () + (* let _success = stage2_solid_boot env ivory_kernel in *) + (* () *) - | None -> - Printf.printf "╔═══════════════════════════════════════╗\n"; - Printf.printf "║ ✗ STAGE 1 FAILED - Cannot continue ║\n"; - Printf.printf "╚═══════════════════════════════════════╝\n\n" + (* | None -> *) + (* Printf.printf "╔═══════════════════════════════════════╗\n"; *) + (* Printf.printf "║ ✗ STAGE 1 FAILED - Cannot continue ║\n"; *) + (* Printf.printf "╚═══════════════════════════════════════╝\n\n" *) let () = Eio_main.run main |