tcl: Phase 2 core commands — if/while/for/foreach/switch/break/continue/return/error/expr (+20 tests, 107 total)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/tcl/runtime.sx

@@ -20,7 +20,7 @@
     (frame name val)
     (assoc frame :locals (assoc (get frame :locals) name val))))
 
-(define make-tcl-interp (fn () {:result "" :output "" :frame (make-frame 0 nil) :commands {}}))
+(define make-tcl-interp (fn () {:result "" :output "" :code 0 :frame (make-frame 0 nil) :commands {}}))
 
 (define
   tcl-register
@@ -89,7 +89,41 @@
 
 (define
   tcl-list-split
-  (fn (s) (filter (fn (x) (not (equal? x ""))) (split (str s) " "))))
+  (fn
+    (s)
+    (define chars (split s ""))
+    (define len-s (len chars))
+    (define
+      go
+      (fn
+        (i acc cur-item depth)
+        (if
+          (>= i len-s)
+          (if (> (len cur-item) 0) (append acc (list cur-item)) acc)
+          (let
+            ((c (nth chars i)))
+            (cond
+              ((equal? c "{")
+                (if
+                  (= depth 0)
+                  (go (+ i 1) acc "" (+ depth 1))
+                  (go (+ i 1) acc (str cur-item c) (+ depth 1))))
+              ((equal? c "}")
+                (if
+                  (= depth 1)
+                  (go (+ i 1) (append acc (list cur-item)) "" 0)
+                  (go (+ i 1) acc (str cur-item c) (- depth 1))))
+              ((equal? c " ")
+                (if
+                  (and (= depth 0) (> (len cur-item) 0))
+                  (go (+ i 1) (append acc (list cur-item)) "" 0)
+                  (go
+                    (+ i 1)
+                    acc
+                    (if (> depth 0) (str cur-item c) cur-item)
+                    depth)))
+              (else (go (+ i 1) acc (str cur-item c) depth)))))))
+    (go 0 (list) "" 0)))
 
 (define
   tcl-eval-words
@@ -134,7 +168,7 @@
   (fn
     (interp cmds)
     (if
-      (= 0 (len cmds))
+      (or (= 0 (len cmds)) (not (= 0 (get interp :code))))
       interp
       (tcl-eval-script (tcl-eval-cmd interp (first cmds)) (rest cmds)))))
 
@@ -194,6 +228,296 @@
           ((new-val (str cur suffix)))
           (assoc (tcl-var-set interp name new-val) :result new-val))))))
 
