blob: eb477db5bc431a4653e32ccba20964b3685f87d9 (
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
|
type noun =
| Atom of Z.t
| Cell of noun * noun
exception Exit
let ensure_non_negative z =
if Z.sign z < 0 then raise Exit else z
let atom z =
Atom (ensure_non_negative z)
let atom_of_int n =
if n < 0 then raise Exit else Atom (Z.of_int n)
(* Convert ASCII string to atom (bytes in little-endian order) *)
let atom_of_string s =
if String.length s = 0 then atom Z.zero
else
let bytes = Bytes.of_string s in
atom (Z.of_bits (Bytes.to_string bytes))
let cell h t = Cell (h, t)
let zero = atom_of_int 0
let one = atom_of_int 1
let is_atom = function
| Atom _ -> true
| Cell _ -> false
let is_cell = function
| Cell _ -> true
| Atom _ -> false
let rec equal a b =
match a, b with
| Atom x, Atom y -> Z.equal x y
| Cell (ah, at), Cell (bh, bt) -> equal ah bh && equal at bt
| _ -> false
let inc = function
| Atom z -> Atom (Z.succ z)
| Cell _ -> raise Exit
let head = function
| Cell (h, _) -> h
| Atom _ -> raise Exit
let tail = function
| Cell (_, t) -> t
| Atom _ -> raise Exit
let rec slot axis noun =
if Z.equal axis Z.one then noun
else if Z.equal axis Z.zero then raise Exit
else
let bit = Z.testbit axis 0 in
let parent = Z.shift_right axis 1 in
let sub = slot parent noun in
if bit then tail sub else head sub
let rec to_list noun =
match noun with
| Atom z when Z.equal z Z.zero -> []
| Cell (h, t) -> h :: to_list t
| _ -> raise Exit
|
