giles
e066e14267
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
240 lines
6.4 KiB
Plaintext
240 lines
6.4 KiB
Plaintext
;; Phase 3 — control flow (IF/ELSE/THEN, BEGIN/UNTIL/WHILE/REPEAT/AGAIN,
|
|
;; DO/LOOP, return stack). Grows as each control construct lands.
|
|
|
|
(define forth-p3-passed 0)
|
|
(define forth-p3-failed 0)
|
|
(define forth-p3-failures (list))
|
|
|
|
(define
|
|
forth-p3-assert
|
|
(fn
|
|
(label expected actual)
|
|
(if
|
|
(= expected actual)
|
|
(set! forth-p3-passed (+ forth-p3-passed 1))
|
|
(begin
|
|
(set! forth-p3-failed (+ forth-p3-failed 1))
|
|
(set!
|
|
forth-p3-failures
|
|
(concat
|
|
forth-p3-failures
|
|
(list
|
|
(str label ": expected " (str expected) " got " (str actual)))))))))
|
|
|
|
(define
|
|
forth-p3-check-stack
|
|
(fn
|
|
(label src expected)
|
|
(let ((r (forth-run src))) (forth-p3-assert label expected (nth r 2)))))
|
|
|
|
(define
|
|
forth-p3-if-tests
|
|
(fn
|
|
()
|
|
(forth-p3-check-stack
|
|
"IF taken (-1)"
|
|
": Q -1 IF 10 THEN ; Q"
|
|
(list 10))
|
|
(forth-p3-check-stack
|
|
"IF not taken (0)"
|
|
": Q 0 IF 10 THEN ; Q"
|
|
(list))
|
|
(forth-p3-check-stack
|
|
"IF with non-zero truthy"
|
|
": Q 42 IF 10 THEN ; Q"
|
|
(list 10))
|
|
(forth-p3-check-stack
|
|
"IF ELSE — true branch"
|
|
": Q -1 IF 10 ELSE 20 THEN ; Q"
|
|
(list 10))
|
|
(forth-p3-check-stack
|
|
"IF ELSE — false branch"
|
|
": Q 0 IF 10 ELSE 20 THEN ; Q"
|
|
(list 20))
|
|
(forth-p3-check-stack
|
|
"IF consumes flag"
|
|
": Q IF 1 ELSE 2 THEN ; 0 Q"
|
|
(list 2))
|
|
(forth-p3-check-stack
|
|
"absolute value via IF"
|
|
": ABS2 DUP 0 < IF NEGATE THEN ; -7 ABS2"
|
|
(list 7))
|
|
(forth-p3-check-stack
|
|
"abs leaves positive alone"
|
|
": ABS2 DUP 0 < IF NEGATE THEN ; 7 ABS2"
|
|
(list 7))
|
|
(forth-p3-check-stack
|
|
"sign: negative"
|
|
": SIGN DUP 0 < IF DROP -1 ELSE DROP 1 THEN ; -3 SIGN"
|
|
(list -1))
|
|
(forth-p3-check-stack
|
|
"sign: positive"
|
|
": SIGN DUP 0 < IF DROP -1 ELSE DROP 1 THEN ; 3 SIGN"
|
|
(list 1))
|
|
(forth-p3-check-stack
|
|
"nested IF (both true)"
|
|
": Q 1 IF 1 IF 10 ELSE 20 THEN ELSE 30 THEN ; Q"
|
|
(list 10))
|
|
(forth-p3-check-stack
|
|
"nested IF (inner false)"
|
|
": Q 1 IF 0 IF 10 ELSE 20 THEN ELSE 30 THEN ; Q"
|
|
(list 20))
|
|
(forth-p3-check-stack
|
|
"nested IF (outer false)"
|
|
": Q 0 IF 0 IF 10 ELSE 20 THEN ELSE 30 THEN ; Q"
|
|
(list 30))
|
|
(forth-p3-check-stack
|
|
"IF before other ops"
|
|
": Q 1 IF 5 ELSE 6 THEN 2 * ; Q"
|
|
(list 10))
|
|
(forth-p3-check-stack
|
|
"IF in chained def"
|
|
": POS? 0 > ;
|
|
: DOUBLE-IF-POS DUP POS? IF 2 * THEN ;
|
|
3 DOUBLE-IF-POS"
|
|
(list 6))
|
|
(forth-p3-check-stack
|
|
"empty then branch"
|
|
": Q 1 IF THEN 99 ; Q"
|
|
(list 99))
|
|
(forth-p3-check-stack
|
|
"empty else branch"
|
|
": Q 0 IF 99 ELSE THEN ; Q"
|
|
(list))
|
|
(forth-p3-check-stack
|
|
"sequential IF blocks"
|
|
": Q -1 IF 1 THEN -1 IF 2 THEN ; Q"
|
|
(list 1 2))))
|
|
|
|
(define
|
|
forth-p3-loop-tests
|
|
(fn
|
|
()
|
|
(forth-p3-check-stack
|
|
"BEGIN UNTIL (countdown to zero)"
|
|
": CD BEGIN 1- DUP 0 = UNTIL ; 3 CD"
|
|
(list 0))
|
|
(forth-p3-check-stack
|
|
"BEGIN UNTIL — single pass (UNTIL true immediately)"
|
|
": Q BEGIN -1 UNTIL 42 ; Q"
|
|
(list 42))
|
|
(forth-p3-check-stack
|
|
"BEGIN UNTIL — accumulate sum 1+2+3"
|
|
": SUM3 0 3 BEGIN TUCK + SWAP 1- DUP 0 = UNTIL DROP ; SUM3"
|
|
(list 6))
|
|
(forth-p3-check-stack
|
|
"BEGIN WHILE REPEAT — triangular sum 5"
|
|
": TRI 0 5 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ; TRI"
|
|
(list 15))
|
|
(forth-p3-check-stack
|
|
"BEGIN WHILE REPEAT — zero iterations"
|
|
": TRI 0 0 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ; TRI"
|
|
(list 0))
|
|
(forth-p3-check-stack
|
|
"BEGIN WHILE REPEAT — one iteration"
|
|
": TRI 0 1 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ; TRI"
|
|
(list 1))
|
|
(forth-p3-check-stack
|
|
"nested BEGIN UNTIL"
|
|
": INNER BEGIN 1- DUP 0 = UNTIL DROP ;
|
|
: OUTER BEGIN 3 INNER 1- DUP 0 = UNTIL ;
|
|
2 OUTER"
|
|
(list 0))
|
|
(forth-p3-check-stack
|
|
"BEGIN UNTIL after colon prefix"
|
|
": TEN 10 ;
|
|
: CD TEN BEGIN 1- DUP 0 = UNTIL ;
|
|
CD"
|
|
(list 0))
|
|
(forth-p3-check-stack
|
|
"WHILE inside IF branch"
|
|
": Q 1 IF 0 3 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ELSE 99 THEN ; Q"
|
|
(list 6))))
|
|
|
|
(define
|
|
forth-p3-do-tests
|
|
(fn
|
|
()
|
|
(forth-p3-check-stack
|
|
"DO LOOP — simple sum 0..4"
|
|
": SUM 0 5 0 DO I + LOOP ; SUM"
|
|
(list 10))
|
|
(forth-p3-check-stack
|
|
"DO LOOP — 10..14 sum using I"
|
|
": SUM 0 15 10 DO I + LOOP ; SUM"
|
|
(list 60))
|
|
(forth-p3-check-stack
|
|
"DO LOOP — limit = start runs one pass"
|
|
": SUM 0 5 5 DO I + LOOP ; SUM"
|
|
(list 5))
|
|
(forth-p3-check-stack
|
|
"DO LOOP — count iterations"
|
|
": COUNT 0 4 0 DO 1+ LOOP ; COUNT"
|
|
(list 4))
|
|
(forth-p3-check-stack
|
|
"DO LOOP — nested, I inner / J outer"
|
|
": MATRIX 0 3 0 DO 3 0 DO I J + + LOOP LOOP ; MATRIX"
|
|
(list 18))
|
|
(forth-p3-check-stack
|
|
"DO LOOP — I used in arithmetic"
|
|
": DBL 0 5 1 DO I 2 * + LOOP ; DBL"
|
|
(list 20))
|
|
(forth-p3-check-stack
|
|
"+LOOP — count by 2"
|
|
": Q 0 10 0 DO I + 2 +LOOP ; Q"
|
|
(list 20))
|
|
(forth-p3-check-stack
|
|
"+LOOP — count by 3"
|
|
": Q 0 10 0 DO I + 3 +LOOP ; Q"
|
|
(list 18))
|
|
(forth-p3-check-stack
|
|
"+LOOP — negative step"
|
|
": Q 0 0 10 DO I + -1 +LOOP ; Q"
|
|
(list 55))
|
|
(forth-p3-check-stack
|
|
"LEAVE — early exit at I=3"
|
|
": Q 0 10 0 DO I 3 = IF LEAVE THEN I + LOOP ; Q"
|
|
(list 3))
|
|
(forth-p3-check-stack
|
|
"LEAVE — in nested loop exits only inner"
|
|
": Q 0 3 0 DO 5 0 DO I 2 = IF LEAVE THEN I + LOOP LOOP ; Q"
|
|
(list 3))
|
|
(forth-p3-check-stack
|
|
"DO LOOP preserves outer stack"
|
|
": Q 99 5 0 DO I + LOOP ; Q"
|
|
(list 109))
|
|
(forth-p3-check-stack
|
|
">R R>"
|
|
": Q 7 >R 11 R> ; Q"
|
|
(list 11 7))
|
|
(forth-p3-check-stack
|
|
">R R@ R>"
|
|
": Q 7 >R R@ R> ; Q"
|
|
(list 7 7))
|
|
(forth-p3-check-stack
|
|
"2>R 2R>"
|
|
": Q 1 2 2>R 99 2R> ; Q"
|
|
(list 99 1 2))
|
|
(forth-p3-check-stack
|
|
"2>R 2R@ 2R>"
|
|
": Q 3 4 2>R 2R@ 2R> ; Q"
|
|
(list 3 4 3 4))))
|
|
|
|
(define
|
|
forth-p3-run-all
|
|
(fn
|
|
()
|
|
(set! forth-p3-passed 0)
|
|
(set! forth-p3-failed 0)
|
|
(set! forth-p3-failures (list))
|
|
(forth-p3-if-tests)
|
|
(forth-p3-loop-tests)
|
|
(forth-p3-do-tests)
|
|
(dict
|
|
"passed"
|
|
forth-p3-passed
|
|
"failed"
|
|
forth-p3-failed
|
|
"failures"
|
|
forth-p3-failures)))
|