summaryrefslogtreecommitdiff
path: root/ocaml/lib/nock_tail.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/lib/nock_tail.ml')
-rw-r--r--ocaml/lib/nock_tail.ml223
1 files changed, 223 insertions, 0 deletions
diff --git a/ocaml/lib/nock_tail.ml b/ocaml/lib/nock_tail.ml
new file mode 100644
index 0000000..cdc1167
--- /dev/null
+++ b/ocaml/lib/nock_tail.ml
@@ -0,0 +1,223 @@
+open Noun
+
+(** Fully tail-recursive Nock using explicit continuations
+
+ Instead of using OCaml's call stack, we use heap-allocated
+ continuations that represent "what to do with a result".
+
+ This is constant stack space - O(1) - no matter how deep
+ the Nock computation goes.
+*)
+
+(* Continuation: what to do with a computed noun *)
+type cont =
+ | Done (* Final result *)
+ | AfterDistLeft of noun * noun * cont (* After left, compute right (bus, gal) *)
+ | AfterDistRight of noun * cont (* After right, construct cell (left) *)
+ | AfterOp2Form of noun * noun * cont (* After formula, compute subject (bus, b_gal) *)
+ | AfterOp2Subj of noun * cont (* After subject, eval (formula) *)
+ | AfterOp3 of cont (* Apply cell test *)
+ | AfterOp4 of cont (* Apply increment *)
+ | AfterOp5 of cont (* Apply equality *)
+ | AfterOp6 of noun * noun * noun * cont (* Select branch (bus, then, else) *)
+ | AfterOp7 of noun * cont (* Tail-call with new bus (formula) *)
+ | AfterOp8 of noun * noun * cont (* Extend and tail-call (old_bus, formula) *)
+ | AfterOp9Core of noun * cont (* Extract slot and tail-call (axis) *)
+
+(* The work queue: either compute or apply continuation *)
+type work =
+ | Eval of noun * noun * cont (* Evaluate nock(bus, fol) with continuation k *)
+ | Cont of noun * cont (* Apply continuation k to result *)
+
+(** Main interpreter loop - fully tail-recursive *)
+let nock_on init_bus init_fol =
+ let queue = ref [Eval (init_bus, init_fol, Done)] in
+
+ let rec loop () =
+ match !queue with
+ | [] -> raise Exit (* Should never happen *)
+
+ | Eval (bus, fol, k) :: rest ->
+ queue := rest;
+
+ (match fol with
+ (* Distribution: [a b] where a is cell *)
+ | Cell { h = hib; t = gal; _ } when is_cell hib ->
+ (* Compute left first, continuation will compute right *)
+ queue := Eval (bus, hib, AfterDistLeft (bus, gal, k)) :: !queue;
+ loop ()
+
+ | Cell { h = Atom { z = op; _ }; t = gal; _ } when Z.fits_int op ->
+ (match Z.to_int op with
+
+ (* 0: slot *)
+ | 0 ->
+ if not (is_atom gal) then raise Exit;
+ let axis = (match gal with Atom { z; _ } -> z | _ -> raise Exit) in
+ let result = slot axis bus in
+ queue := Cont (result, k) :: !queue;
+ loop ()
+
+ (* 1: constant *)
+ | 1 ->
+ queue := Cont (gal, k) :: !queue;
+ loop ()
+
+ (* 2: eval *)
+ | 2 ->
+ if not (is_cell gal) then raise Exit;
+ let b_gal = head gal in
+ let c_gal = tail gal in
+ (* Compute formula first, then subject, then eval *)
+ queue := Eval (bus, c_gal, AfterOp2Form (bus, b_gal, k)) :: !queue;
+ loop ()
+
+ (* 3: cell test *)
+ | 3 ->
+ queue := Eval (bus, gal, AfterOp3 k) :: !queue;
+ loop ()
+
+ (* 4: increment *)
+ | 4 ->
+ queue := Eval (bus, gal, AfterOp4 k) :: !queue;
+ loop ()
+
+ (* 5: equality *)
+ | 5 ->
+ queue := Eval (bus, gal, AfterOp5 k) :: !queue;
+ loop ()
+
+ (* 6: if-then-else *)
+ | 6 ->
+ 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
+ queue := Eval (bus, b_gal, AfterOp6 (bus, c_gal, d_gal, k)) :: !queue;
+ loop ()
+
+ (* 7: compose *)
+ | 7 ->
+ if not (is_cell gal) then raise Exit;
+ let b_gal = head gal in
+ let c_gal = tail gal in
+ queue := Eval (bus, b_gal, AfterOp7 (c_gal, k)) :: !queue;
+ loop ()
+
+ (* 8: extend *)
+ | 8 ->
+ if not (is_cell gal) then raise Exit;
+ let b_gal = head gal in
+ let c_gal = tail gal in
+ queue := Eval (bus, b_gal, AfterOp8 (bus, c_gal, k)) :: !queue;
+ loop ()
+
+ (* 9: invoke *)
+ | 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;
+ queue := Eval (bus, c_gal, AfterOp9Core (b_gal, k)) :: !queue;
+ loop ()
+
+ (* 10: hint - ignore *)
+ | 10 ->
+ if not (is_cell gal) then raise Exit;
+ let q_gal = tail gal in
+ queue := Eval (bus, q_gal, k) :: !queue;
+ loop ()
+
+ (* 11: hint - ignore *)
+ | 11 ->
+ if not (is_cell gal) then raise Exit;
+ let q_gal = tail gal in
+ queue := Eval (bus, q_gal, k) :: !queue;
+ loop ()
+
+ | _ -> raise Exit)
+
+ | _ -> raise Exit)
+
+ | Cont (result, k) :: rest ->
+ queue := rest;
+
+ (match k with
+ (* Done - return final result *)
+ | Done ->
+ result
+
+ (* After computing left side of distribution, compute right *)
+ | AfterDistLeft (bus, gal, k') ->
+ queue := Eval (bus, gal, AfterDistRight (result, k')) :: !queue;
+ loop ()
+
+ (* After computing both sides, construct cell *)
+ | AfterDistRight (left, k') ->
+ queue := Cont (cell left result, k') :: !queue;
+ loop ()
+
+ (* After computing formula for op2, compute subject *)
+ | AfterOp2Form (bus, b_gal, k') ->
+ let formula = result in
+ queue := Eval (bus, b_gal, AfterOp2Subj (formula, k')) :: !queue;
+ loop ()
+
+ (* After computing subject for op2, eval formula with new subject *)
+ | AfterOp2Subj (formula, k') ->
+ let subject = result in
+ queue := Eval (subject, formula, k') :: !queue;
+ loop ()
+
+ (* After computing test for op6, select branch *)
+ | AfterOp6 (bus, c_gal, d_gal, k') ->
+ let branch = match result with
+ | Atom { z; _ } when Z.equal z Z.zero -> c_gal
+ | Atom { z; _ } when Z.equal z Z.one -> d_gal
+ | _ -> raise Exit
+ in
+ queue := Eval (bus, branch, k') :: !queue;
+ loop ()
+
+ (* After computing subject for op7, eval formula with new subject *)
+ | AfterOp7 (c_gal, k') ->
+ queue := Eval (result, c_gal, k') :: !queue;
+ loop ()
+
+ (* After computing pin for op8, extend and eval *)
+ | AfterOp8 (old_bus, c_gal, k') ->
+ let new_bus = cell result old_bus in
+ queue := Eval (new_bus, c_gal, k') :: !queue;
+ loop ()
+
+ (* After computing core for op9, extract arm and eval *)
+ | AfterOp9Core (b_gal, k') ->
+ if not (is_atom b_gal) then raise Exit;
+ let axis = (match b_gal with Atom { z; _ } -> z | _ -> raise Exit) in
+ let core = result in
+ let arm = slot axis core in
+ queue := Eval (core, arm, k') :: !queue;
+ loop ()
+
+ (* Apply operations *)
+ | AfterOp3 k' ->
+ let res = if is_cell result then atom 0 else atom 1 in
+ queue := Cont (res, k') :: !queue;
+ loop ()
+
+ | AfterOp4 k' ->
+ queue := Cont (inc result, k') :: !queue;
+ loop ()
+
+ | AfterOp5 k' ->
+ if not (is_cell result) then raise Exit;
+ let a = head result in
+ let b = tail result in
+ let res = if equal a b then atom 0 else atom 1 in
+ queue := Cont (res, k') :: !queue;
+ loop ())
+
+ in
+ loop ()
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-16 22:54:52 +0000