forth: IF/ELSE/THEN + PC-driven body runner (+18)

lib/forth/compiler.sx

@@ -52,9 +52,53 @@
       ((def (get state "current-def")))
       (dict-set! def "body" (concat (get def "body") (list op))))))
 
+(define
+  forth-def-length
+  (fn (state) (len (get (get state "current-def") "body"))))
+
+(define
+  forth-make-branch
+  (fn
+    (kind target)
+    (let ((b (dict))) (dict-set! b "kind" kind) (dict-set! b "target" target) b)))
+
+(define
+  forth-make-target
+  (fn () (let ((t (dict))) (dict-set! t "v" 0) t)))
+
 (define
   forth-make-colon-body
-  (fn (ops) (fn (s) (for-each (fn (op) (op s)) ops))))
+  (fn
+    (ops)
+    (let
+      ((n (len ops)))
+      (fn
+        (s)
+        (let ((pc (dict))) (dict-set! pc "v" 0) (forth-run-body s ops pc n))))))
+
+(define
+  forth-step-op
+  (fn
+    (s op pc)
+    (cond
+      ((and (dict? op) (= (get op "kind") "bif"))
+        (if
+          (= (forth-pop s) 0)
+          (dict-set! pc "v" (get (get op "target") "v"))
+          (dict-set! pc "v" (+ (get pc "v") 1))))
+      ((and (dict? op) (= (get op "kind") "branch"))
+        (dict-set! pc "v" (get (get op "target") "v")))
+      (else (begin (op s) (dict-set! pc "v" (+ (get pc "v") 1)))))))
+
+(define
+  forth-run-body
+  (fn
+    (s ops pc n)
+    (when
+      (< (get pc "v") n)
+      (begin
+        (forth-step-op s (nth ops (get pc "v")) pc)
+        (forth-run-body s ops pc n)))))
 
 ;; Override forth-interpret-token to branch on compile mode.
 (define
@@ -139,6 +183,42 @@
         (let
           ((name (get (get s "current-def") "name")))
           (forth-compile-call s name))))
+    (forth-def-prim-imm!
+      state
+      "IF"
+      (fn
+        (s)
+        (when (not (get s "compiling")) (forth-error s "IF 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
+      "ELSE"
+      (fn
+        (s)
+        (when
+          (not (get s "compiling"))
+          (forth-error s "ELSE outside definition"))
+        (let
+          ((new-target (forth-make-target)))
+          (forth-def-append! s (forth-make-branch "branch" new-target))
+          (let
+            ((if-target (forth-cpop s)))
+            (dict-set! if-target "v" (forth-def-length s)))
+          (forth-cpush s new-target))))
+    (forth-def-prim-imm!
+      state
+      "THEN"
+      (fn
+        (s)
+        (when
+          (not (get s "compiling"))
+          (forth-error s "THEN outside definition"))
+        (let
+          ((target (forth-cpop s)))
+          (dict-set! target "v" (forth-def-length s)))))
     (forth-def-prim!
       state
       "VARIABLE"

lib/forth/runtime.sx

@@ -20,8 +20,27 @@
       (dict-set! s "current-def" nil)
       (dict-set! s "base" 10)
       (dict-set! s "vars" (dict))
+      (dict-set! s "cstack" (list))
       s)))
 
+(define
+  forth-cpush
+  (fn (state v) (dict-set! state "cstack" (cons v (get state "cstack")))))
+
+(define
+  forth-cpop
+  (fn
+    (state)
+    (let
+      ((cs (get state "cstack")))
+      (if
+        (= (len cs) 0)
+        (forth-error state "control stack underflow")
+        (let
+          ((top (first cs)))
+          (dict-set! state "cstack" (rest cs))
+          top)))))
+
 (define
   forth-error
   (fn (state msg) (dict-set! state "error" msg) (raise msg)))
@@ -416,7 +435,7 @@
     (forth-def-prim!
       state
       "EMIT"
-      (fn (s) (forth-emit-str s (code-char (forth-pop s)))))
+      (fn (s) (forth-emit-str s (char-from-code (forth-pop s)))))
     (forth-def-prim! state "CR" (fn (s) (forth-emit-str s "\n")))
     (forth-def-prim! state "SPACE" (fn (s) (forth-emit-str s " ")))
     (forth-def-prim!

lib/forth/tests/test-phase3.sx

@@ -0,0 +1,123 @@
+;; 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-run-all
+  (fn
+    ()
+    (set! forth-p3-passed 0)
+    (set! forth-p3-failed 0)
+    (set! forth-p3-failures (list))
+    (forth-p3-if-tests)
+    (dict
+      "passed"
+      forth-p3-passed
+      "failed"
+      forth-p3-failed
+      "failures"
+      forth-p3-failures)))

plans/forth-on-sx.md

@@ -69,7 +69,7 @@ Representation:
 - [x] Tests in `lib/forth/tests/test-phase2.sx` — 26/26 pass
 
 ### Phase 3 — control flow + first Hayes tests green
-- [ ] `IF`, `ELSE`, `THEN` — compile to SX `if`
+- [x] `IF`, `ELSE`, `THEN` — compile to SX `if`
 - [ ] `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@`
@@ -99,6 +99,19 @@ Representation:
 
 _Newest first._
 
+- **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
+  `{"kind" "bif"|"branch" "target" cell}` alongside the existing
+  `(fn (s) ...)` shape. IF compiles a `bif` with a fresh target cell
+  pushed to `state.cstack`; ELSE emits an unconditional `branch`,
+  patches the IF's target to the instruction after this branch, and
+  pushes the new target; THEN patches the most recent target to the
+  current body length. Nested IF/ELSE/THEN works via the cstack.
+  Also fixed `EMIT`: `code-char` → `char-from-code` (spec-correct
+  primitive name) so Phase 1/2 tests run green on sx_server.
+  152/152 (Phase 1 + 2 + 3) green.
+
 - **Phase 2 complete — colon defs, compile mode, VARIABLE/CONSTANT/VALUE/TO, @/!/+! (+26).**
   `lib/forth/compiler.sx` plus `tests/test-phase2.sx`.
   Colon-def body is a list of ops (one per source token) wrapped in a single