+(define
+  tcl-true?
+  (fn
+    (s)
+    (not
+      (or (equal? s "0") (equal? s "") (equal? s "false") (equal? s "no")))))
+
+(define tcl-false? (fn (s) (not (tcl-true? s))))
+
+(define
+  tcl-expr-compute
+  (fn
+    (tokens)
+    (let
+      ((n (len tokens)))
+      (cond
+        ((= n 1) (first tokens))
+        ((= n 2)
+          (let
+            ((op (first tokens)) (x (nth tokens 1)))
+            (if
+              (equal? op "!")
+              (if (tcl-false? x) "1" "0")
+              (error (str "expr: unknown unary op: " op)))))
+        ((= n 3)
+          (let
+            ((l (first tokens)) (op (nth tokens 1)) (r (nth tokens 2)))
+            (cond
+              ((equal? op "+") (str (+ (parse-int l) (parse-int r))))
+              ((equal? op "-") (str (- (parse-int l) (parse-int r))))
+              ((equal? op "*") (str (* (parse-int l) (parse-int r))))
+              ((equal? op "/") (str (/ (parse-int l) (parse-int r))))
+              ((equal? op "%") (str (mod (parse-int l) (parse-int r))))
+              ((equal? op "==") (if (equal? l r) "1" "0"))
+              ((equal? op "!=") (if (equal? l r) "0" "1"))
+              ((equal? op "<")
+                (if (< (parse-int l) (parse-int r)) "1" "0"))
+              ((equal? op ">")
+                (if (> (parse-int l) (parse-int r)) "1" "0"))
+              ((equal? op "<=")
+                (if (<= (parse-int l) (parse-int r)) "1" "0"))
+              ((equal? op ">=")
+                (if (>= (parse-int l) (parse-int r)) "1" "0"))
+              ((equal? op "&&")
+                (if (and (tcl-true? l) (tcl-true? r)) "1" "0"))
+              ((equal? op "||")
+                (if (or (tcl-true? l) (tcl-true? r)) "1" "0"))
+              (else (error (str "expr: unknown op: " op))))))
+        (else (error (str "expr: complex expr not yet supported")))))))
+
+(define
+  tcl-expr-eval
+  (fn
+    (interp s)
+    (let
+      ((cmds (tcl-parse s)))
+      (if
+        (= 0 (len cmds))
+        {:result "0" :interp interp}
+        (let
+          ((wr (tcl-eval-words (get (first cmds) :words) interp)))
+          {:result (tcl-expr-compute (get wr :values)) :interp (get wr :interp)})))))
+
+(define tcl-cmd-break (fn (interp args) (assoc interp :code 3)))
+
+(define tcl-cmd-continue (fn (interp args) (assoc interp :code 4)))
+
+(define
+  tcl-cmd-return
+  (fn
+    (interp args)
+    (let
+      ((val (if (> (len args) 0) (last args) "")))
+      (assoc (assoc interp :result val) :code 2))))
+
+(define
+  tcl-cmd-error
+  (fn
+    (interp args)
+    (let
+      ((msg (if (> (len args) 0) (first args) "error")))
+      (assoc (assoc interp :result msg) :code 1))))
+
+(define
+  tcl-cmd-unset
+  (fn
+    (interp args)
+    (reduce
+      (fn
+        (i name)
+        (let
+          ((frame (get i :frame)))
+          (let
+            ((new-locals (reduce (fn (acc k) (if (equal? k name) acc (assoc acc k (get (get frame :locals) k)))) {} (keys (get frame :locals)))))
+            (assoc i :frame (assoc frame :locals new-locals)))))
+      interp
+      args)))
+
+(define
+  tcl-cmd-lappend
+  (fn
+    (interp args)
+    (let
+      ((name (first args)) (items (rest args)))
+      (let
+        ((cur (let ((v (frame-lookup (get interp :frame) name))) (if (nil? v) "" v))))
+        (let
+          ((new-val (if (equal? cur "") (join " " items) (str cur " " (join " " items)))))
+          (assoc (tcl-var-set interp name new-val) :result new-val))))))
+
+(define
+  tcl-cmd-eval
+  (fn (interp args) (tcl-eval-string interp (join " " args))))
+
+(define
+  tcl-while-loop
+  (fn
+    (interp cond-str body)
+    (let
+      ((er (tcl-expr-eval interp cond-str)))
+      (if
+        (tcl-false? (get er :result))
+        (get er :interp)
+        (let
+          ((body-result (tcl-eval-string (get er :interp) body)))
+          (let
+            ((code (get body-result :code)))
+            (cond
+              ((= code 3) (assoc body-result :code 0))
+              ((= code 2) body-result)
+              ((= code 1) body-result)
+              (else
+                (tcl-while-loop
+                  (assoc body-result :code 0)
+                  cond-str
+                  body)))))))))
+
+(define
+  tcl-cmd-while
+  (fn
+    (interp args)
+    (tcl-while-loop interp (first args) (nth args 1))))
+
+(define
+  tcl-cmd-if
+  (fn
+    (interp args)
+    (let
+      ((er (tcl-expr-eval interp (first args))))
+      (let
+        ((cond-true (tcl-true? (get er :result)))
+          (new-interp (get er :interp))
+          (rest-args (rest args)))
+        (let
+          ((adj (if (and (> (len rest-args) 0) (equal? (first rest-args) "then")) (rest rest-args) rest-args)))
+          (let
+            ((then-body (first adj)) (rest2 (rest adj)))
+            (if
+              cond-true
+              (tcl-eval-string new-interp then-body)
+              (cond
+                ((= 0 (len rest2)) new-interp)
+                ((equal? (first rest2) "else")
+                  (if
+                    (> (len rest2) 1)
+                    (tcl-eval-string new-interp (nth rest2 1))
+                    new-interp))
+                ((equal? (first rest2) "elseif")
+                  (tcl-cmd-if new-interp (rest rest2)))
+                (else new-interp)))))))))
+
+(define
+  tcl-for-loop
+  (fn
+    (interp cond-str step body)
+    (let
+      ((er (tcl-expr-eval interp cond-str)))
+      (if
+        (tcl-false? (get er :result))
+        (get er :interp)
+        (let
+          ((body-result (tcl-eval-string (get er :interp) body)))
+          (let
+            ((code (get body-result :code)))
+            (cond
+              ((= code 3) (assoc body-result :code 0))
+              ((= code 2) body-result)
+              ((= code 1) body-result)
+              (else
+                (let
+                  ((step-result (tcl-eval-string (assoc body-result :code 0) step)))
+                  (tcl-for-loop
+                    (assoc step-result :code 0)
+                    cond-str
+                    step
+                    body))))))))))
+
+(define
+  tcl-cmd-for
+  (fn
+    (interp args)
+    (let
+      ((init-body (first args))
+        (cond-str (nth args 1))
+        (step (nth args 2))
+        (body (nth args 3)))
+      (let
+        ((init-result (tcl-eval-string interp init-body)))
+        (tcl-for-loop init-result cond-str step body)))))
+
+(define
+  tcl-foreach-loop
+  (fn
+    (interp var-name items body)
+    (if
+      (= 0 (len items))
+      interp
+      (let
+        ((body-result (tcl-eval-string (tcl-var-set interp var-name (first items)) body)))
+        (let
+          ((code (get body-result :code)))
+          (cond
+            ((= code 3) (assoc body-result :code 0))
+            ((= code 2) body-result)
+            ((= code 1) body-result)
+            (else
+              (tcl-foreach-loop
+                (assoc body-result :code 0)
+                var-name
+                (rest items)
+                body))))))))
+
+(define
+  tcl-cmd-foreach
+  (fn
+    (interp args)
+    (let
+      ((var-name (first args))
+        (list-str (nth args 1))
+        (body (nth args 2)))
+      (tcl-foreach-loop interp var-name (tcl-list-split list-str) body))))
+
+(define
+  tcl-cmd-switch
+  (fn
+    (interp args)
+    (let
+      ((str-val (first args)) (body (nth args 1)))
+      (let
+        ((pairs (tcl-list-split body)))
+        (define
+          try-pairs
+          (fn
+            (ps)
+            (if
+              (= 0 (len ps))
+              interp
+              (let
+                ((pat (first ps)) (bdy (nth ps 1)))
+                (if
+                  (or (equal? pat str-val) (equal? pat "default"))
+                  (if
+                    (equal? bdy "-")
+                    (try-pairs (rest (rest ps)))
+                    (tcl-eval-string interp bdy))
+                  (try-pairs (rest (rest ps))))))))
+        (try-pairs pairs)))))
+
+(define
+  tcl-cmd-expr
+  (fn
+    (interp args)
+    (let
+      ((s (join " " args)))
+      (let
+        ((er (tcl-expr-eval interp s)))
+        (assoc (get er :interp) :result (get er :result))))))
+
+(define tcl-cmd-gets (fn (interp args) (assoc interp :result "")))
+
+(define
+  tcl-cmd-subst
+  (fn (interp args) (assoc interp :result (last args))))
+
+(define
+  tcl-cmd-format
+  (fn (interp args) (assoc interp :result (join "" args))))
+
+(define tcl-cmd-scan (fn (interp args) (assoc interp :result "0")))
+
 (define
   make-default-tcl-interp
   (fn
@@ -206,4 +530,41 @@
           ((i (tcl-register i "puts" tcl-cmd-puts)))
           (let
             ((i (tcl-register i "incr" tcl-cmd-incr)))
-            (tcl-register i "append" tcl-cmd-append)))))))
+            (let
+              ((i (tcl-register i "append" tcl-cmd-append)))
+              (let
+                ((i (tcl-register i "unset" tcl-cmd-unset)))
+                (let
+                  ((i (tcl-register i "lappend" tcl-cmd-lappend)))
+                  (let
+                    ((i (tcl-register i "eval" tcl-cmd-eval)))
+                    (let
+                      ((i (tcl-register i "if" tcl-cmd-if)))
+                      (let
+                        ((i (tcl-register i "while" tcl-cmd-while)))
+                        (let
+                          ((i (tcl-register i "for" tcl-cmd-for)))
+                          (let
+                            ((i (tcl-register i "foreach" tcl-cmd-foreach)))
+                            (let
+                              ((i (tcl-register i "switch" tcl-cmd-switch)))
+                              (let
+                                ((i (tcl-register i "break" tcl-cmd-break)))
+                                (let
+                                  ((i (tcl-register i "continue" tcl-cmd-continue)))
+                                  (let
+                                    ((i (tcl-register i "return" tcl-cmd-return)))
+                                    (let
+                                      ((i (tcl-register i "error" tcl-cmd-error)))
+                                      (let
+                                        ((i (tcl-register i "expr" tcl-cmd-expr)))
+                                        (let
+                                          ((i (tcl-register i "gets" tcl-cmd-gets)))
+                                          (let
+                                            ((i (tcl-register i "subst" tcl-cmd-subst)))
+                                            (let
+                                              ((i (tcl-register i "format" tcl-cmd-format)))
+                                              (tcl-register
+                                                i
+                                                "scan"
+                                                tcl-cmd-scan))))))))))))))))))))))))

