summaryrefslogtreecommitdiff
path: root/ocaml/noun.ml
diff options
context:
space:
mode:
authorpolwex <polwex@sortug.com>2025-10-05 22:57:55 +0700
committerpolwex <polwex@sortug.com>2025-10-05 22:57:55 +0700
commitc4b71435d9afdb67450f320f54fb7aa99dcae85e (patch)
treea08c4c2f7965a95fcfe6dda09629d3f103d25a0b /ocaml/noun.ml
parentfcedfddf00b3f994e4f4e40332ac7fc192c63244 (diff)
fixed jamcue
Diffstat (limited to 'ocaml/noun.ml')
-rw-r--r--ocaml/noun.ml69
1 files changed, 0 insertions, 69 deletions
diff --git a/ocaml/noun.ml b/ocaml/noun.ml
deleted file mode 100644
index c59ec80..0000000
--- a/ocaml/noun.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-(** Noun type and basic operations *)
-
-(** A noun is either an atom (arbitrary-precision integer) or a cell (pair of nouns) *)
-type noun =
- | Atom of Z.t (** Arbitrary-precision integer using Zarith *)
- | Cell of noun * noun (** Pair of nouns *)
-
-(** Exception raised on nock evaluation errors *)
-exception Exit
-
-(** Create an atom from an int *)
-let atom n = Atom (Z.of_int n)
-
-(** Create a cell *)
-let cell a b = Cell (a, b)
-
-(** Test if a noun is a cell *)
-let is_cell = function
- | Cell _ -> true
- | Atom _ -> false
-
-(** Test if a noun is an atom *)
-let is_atom = function
- | Atom _ -> true
- | Cell _ -> false
-
-(** Get head of a cell *)
-let head = function
- | Cell (h, _) -> h
- | Atom _ -> raise Exit
-
-(** Get tail of a cell *)
-let tail = function
- | Cell (_, t) -> t
- | Atom _ -> raise Exit
-
-(** Fragment/axis lookup: slot(n, noun)
- This implements the tree-addressing scheme:
- - 1 is the root
- - 2 is head, 3 is tail
- - For n > 1: if even, go left; if odd, go right
-*)
-let rec slot n noun =
- if Z.equal n Z.one then
- noun
- else if Z.equal n Z.zero then
- raise Exit
- else
- let bit = Z.testbit n 0 in (* Check if odd *)
- let parent = Z.shift_right n 1 in
- let sub = slot parent noun in
- if bit then tail sub else head sub
-
-(** Equality test for nouns *)
-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
-
-(** Increment an atom *)
-let inc = function
- | Atom n -> Atom (Z.succ n)
- | Cell _ -> raise Exit
-
-(** Pretty-print a noun *)
-let rec pp_noun fmt = function
- | Atom n -> Format.fprintf fmt "%s" (Z.to_string n)
- | Cell (a, b) -> Format.fprintf fmt "[%a %a]" pp_noun a pp_noun b