1 files changed, 289 insertions, 0 deletions
diff --git a/ocaml/lib/nock_old.ml b/ocaml/lib/nock_old.ml
new file mode 100644
index 0000000..d3a6051
--- /dev/null
+++ b/ocaml/lib/nock_old.ml
@@ -0,0 +1,289 @@
+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)
+*)
+
+(* 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!)
+   - show_mugs: global flag to enable/disable mug logging
+*)
+let call_count = ref 0
+let depth = ref 0
+let max_calls = 100
+let max_mug_depth = ref (-1)  (* Can be set from outside *)
+let show_mugs = ref false  (* Enable from test code to show mugs at every step *)
+
+(* 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)
+
+    In Nock notation: *[subject formula]
+
+    This is a direct port of _n_nock_on from nock.c:157-396
+
+    Uses a trampoline/loop pattern to match C's tail-call optimization
+*)
+let rec nock_on init_bus init_fol =
+  let bus = ref init_bus in
+  let fol = ref init_fol in
+
+  let rec loop () =
+  (* 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 { h = Atom { z = op; _ }; _ } when Z.fits_int op -> opcode_name (Z.to_int op)
+      | Cell { h = Cell _; _ } -> "CELL(dist)"
+      | _ -> "?"
+    in
+    (* Only compute mugs at shallow depths to avoid performance penalty, or if show_mugs is enabled *)
+    if !show_mugs || !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 { h = hib; t = gal; _ } when is_cell hib ->
+        (* 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 { h = Atom { z = op; _ }; t = gal; _ } ->
+        (* Check if opcode fits in int *)
+        if Z.compare op (Z.of_int max_int) > 0 then raise Exit;
+        let opcode = Z.to_int op in
+
+        (match opcode with
+        | 0 ->
+            (* Nock 0: /[axis subject] - slot/fragment lookup *)
+            if not (is_atom gal) then raise Exit
+            else slot (match gal with Atom { z = n; _ } -> n | _ -> raise Exit) bus
+
+        | 1 ->
+            (* Nock 1: constant - return gal as-is *)
+            gal
+
+        | 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
+
+        | 3 ->
+            (* 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 ->
+            (* Nock 4: +[subject formula] - increment *)
+            let gof = nock_on bus gal in
+            inc gof
+
+        | 5 ->
+            (* Nock 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 ->
+            (* 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 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 { z = n; _ } when Z.equal n Z.zero -> c_gal
+              | Atom { z = n; _ } when Z.equal n Z.one -> d_gal
+              | _ -> raise Exit
+            in
+            nock_on bus nex
+
+        | 7 ->
+            (* 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 ->
+            (* 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
+            let heb = nock_on bus b_gal in
+            let bod = cell heb bus in
+            nock_on bod c_gal
+
+        | 9 ->
+            (* 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 raise Exit;
+            let seb = nock_on bus c_gal in
+            let nex = slot (match b_gal with Atom { z; _ } -> z | _ -> raise Exit) seb in
+            nock_on seb nex
+
+        | 10 ->
+            (* 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 ->
+            (* 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 *)
+            raise Exit
+        )
+
+    | _ ->
+        (* Invalid formula structure *)
+        raise Exit
+    in
+
+    (* Restore depth and log exit before returning *)
+    decr depth;
+    if should_log then begin
+      (* Only compute mugs at shallow depths to avoid performance penalty, or if show_mugs is enabled *)
+      if !show_mugs || !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 ->
+    (* Restore depth even on exception *)
+    decr depth;
+    raise e
+
+(** 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