blob: 037c0d006e9289c24943369f152ec52025d90f29 (
plain)
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
|
open Noun
(** Nock interpreter
Based on the reference implementation from vere/pkg/noun/nock.c
The Nock spec has 12 opcodes (0-11):
- 0: slot/fragment lookup
- 1: constant
- 2: nock (recursion)
- 3: is-cell test
- 4: increment
- 5: equality test
- 6: if-then-else
- 7: composition
- 8: push
- 9: call with axis
- 10: hint (ignored in reference implementation)
- 11: scry (errors in reference implementation)
*)
(** Main nock evaluation function: nock(subject, formula)
In Nock notation: *[subject formula]
This is a direct port of _n_nock_on from nock.c:157-396
*)
let rec nock_on bus fol =
match fol with
| Cell (hib, gal) when is_cell hib ->
(* [a b] -> compute both sides and cons *)
let poz = nock_on bus hib in
let riv = nock_on bus gal in
cell poz riv
| Cell (Atom op, gal) ->
(match Z.to_int op with
| 0 ->
(* /[axis subject] - slot/fragment lookup *)
if not (is_atom gal) then raise Exit
else slot (match gal with Atom n -> n | _ -> raise Exit) bus
| 1 ->
(* =[constant subject] - return constant *)
gal
| 2 ->
(* *[subject formula new_subject] - evaluate with new subject *)
if not (is_cell gal) then raise Exit;
let b_gal = head gal in
let c_gal = tail gal in
let seb = nock_on bus b_gal in
let nex = nock_on bus c_gal in
nock_on seb nex
| 3 ->
(* ?[subject formula] - is-cell test *)
let gof = nock_on bus gal in
if is_cell gof then atom 0 else atom 1
| 4 ->
(* +[subject formula] - increment *)
let gof = nock_on bus gal in
inc gof
| 5 ->
(* =[subject formula] - equality test *)
let wim = nock_on bus gal in
if not (is_cell wim) then raise Exit;
let a = head wim in
let b = tail wim in
if equal a b then atom 0 else atom 1
| 6 ->
(* if-then-else *)
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
let tys = nock_on bus b_gal in
let nex = match tys with
| Atom n when Z.equal n Z.zero -> c_gal
| Atom n when Z.equal n Z.one -> d_gal
| _ -> raise Exit
in
nock_on bus nex
| 7 ->
(* composition: *[*[subject b] c] *)
if not (is_cell gal) then raise Exit;
let b_gal = head gal in
let c_gal = tail gal in
let bod = nock_on bus b_gal in
nock_on bod c_gal
| 8 ->
(* push: *[[*[subject b] subject] c] *)
if not (is_cell gal) then raise Exit;
let b_gal = head gal in
let c_gal = tail gal in
let heb = nock_on bus b_gal in
let bod = cell heb bus in
nock_on bod c_gal
| 9 ->
(* call: *[*[subject c] axis] *)
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;
let seb = nock_on bus c_gal in
let nex = slot (match b_gal with Atom n -> n | _ -> raise Exit) seb in
nock_on seb nex
| 10 ->
(* hint - in reference implementation, hints are mostly ignored *)
(* gal must be a cell: [hint-spec formula] *)
if not (is_cell gal) then raise Exit;
let nex = tail gal in
nock_on bus nex
| 11 ->
(* scry - not implemented in reference nock, raises error *)
raise Exit
| _ ->
(* Invalid opcode *)
raise Exit
)
| _ ->
(* Invalid formula structure *)
raise Exit
(** Convenience function: nock(subject, formula) *)
let nock subject formula =
nock_on subject formula
(** slam: apply gate to sample
slam(gate, sample) = *[gate [9 2 [0 1] [0 6] [1 sample] [0 7]]]
In practice this evaluates the gate (which is a core with a formula at axis 2)
with a modified sample (at axis 6).
*)
let slam gat sam =
let cor = cell (head gat) (cell sam (tail (tail gat))) in
let formula = slot (Z.of_int 2) cor in
nock_on cor formula
(** kick: fire gate without changing sample
kick(gate) = *[gate 9 2 0 1]
*)
let kick gat =
let formula = slot (Z.of_int 2) gat in
nock_on gat formula
|
