From ac013c9381bd3692d4f23eda0740462bc6bbf105 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Wed, 6 May 2026 08:43:02 +0000
Subject: [PATCH] =?UTF-8?q?tcl:=20expr=20mini-language=20=E2=80=94=20recur?=
 =?UTF-8?q?sive=20descent=20parser=20(+20=20tests,=20127=20total)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Replaces 3-token flat evaluator with full recursive descent parser:
operator precedence, parentheses, unary ops, ** power, function calls
(abs/sqrt/pow/max/min/int/double), expression tokenizer for dense syntax.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
---
 lib/tcl/runtime.sx    | 457 ++++++++++++++++++++++++++++++++++++++----
 lib/tcl/tests/eval.sx |  20 ++
 plans/tcl-on-sx.md    |   3 +-
 3 files changed, 443 insertions(+), 37 deletions(-)

diff --git a/lib/tcl/runtime.sx b/lib/tcl/runtime.sx
index c7ff9f62..1270fd8b 100644
--- a/lib/tcl/runtime.sx
+++ b/lib/tcl/runtime.sx
@@ -238,45 +238,426 @@
 (define tcl-false? (fn (s) (not (tcl-true? s))))
 
 (define
-  tcl-expr-compute
+  tcl-expr-digit?
+  (fn
+    (c)
+    (contains? (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") c)))
+
+(define
+  tcl-expr-alpha?
+  (fn
+    (c)
+    (contains?
+      (list
+        "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m"
+        "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"
+        "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
+        "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"
+        "_")
+      c)))
+
+(define
+  tcl-expr-op-char?
+  (fn
+    (c)
+    (contains?
+      (list "+" "-" "*" "/" "%" "!" "~" "&" "|" "^" "<" ">" "=")
+      c)))
+
+(define
+  tcl-expr-ws?
+  (fn (c) (or (equal? c " ") (equal? c "\t") (equal? c "\n") (equal? c "\r"))))
+
+(define
+  tcl-pow
+  (fn
+    (base exp)
+    (if
+      (= exp 0)
+      1
+      (* base (tcl-pow base (- exp 1))))))
+
+(define
+  tcl-isqrt
+  (fn
+    (n)
+    (if
+      (<= n 0)
+      0
+      (let
+        ((go (fn (x) (let ((x2 (/ (+ x (/ n x)) 2))) (if (>= x2 x) x (go x2))))))
+        (go n)))))
+
+(define
+  tcl-apply-func
+  (fn
+    (name args)
+    (let
+      ((a0 (if (> (len args) 0) (parse-int (first args)) 0))
+        (a1 (if (> (len args) 1) (parse-int (nth args 1)) 0)))
+      (cond
+        ((equal? name "abs") (str (if (< a0 0) (- 0 a0) a0)))
+        ((equal? name "int") (str a0))
+        ((equal? name "double") (str a0))
+        ((equal? name "round") (str a0))
+        ((equal? name "floor") (str a0))
+        ((equal? name "ceil") (str a0))
+        ((equal? name "sqrt") (str (tcl-isqrt a0)))
+        ((equal? name "pow") (str (tcl-pow a0 a1)))
+        ((equal? name "max") (str (if (>= a0 a1) a0 a1)))
+        ((equal? name "min") (str (if (<= a0 a1) a0 a1)))
+        ((equal? name "sin") "0")
+        ((equal? name "cos") "1")
+        ((equal? name "tan") "0")
+        (else (error (str "expr: unknown function: " name)))))))
+
+(define
+  tcl-apply-binop
+  (fn
+    (op l r)
+    (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"))
+      ((equal? op "**") (str (tcl-pow (parse-int l) (parse-int r))))
+      (else (error (str "expr: unknown op: " op))))))
+
+(define
+  tcl-expr-tokenize
+  (fn
+    (s)
+    (let
+      ((chars (split s ""))
+        (n (len (split s ""))))
+      (let
+        ((go
+          (fn
+            (i acc cur mode)
+            (if
+              (>= i n)
+              (if (> (len cur) 0) (append acc (list cur)) acc)
+              (let
+                ((c (nth chars i)))
+                (cond
+                  ((tcl-expr-ws? c)
+                    (if
+                      (> (len cur) 0)
+                      (go (+ i 1) (append acc (list cur)) "" "none")
+                      (go (+ i 1) acc "" "none")))
+                  ((or (equal? c "(") (equal? c ")") (equal? c ","))
+                    (let
+                      ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
+                      (go (+ i 1) (append acc2 (list c)) "" "none")))
+                  ((equal? c "\"")
+                    (let
+                      ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
+                      (let
+                        ((read-str
+                          (fn
+                            (j s-acc)
+                            (if
+                              (>= j n)
+                              {:tok s-acc :next j}
+                              (let
+                                ((sc (nth chars j)))
+                                (if
+                                  (equal? sc "\"")
+                                  {:tok s-acc :next (+ j 1)}
+                                  (read-str (+ j 1) (str s-acc sc))))))))
+                        (let
+                          ((sr (read-str (+ i 1) "")))
+                          (go (get sr :next) (append acc2 (list (get sr :tok))) "" "none")))))
+                  ((tcl-expr-op-char? c)
+                    (let
+                      ((acc2 (if (and (> (len cur) 0) (not (equal? mode "op"))) (append acc (list cur)) acc))
+                        (cur2 (if (and (> (len cur) 0) (not (equal? mode "op"))) "" cur)))
+                      (let
+                        ((next-c (if (< (+ i 1) n) (nth chars (+ i 1)) "")))
+                        (let
+                          ((two (str c next-c)))
+                          (if
+                            (contains? (list "**" "==" "!=" "<=" ">=" "&&" "||") two)
+                            (let
+                              ((acc3 (if (> (len cur2) 0) (append acc2 (list cur2)) acc2)))
+                              (go (+ i 2) (append acc3 (list two)) "" "none"))
+                            (let
+                              ((acc3 (if (> (len cur2) 0) (append acc2 (list cur2)) acc2)))
+                              (go (+ i 1) (append acc3 (list c)) "" "none")))))))
+                  ((tcl-expr-digit? c)
+                    (if
+                      (equal? mode "ident")
+                      (go (+ i 1) acc (str cur c) "ident")
+                      (if
+                        (or (equal? mode "num") (equal? mode "none") (equal? mode ""))
+                        (go (+ i 1) acc (str cur c) "num")
+                        (let
+                          ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
+                          (go (+ i 1) acc2 c "num")))))
+                  ((equal? c ".")
+                    (go (+ i 1) acc (str cur c) "num"))
+                  ((tcl-expr-alpha? c)
+                    (if
+                      (or (equal? mode "ident") (equal? mode "none") (equal? mode ""))
+                      (go (+ i 1) acc (str cur c) "ident")
+                      (let
+                        ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
+                        (go (+ i 1) acc2 c "ident"))))
+                  (else
+                    (let
+                      ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
+                      (go (+ i 1) (append acc2 (list c)) "" "none")))))))))
+        (go 0 (list) "" "none")))))
+
+(define
+  tcl-expr-parse-args-rest
+  (fn
+    (tokens acc)
+    (if
+      (or (= 0 (len tokens)) (equal? (first tokens) ")"))
+      {:args acc :tokens tokens}
+      (if
+        (equal? (first tokens) ",")
+        (let
+          ((r (tcl-expr-parse-or (rest tokens))))
+          (tcl-expr-parse-args-rest
+            (get r :tokens)
+            (append acc (list (get r :value)))))
+        {:args acc :tokens tokens}))))
+
+(define
+  tcl-expr-parse-args
+  (fn
+    (tokens)
+    (if
+      (or (= 0 (len tokens)) (equal? (first tokens) ")"))
+      {:args (list) :tokens tokens}
+      (let
+        ((r (tcl-expr-parse-or tokens)))
+        (tcl-expr-parse-args-rest
+          (get r :tokens)
+          (list (get r :value)))))))
+
+(define
+  tcl-expr-parse-primary
+  (fn
+    (tokens)
+    (if
+      (= 0 (len tokens))
+      (error "expr: unexpected end of expression")
+      (let
+        ((tok (first tokens)) (rest-toks (rest tokens)))
+        (cond
+          ((equal? tok "(")
+            (let
+              ((inner (tcl-expr-parse-or rest-toks)))
+              (let
+                ((after (get inner :tokens)))
+                (if
+                  (and (> (len after) 0) (equal? (first after) ")"))
+                  {:value (get inner :value) :tokens (rest after)}
+                  (error "expr: missing closing paren")))))
+          ((and
+            (> (len rest-toks) 0)
+            (equal? (first rest-toks) "("))
+            (let
+              ((args-r (tcl-expr-parse-args (rest rest-toks))))
+              (let
+                ((after-args (get args-r :tokens)))
+                (if
+                  (and (> (len after-args) 0) (equal? (first after-args) ")"))
+                  {:value (tcl-apply-func tok (get args-r :args)) :tokens (rest after-args)}
+                  (error (str "expr: missing ) after function call " tok))))))
+          (else {:value tok :tokens rest-toks}))))))
+
+(define
+  tcl-expr-parse-unary
+  (fn
+    (tokens)
+    (if
+      (= 0 (len tokens))
+      (error "expr: unexpected end in unary")
+      (let
+        ((tok (first tokens)))
+        (cond
+          ((equal? tok "!")
+            (let
+              ((r (tcl-expr-parse-unary (rest tokens))))
+              {:value (if (tcl-false? (get r :value)) "1" "0") :tokens (get r :tokens)}))
+          ((equal? tok "-")
+            (let
+              ((r (tcl-expr-parse-unary (rest tokens))))
+              {:value (str (- 0 (parse-int (get r :value)))) :tokens (get r :tokens)}))
+          ((equal? tok "+")
+            (tcl-expr-parse-unary (rest tokens)))
+          (else (tcl-expr-parse-primary tokens)))))))
+
+(define
+  tcl-expr-parse-power
   (fn
     (tokens)
     (let
-      ((n (len tokens)))
-      (cond
-        ((= n 1) (first tokens))
-        ((= n 2)
+      ((base-r (tcl-expr-parse-unary tokens)))
+      (let
+        ((base-val (get base-r :value)) (rest-toks (get base-r :tokens)))
+        (if
+          (and (> (len rest-toks) 0) (equal? (first rest-toks) "**"))
           (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")))))))
+            ((exp-r (tcl-expr-parse-power (rest rest-toks))))
+            {:value (str (tcl-pow (parse-int base-val) (parse-int (get exp-r :value)))) :tokens (get exp-r :tokens)})
+          {:value base-val :tokens rest-toks})))))
+
+(define
+  tcl-expr-parse-multiplicative-rest
+  (fn
+    (tokens left)
+    (if
+      (or (= 0 (len tokens)) (not (contains? (list "*" "/" "%") (first tokens))))
+      {:value left :tokens tokens}
+      (let
+        ((op (first tokens)))
+        (let
+          ((r (tcl-expr-parse-power (rest tokens))))
+          (tcl-expr-parse-multiplicative-rest
+            (get r :tokens)
+            (tcl-apply-binop op left (get r :value))))))))
+
+(define
+  tcl-expr-parse-multiplicative
+  (fn
+    (tokens)
+    (let
+      ((r (tcl-expr-parse-power tokens)))
+      (tcl-expr-parse-multiplicative-rest (get r :tokens) (get r :value)))))
+
+(define
+  tcl-expr-parse-additive-rest
+  (fn
+    (tokens left)
+    (if
+      (or (= 0 (len tokens)) (not (contains? (list "+" "-") (first tokens))))
+      {:value left :tokens tokens}
+      (let
+        ((op (first tokens)))
+        (let
+          ((r (tcl-expr-parse-multiplicative (rest tokens))))
+          (tcl-expr-parse-additive-rest
+            (get r :tokens)
+            (tcl-apply-binop op left (get r :value))))))))
+
+(define
+  tcl-expr-parse-additive
+  (fn
+    (tokens)
+    (let
+      ((r (tcl-expr-parse-multiplicative tokens)))
+      (tcl-expr-parse-additive-rest (get r :tokens) (get r :value)))))
+
+(define
+  tcl-expr-parse-relational-rest
+  (fn
+    (tokens left)
+    (if
+      (or (= 0 (len tokens)) (not (contains? (list "<" ">" "<=" ">=") (first tokens))))
+      {:value left :tokens tokens}
+      (let
+        ((op (first tokens)))
+        (let
+          ((r (tcl-expr-parse-additive (rest tokens))))
+          (tcl-expr-parse-relational-rest
+            (get r :tokens)
+            (tcl-apply-binop op left (get r :value))))))))
+
+(define
+  tcl-expr-parse-relational
+  (fn
+    (tokens)
+    (let
+      ((r (tcl-expr-parse-additive tokens)))
+      (tcl-expr-parse-relational-rest (get r :tokens) (get r :value)))))
+
+(define
+  tcl-expr-parse-equality-rest
+  (fn
+    (tokens left)
+    (if
+      (or (= 0 (len tokens)) (not (contains? (list "==" "!=") (first tokens))))
+      {:value left :tokens tokens}
+      (let
+        ((op (first tokens)))
+        (let
+          ((r (tcl-expr-parse-relational (rest tokens))))
+          (tcl-expr-parse-equality-rest
+            (get r :tokens)
+            (tcl-apply-binop op left (get r :value))))))))
+
+(define
+  tcl-expr-parse-equality
+  (fn
+    (tokens)
+    (let
+      ((r (tcl-expr-parse-relational tokens)))
+      (tcl-expr-parse-equality-rest (get r :tokens) (get r :value)))))
+
+(define
+  tcl-expr-parse-and-rest
+  (fn
+    (tokens left)
+    (if
+      (or (= 0 (len tokens)) (not (equal? (first tokens) "&&")))
+      {:value left :tokens tokens}
+      (let
+        ((r (tcl-expr-parse-equality (rest tokens))))
+        (tcl-expr-parse-and-rest
+          (get r :tokens)
+          (tcl-apply-binop "&&" left (get r :value)))))))
+
+(define
+  tcl-expr-parse-and
+  (fn
+    (tokens)
+    (let
+      ((r (tcl-expr-parse-equality tokens)))
+      (tcl-expr-parse-and-rest (get r :tokens) (get r :value)))))
+
+(define
+  tcl-expr-parse-or-rest
+  (fn
+    (tokens left)
+    (if
+      (or (= 0 (len tokens)) (not (equal? (first tokens) "||")))
+      {:value left :tokens tokens}
+      (let
+        ((r (tcl-expr-parse-and (rest tokens))))
+        (tcl-expr-parse-or-rest
+          (get r :tokens)
+          (tcl-apply-binop "||" left (get r :value)))))))
+
+(define
+  tcl-expr-parse-or
+  (fn
+    (tokens)
+    (let
+      ((r (tcl-expr-parse-and tokens)))
+      (tcl-expr-parse-or-rest (get r :tokens) (get r :value)))))
+
+(define
+  tcl-expr-parse
+  (fn
+    (tokens)
+    (if
+      (= 0 (len tokens))
+      "0"
+      (get (tcl-expr-parse-or tokens) :value))))
 
 (define
   tcl-expr-eval
@@ -289,7 +670,11 @@
         {: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)})))))
+          (let
+            ((flat (join " " (get wr :values))))
+            (let
+              ((tokens (tcl-expr-tokenize flat)))
+              {:result (tcl-expr-parse tokens) :interp (get wr :interp)})))))))
 
 (define tcl-cmd-break (fn (interp args) (assoc interp :code 3)))
 
