forth: BEGIN/UNTIL/WHILE/REPEAT/AGAIN (+9)

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"

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

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