getting serious in fixing fooking nock

1 files changed, 198 insertions, 239 deletions

diff --git a/ocaml/lib/nock.ml b/ocaml/lib/nock.ml
index 73e5407..ee06eeb 100644
--- a/ocaml/lib/nock.ml
+++ b/ocaml/lib/nock.ml
@@ -1,38 +1,17 @@
 open Noun
 
-(** Nock interpreter
+(** Nock interpreter with trampoline to match C's tail-call optimization
 
-    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)
+    This is a more direct port of the C version which uses continue for tail calls
 *)
 
-(* 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
-*)
+(* Trace tracking *)
 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 *)
+let max_mug_depth = ref (-1)
+let show_mugs = ref false
 
-(* Helper to generate indentation based on depth *)
 let indent () =
   match !depth with
   | 0 -> ""
@@ -42,7 +21,6 @@ let indent () =
   | 4 -> "        "
   | _ -> "          "
 
-(* Helper to get opcode name/description *)
 let opcode_name op =
   match op with
   | 0 -> "0(slot)"
@@ -59,225 +37,206 @@ let opcode_name op =
   | 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
-*)
-let rec nock_on bus fol =
-  (* 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
+(** Main nock evaluation using trampoline pattern like C *)
+let rec nock_on init_bus init_fol =
+  let bus = ref init_bus in
+  let fol = ref init_fol in
 
-        | 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
+  let rec loop () =
+    let my_call = !call_count in
+    let should_log = my_call < max_calls in
 
-        | 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;
+    (* Log entry *)
     if should_log then begin
-      (* Only compute mugs at shallow depths to avoid performance penalty, or if show_mugs is enabled *)
+      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
       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
+        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<<< EXIT  call #%d depth=%d returns=%s\n%!"
-          (indent ()) my_call !depth
-          (if is_cell result then "cell" else "atom")
-      end
+        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;
-    result
 
-  with e ->
-    (* Restore depth even on exception *)
-    decr depth;
-    raise e
+    incr depth;
+
+    try
+      let result = match !fol with
+      | Cell { h = hib; t = gal; _ } when is_cell hib ->
+          (* Distribution *)
+          let poz = nock_on !bus hib in
+          let riv = nock_on !bus gal in
+          cell poz riv
+
+      | Cell { h = Atom { z = op; _ }; t = gal; _ } ->
+          if Z.compare op (Z.of_int max_int) > 0 then raise Exit;
+          let opcode = Z.to_int op in
+
+          (match opcode with
+          | 0 ->
+              if not (is_atom gal) then raise Exit
+              else slot (match gal with Atom { z = n; _ } -> n | _ -> raise Exit) !bus
+
+          | 1 ->
+              gal
+
+          | 2 ->
+              (* Tail-call optimization: set bus/fol and loop *)
+              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
+              let seb = nock_on !bus b_gal in
+              bus := seb;
+              fol := nex;
+              decr depth;
+              if should_log then begin
+                if !show_mugs || !depth <= !max_mug_depth then begin
+                  let result_mug = mug !bus in
+                  Printf.eprintf "%s<<< CONTINUE call #%d depth=%d with bus[mug=0x%lx]\n%!"
+                    (indent ()) my_call !depth result_mug
+                end
+              end;
+              loop ()
+
+          | 3 ->
+              let gof = nock_on !bus gal in
+              if is_cell gof then atom 0 else atom 1
+
+          | 4 ->
+              let gof = nock_on !bus gal in
+              inc gof
+
+          | 5 ->
+              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 ->
+              (* Tail-call optimization *)
+              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
+              fol := nex;
+              decr depth;
+              if should_log then begin
+                Printf.eprintf "%s<<< CONTINUE call #%d depth=%d (if-branch)\n%!"
+                  (indent ()) my_call !depth
+              end;
+              loop ()
+
+          | 7 ->
+              (* Tail-call optimization *)
+              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
+              bus := bod;
+              fol := c_gal;
+              decr depth;
+              if should_log then begin
+                if !show_mugs || !depth <= !max_mug_depth then begin
+                  let result_mug = mug !bus in
+                  Printf.eprintf "%s<<< CONTINUE call #%d depth=%d with bus[mug=0x%lx]\n%!"
+                    (indent ()) my_call !depth result_mug
+                end
+              end;
+              loop ()
+
+          | 8 ->
+              (* Tail-call optimization *)
+              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
+              bus := bod;
+              fol := c_gal;
+              decr depth;
+              if should_log then begin
+                if !show_mugs || !depth <= !max_mug_depth then begin
+                  let result_mug = mug !bus in
+                  Printf.eprintf "%s<<< CONTINUE call #%d depth=%d with bus[mug=0x%lx]\n%!"
+                    (indent ()) my_call !depth result_mug
+                end
+              end;
+              loop ()
+
+          | 9 ->
+              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 ->
+              if not (is_cell gal) then raise Exit;
+              let _p_gal = head gal in
+              let q_gal = tail gal in
+              nock_on !bus q_gal
+
+          | 11 ->
+              if not (is_cell gal) then raise Exit;
+              let p_gal = head gal in
+              let q_gal = tail gal in
+              if is_cell p_gal then
+                nock_on !bus q_gal
+              else
+                nock_on !bus q_gal
+
+          | _ ->
+              raise Exit
+          )
+
+      | _ ->
+          raise Exit
+      in
+
+      (* Log exit and return *)
+      decr depth;
+      if should_log then begin
+        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 ->
+      decr depth;
+      raise e
+  in
+
+  loop ()
 
-(** 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