1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
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 ()
|
