diff options
Diffstat (limited to 'ocaml/lib')
| -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 |
3 files changed, 352 insertions, 180 deletions
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) |