From bb16477fd47deb21a1c1010644a068e9cea1e1f3 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 17:33:25 +0000 Subject: [PATCH] forth: BEGIN/UNTIL/WHILE/REPEAT/AGAIN (+9) --- lib/forth/compiler.sx | 66 ++++++++++++++++++++++++++++++++++ lib/forth/tests/test-phase3.sx | 46 ++++++++++++++++++++++++ plans/forth-on-sx.md | 16 ++++++++- 3 files changed, 127 insertions(+), 1 deletion(-) diff --git a/lib/forth/compiler.sx b/lib/forth/compiler.sx index c58dc44e..9ebcf532 100644 --- a/lib/forth/compiler.sx +++ b/lib/forth/compiler.sx @@ -219,6 +219,72 @@ (let ((target (forth-cpop s))) (dict-set! target "v" (forth-def-length s))))) + (forth-def-prim-imm! + state + "BEGIN" + (fn + (s) + (when + (not (get s "compiling")) + (forth-error s "BEGIN outside definition")) + (forth-cpush s (forth-def-length s)))) + (forth-def-prim-imm! + state + "UNTIL" + (fn + (s) + (when + (not (get s "compiling")) + (forth-error s "UNTIL outside definition")) + (let + ((back-pc (forth-cpop s))) + (let + ((target (forth-make-target))) + (dict-set! target "v" back-pc) + (forth-def-append! s (forth-make-branch "bif" target)))))) + (forth-def-prim-imm! + state + "AGAIN" + (fn + (s) + (when + (not (get s "compiling")) + (forth-error s "AGAIN outside definition")) + (let + ((back-pc (forth-cpop s))) + (let + ((target (forth-make-target))) + (dict-set! target "v" back-pc) + (forth-def-append! s (forth-make-branch "branch" target)))))) + (forth-def-prim-imm! + state + "WHILE" + (fn + (s) + (when + (not (get s "compiling")) + (forth-error s "WHILE outside definition")) + (let + ((target (forth-make-target))) + (forth-def-append! s (forth-make-branch "bif" target)) + (forth-cpush s target)))) + (forth-def-prim-imm! + state + "REPEAT" + (fn + (s) + (when + (not (get s "compiling")) + (forth-error s "REPEAT outside definition")) + (let + ((while-target (forth-cpop s))) + (let + ((back-pc (forth-cpop s))) + (let + ((b-target (forth-make-target))) + (dict-set! b-target "v" back-pc) + (forth-def-append! s (forth-make-branch "branch" b-target)) + (dict-set! while-target "v" (forth-def-length s))))))) (forth-def-prim! state "VARIABLE" diff --git a/lib/forth/tests/test-phase3.sx b/lib/forth/tests/test-phase3.sx index 604d0b42..8862bed2 100644 --- a/lib/forth/tests/test-phase3.sx +++ b/lib/forth/tests/test-phase3.sx @@ -106,6 +106,51 @@ ": 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-run-all (fn @@ -114,6 +159,7 @@ (set! forth-p3-failed 0) (set! forth-p3-failures (list)) (forth-p3-if-tests) + (forth-p3-loop-tests) (dict "passed" forth-p3-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 46aa300c..87dade1e 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -70,7 +70,7 @@ Representation: ### Phase 3 — control flow + first Hayes tests green - [x] `IF`, `ELSE`, `THEN` — compile to SX `if` -- [ ] `BEGIN`, `UNTIL`, `WHILE`, `REPEAT`, `AGAIN` — compile to loops +- [x] `BEGIN`, `UNTIL`, `WHILE`, `REPEAT`, `AGAIN` — compile to loops - [ ] `DO`, `LOOP`, `+LOOP`, `I`, `J`, `LEAVE` — counted loops (needs a return stack) - [ ] Return stack: `>R`, `R>`, `R@`, `2>R`, `2R>`, `2R@` - [ ] Vendor John Hayes' test suite to `lib/forth/ans-tests/` @@ -99,6 +99,20 @@ Representation: _Newest first._ +- **Phase 3 — `BEGIN`/`UNTIL`/`WHILE`/`REPEAT`/`AGAIN` (+9).** Indefinite-loop + constructs built on the same PC-driven body runner introduced for `IF`. + BEGIN records the current body length on `state.cstack` (a plain numeric + back-target). UNTIL/AGAIN pop that back-target and emit a `bif`/`branch` + op whose target cell is set to the recorded PC. WHILE emits a forward + `bif` with a fresh target cell and pushes it on the cstack *above* the + BEGIN marker; REPEAT pops both (while-target first, then back-pc), emits + an unconditional branch back to BEGIN, then patches the while-target to + the current body length — so WHILE's false flag jumps past the REPEAT. + Mixed compile-time layout (numeric back-targets + dict forward targets + on the same cstack) is OK because the immediate words pop them in the + order they expect. AGAIN works structurally but lacks a test without a + usable mid-loop exit; revisit once `EXIT` lands. 161/161 green. + - **Phase 3 start — `IF`/`ELSE`/`THEN` (+18).** `lib/forth/compiler.sx` + `tests/test-phase3.sx`. Colon-def body switched from `for-each` to a PC-driven runner so branch ops can jump: ops now include dict tags