forth: DO/LOOP/+LOOP/I/J/LEAVE + return stack words (+16)

lib/forth/tests/test-phase3.sx

@@ -151,6 +151,75 @@
       ": 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
@@ -160,6 +229,7 @@
     (set! forth-p3-failures (list))
     (forth-p3-if-tests)
     (forth-p3-loop-tests)
+    (forth-p3-do-tests)
     (dict
       "passed"
       forth-p3-passed