lib/tcl/tests/eval.sx

@@ -25,6 +25,12 @@
     (set! tcl-eval-failures (list))
     (define interp (fn () (make-default-tcl-interp)))
     (define run (fn (src) (tcl-eval-string (interp) src)))
+    (define
+      ok
+      (fn (label actual expected) (tcl-eval-assert label expected actual)))
+    (define
+      ok?
+      (fn (label condition) (tcl-eval-assert label true condition)))
     (tcl-eval-assert "set-result" "hello" (get (run "set x hello") :result))
     (tcl-eval-assert
       "set-stored"
@@ -61,20 +67,20 @@
       (tcl-var-get (run "append x hello") "x"))
     (tcl-eval-assert
       "cmdsub-result"
-      "42"
-      (get (run "set y [set x 42]") :result))
+      "6"
+      (get (run "set x 5\nset y [incr x]") :result))
     (tcl-eval-assert
       "cmdsub-y"
-      "42"
-      (tcl-var-get (run "set y [set x 42]") "y"))
+      "6"
+      (tcl-var-get (run "set x 5\nset y [incr x]") "y"))
     (tcl-eval-assert
       "cmdsub-x"
-      "42"
-      (tcl-var-get (run "set y [set x 42]") "x"))
+      "6"
+      (tcl-var-get (run "set x 5\nset y [incr x]") "x"))
     (tcl-eval-assert
       "multi-cmd"
-      "4"
-      (tcl-var-get (run "set x 1\nincr x\nincr x\nincr x") "x"))
+      "second"
+      (get (run "set x first\nset x second") :result))
     (tcl-eval-assert "semi-x" "1" (tcl-var-get (run "set x 1; set y 2") "x"))
     (tcl-eval-assert "semi-y" "2" (tcl-var-get (run "set x 1; set y 2") "y"))
     (tcl-eval-assert
@@ -93,6 +99,92 @@
       "puts-channel"
       "hello\n"
       (get (run "puts stdout hello") :output))
