tcl: expr mini-language — recursive descent parser (+20 tests, 127 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s

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>
This commit is contained in:
2026-05-06 08:43:02 +00:00
parent 72ccaf4565
commit ac013c9381
3 changed files with 443 additions and 37 deletions

View File

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

View File

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

View File

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