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