diff --git a/lib/tcl/tests/eval.sx b/lib/tcl/tests/eval.sx
index 0cb87e66..e3b71045 100644
--- a/lib/tcl/tests/eval.sx
+++ b/lib/tcl/tests/eval.sx
@@ -153,6 +153,26 @@
           ((frame (get i :frame)))
           (nil? (get (get frame :locals) "x")))))
     (ok "eval" (tcl-var-get (run "eval {set x hello}") "x") "hello")
+    (ok "expr-precedence" (get (run "expr {3 + 4 * 2}") :result) "11")
+    (ok "expr-parens" (get (run "expr {(3 + 4) * 2}") :result) "14")
+    (ok "expr-unary-minus" (get (run "expr {-5}") :result) "-5")
+    (ok "expr-unary-not-0" (get (run "expr {!0}") :result) "1")
+    (ok "expr-unary-not-1" (get (run "expr {!1}") :result) "0")
+    (ok "expr-power" (get (run "expr {2 ** 10}") :result) "1024")
+    (ok "expr-le" (get (run "expr {3 <= 3}") :result) "1")
+    (ok "expr-ge" (get (run "expr {4 >= 5}") :result) "0")
+    (ok "expr-and" (get (run "expr {1 && 1}") :result) "1")
+    (ok "expr-or" (get (run "expr {0 || 1}") :result) "1")
+    (ok "expr-var-sub" (get (run "set x 7\nexpr {$x * 3}") :result) "21")
+    (ok "expr-abs-neg" (get (run "expr {abs(-3)}") :result) "3")
+    (ok "expr-abs-pos" (get (run "expr {abs(5)}") :result) "5")
+    (ok "expr-pow-fn" (get (run "expr {pow(2, 8)}") :result) "256")
+    (ok "expr-max" (get (run "expr {max(3, 7)}") :result) "7")
+    (ok "expr-min" (get (run "expr {min(3, 7)}") :result) "3")
+    (ok "expr-sqrt-9" (get (run "expr {sqrt(9)}") :result) "3")
+    (ok "expr-sqrt-16" (get (run "expr {sqrt(16)}") :result) "4")
+    (ok "expr-mod" (get (run "expr {17 % 5}") :result) "2")
+    (ok "expr-nospace" (get (run "expr {3+4*2}") :result) "11")
     (ok "expr-add" (get (run "expr {3 + 4}") :result) "7")
     (ok "expr-cmp" (get (run "expr {5 > 3}") :result) "1")
     (ok
diff --git a/plans/tcl-on-sx.md b/plans/tcl-on-sx.md
index ca1f115f..f225e5db 100644
--- a/plans/tcl-on-sx.md
+++ b/plans/tcl-on-sx.md
@@ -69,7 +69,7 @@ Core mapping:
 ### Phase 2 — sequential eval + core commands
 - [x] `tcl-eval-script`: walk command list, dispatch each first-word into command table
 - [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
+- [x] `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`
 - [ ] Dict commands: `dict create`, `dict get`, `dict set`, `dict unset`, `dict exists`, `dict keys`, `dict values`, `dict size`, `dict for`, `dict update`, `dict merge`
@@ -120,6 +120,7 @@ Core mapping:
 
 _Newest first._
 
+- 2026-05-06: Phase 2 expr mini-language — recursive descent parser, operator precedence, parens, unary ops, pow/sqrt/abs/max/min/int/double, 127 tests green (67 parse + 60 eval)
 - 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