blob: 5a51a928812f3563fd1f58dddf6cbe4f1e86885c (
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
|
open Noun
let rec nock subject formula =
match formula with
| Atom _ -> raise Exit
| Cell (head_node, tail_node) -> (
match head_node with
| Atom op when Z.fits_int op ->
let opcode = Z.to_int op in
begin match opcode with
| 0 ->
let axis = match tail_node with
| Atom z -> z
| _ -> raise Exit
in
slot axis subject
| 1 ->
tail_node
| 2 ->
if not (is_cell tail_node) then raise Exit;
let b = head tail_node in
let c = tail tail_node in
let new_subject = nock subject b in
let new_formula = nock subject c in
nock new_subject new_formula
| 3 ->
let res = nock subject tail_node in
if is_cell res then zero else one
| 4 ->
let res = nock subject tail_node in
inc res
| 5 ->
let res = nock subject tail_node in
if not (is_cell res) then raise Exit;
let a = head res in
let b = tail res in
if equal a b then zero else one
| 6 ->
if not (is_cell tail_node) then raise Exit;
let b = head tail_node in
let rest = tail tail_node in
if not (is_cell rest) then raise Exit;
let c = head rest in
let d = tail rest in
let test = nock subject b in
begin match test with
| Atom z when Z.equal z Z.zero -> nock subject c
| Atom z when Z.equal z Z.one -> nock subject d
| _ -> raise Exit
end
| 7 ->
if not (is_cell tail_node) then raise Exit;
let b = head tail_node in
let c = tail tail_node in
let new_subject = nock subject b in
nock new_subject c
| 8 ->
if not (is_cell tail_node) then raise Exit;
let b = head tail_node in
let c = tail tail_node in
let value = nock subject b in
let new_subject = cell value subject in
nock new_subject c
| 9 ->
if not (is_cell tail_node) then raise Exit;
let b = head tail_node in
let c = tail tail_node in
let axis = match b with
| Atom z -> z
| _ -> raise Exit
in
let core = nock subject c in
let target = slot axis core in
nock core target
| 10 ->
if not (is_cell tail_node) then raise Exit;
let _p = head tail_node in
let q = tail tail_node in
nock subject q
| 11 ->
if not (is_cell tail_node) then raise Exit;
let _p = head tail_node in
let q = tail tail_node in
nock subject q
| _ ->
raise Exit
end
| _ ->
let left = nock subject head_node in
let right = nock subject tail_node in
cell left right)
let nock_on subject formula = nock subject formula
|
