neoinityes

1 files changed, 93 insertions, 0 deletions

diff --git a/ocaml/lib/nock.ml b/ocaml/lib/nock.ml
new file mode 100644
index 0000000..5a51a92
--- /dev/null
+++ b/ocaml/lib/nock.ml
@@ -0,0 +1,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