summaryrefslogtreecommitdiff
path: root/ocaml/lib
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/lib')
-rw-r--r--ocaml/lib/dune2
-rw-r--r--ocaml/lib/nock_iter.ml231
-rw-r--r--ocaml/lib/nock_tail.ml223
3 files changed, 455 insertions, 1 deletions
diff --git a/ocaml/lib/dune b/ocaml/lib/dune
index a0cb4b8..91e51bc 100644
--- a/ocaml/lib/dune
+++ b/ocaml/lib/dune
@@ -1,4 +1,4 @@
(library
(name nock_lib)
- (modules noun nock bitstream serial eventlog state effects boot runtime domain_pool nock_parallel)
+ (modules noun nock nock_iter nock_tail bitstream serial eventlog state effects boot runtime domain_pool nock_parallel)
(libraries zarith eio eio.unix domainslib murmur3))
diff --git a/ocaml/lib/nock_iter.ml b/ocaml/lib/nock_iter.ml
new file mode 100644
index 0000000..48094ba
--- /dev/null
+++ b/ocaml/lib/nock_iter.ml
@@ -0,0 +1,231 @@
+(** Fully iterative Nock interpreter using explicit stack
+
+ No recursion at all - uses a work stack and result stack.
+ This will never overflow regardless of computation depth.
+*)
+
+open Noun
+
+type frame =
+ | EvalFrame of noun * noun (* Need to evaluate nock_on(bus, fol) *)
+ | DistLeft of noun * noun (* After computing left of [a b], compute right *)
+ | DistBoth of noun (* After both sides, construct cell *)
+ | Op2Formula of noun * noun (* After formula, compute subject *)
+ | Op2Subject of noun (* After subject, tail-call *)
+ | Op3Apply (* Apply cell test *)
+ | Op4Apply (* Apply increment *)
+ | Op5Apply (* Apply equality *)
+ | Op6Test of noun * noun * noun (* After test, select branch (bus, c, d) *)
+ | Op7Subject of noun (* After subject, tail-call with formula *)
+ | Op8Pin of noun * noun (* After pin, extend and tail-call (old_bus, c) *)
+ | Op9Core of noun * noun (* After core, extract slot (bus, b_gal/axis) *)
+
+let nock_on init_bus init_fol =
+ let work_stack = ref [EvalFrame (init_bus, init_fol)] in
+ let result_stack = ref [] in
+
+ let rec loop () =
+ match !work_stack with
+ | [] ->
+ (match !result_stack with
+ | [result] -> result
+ | _ -> raise Exit) (* Should have exactly one result *)
+
+ | EvalFrame (bus, fol) :: work_rest ->
+ work_stack := work_rest;
+
+ (match fol with
+ | Cell { h = hib; t = gal; _ } when is_cell hib ->
+ (* Distribution: push frames in reverse order *)
+ work_stack := EvalFrame (bus, hib) :: DistLeft (bus, gal) :: !work_stack;
+ loop ()
+
+ | Cell { h = Atom { z = op; _ }; t = gal; _ } ->
+ if Z.compare op (Z.of_int max_int) > 0 then raise Exit;
+
+ (match Z.to_int op with
+ | 0 ->
+ if not (is_atom gal) then raise Exit;
+ let axis = (match gal with Atom { z = n; _ } -> n | _ -> raise Exit) in
+ let res = slot axis bus in
+ result_stack := res :: !result_stack;
+ loop ()
+
+ | 1 ->
+ result_stack := gal :: !result_stack;
+ loop ()
+
+ | 2 ->
+ if not (is_cell gal) then raise Exit;
+ let c_gal = tail gal in
+ let b_gal = head gal in
+ work_stack := EvalFrame (bus, c_gal) :: Op2Formula (bus, b_gal) :: !work_stack;
+ loop ()
+
+ | 3 ->
+ work_stack := EvalFrame (bus, gal) :: Op3Apply :: !work_stack;
+ loop ()
+
+ | 4 ->
+ work_stack := EvalFrame (bus, gal) :: Op4Apply :: !work_stack;
+ loop ()
+
+ | 5 ->
+ work_stack := EvalFrame (bus, gal) :: Op5Apply :: !work_stack;
+ loop ()
+
+ | 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
+ work_stack := EvalFrame (bus, b_gal) :: Op6Test (bus, c_gal, d_gal) :: !work_stack;
+ loop ()
+
+ | 7 ->
+ if not (is_cell gal) then raise Exit;
+ let b_gal = head gal in
+ let c_gal = tail gal in
+ work_stack := EvalFrame (bus, b_gal) :: Op7Subject c_gal :: !work_stack;
+ loop ()
+
+ | 8 ->
+ if not (is_cell gal) then raise Exit;
+ let b_gal = head gal in
+ let c_gal = tail gal in
+ work_stack := EvalFrame (bus, b_gal) :: Op8Pin (bus, c_gal) :: !work_stack;
+ 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;
+ work_stack := EvalFrame (bus, c_gal) :: Op9Core (bus, b_gal) :: !work_stack;
+ loop ()
+
+ | 10 ->
+ (* Hint - just evaluate tail, ignore head *)
+ if not (is_cell gal) then raise Exit;
+ let q_gal = tail gal in
+ work_stack := EvalFrame (bus, q_gal) :: !work_stack;
+ loop ()
+
+ | 11 ->
+ if not (is_cell gal) then raise Exit;
+ let q_gal = tail gal in
+ work_stack := EvalFrame (bus, q_gal) :: !work_stack;
+ loop ()
+
+ | _ -> raise Exit)
+
+ | _ -> raise Exit)
+
+ | DistLeft (bus, gal) :: work_rest ->
+ (match !result_stack with
+ | left :: result_rest ->
+ result_stack := result_rest;
+ work_stack := EvalFrame (bus, gal) :: DistBoth left :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | DistBoth left :: work_rest ->
+ (match !result_stack with
+ | right :: result_rest ->
+ result_stack := cell left right :: result_rest;
+ work_stack := work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op2Formula (bus, b_gal) :: work_rest ->
+ (match !result_stack with
+ | nex :: result_rest ->
+ result_stack := result_rest;
+ work_stack := EvalFrame (bus, b_gal) :: Op2Subject nex :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op2Subject nex :: work_rest ->
+ (match !result_stack with
+ | seb :: result_rest ->
+ result_stack := result_rest;
+ (* Tail call: push new eval frame *)
+ work_stack := EvalFrame (seb, nex) :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op3Apply :: work_rest ->
+ (match !result_stack with
+ | gof :: result_rest ->
+ let res = if is_cell gof then atom 0 else atom 1 in
+ result_stack := res :: result_rest;
+ work_stack := work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op4Apply :: work_rest ->
+ (match !result_stack with
+ | gof :: result_rest ->
+ result_stack := inc gof :: result_rest;
+ work_stack := work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op5Apply :: work_rest ->
+ (match !result_stack with
+ | wim :: result_rest ->
+ if not (is_cell wim) then raise Exit;
+ let a = head wim in
+ let b = tail wim in
+ let res = if equal a b then atom 0 else atom 1 in
+ result_stack := res :: result_rest;
+ work_stack := work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op6Test (bus, c_gal, d_gal) :: work_rest ->
+ (match !result_stack with
+ | tys :: result_rest ->
+ result_stack := result_rest;
+ 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
+ work_stack := EvalFrame (bus, nex) :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op7Subject c_gal :: work_rest ->
+ (match !result_stack with
+ | bod :: result_rest ->
+ result_stack := result_rest;
+ work_stack := EvalFrame (bod, c_gal) :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op8Pin (old_bus, c_gal) :: work_rest ->
+ (match !result_stack with
+ | heb :: result_rest ->
+ result_stack := result_rest;
+ let new_bus = cell heb old_bus in
+ work_stack := EvalFrame (new_bus, c_gal) :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ | Op9Core (_bus, b_gal) :: work_rest ->
+ (match !result_stack with
+ | cor :: result_rest ->
+ result_stack := result_rest;
+ if not (is_atom b_gal) then raise Exit;
+ let axis = (match b_gal with Atom { z = n; _ } -> n | _ -> raise Exit) in
+ let arm = slot axis cor in
+ work_stack := EvalFrame (cor, arm) :: work_rest;
+ loop ()
+ | _ -> raise Exit)
+
+ in
+
+ loop ()
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 14:58:59 +0000