coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 8 Packages Projects Releases Wiki Activity

Recover agent-loop progress: lua/prolog/forth/erlang/haskell phases 1-2

Browse Source 
Salvaged from worktree-agent-* branches killed during sx-tree MCP outage:
- lua: tokenizer + parser + phase-2 transpile (~157 tests)
- prolog: tokenizer + parser + unification (72 tests, plan update lost to WIP)
- forth: phase-1 reader/interpreter + phase-2 colon/VARIABLE (134 tests)
- erlang: tokenizer + parser (114 tests)
- haskell: tokenizer + parse tests (43 tests)

Cherry-picked file contents only, not branch history, to avoid pulling in
unrelated ocaml-vm merge commits that were in those branches' bases.
This commit is contained in:
giles
2026-04-24 16:03:00 +00:00
parent e274878052
commit 99753580b4
32 changed files with 7803 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

224
lib/forth/tests/test-phase1.sx Normal file
View File

@@ -0,0 +1,224 @@
;; Phase 1 — reader + interpret mode + core words.
;; Simple assertion driver: (forth-test label input expected-stack)
;; forth-run returns (state, output, stack-bottom-to-top).
(define forth-tests-passed 0)
(define forth-tests-failed 0)
(define forth-tests-failures (list))
(define
forth-assert
(fn
(label expected actual)
(if
(= expected actual)
(set! forth-tests-passed (+ forth-tests-passed 1))
(begin
(set! forth-tests-failed (+ forth-tests-failed 1))
(set!
forth-tests-failures
(concat
forth-tests-failures
(list
(str label ": expected " (str expected) " got " (str actual)))))))))
(define
forth-check-stack
(fn
(label src expected)
(let ((r (forth-run src))) (forth-assert label expected (nth r 2)))))
(define
forth-check-output
(fn
(label src expected)
(let ((r (forth-run src))) (forth-assert label expected (nth r 1)))))
(define
forth-reader-tests
(fn
()
(forth-assert
"tokens split"
(list "1" "2" "+")
(forth-tokens " 1 2 + "))
(forth-assert "tokens empty" (list) (forth-tokens ""))
(forth-assert
"tokens tab/newline"
(list "a" "b" "c")
(forth-tokens "a\tb\nc"))
(forth-assert "number decimal" 42 (forth-parse-number "42" 10))
(forth-assert "number negative" -7 (forth-parse-number "-7" 10))
(forth-assert "number hex prefix" 255 (forth-parse-number "$ff" 10))
(forth-assert "number binary prefix" 10 (forth-parse-number "%1010" 10))
(forth-assert
"number decimal override under hex base"
123
(forth-parse-number "#123" 16))
(forth-assert "number none" nil (forth-parse-number "abc" 10))
(forth-assert "number in hex base" 255 (forth-parse-number "ff" 16))
(forth-assert
"number negative hex prefix"
-16
(forth-parse-number "-$10" 10))
(forth-assert "char literal" 65 (forth-parse-number "'A'" 10))
(forth-assert
"mixed-case digit in base 10"
nil
(forth-parse-number "1A" 10))
(forth-assert
"mixed-case digit in base 16"
26
(forth-parse-number "1a" 16))))
(define
forth-stack-tests
(fn
()
(forth-check-stack "push literal" "42" (list 42))
(forth-check-stack "push multiple" "1 2 3" (list 1 2 3))
(forth-check-stack "DUP" "7 DUP" (list 7 7))
(forth-check-stack "DROP" "1 2 DROP" (list 1))
(forth-check-stack "SWAP" "1 2 SWAP" (list 2 1))
(forth-check-stack "OVER" "1 2 OVER" (list 1 2 1))
(forth-check-stack "ROT" "1 2 3 ROT" (list 2 3 1))
(forth-check-stack "-ROT" "1 2 3 -ROT" (list 3 1 2))
(forth-check-stack "NIP" "1 2 NIP" (list 2))
(forth-check-stack "TUCK" "1 2 TUCK" (list 2 1 2))
(forth-check-stack "?DUP non-zero" "5 ?DUP" (list 5 5))
(forth-check-stack "?DUP zero" "0 ?DUP" (list 0))
(forth-check-stack "DEPTH empty" "DEPTH" (list 0))
(forth-check-stack "DEPTH non-empty" "1 2 3 DEPTH" (list 1 2 3 3))
(forth-check-stack "PICK 0" "10 20 30 0 PICK" (list 10 20 30 30))
(forth-check-stack "PICK 1" "10 20 30 1 PICK" (list 10 20 30 20))
(forth-check-stack "PICK 2" "10 20 30 2 PICK" (list 10 20 30 10))
(forth-check-stack "ROLL 0 is no-op" "10 20 30 0 ROLL" (list 10 20 30))
(forth-check-stack "ROLL 2" "10 20 30 2 ROLL" (list 20 30 10))
(forth-check-stack "2DUP" "1 2 2DUP" (list 1 2 1 2))
(forth-check-stack "2DROP" "1 2 3 4 2DROP" (list 1 2))
(forth-check-stack "2SWAP" "1 2 3 4 2SWAP" (list 3 4 1 2))
(forth-check-stack "2OVER" "1 2 3 4 2OVER" (list 1 2 3 4 1 2))))
(define
forth-arith-tests
(fn
()
(forth-check-stack "+" "3 4 +" (list 7))
(forth-check-stack "-" "10 3 -" (list 7))
(forth-check-stack "*" "6 7 *" (list 42))
(forth-check-stack "/ positive" "7 2 /" (list 3))
(forth-check-stack "/ negative numerator" "-7 2 /" (list -3))
(forth-check-stack "/ both negative" "-7 -2 /" (list 3))
(forth-check-stack "MOD positive" "7 3 MOD" (list 1))
(forth-check-stack "MOD negative" "-7 3 MOD" (list -1))
(forth-check-stack "/MOD positive" "7 3 /MOD" (list 1 2))
(forth-check-stack "NEGATE" "5 NEGATE" (list -5))
(forth-check-stack "ABS negative" "-5 ABS" (list 5))
(forth-check-stack "ABS positive" "5 ABS" (list 5))
(forth-check-stack "MIN a<b" "3 5 MIN" (list 3))
(forth-check-stack "MIN a>b" "5 3 MIN" (list 3))
(forth-check-stack "MAX a<b" "3 5 MAX" (list 5))
(forth-check-stack "MAX a>b" "5 3 MAX" (list 5))
(forth-check-stack "1+" "5 1+" (list 6))
(forth-check-stack "1-" "5 1-" (list 4))
(forth-check-stack "2+" "5 2+" (list 7))
(forth-check-stack "2-" "5 2-" (list 3))
(forth-check-stack "2*" "5 2*" (list 10))
(forth-check-stack "2/" "7 2/" (list 3))))
(define
forth-cmp-tests
(fn
()
(forth-check-stack "= true" "5 5 =" (list -1))
(forth-check-stack "= false" "5 6 =" (list 0))
(forth-check-stack "<> true" "5 6 <>" (list -1))
(forth-check-stack "<> false" "5 5 <>" (list 0))
(forth-check-stack "< true" "3 5 <" (list -1))
(forth-check-stack "< false" "5 3 <" (list 0))
(forth-check-stack "> true" "5 3 >" (list -1))
(forth-check-stack "> false" "3 5 >" (list 0))
(forth-check-stack "<= equal" "5 5 <=" (list -1))
(forth-check-stack "<= less" "3 5 <=" (list -1))
(forth-check-stack ">= equal" "5 5 >=" (list -1))
(forth-check-stack ">= greater" "5 3 >=" (list -1))
(forth-check-stack "0= true" "0 0=" (list -1))
(forth-check-stack "0= false" "1 0=" (list 0))
(forth-check-stack "0<> true" "1 0<>" (list -1))
(forth-check-stack "0<> false" "0 0<>" (list 0))
(forth-check-stack "0< true" "-5 0<" (list -1))
(forth-check-stack "0< false" "5 0<" (list 0))
(forth-check-stack "0> true" "5 0>" (list -1))
(forth-check-stack "0> false" "-5 0>" (list 0))))
(define
forth-bitwise-tests
(fn
()
(forth-check-stack "AND flags" "-1 0 AND" (list 0))
(forth-check-stack "AND flags 2" "-1 -1 AND" (list -1))
(forth-check-stack "AND 12 10" "12 10 AND" (list 8))
(forth-check-stack "OR flags" "-1 0 OR" (list -1))
(forth-check-stack "OR 12 10" "12 10 OR" (list 14))
(forth-check-stack "XOR 12 10" "12 10 XOR" (list 6))
(forth-check-stack "XOR same" "15 15 XOR" (list 0))
(forth-check-stack "INVERT 0" "0 INVERT" (list -1))
(forth-check-stack "INVERT 5" "5 INVERT" (list -6))
(forth-check-stack "double INVERT" "7 INVERT INVERT" (list 7))))
(define
forth-io-tests
(fn
()
(forth-check-output "." "42 ." "42 ")
(forth-check-output ". two values" "1 2 . ." "2 1 ")
(forth-check-output ".S empty" ".S" "<0> ")
(forth-check-output ".S three" "1 2 3 .S" "<3> 1 2 3 ")
(forth-check-output "EMIT A" "65 EMIT" "A")
(forth-check-output "CR" "CR" "\n")
(forth-check-output "SPACE" "SPACE" " ")
(forth-check-output "SPACES 3" "3 SPACES" " ")
(forth-check-output "SPACES 0" "0 SPACES" "")
(forth-check-stack "BL" "BL" (list 32))))
(define
forth-case-tests
(fn
()
(forth-check-stack "case-insensitive DUP" "5 dup" (list 5 5))
(forth-check-stack "case-insensitive SWAP" "1 2 Swap" (list 2 1))))
(define
forth-mixed-tests
(fn
()
(forth-check-stack "chained arith" "1 2 3 + +" (list 6))
(forth-check-stack "(3+4)*2" "3 4 + 2 *" (list 14))
(forth-check-stack "max of three" "5 3 MAX 7 MAX" (list 7))
(forth-check-stack "abs chain" "-5 ABS 1+" (list 6))
(forth-check-stack "swap then add" "5 7 SWAP -" (list 2))
(forth-check-stack "hex literal" "$10 $20 +" (list 48))
(forth-check-stack "binary literal" "%1010 %0011 +" (list 13))))
(define
forth-run-all-phase1-tests
(fn
()
(set! forth-tests-passed 0)
(set! forth-tests-failed 0)
(set! forth-tests-failures (list))
(forth-reader-tests)
(forth-stack-tests)
(forth-arith-tests)
(forth-cmp-tests)
(forth-bitwise-tests)
(forth-io-tests)
(forth-case-tests)
(forth-mixed-tests)
(dict
"passed"
forth-tests-passed
"failed"
forth-tests-failed
"failures"
forth-tests-failures)))