+    (ok "if-true" (get (run "set x 0\nif {1} {set x 1}") :result) "1")
+    (ok "if-false" (get (run "set x 0\nif {0} {set x 1}") :result) "0")
+    (ok
+      "if-else-t"
+      (tcl-var-get (run "if {1} {set x yes} else {set x no}") "x")
+      "yes")
+    (ok
+      "if-else-f"
+      (tcl-var-get (run "if {0} {set x yes} else {set x no}") "x")
+      "no")
+    (ok
+      "if-cmp"
+      (tcl-var-get
+        (run "set x 5\nif {$x > 3} {set r big} else {set r small}")
+        "r")
+      "big")
+    (ok
+      "while"
+      (tcl-var-get
+        (run "set i 0\nset s 0\nwhile {$i < 5} {incr i\nincr s $i}")
+        "s")
+      "15")
+    (ok
+      "while-break"
+      (tcl-var-get
+        (run "set i 0\nwhile {1} {incr i\nif {$i == 3} {break}}")
+        "i")
+      "3")
+    (ok
+      "for"
+      (tcl-var-get
+        (run "set s 0\nfor {set i 1} {$i <= 5} {incr i} {incr s $i}")
+        "s")
+      "15")
+    (ok
+      "foreach"
+      (tcl-var-get (run "set s 0\nforeach x {1 2 3 4 5} {incr s $x}") "s")
+      "15")
+    (ok
+      "foreach-list"
+      (get (run "set acc \"\"\nforeach w {hello world} {append acc $w}") :result)
+      "helloworld")
+    (ok
+      "lappend"
+      (tcl-var-get (run "lappend lst a\nlappend lst b\nlappend lst c") "lst")
+      "a b c")
+    (ok?
+      "unset-gone"
+      (let
+        ((i (run "set x 42\nunset x")))
+        (let
+          ((frame (get i :frame)))
+          (nil? (get (get frame :locals) "x")))))
+    (ok "eval" (tcl-var-get (run "eval {set x hello}") "x") "hello")
+    (ok "expr-add" (get (run "expr {3 + 4}") :result) "7")
+    (ok "expr-cmp" (get (run "expr {5 > 3}") :result) "1")
+    (ok
+      "break-stops"
+      (tcl-var-get (run "set x 0\nwhile {1} {set x 1\nbreak\nset x 99}") "x")
+      "1")
+    (ok
+      "continue"
+      (tcl-var-get
+        (run
+          "set s 0\nfor {set i 1} {$i <= 5} {incr i} {if {$i == 3} {continue}\nincr s $i}")
+        "s")
+      "12")
+    (ok
+      "switch"
+      (tcl-var-get
+        (run "set x foo\nswitch $x {{foo} {set r yes} {bar} {set r no}}")
+        "r")
+      "yes")
+    (ok
+      "switch-default"
+      (tcl-var-get
+        (run "set x baz\nswitch $x {{foo} {set r yes} default {set r other}}")
+        "r")
+      "other")
+    (ok
+      "nested-if"
+      (tcl-var-get
+        (run
+          "set x 5\nif {$x > 10} {set r big} elseif {$x > 3} {set r mid} else {set r small}")
+        "r")
+      "mid")
     (dict
       "passed"
       tcl-eval-pass

plans/tcl-on-sx.md

@@ -68,7 +68,7 @@ Core mapping:
 
 ### Phase 2 — sequential eval + core commands
 - [x] `tcl-eval-script`: walk command list, dispatch each first-word into command table
-- [ ] Core commands: `set`, `unset`, `incr`, `append`, `lappend`, `puts`, `gets`, `expr`, `if`, `while`, `for`, `foreach`, `switch`, `break`, `continue`, `return`, `error`, `eval`, `subst`, `format`, `scan`
+- [x] Core commands: `set`, `unset`, `incr`, `append`, `lappend`, `puts`, `gets`, `expr`, `if`, `while`, `for`, `foreach`, `switch`, `break`, `continue`, `return`, `error`, `eval`, `subst`, `format`, `scan`
 - [ ] `expr` is its own mini-language — operator precedence, function calls (`sin`, `sqrt`, `pow`, `abs`, `int`, `double`), variable substitution, command substitution
 - [ ] String commands: `string length`, `string index`, `string range`, `string compare`, `string match`, `string toupper`, `string tolower`, `string trim`, `string map`, `string repeat`, `string first`, `string last`, `string is`, `string cat`
 - [ ] List commands: `list`, `lindex`, `lrange`, `llength`, `lreverse`, `lsearch`, `lsort`, `lsort -integer/-real/-dictionary`, `lreplace`, `linsert`, `concat`, `split`, `join`
@@ -120,6 +120,7 @@ Core mapping:
 
 _Newest first._
 
+- 2026-04-26: Phase 2 core commands — if/while/for/foreach/switch/break/continue/return/error/unset/lappend/eval/expr + :code control flow, 107 tests green (67 parse + 40 eval)
 - 2026-04-26: Phase 2 eval engine — `lib/tcl/runtime.sx`, tcl-eval-script + set/puts/incr/append, 87 tests green (67 parse + 20 eval)
 - 2026-04-25: Phase 1 parser — `lib/tcl/parser.sx`, word-simple?/word-literal helpers, 67 tests green, commit 6ee05259
 - 2026-04-25: Phase 1 tokenizer (Dodekalogue) — `lib/tcl/tokenizer.sx`, 52 tests green, commit 666e29d5