From c4b71435d9afdb67450f320f54fb7aa99dcae85e Mon Sep 17 00:00:00 2001 From: polwex Date: Sun, 5 Oct 2025 22:57:55 +0700 Subject: fixed jamcue --- ocaml/test/test_nock.ml | 284 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 284 insertions(+) create mode 100644 ocaml/test/test_nock.ml (limited to 'ocaml/test/test_nock.ml') 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" -- cgit v1.2.3