;; 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)))