146
lib/forth/tests/test-phase2.sx Normal file
View File

@@ -0,0 +1,146 @@
;; Phase 2 — colon definitions + compile mode + variables/values/fetch/store.
(define forth-p2-passed 0)
(define forth-p2-failed 0)
(define forth-p2-failures (list))
(define
forth-p2-assert
(fn
(label expected actual)
(if
(= expected actual)
(set! forth-p2-passed (+ forth-p2-passed 1))
(begin
(set! forth-p2-failed (+ forth-p2-failed 1))
(set!
forth-p2-failures
(concat
forth-p2-failures
(list
(str label ": expected " (str expected) " got " (str actual)))))))))
(define
forth-p2-check-stack
(fn
(label src expected)
(let ((r (forth-run src))) (forth-p2-assert label expected (nth r 2)))))
(define
forth-p2-check-output
(fn
(label src expected)
(let ((r (forth-run src))) (forth-p2-assert label expected (nth r 1)))))
(define
forth-p2-colon-tests
(fn
()
(forth-p2-check-stack "simple colon" ": DOUBLE 2 * ; 7 DOUBLE" (list 14))
(forth-p2-check-stack "three-op body" ": ADD3 + + ; 1 2 3 ADD3" (list 6))
(forth-p2-check-stack
"nested call"
": SQR DUP * ; : SOS SQR SWAP SQR + ; 3 4 SOS"
(list 25))
(forth-p2-check-stack
"deep chain"
": D 2 ; : B D ; : A B D * ; A"
(list 4))
(forth-p2-check-stack
"colon uses literal"
": FOO 1 2 + ; FOO FOO +"
(list 6))
(forth-p2-check-stack "case-insensitive def" ": BAR 9 ; bar" (list 9))
(forth-p2-check-stack
"redefinition picks newest"
": F 1 ; : F 2 ; F"
(list 2))
(forth-p2-check-stack
"negative literal in def"
": NEG5 -5 ; NEG5"
(list -5))
(forth-p2-check-stack "hex literal in def" ": X $10 ; X" (list 16))))
(define
forth-p2-var-tests
(fn
()
(forth-p2-check-stack "VARIABLE + !, @" "VARIABLE X 42 X ! X @" (list 42))
(forth-p2-check-stack "uninitialised @ is 0" "VARIABLE Y Y @" (list 0))
(forth-p2-check-stack
"two variables"
"VARIABLE A VARIABLE B 1 A ! 2 B ! A @ B @ +"
(list 3))
(forth-p2-check-stack
"+! increments"
"VARIABLE X 10 X ! 5 X +! X @"
(list 15))
(forth-p2-check-stack
"+! multiple"
"VARIABLE X 0 X ! 1 X +! 2 X +! 3 X +! X @"
(list 6))))
(define
forth-p2-const-tests
(fn
()
(forth-p2-check-stack "CONSTANT" "100 CONSTANT C C" (list 100))
(forth-p2-check-stack
"CONSTANT used twice"
"5 CONSTANT FIVE FIVE FIVE *"
(list 25))
(forth-p2-check-stack
"CONSTANT in colon"
"3 CONSTANT T : TRIPLE T * ; 7 TRIPLE"
(list 21))))
(define
forth-p2-value-tests
(fn
()
(forth-p2-check-stack "VALUE initial" "50 VALUE V V" (list 50))
(forth-p2-check-stack "TO overwrites" "50 VALUE V 99 TO V V" (list 99))
(forth-p2-check-stack "TO twice" "1 VALUE V 2 TO V 3 TO V V" (list 3))
(forth-p2-check-stack "VALUE in arithmetic" "7 VALUE V V 3 +" (list 10))))
(define
forth-p2-io-tests
(fn
()
(forth-p2-check-output
"colon prints"
": HELLO 72 EMIT 73 EMIT ; HELLO"
"HI")
(forth-p2-check-output "colon CR" ": LINE 42 . CR ; LINE" "42 \n")))
(define
forth-p2-mode-tests
(fn
()
(forth-p2-check-stack "empty colon body" ": NOP ; 5 NOP" (list 5))
(forth-p2-check-stack
"colon using DUP"
": TWICE DUP ; 9 TWICE"
(list 9 9))
(forth-p2-check-stack "IMMEDIATE NOP" ": X ; X" (list))))
(define
forth-p2-run-all
(fn
()
(set! forth-p2-passed 0)
(set! forth-p2-failed 0)
(set! forth-p2-failures (list))
(forth-p2-colon-tests)
(forth-p2-var-tests)
(forth-p2-const-tests)
(forth-p2-value-tests)
(forth-p2-io-tests)
(forth-p2-mode-tests)
(dict
"passed"
forth-p2-passed
"failed"
forth-p2-failed
"failures"
forth-p2-failures)))