tcl: expr mini-language — recursive descent parser (+20 tests, 127 total)

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

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