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 ()