From 64611d312280dd5d63d498ded09ae4e9a6eaf34c Mon Sep 17 00:00:00 2001 From: polwex Date: Tue, 7 Oct 2025 02:38:28 +0700 Subject: refining nock with tail calls and sheet --- ocaml/lib/nock_tail.ml | 223 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 223 insertions(+) create mode 100644 ocaml/lib/nock_tail.ml (limited to 'ocaml/lib/nock_tail.ml') 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 () -- cgit v1.2.3