giles
99753580b4
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.
147 lines
3.7 KiB
Plaintext
147 lines
3.7 KiB
Plaintext
;; 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)))
|