fixed jamcue

1 files changed, 284 insertions, 0 deletions

diff --git a/ocaml/test/test_nock.ml b/ocaml/test/test_nock.ml
new file mode 100644
index 0000000..73f2ce2
--- /dev/null
+++ b/ocaml/test/test_nock.ml
@@ -0,0 +1,284 @@
+open Nock_lib.Noun
+open Nock_lib.Nock
+
+(** Test utilities *)
+
+let assert_equal expected actual msg =
+  if not (equal expected actual) then begin
+    Printf.printf "FAIL: %s\n" msg;
+    Format.printf "  Expected: %a@." pp_noun expected;
+    Format.printf "  Actual:   %a@." pp_noun actual;
+    exit 1
+  end else
+    Printf.printf "PASS: %s\n" msg
+
+let _assert_raises_exit f msg =
+  try
+    let _ = f () in
+    Printf.printf "FAIL: %s (expected Exit exception)\n" msg;
+    exit 1
+  with Exit ->
+    Printf.printf "PASS: %s\n" msg
+
+(** Basic noun tests *)
+
+let test_noun_basics () =
+  Printf.printf "\n=== Testing basic noun operations ===\n";
+
+  (* Test atom creation *)
+  let a = atom 42 in
+  assert_equal (atom 42) a "atom creation";
+
+  (* Test cell creation *)
+  let c = cell (atom 1) (atom 2) in
+  assert_equal (atom 1) (head c) "cell head";
+  assert_equal (atom 2) (tail c) "cell tail";
+
+  (* Test is_cell and is_atom *)
+  if not (is_atom a) then Printf.printf "FAIL: is_atom on atom\n" else Printf.printf "PASS: is_atom on atom\n";
+  if not (is_cell c) then Printf.printf "FAIL: is_cell on cell\n" else Printf.printf "PASS: is_cell on cell\n";
+  if is_atom c then Printf.printf "FAIL: not is_atom on cell\n" else Printf.printf "PASS: not is_atom on cell\n";
+  if is_cell a then Printf.printf "FAIL: not is_cell on atom\n" else Printf.printf "PASS: not is_cell on atom\n"
+
+(** Test slot/fragment addressing *)
+let test_slots () =
+  Printf.printf "\n=== Testing slot/fragment addressing ===\n";
+
+  (* Build tree: [[1 2] [3 4]] *)
+  let tree = cell (cell (atom 1) (atom 2)) (cell (atom 3) (atom 4)) in
+
+  (* Test slot addressing
+     1 = whole tree
+     2 = head = [1 2]
+     3 = tail = [3 4]
+     4 = head of head = 1
+     5 = tail of head = 2
+     6 = head of tail = 3
+     7 = tail of tail = 4
+  *)
+  assert_equal tree (slot Z.one tree) "slot 1 (root)";
+  assert_equal (cell (atom 1) (atom 2)) (slot (Z.of_int 2) tree) "slot 2 (head)";
+  assert_equal (cell (atom 3) (atom 4)) (slot (Z.of_int 3) tree) "slot 3 (tail)";
+  assert_equal (atom 1) (slot (Z.of_int 4) tree) "slot 4";
+  assert_equal (atom 2) (slot (Z.of_int 5) tree) "slot 5";
+  assert_equal (atom 3) (slot (Z.of_int 6) tree) "slot 6";
+  assert_equal (atom 4) (slot (Z.of_int 7) tree) "slot 7"
+
+(** Test Nock opcode 0: slot lookup *)
+let test_nock_0 () =
+  Printf.printf "\n=== Testing Nock opcode 0 (slot) ===\n";
+
+  let subject = cell (atom 4) (atom 5) in
+
+  (* *[subject [0 1]] = subject *)
+  assert_equal subject (nock subject (cell (atom 0) (atom 1))) "nock 0: axis 1";
+
+  (* *[[4 5] [0 2]] = 4 *)
+  assert_equal (atom 4) (nock subject (cell (atom 0) (atom 2))) "nock 0: axis 2";
+
+  (* *[[4 5] [0 3]] = 5 *)
+  assert_equal (atom 5) (nock subject (cell (atom 0) (atom 3))) "nock 0: axis 3"
+
+(** Test Nock opcode 1: constant *)
+let test_nock_1 () =
+  Printf.printf "\n=== Testing Nock opcode 1 (constant) ===\n";
+
+  let subject = atom 99 in
+
+  (* *[subject [1 42]] = 42 *)
+  assert_equal (atom 42) (nock subject (cell (atom 1) (atom 42))) "nock 1: return constant";
+
+  (* *[subject [1 [1 2]]] = [1 2] *)
+  assert_equal
+    (cell (atom 1) (atom 2))
+    (nock subject (cell (atom 1) (cell (atom 1) (atom 2))))
+    "nock 1: return constant cell"
+
+(** Test Nock opcode 2: recursion *)
+let test_nock_2 () =
+  Printf.printf "\n=== Testing Nock opcode 2 (nock) ===\n";
+
+  (* *[42 [2 [0 1] [1 0]]] = *[42 0] = crash *)
+  (* *[42 [2 [1 99] [1 0 1]]] = *[99 [0 1]] = 99 *)
+  let subject = atom 42 in
+  let formula = cell (atom 2) (cell (cell (atom 1) (atom 99)) (cell (atom 1) (cell (atom 0) (atom 1)))) in
+  assert_equal (atom 99) (nock subject formula) "nock 2: evaluate with new subject"
+
+(** Test Nock opcode 3: is-cell *)
+let test_nock_3 () =
+  Printf.printf "\n=== Testing Nock opcode 3 (is-cell) ===\n";
+
+  (* *[42 [3 1 42]] = 1 (atom) *)
+  assert_equal (atom 1) (nock (atom 42) (cell (atom 3) (cell (atom 1) (atom 42)))) "nock 3: is-cell of atom";
+
+  (* *[42 [3 1 [1 2]]] = 0 (cell) *)
+  assert_equal
+    (atom 0)
+    (nock (atom 42) (cell (atom 3) (cell (atom 1) (cell (atom 1) (atom 2)))))
+    "nock 3: is-cell of cell"
+
+(** Test Nock opcode 4: increment *)
+let test_nock_4 () =
+  Printf.printf "\n=== Testing Nock opcode 4 (increment) ===\n";
+
+  (* *[42 [4 1 41]] = 42 *)
+  assert_equal (atom 42) (nock (atom 0) (cell (atom 4) (cell (atom 1) (atom 41)))) "nock 4: increment";
+
+  (* *[0 [4 0 1]] = 1 *)
+  assert_equal (atom 1) (nock (atom 0) (cell (atom 4) (cell (atom 0) (atom 1)))) "nock 4: increment subject"
+
+(** Test Nock opcode 5: equality *)
+let test_nock_5 () =
+  Printf.printf "\n=== Testing Nock opcode 5 (equality) ===\n";
+
+  (* *[0 [5 [1 4] [1 5]]] = 1 (not equal) *)
+  assert_equal
+    (atom 1)
+    (nock (atom 0) (cell (atom 5) (cell (cell (atom 1) (atom 4)) (cell (atom 1) (atom 5)))))
+    "nock 5: not equal";
+
+  (* *[0 [5 [1 4] [1 4]]] = 0 (equal) *)
+  assert_equal
+    (atom 0)
+    (nock (atom 0) (cell (atom 5) (cell (cell (atom 1) (atom 4)) (cell (atom 1) (atom 4)))))
+    "nock 5: equal"
+
+(** Test Nock opcode 6: if-then-else *)
+let test_nock_6 () =
+  Printf.printf "\n=== Testing Nock opcode 6 (if-then-else) ===\n";
+
+  (* *[42 [6 [1 0] [1 11] [1 22]]] = 11 (if 0 then 11 else 22) *)
+  assert_equal
+    (atom 11)
+    (nock (atom 42) (cell (atom 6) (cell (cell (atom 1) (atom 0)) (cell (cell (atom 1) (atom 11)) (cell (atom 1) (atom 22))))))
+    "nock 6: if true";
+
+  (* *[42 [6 [1 1] [1 11] [1 22]]] = 22 (if 1 then 11 else 22) *)
+  assert_equal
+    (atom 22)
+    (nock (atom 42) (cell (atom 6) (cell (cell (atom 1) (atom 1)) (cell (cell (atom 1) (atom 11)) (cell (atom 1) (atom 22))))))
+    "nock 6: if false"
+
+(** Test Nock opcode 7: composition *)
+let test_nock_7 () =
+  Printf.printf "\n=== Testing Nock opcode 7 (composition) ===\n";
+
+  (* *[42 [7 [1 99] [0 1]]] = *[99 [0 1]] = 99 *)
+  assert_equal
+    (atom 99)
+    (nock (atom 42) (cell (atom 7) (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1)))))
+    "nock 7: composition"
+
+(** Test Nock opcode 8: push *)
+let test_nock_8 () =
+  Printf.printf "\n=== Testing Nock opcode 8 (push) ===\n";
+
+  (* *[42 [8 [1 99] [0 1]]] = *[[99 42] [0 1]] = [99 42] *)
+  assert_equal
+    (cell (atom 99) (atom 42))
+    (nock (atom 42) (cell (atom 8) (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1)))))
+    "nock 8: push"
+
+(** Test Nock opcode 9: call *)
+let test_nock_9 () =
+  Printf.printf "\n=== Testing Nock opcode 9 (call) ===\n";
+
+  (* Simplest test: *[42 [9 1 [0 1]]]
+     = evaluate [0 1] with 42 -> 42
+     = slot 1 of 42 -> 42
+     = *[42 42] -> should crash since 42 is not a valid formula
+
+     Better test: create subject with formula at position 3
+     *[[formula value] [9 2 [0 1]]]
+     where formula = [0 3] (get tail)
+
+     Actually: *[[1 2] [9 2 [1 [0 3]]]]
+     = evaluate [1 [0 3]] with [1 2] -> [0 3]
+     = slot 2 of [1 2] -> 1
+
+     Wait, that's wrong. Let me think about what 9 does:
+     *[subject [9 axis formula]]
+     = *[subject *[*[subject formula] axis]]
+
+     So: *[[1 2] [9 3 [0 1]]]
+     = *[*[[1 2] [0 1]] 3]
+     = *[[1 2] 3]
+     = slot 3 of [1 2]
+     = 2
+
+     But that's not right either. Let me re-read the spec.
+
+     Actually from the C code:
+     seb = nock(bus, c_gal)
+     nex = slot(b_gal, seb)
+     result = nock(seb, nex)
+
+     So for [9 b c]:
+     1. Evaluate c with subject -> seb
+     2. Get slot b from seb -> nex (this is the formula)
+     3. Evaluate nex with seb as subject
+
+     Test: *[[99 [4 [0 2]]] [9 3 [0 1]]]
+     1. seb = *[[99 [4 [0 2]]] [0 1]] = [99 [4 [0 2]]]
+     2. nex = slot 3 of [99 [4 [0 2]]] = [4 [0 2]]
+     3. result = *[[99 [4 [0 2]]] [4 [0 2]]]
+                = increment of *[[99 [4 [0 2]]] [0 2]]
+                = increment of 99
+                = 100
+  *)
+  let subj = cell (atom 99) (cell (atom 4) (cell (atom 0) (atom 2))) in
+  assert_equal
+    (atom 100)
+    (nock subj (cell (atom 9) (cell (atom 3) (cell (atom 0) (atom 1)))))
+    "nock 9: call formula at axis 3"
+
+(** Test Nock opcode 10: hint *)
+let test_nock_10 () =
+  Printf.printf "\n=== Testing Nock opcode 10 (hint) ===\n";
+
+  (* *[42 [10 99 [1 11]]] = 11 (hint ignored) *)
+  assert_equal
+    (atom 11)
+    (nock (atom 42) (cell (atom 10) (cell (atom 99) (cell (atom 1) (atom 11)))))
+    "nock 10: hint with value (ignored)";
+
+  (* *[42 [10 [99 [1 88]] [1 11]]] = 11 (hint ignored) *)
+  assert_equal
+    (atom 11)
+    (nock (atom 42) (cell (atom 10) (cell (cell (atom 99) (cell (atom 1) (atom 88))) (cell (atom 1) (atom 11)))))
+    "nock 10: hint with computed value (ignored)"
+
+(** Test Nock cell constructor shorthand *)
+let test_nock_cons () =
+  Printf.printf "\n=== Testing Nock cons (cell auto-construction) ===\n";
+
+  (* *[42 [[1 6] [1 7]]] = [6 7] *)
+  assert_equal
+    (cell (atom 6) (atom 7))
+    (nock (atom 42) (cell (cell (atom 1) (atom 6)) (cell (atom 1) (atom 7))))
+    "nock cons: [[1 6] [1 7]]"
+
+(** Run all tests *)
+let () =
+  Printf.printf "=================================\n";
+  Printf.printf "Nock OCaml Test Suite\n";
+  Printf.printf "=================================\n";
+
+  test_noun_basics ();
+  test_slots ();
+  test_nock_0 ();
+  test_nock_1 ();
+  test_nock_2 ();
+  test_nock_3 ();
+  test_nock_4 ();
+  test_nock_5 ();
+  test_nock_6 ();
+  test_nock_7 ();
+  test_nock_8 ();
+  test_nock_9 ();
+  test_nock_10 ();
+  test_nock_cons ();
+
+  Printf.printf "\n=================================\n";
+  Printf.printf "All tests passed!\n";
+  Printf.printf "=================================\n"