; Tcl-on-SX runtime evaluator
; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output}

(define make-frame (fn (level parent) {:level level :locals {} :parent parent}))

(define
  frame-lookup
  (fn
    (frame name)
    (if
      (nil? frame)
      nil
      (let
        ((val (get (get frame :locals) name)))
        (if (nil? val) (frame-lookup (get frame :parent) name) val)))))

(define
  frame-set-top
  (fn
    (frame name val)
    (assoc frame :locals (assoc (get frame :locals) name val))))

(define make-tcl-interp (fn () {:result "" :output "" :code 0 :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {}}))

(define
  tcl-register
  (fn
    (interp name f)
    (assoc interp :commands (assoc (get interp :commands) name f))))

; --- upvar alias helpers ---

(define upvar-alias? (fn (v) (and (dict? v) (not (nil? (get v :upvar-level))))))

; take first n elements of a list
(define
  take-n
  (fn
    (lst n)
    (if
      (or (<= n 0) (= 0 (len lst)))
      (list)
      (append (list (first lst)) (take-n (rest lst) (- n 1))))))

; replace element at index i in list with val (0-based)
(define
  replace-at
  (fn
    (lst i val)
    (let
      ((go
        (fn
          (remaining j acc)
          (if
            (= 0 (len remaining))
            acc
            (go
              (rest remaining)
              (+ j 1)
              (append acc (list (if (= j i) val (first remaining)))))))))
      (go lst 0 (list)))))

; build full-stack = frame-stack + [current-frame]
(define
  tcl-full-stack
  (fn (interp)
    (append (get interp :frame-stack) (list (get interp :frame)))))

; get target frame at absolute level from full-stack
(define
  tcl-frame-nth
  (fn (full-stack level)
    (nth full-stack level)))

(define
  tcl-var-get
  (fn
    (interp name)
    (let
      ((val (frame-lookup (get interp :frame) name)))
      (if
        (nil? val)
        (error (str "can't read \"" name "\": no such variable"))
        (if
          (upvar-alias? val)
          ; follow alias to target frame
          (let
            ((target-level (get val :upvar-level))
              (target-name (get val :upvar-name)))
            (let
              ((full-stack (tcl-full-stack interp)))
              (let
                ((target-frame (tcl-frame-nth full-stack target-level)))
                (let
                  ((target-val (frame-lookup target-frame target-name)))
                  (if
                    (nil? target-val)
                    (error (str "can't read \"" name "\": no such variable"))
                    target-val)))))
          val)))))

(define
  tcl-var-set
  (fn
    (interp name val)
    (let
      ((cur-val (get (get (get interp :frame) :locals) name)))
      (if
        (and (not (nil? cur-val)) (upvar-alias? cur-val))
        ; set in target frame
        (let
          ((target-level (get cur-val :upvar-level))
            (target-name (get cur-val :upvar-name)))
          (let
            ((full-stack (tcl-full-stack interp)))
            (let
              ((target-frame (tcl-frame-nth full-stack target-level)))
              (let
                ((updated-target (frame-set-top target-frame target-name val)))
                (let
                  ((new-full-stack (replace-at full-stack target-level updated-target)))
                  (let
                    ((new-frame-stack (take-n new-full-stack (- (len new-full-stack) 1)))
                      (new-current (nth new-full-stack (- (len new-full-stack) 1))))
                    (assoc interp :frame new-current :frame-stack new-frame-stack)))))))
        ; normal set in current frame top
        (assoc interp :frame (frame-set-top (get interp :frame) name val))))))

(define
  tcl-eval-parts
  (fn
    (parts interp)
    (reduce
      (fn
        (acc part)
        (let
          ((type (get part :type)) (cur-interp (get acc :interp)))
          (cond
            ((equal? type "text") {:values (append (get acc :values) (list (get part :value))) :interp cur-interp})
            ((equal? type "var") {:values (append (get acc :values) (list (tcl-var-get cur-interp (get part :name)))) :interp cur-interp})
            ((equal? type "var-arr")
              (let
                ((key-acc (tcl-eval-parts (get part :key) cur-interp)))
                (let
                  ((key (join "" (get key-acc :values)))
                    (next-interp (get key-acc :interp)))
                  {:values (append (get acc :values) (list (tcl-var-get next-interp (str (get part :name) "(" key ")")))) :interp next-interp})))
            ((equal? type "cmd")
              (let
                ((new-interp (tcl-eval-string cur-interp (get part :src))))
                {:values (append (get acc :values) (list (get new-interp :result))) :interp new-interp}))
            (else (error (str "tcl: unknown part type: " type))))))
      {:values (quote ()) :interp interp}
      parts)))

(define
  tcl-eval-word
  (fn
    (word interp)
    (let
      ((type (get word :type)))
      (cond
        ((equal? type "braced") {:interp interp :value (get word :value)})
        ((equal? type "compound")
          (let
            ((result (tcl-eval-parts (get word :parts) interp)))
            {:interp (get result :interp) :value (join "" (get result :values))}))
        ((equal? type "expand") (tcl-eval-word (get word :word) interp))
        (else (error (str "tcl: unknown word type: " type)))))))

(define
  tcl-list-split
  (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
  (fn
    (words interp)
    (reduce
      (fn
        (acc w)
        (let
          ((cur-interp (get acc :interp)))
          (if
            (equal? (get w :type) "expand")
            (let
              ((wr (tcl-eval-word (get w :word) cur-interp)))
              {:values (append (get acc :values) (tcl-list-split (get wr :value))) :interp (get wr :interp)})
            (let ((wr (tcl-eval-word w cur-interp))) {:values (append (get acc :values) (list (get wr :value))) :interp (get wr :interp)}))))
      {:values (quote ()) :interp interp}
      words)))

; --- proc call ---

; Bind proc parameters: returns updated frame
(define
  tcl-bind-params
  (fn
    (frame params call-args)
    (if
      (= 0 (len params))
      frame
      (let
        ((pname (first params)) (rest-ps (rest params)))
        (if
          (equal? pname "args")
          ; rest param: collect remaining call-args as list string
          (frame-set-top frame "args" (tcl-list-build call-args))
          (if
            (= 0 (len call-args))
            (error (str "wrong # args: no value for parameter \"" pname "\""))
            (tcl-bind-params
              (frame-set-top frame pname (first call-args))
              rest-ps
              (rest call-args))))))))

(define
  tcl-call-proc
  (fn
    (interp proc-name proc-def call-args)
    (let
      ((param-spec (get proc-def :args))
        (body (get proc-def :body)))
      (let
        ((params (if (equal? param-spec "") (list) (tcl-list-split param-spec))))
        (let
          ((caller-stack-len (len (get interp :frame-stack)))
            (new-frame (make-frame (+ (len (get interp :frame-stack)) 1) nil)))
          (let
            ((bound-frame (tcl-bind-params new-frame params call-args)))
            (let
              ((proc-interp
                (assoc interp
                  :frame bound-frame
                  :frame-stack (append (get interp :frame-stack) (list (get interp :frame)))
                  :output ""
                  :result ""
                  :code 0))
                (caller-output (get interp :output)))
              (let
                ((result-interp (tcl-eval-string proc-interp body)))
                (let
                  ((code (get result-interp :code))
                    (result-val (get result-interp :result))
                    (proc-output (get result-interp :output)))
                  (let
                    ; result-stack = [updated-frame-0..updated-caller-frame]
                    ; recover updated caller frame and below-caller frames
                    ((result-stack (get result-interp :frame-stack)))
                    (let
                      ((updated-below (take-n result-stack caller-stack-len))
                        (updated-caller
                          (if
                            (> (len result-stack) caller-stack-len)
                            (nth result-stack caller-stack-len)
                            (get interp :frame))))
                      (assoc interp
                        :frame updated-caller
                        :frame-stack updated-below
                        :result result-val
                        :output (str caller-output proc-output)
                        :code (if (= code 2) 0 code)))))))))))))

(define
  tcl-eval-cmd
  (fn
    (interp cmd)
    (let
      ((wr (tcl-eval-words (get cmd :words) interp)))
      (let
        ((words (get wr :values)) (cur-interp (get wr :interp)))
        (if
          (= 0 (len words))
          cur-interp
          (let
            ((cmd-name (first words)) (cmd-args (rest words)))
            (let
              ((cmd-fn (get (get cur-interp :commands) cmd-name)))
              (if
                (nil? cmd-fn)
                (let
                  ((proc-def (get (get cur-interp :procs) cmd-name)))
                  (if
                    (nil? proc-def)
                    (error (str "unknown command: \"" cmd-name "\""))
                    (tcl-call-proc cur-interp cmd-name proc-def cmd-args)))
                (cmd-fn cur-interp cmd-args)))))))))

(define
  tcl-eval-script
  (fn
    (interp cmds)
    (if
      (or (= 0 (len cmds)) (not (= 0 (get interp :code))))
      interp
      (tcl-eval-script (tcl-eval-cmd interp (first cmds)) (rest cmds)))))

(define
  tcl-eval-string
  (fn (interp src) (tcl-eval-script interp (tcl-parse src))))

(define
  tcl-cmd-set
  (fn
    (interp args)
    (if
      (= (len args) 1)
      (assoc interp :result (tcl-var-get interp (first args)))
      (let
        ((val (nth args 1)))
        (assoc (tcl-var-set interp (first args) val) :result val)))))

(define
  tcl-cmd-puts
  (fn
    (interp args)
    (let
      ((text (last args))
        (no-nl
          (and
            (> (len args) 1)
            (equal? (first args) "-nonewline"))))
      (let
        ((line (if no-nl text (str text "\n"))))
        (assoc interp :output (str (get interp :output) line))))))

(define
  tcl-cmd-incr
  (fn
    (interp args)
    (let
      ((name (first args))
        (delta
          (if
            (> (len args) 1)
            (parse-int (nth args 1))
            1)))
      (let
        ((new-val (str (+ (parse-int (tcl-var-get interp name)) delta))))
        (assoc (tcl-var-set interp name new-val) :result new-val)))))

(define
  tcl-cmd-append
  (fn
    (interp args)
    (let
      ((name (first args)) (suffix (join "" (rest args))))
      (let
        ((cur (let ((v (frame-lookup (get interp :frame) name))) (if (nil? v) "" v))))
        (let
          ((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-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
      ((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
            ((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
  (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)))
          (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)))

(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")))

; --- string command helpers ---

; glob match: pattern chars list, string chars list
(define
  tcl-glob-match
  (fn
    (pat-chars str-chars)
    (cond
      ; both exhausted → success
      ((and (= 0 (len pat-chars)) (= 0 (len str-chars))) true)
      ; pattern exhausted but string remains → fail
      ((= 0 (len pat-chars)) false)
      ; leading * in pattern
      ((equal? (first pat-chars) "*")
        (let
          ((rest-pat (rest pat-chars)))
          ; * can match zero chars (skip *) or consume one str char and retry
          (if
            (tcl-glob-match rest-pat str-chars)
            true
            (if
              (= 0 (len str-chars))
              false
              (tcl-glob-match pat-chars (rest str-chars))))))
      ; string exhausted but pattern non-empty (and not *) → fail
      ((= 0 (len str-chars)) false)
      ; ? matches any single char
      ((equal? (first pat-chars) "?")
        (tcl-glob-match (rest pat-chars) (rest str-chars)))
      ; literal match
      ((equal? (first pat-chars) (first str-chars))
        (tcl-glob-match (rest pat-chars) (rest str-chars)))
      ; literal mismatch
      (else false))))

; toupper/tolower via char tables
(define
  tcl-upcase-char
  (fn
    (c)
    (cond
      ((equal? c "a") "A") ((equal? c "b") "B") ((equal? c "c") "C")
      ((equal? c "d") "D") ((equal? c "e") "E") ((equal? c "f") "F")
      ((equal? c "g") "G") ((equal? c "h") "H") ((equal? c "i") "I")
      ((equal? c "j") "J") ((equal? c "k") "K") ((equal? c "l") "L")
      ((equal? c "m") "M") ((equal? c "n") "N") ((equal? c "o") "O")
      ((equal? c "p") "P") ((equal? c "q") "Q") ((equal? c "r") "R")
      ((equal? c "s") "S") ((equal? c "t") "T") ((equal? c "u") "U")
      ((equal? c "v") "V") ((equal? c "w") "W") ((equal? c "x") "X")
      ((equal? c "y") "Y") ((equal? c "z") "Z")
      (else c))))

(define
  tcl-downcase-char
  (fn
    (c)
    (cond
      ((equal? c "A") "a") ((equal? c "B") "b") ((equal? c "C") "c")
      ((equal? c "D") "d") ((equal? c "E") "e") ((equal? c "F") "f")
      ((equal? c "G") "g") ((equal? c "H") "h") ((equal? c "I") "i")
      ((equal? c "J") "j") ((equal? c "K") "k") ((equal? c "L") "l")
      ((equal? c "M") "m") ((equal? c "N") "n") ((equal? c "O") "o")
      ((equal? c "P") "p") ((equal? c "Q") "q") ((equal? c "R") "r")
      ((equal? c "S") "s") ((equal? c "T") "t") ((equal? c "U") "u")
      ((equal? c "V") "v") ((equal? c "W") "w") ((equal? c "X") "x")
      ((equal? c "Y") "y") ((equal? c "Z") "z")
      (else c))))

; strip chars from left
(define
  tcl-trim-left-chars
  (fn
    (chars strip-set)
    (if
      (or (= 0 (len chars)) (not (contains? strip-set (first chars))))
      chars
      (tcl-trim-left-chars (rest chars) strip-set))))

; strip chars from right (reverse, trim left, reverse)
(define
  tcl-reverse-list
  (fn (lst) (reduce (fn (acc x) (append (list x) acc)) (list) lst)))

(define
  tcl-trim-right-chars
  (fn
    (chars strip-set)
    (tcl-reverse-list (tcl-trim-left-chars (tcl-reverse-list chars) strip-set))))

; default whitespace set
(define
  tcl-ws-set
  (list " " "\t" "\n" "\r"))

; string map: apply flat list of pairs old→new to string
(define
  tcl-string-map-apply
  (fn
    (s pairs)
    (if
      (< (len pairs) 2)
      s
      (let
        ((old (first pairs)) (new-s (nth pairs 1)) (rest-pairs (rest (rest pairs))))
        (let
          ((old-chars (split old ""))
            (old-len (string-length old)))
          (let
            ((go
              (fn
                (i acc)
                (if
                  (>= i (string-length s))
                  acc
                  (let
                    ((chunk (if (> (+ i old-len) (string-length s)) "" (substring s i (+ i old-len)))))
                    (if
                      (equal? chunk old)
                      (go (+ i old-len) (str acc new-s))
                      (go (+ i 1) (str acc (substring s i (+ i 1))))))))))
          (tcl-string-map-apply (go 0 "") rest-pairs)))))))

; string first: index of needle in haystack starting at start
(define
  tcl-string-first
  (fn
    (needle haystack start)
    (let
      ((nl (string-length needle)) (hl (string-length haystack)))
      (if
        (= nl 0)
        (str start)
        (let
          ((go
            (fn
              (i)
              (if
                (> (+ i nl) hl)
                "-1"
                (if
                  (equal? (substring haystack i (+ i nl)) needle)
                  (str i)
                  (go (+ i 1)))))))
          (go start))))))

; string last: last index of needle in haystack up to end
(define
  tcl-string-last
  (fn
    (needle haystack end-idx)
    (let
      ((nl (string-length needle)) (hl (string-length haystack)))
      (let
        ((bound (if (< end-idx 0) (- hl 1) (if (>= end-idx hl) (- hl 1) end-idx))))
        (if
          (= nl 0)
          (str bound)
          (let
            ((go
              (fn
                (i)
                (if
                  (< i 0)
                  "-1"
                  (if
                    (and
                      (<= (+ i nl) hl)
                      (equal? (substring haystack i (+ i nl)) needle))
                    (str i)
                    (go (- i 1)))))))
            (go (- (+ bound 1) nl))))))))

; string is: check string class
(define
  tcl-string-is
  (fn
    (class s)
    (let
      ((chars (split s ""))
        (n (string-length s)))
      (cond
        ((equal? class "integer")
          (if
            (= n 0)
            "0"
            (let
              ((start (if (or (equal? (first chars) "-") (equal? (first chars) "+")) 1 0)))
              (if
                (= start n)
                "0"
                (if
                  (reduce
                    (fn (ok c) (and ok (tcl-expr-digit? c)))
                    true
                    (slice chars start n))
                  "1"
                  "0")))))
        ((equal? class "double")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn (ok c) (and ok (or (tcl-expr-digit? c) (equal? c ".") (equal? c "-") (equal? c "+") (equal? c "e") (equal? c "E"))))
                true
                chars)
              "1"
              "0")))
        ((equal? class "alpha")
          (if
            (= n 0)
            "0"
            (if
              (reduce (fn (ok c) (and ok (tcl-expr-alpha? c))) true chars)
              "1"
              "0")))
        ((equal? class "alnum")
          (if
            (= n 0)
            "0"
            (if
              (reduce (fn (ok c) (and ok (or (tcl-expr-alpha? c) (tcl-expr-digit? c)))) true chars)
              "1"
              "0")))
        ((equal? class "digit")
          (if
            (= n 0)
            "0"
            (if
              (reduce (fn (ok c) (and ok (tcl-expr-digit? c))) true chars)
              "1"
              "0")))
        ((equal? class "space")
          (if
            (= n 0)
            "1"
            (if
              (reduce (fn (ok c) (and ok (tcl-expr-ws? c))) true chars)
              "1"
              "0")))
        ((equal? class "upper")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn
                  (ok c)
                  (and
                    ok
                    (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")
                      c)))
                true
                chars)
              "1"
              "0")))
        ((equal? class "lower")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn
                  (ok c)
                  (and
                    ok
                    (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")
                      c)))
                true
                chars)
              "1"
              "0")))
        ((equal? class "boolean")
          (if
            (or (equal? s "0") (equal? s "1")
                (equal? s "true") (equal? s "false")
                (equal? s "yes") (equal? s "no")
                (equal? s "on") (equal? s "off"))
            "1"
            "0"))
        (else "0")))))

(define
  tcl-cmd-string
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "string: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ; string length s
          ((equal? sub "length")
            (assoc interp :result (str (string-length (first rest-args)))))
          ; string index s i
          ((equal? sub "index")
            (let
              ((s (first rest-args)) (idx (parse-int (nth rest-args 1))))
              (let
                ((n (string-length s)))
                (if
                  (or (< idx 0) (>= idx n))
                  (assoc interp :result "")
                  (assoc interp :result (substring s idx (+ idx 1)))))))
          ; string range s first last
          ((equal? sub "range")
            (let
              ((s (first rest-args))
                (fi (parse-int (nth rest-args 1)))
                (li (parse-int (nth rest-args 2))))
              (let
                ((n (string-length s)))
                (let
                  ((f (if (< fi 0) 0 fi))
                    (l (if (>= li n) (- n 1) li)))
                  (if
                    (> f l)
                    (assoc interp :result "")
                    (assoc interp :result (substring s f (+ l 1))))))))
          ; string compare s1 s2
          ((equal? sub "compare")
            (let
              ((s1 (first rest-args)) (s2 (nth rest-args 1)))
              (assoc
                interp
                :result
                (cond
                  ((equal? s1 s2) "0")
                  ((< s1 s2) "-1")
                  (else "1")))))
          ; string match pattern s
          ((equal? sub "match")
            (let
              ((pat (first rest-args)) (s (nth rest-args 1)))
              (assoc
                interp
                :result
                (if (tcl-glob-match (split pat "") (split s "")) "1" "0"))))
          ; string toupper s
          ((equal? sub "toupper")
            (let
              ((s (first rest-args)))
              (assoc
                interp
                :result
                (join "" (map tcl-upcase-char (split s ""))))))
          ; string tolower s
          ((equal? sub "tolower")
            (let
              ((s (first rest-args)))
              (assoc
                interp
                :result
                (join "" (map tcl-downcase-char (split s ""))))))
          ; string trim s ?chars?
          ((equal? sub "trim")
            (let
              ((s (first rest-args))
                (strip-set (if (> (len rest-args) 1) (split (nth rest-args 1) "") tcl-ws-set)))
              (let
                ((chars (split s "")))
                (assoc
                  interp
                  :result
                  (join "" (tcl-trim-right-chars (tcl-trim-left-chars chars strip-set) strip-set))))))
          ; string trimleft s ?chars?
          ((equal? sub "trimleft")
            (let
              ((s (first rest-args))
                (strip-set (if (> (len rest-args) 1) (split (nth rest-args 1) "") tcl-ws-set)))
              (assoc
                interp
                :result
                (join "" (tcl-trim-left-chars (split s "") strip-set)))))
          ; string trimright s ?chars?
          ((equal? sub "trimright")
            (let
              ((s (first rest-args))
                (strip-set (if (> (len rest-args) 1) (split (nth rest-args 1) "") tcl-ws-set)))
              (assoc
                interp
                :result
                (join "" (tcl-trim-right-chars (split s "") strip-set)))))
          ; string map mapping s
          ((equal? sub "map")
            (let
              ((mapping (first rest-args)) (s (nth rest-args 1)))
              (assoc
                interp
                :result
                (tcl-string-map-apply s (tcl-list-split mapping)))))
          ; string repeat s n
          ((equal? sub "repeat")
            (let
              ((s (first rest-args)) (n (parse-int (nth rest-args 1))))
              (assoc
                interp
                :result
                (let
                  ((go (fn (i acc) (if (>= i n) acc (go (+ i 1) (str acc s))))))
                  (go 0 "")))))
          ; string first needle haystack ?start?
          ((equal? sub "first")
            (let
              ((needle (first rest-args))
                (haystack (nth rest-args 1))
                (start (if (> (len rest-args) 2) (parse-int (nth rest-args 2)) 0)))
              (assoc interp :result (tcl-string-first needle haystack start))))
          ; string last needle haystack ?end?
          ((equal? sub "last")
            (let
              ((needle (first rest-args))
                (haystack (nth rest-args 1))
                (end-idx (if (> (len rest-args) 2) (parse-int (nth rest-args 2)) -1)))
              (assoc interp :result (tcl-string-last needle haystack end-idx))))
          ; string is class s
          ((equal? sub "is")
            (let
              ((class (first rest-args)) (s (nth rest-args 1)))
              (assoc interp :result (tcl-string-is class s))))
          ; string cat ?args...?
          ((equal? sub "cat")
            (assoc interp :result (join "" rest-args)))
          (else (error (str "string: unknown subcommand: " sub))))))))


; --- list command helpers ---

; Quote a single list element: add braces if it contains a space or is empty
(define
  tcl-list-quote-elem
  (fn
    (elem)
    (if
      (or (equal? elem "") (contains? (split elem "") " "))
      (str "{" elem "}")
      elem)))

; Build a Tcl list string from an SX list of string elements
(define
  tcl-list-build
  (fn (elems) (join " " (map tcl-list-quote-elem elems))))

; Resolve "end" index to numeric value given list length
(define
  tcl-end-index
  (fn
    (s n)
    (if (equal? s "end") (- n 1) (parse-int s))))

; Insertion sort for list commands (comparator: fn(a b) -> true if a before b)
(define
  tcl-insert-sorted
  (fn
    (lst before? x)
    (if
      (= 0 (len lst))
      (list x)
      (if
        (before? x (first lst))
        (append (list x) lst)
        (append (list (first lst)) (tcl-insert-sorted (rest lst) before? x))))))

(define
  tcl-insertion-sort
  (fn
    (lst before?)
    (reduce
      (fn (sorted x) (tcl-insert-sorted sorted before? x))
      (list)
      lst)))

; --- list commands ---

(define
  tcl-cmd-list
  (fn
    (interp args)
    (assoc interp :result (tcl-list-build args))))

(define
  tcl-cmd-lindex
  (fn
    (interp args)
    (let
      ((elems (tcl-list-split (first args)))
        (idx (tcl-end-index (nth args 1) (len (tcl-list-split (first args))))))
      (assoc
        interp
        :result
        (if
          (or (< idx 0) (>= idx (len elems)))
          ""
          (nth elems idx))))))

(define
  tcl-cmd-lrange
  (fn
    (interp args)
    (let
      ((elems (tcl-list-split (first args))))
      (let
        ((n (len elems))
          (fi (tcl-end-index (nth args 1) (len elems)))
          (li (tcl-end-index (nth args 2) (len elems))))
        (let
          ((f (if (< fi 0) 0 fi))
            (l (if (>= li n) (- n 1) li)))
          (assoc
            interp
            :result
            (if
              (> f l)
              ""
              (tcl-list-build (slice elems f (+ l 1))))))))))

(define
  tcl-cmd-llength
  (fn
    (interp args)
    (assoc interp :result (str (len (tcl-list-split (first args)))))))

(define
  tcl-cmd-lreverse
  (fn
    (interp args)
    (assoc
      interp
      :result
      (tcl-list-build (tcl-reverse-list (tcl-list-split (first args)))))))

(define
  tcl-cmd-lsearch
  (fn
    (interp args)
    (let
      ((exact? (and (> (len args) 2) (equal? (first args) "-exact")))
        (list-str (if (and (> (len args) 2) (equal? (first args) "-exact")) (nth args 1) (first args)))
        (value (if (and (> (len args) 2) (equal? (first args) "-exact")) (nth args 2) (nth args 1))))
      (let
        ((elems (tcl-list-split list-str)))
        (define
          find-idx
          (fn
            (lst i)
            (if
              (= 0 (len lst))
              "-1"
              (if
                (equal? (first lst) value)
                (str i)
                (find-idx (rest lst) (+ i 1))))))
        (assoc interp :result (find-idx elems 0))))))

(define
  tcl-cmd-lsort
  (fn
    (interp args)
    (define
      parse-opts
      (fn
        (remaining)
        (if
          (or (= 0 (len remaining)) (not (equal? (substring (first remaining) 0 1) "-")))
          {:mode "ascii" :decreasing false :list-str (first remaining)}
          (if
            (equal? (first remaining) "-integer")
            (let ((r (parse-opts (rest remaining)))) (assoc r :mode "integer"))
            (if
              (equal? (first remaining) "-real")
              (let ((r (parse-opts (rest remaining)))) (assoc r :mode "real"))
              (if
                (equal? (first remaining) "-dictionary")
                (let ((r (parse-opts (rest remaining)))) (assoc r :mode "dictionary"))
                (if
                  (equal? (first remaining) "-decreasing")
                  (let ((r (parse-opts (rest remaining)))) (assoc r :decreasing true))
                  {:mode "ascii" :decreasing false :list-str (first remaining)})))))))
    (let
      ((opts (parse-opts args)))
      (let
        ((elems (tcl-list-split (get opts :list-str)))
          (mode (get opts :mode))
          (decreasing? (get opts :decreasing)))
        (let
          ((before?
            (if
              (equal? mode "integer")
              (fn (a b) (< (parse-int a) (parse-int b)))
              (fn (a b) (< a b)))))
          (let
            ((sorted (tcl-insertion-sort elems before?)))
            (assoc
              interp
              :result
              (tcl-list-build
                (if decreasing? (tcl-reverse-list sorted) sorted)))))))))

(define
  tcl-cmd-lreplace
  (fn
    (interp args)
    (let
      ((elems (tcl-list-split (first args))))
      (let
        ((n (len elems))
          (fi (tcl-end-index (nth args 1) n))
          (li (tcl-end-index (nth args 2) n))
          (new-elems (slice args 3 (len args))))
        (let
          ((f (if (< fi 0) 0 fi))
            (l (if (>= li (- n 1)) (- n 1) li)))
          (let
            ((before (slice elems 0 f))
              (after (slice elems (+ l 1) n)))
            (assoc
              interp
              :result
              (tcl-list-build
                (reduce
                  (fn (acc x) (append acc (list x)))
                  (reduce (fn (acc x) (append acc (list x))) before new-elems)
                  after)))))))))

(define
  tcl-cmd-linsert
  (fn
    (interp args)
    (let
      ((elems (tcl-list-split (first args))))
      (let
        ((n (len elems))
          (raw-idx (nth args 1))
          (new-elems (slice args 2 (len args))))
        (let
          ((idx
            (if
              (equal? raw-idx "end")
              n
              (let
                ((i (parse-int raw-idx)))
                (if (< i 0) 0 (if (> i n) n i))))))
          (let
            ((before (slice elems 0 idx))
              (after (slice elems idx n)))
            (assoc
              interp
              :result
              (tcl-list-build
                (reduce
                  (fn (acc x) (append acc (list x)))
                  (reduce (fn (acc x) (append acc (list x))) before new-elems)
                  after)))))))))

(define
  tcl-cmd-concat
  (fn
    (interp args)
    (let
      ((all-elems
        (reduce
          (fn (acc s) (append acc (tcl-list-split s)))
          (list)
          args)))
      (assoc interp :result (tcl-list-build all-elems)))))

(define
  tcl-cmd-split
  (fn
    (interp args)
    (let
      ((s (first args))
        (sep (if (> (len args) 1) (nth args 1) " ")))
      (let
        ((parts
          (if
            (equal? sep " ")
            (filter (fn (x) (not (equal? x ""))) (split s " "))
            (split s sep))))
        (assoc interp :result (tcl-list-build parts))))))

(define
  tcl-cmd-join
  (fn
    (interp args)
    (let
      ((elems (tcl-list-split (first args)))
        (sep (if (> (len args) 1) (nth args 1) " ")))
      (assoc interp :result (join sep elems)))))

; --- dict command helpers ---

; Parse flat dict string into SX list of [key val] pairs
(define
  tcl-dict-to-pairs
  (fn
    (dict-str)
    (let
      ((flat (tcl-list-split dict-str)))
      (let
        ((go
          (fn
            (lst acc)
            (if
              (= 0 (len lst))
              acc
              (if
                (= 1 (len lst))
                (error "dict: malformed dict (odd number of elements)")
                (go (rest (rest lst)) (append acc (list (list (first lst) (nth lst 1))))))))))
        (go flat (list))))))

; Build flat dict string from SX list of [key val] pairs
(define
  tcl-dict-from-pairs
  (fn
    (pairs)
    (tcl-list-build
      (reduce
        (fn (acc pair) (append (append acc (list (first pair))) (list (nth pair 1))))
        (list)
        pairs))))

; Get value for key from flat dict string; returns nil if missing
(define
  tcl-dict-get
  (fn
    (dict-str key)
    (let
      ((flat (tcl-list-split dict-str)))
      (let
        ((go
          (fn
            (lst)
            (if
              (< (len lst) 2)
              nil
              (if
                (equal? (first lst) key)
                (nth lst 1)
                (go (rest (rest lst))))))))
        (go flat)))))

; Set key=val in flat dict string; returns new flat dict string
(define
  tcl-dict-set-pair
  (fn
    (dict-str key val)
    (let
      ((pairs (tcl-dict-to-pairs dict-str)))
      (let
        ((found? (reduce (fn (acc pair) (or acc (equal? (first pair) key))) false pairs)))
        (if
          found?
          (tcl-dict-from-pairs (map (fn (pair) (if (equal? (first pair) key) (list key val) pair)) pairs))
          (tcl-dict-from-pairs (append pairs (list (list key val)))))))))

; Remove key from flat dict string; returns new flat dict string
(define
  tcl-dict-unset-key
  (fn
    (dict-str key)
    (tcl-dict-from-pairs
      (filter (fn (pair) (not (equal? (first pair) key))) (tcl-dict-to-pairs dict-str)))))

; --- dict command ---

(define
  tcl-cmd-dict
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "dict: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ; dict create ?key val …?
          ((equal? sub "create")
            (if
              (= 1 (mod (len rest-args) 2))
              (error "dict create: wrong # args (must be even)")
              (assoc interp :result (tcl-list-build rest-args))))
          ; dict get dict key
          ((equal? sub "get")
            (let
              ((dict-str (first rest-args)) (key (nth rest-args 1)))
              (let
                ((val (tcl-dict-get dict-str key)))
                (if
                  (nil? val)
                  (error (str "dict get: key \"" key "\" not known in dictionary"))
                  (assoc interp :result val)))))
          ; dict set varname key val
          ((equal? sub "set")
            (let
              ((varname (first rest-args))
                (key (nth rest-args 1))
                (val (nth rest-args 2)))
              (let
                ((cur (let ((v (frame-lookup (get interp :frame) varname))) (if (nil? v) "" v))))
                (let
                  ((new-dict (tcl-dict-set-pair cur key val)))
                  (assoc (tcl-var-set interp varname new-dict) :result new-dict)))))
          ; dict unset varname key
          ((equal? sub "unset")
            (let
              ((varname (first rest-args)) (key (nth rest-args 1)))
              (let
                ((cur (let ((v (frame-lookup (get interp :frame) varname))) (if (nil? v) "" v))))
                (let
                  ((new-dict (tcl-dict-unset-key cur key)))
                  (assoc (tcl-var-set interp varname new-dict) :result new-dict)))))
          ; dict exists dict key
          ((equal? sub "exists")
            (let
              ((dict-str (first rest-args)) (key (nth rest-args 1)))
              (assoc interp :result (if (nil? (tcl-dict-get dict-str key)) "0" "1"))))
          ; dict keys dict ?pattern?
          ((equal? sub "keys")
            (let
              ((dict-str (first rest-args))
                (pattern (if (> (len rest-args) 1) (nth rest-args 1) nil)))
              (let
                ((all-keys (map first (tcl-dict-to-pairs dict-str))))
                (let
                  ((filtered
                    (if
                      (nil? pattern)
                      all-keys
                      (filter (fn (k) (tcl-glob-match (split pattern "") (split k ""))) all-keys))))
                  (assoc interp :result (tcl-list-build filtered))))))
          ; dict values dict
          ((equal? sub "values")
            (let
              ((dict-str (first rest-args)))
              (assoc interp :result (tcl-list-build (map (fn (pair) (nth pair 1)) (tcl-dict-to-pairs dict-str))))))
          ; dict size dict
          ((equal? sub "size")
            (let
              ((dict-str (first rest-args)))
              (assoc interp :result (str (len (tcl-dict-to-pairs dict-str))))))
          ; dict for {kvar vvar} dict body
          ((equal? sub "for")
            (let
              ((var-pair-str (first rest-args))
                (dict-str (nth rest-args 1))
                (body (nth rest-args 2)))
              (let
                ((var-list (tcl-list-split var-pair-str)))
                (let
                  ((kvar (first var-list)) (vvar (nth var-list 1)))
                  (let
                    ((pairs (tcl-dict-to-pairs dict-str)))
                    (define
                      dict-for-loop
                      (fn
                        (cur-interp ps)
                        (if
                          (= 0 (len ps))
                          cur-interp
                          (let
                            ((pair (first ps)))
                            (let
                              ((bound (tcl-var-set (tcl-var-set cur-interp kvar (first pair)) vvar (nth pair 1))))
                              (let
                                ((body-result (tcl-eval-string bound body)))
                                (let
                                  ((code (get body-result :code)))
                                  (cond
                                    ((= code 3) (assoc body-result :code 0))
                                    ((= code 2) body-result)
                                    ((= code 1) body-result)
                                    (else (dict-for-loop (assoc body-result :code 0) (rest ps)))))))))))
                    (dict-for-loop interp pairs))))))
          ; dict update varname key var … body
          ((equal? sub "update")
            (let
              ((varname (first rest-args)))
              (let
                ((n (len rest-args)))
                (let
                  ((body (nth rest-args (- n 1)))
                    (kv-args (slice rest-args 1 (- n 1))))
                  (let
                    ((cur (let ((v (frame-lookup (get interp :frame) varname))) (if (nil? v) "" v))))
                    (let
                      ((bound-interp
                        (let
                          ((bind-pairs
                            (fn
                              (i-interp remaining)
                              (if
                                (< (len remaining) 2)
                                i-interp
                                (let
                                  ((k (first remaining)) (var (nth remaining 1)))
                                  (let
                                    ((val (tcl-dict-get cur k)))
                                    (bind-pairs
                                      (tcl-var-set i-interp var (if (nil? val) "" val))
                                      (rest (rest remaining)))))))))
                          (bind-pairs interp kv-args))))
                      (let
                        ((body-result (tcl-eval-string bound-interp body)))
                        (let
                          ((write-back
                            (fn
                              (i-interp remaining new-dict)
                              (if
                                (< (len remaining) 2)
                                (assoc (tcl-var-set i-interp varname new-dict) :result new-dict)
                                (let
                                  ((k (first remaining)) (var (nth remaining 1)))
                                  (let
                                    ((new-val (frame-lookup (get body-result :frame) var)))
                                    (write-back
                                      i-interp
                                      (rest (rest remaining))
                                      (if (nil? new-val) (tcl-dict-unset-key new-dict k) (tcl-dict-set-pair new-dict k new-val)))))))))
                          (write-back body-result kv-args cur)))))))))
          ; dict merge ?dict…?
          ((equal? sub "merge")
            (let
              ((merged
                (reduce
                  (fn
                    (acc dict-str)
                    (reduce
                      (fn (a pair) (tcl-dict-set-pair a (first pair) (nth pair 1)))
                      acc
                      (tcl-dict-to-pairs dict-str)))
                  ""
                  rest-args)))
              (assoc interp :result merged)))
          ; dict incr varname key ?increment?
          ((equal? sub "incr")
            (let
              ((varname (first rest-args))
                (key (nth rest-args 1))
                (delta (if (> (len rest-args) 2) (parse-int (nth rest-args 2)) 1)))
              (let
                ((cur (let ((v (frame-lookup (get interp :frame) varname))) (if (nil? v) "" v))))
                (let
                  ((old-val (let ((v (tcl-dict-get cur key))) (if (nil? v) "0" v))))
                  (let
                    ((new-val (str (+ (parse-int old-val) delta))))
                    (let
                      ((new-dict (tcl-dict-set-pair cur key new-val)))
                      (assoc (tcl-var-set interp varname new-dict) :result new-dict)))))))
          ; dict append varname key ?string…?
          ((equal? sub "append")
            (let
              ((varname (first rest-args))
                (key (nth rest-args 1))
                (suffix (join "" (slice rest-args 2 (len rest-args)))))
              (let
                ((cur (let ((v (frame-lookup (get interp :frame) varname))) (if (nil? v) "" v))))
                (let
                  ((old-val (let ((v (tcl-dict-get cur key))) (if (nil? v) "" v))))
                  (let
                    ((new-val (str old-val suffix)))
                    (let
                      ((new-dict (tcl-dict-set-pair cur key new-val)))
                      (assoc (tcl-var-set interp varname new-dict) :result new-dict)))))))
          (else (error (str "dict: unknown subcommand \"" sub "\""))))))))

; --- proc command ---

(define
  tcl-cmd-proc
  (fn
    (interp args)
    (let
      ((name (first args))
        (arg-spec (nth args 1))
        (body (nth args 2)))
      (assoc interp
        :procs (assoc (get interp :procs) name {:args arg-spec :body body})
        :result ""))))

; --- parse uplevel/upvar level argument ---
; Returns absolute level number.
; current-level = len(frame-stack)
(define
  tcl-parse-level
  (fn
    (level-str current-level)
    (if
      (equal? (substring level-str 0 1) "#")
      ; absolute: #N
      (parse-int (substring level-str 1 (string-length level-str)))
      ; relative: N levels up from current
      (- current-level (parse-int level-str)))))

; --- uplevel command ---

(define
  tcl-cmd-uplevel
  (fn
    (interp args)
    (let
      ((current-level (len (get interp :frame-stack))))
      (let
        ; check if first arg is a level specifier
        ((has-level
          (and
            (> (len args) 1)
            (or
              (equal? (substring (first args) 0 1) "#")
              (let
                ((fst (first args)))
                (and
                  (> (string-length fst) 0)
                  (tcl-expr-digit? (substring fst 0 1)))))))
          (level-str (if (and (> (len args) 1) (or (equal? (substring (first args) 0 1) "#") (and (> (string-length (first args)) 0) (tcl-expr-digit? (substring (first args) 0 1))))) (first args) "1"))
          (script (if (and (> (len args) 1) (or (equal? (substring (first args) 0 1) "#") (and (> (string-length (first args)) 0) (tcl-expr-digit? (substring (first args) 0 1))))) (nth args 1) (first args))))
        (let
          ((target-level (tcl-parse-level level-str current-level)))
          (let
            ((full-stack (tcl-full-stack interp)))
            (let
              ((target-frame (tcl-frame-nth full-stack target-level)))
              (let
                ((temp-interp
                  (assoc interp
                    :frame target-frame
                    :frame-stack (take-n (get interp :frame-stack) target-level)
                    :output ""))
                  (saved-output (get interp :output)))
                (let
                  ((result-interp (tcl-eval-string temp-interp script)))
                  (let
                    ((updated-target (get result-interp :frame))
                      (new-output (get result-interp :output)))
                    (let
                      ((new-full-stack (replace-at full-stack target-level updated-target)))
                      (let
                        ((new-frame-stack (take-n new-full-stack (- (len new-full-stack) 1)))
                          (new-current (nth new-full-stack (- (len new-full-stack) 1))))
                        (assoc interp
                          :frame new-current
                          :frame-stack new-frame-stack
                          :result (get result-interp :result)
                          :output (str saved-output new-output)
                          :code (get result-interp :code))))))))))))))

; --- upvar command ---

(define
  tcl-cmd-upvar
  (fn
    (interp args)
    (let
      ((current-level (len (get interp :frame-stack))))
      (let
        ; check if first arg is a level specifier
        ((has-level
          (and
            (> (len args) 2)
            (or
              (equal? (substring (first args) 0 1) "#")
              (tcl-expr-digit? (substring (first args) 0 1)))))
          (level-str (if (and (> (len args) 2) (or (equal? (substring (first args) 0 1) "#") (tcl-expr-digit? (substring (first args) 0 1)))) (first args) "1"))
          (pair-args (if (and (> (len args) 2) (or (equal? (substring (first args) 0 1) "#") (tcl-expr-digit? (substring (first args) 0 1)))) (rest args) args)))
        (let
          ((target-level (tcl-parse-level level-str current-level)))
          (let
            ((bind-pairs
              (fn
                (i-interp remaining)
                (if
                  (< (len remaining) 2)
                  i-interp
                  (let
                    ((remote-name (first remaining))
                      (local-name (nth remaining 1)))
                    (let
                      ((alias {:upvar-level target-level :upvar-name remote-name}))
                      (bind-pairs
                        (assoc i-interp :frame (frame-set-top (get i-interp :frame) local-name alias))
                        (rest (rest remaining)))))))))
            (assoc (bind-pairs interp pair-args) :result "")))))))

; --- global command ---

(define
  tcl-cmd-global
  (fn
    (interp args)
    (reduce
      (fn
        (i name)
        (tcl-cmd-upvar i (list "#0" name name)))
      interp
      args)))

; --- variable command ---

(define
  tcl-cmd-variable
  (fn
    (interp args)
    (let
      ((go
        (fn
          (i remaining)
          (if
            (= 0 (len remaining))
            i
            (let
              ((name (first remaining))
                (rest-rem (rest remaining)))
              (let
                ((linked (tcl-cmd-upvar i (list "#0" name name))))
                (if
                  (and (> (len rest-rem) 0) (not (equal? (substring (first rest-rem) 0 1) "-")))
                  (let
                    ((val (first rest-rem)))
                    (go (assoc (tcl-var-set linked name val) :result "") (rest rest-rem)))
                  (go linked rest-rem))))))))
      (go interp args))))

; --- info command ---

(define
  tcl-cmd-info
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "info: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ; info level
          ((equal? sub "level")
            (assoc interp :result (str (len (get interp :frame-stack)))))
          ; info vars / info locals
          ((or (equal? sub "vars") (equal? sub "locals"))
            (let
              ((frame-locals (get (get interp :frame) :locals)))
              (assoc interp :result
                (tcl-list-build
                  (filter
                    (fn (k) (not (upvar-alias? (get frame-locals k))))
                    (keys frame-locals))))))
          ; info globals
          ((equal? sub "globals")
            (let
              ((global-frame
                (if
                  (= 0 (len (get interp :frame-stack)))
                  (get interp :frame)
                  (first (get interp :frame-stack)))))
              (let
                ((global-locals (get global-frame :locals)))
                (assoc interp :result
                  (tcl-list-build
                    (filter
                      (fn (k) (not (upvar-alias? (get global-locals k))))
                      (keys global-locals)))))))
          ; info commands
          ((equal? sub "commands")
            (assoc interp :result (tcl-list-build (keys (get interp :commands)))))
          ; info procs
          ((equal? sub "procs")
            (assoc interp :result (tcl-list-build (keys (get interp :procs)))))
          ; info args procname
          ((equal? sub "args")
            (let
              ((pname (first rest-args)))
              (let
                ((proc-def (get (get interp :procs) pname)))
                (if
                  (nil? proc-def)
                  (error (str "info args: \"" pname "\" isn't a procedure"))
                  (assoc interp :result (get proc-def :args))))))
          ; info body procname
          ((equal? sub "body")
            (let
              ((pname (first rest-args)))
              (let
                ((proc-def (get (get interp :procs) pname)))
                (if
                  (nil? proc-def)
                  (error (str "info body: \"" pname "\" isn't a procedure"))
                  (assoc interp :result (get proc-def :body))))))
          (else (error (str "info: unknown subcommand \"" sub "\""))))))))

(define
  make-default-tcl-interp
  (fn
    ()
    (let
      ((i (make-tcl-interp)))
      (let
        ((i (tcl-register i "set" tcl-cmd-set)))
        (let
          ((i (tcl-register i "puts" tcl-cmd-puts)))
          (let
            ((i (tcl-register i "incr" tcl-cmd-incr)))
            (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)))
                                              (let
                                                ((i (tcl-register i "scan" tcl-cmd-scan)))
                                                (let
                                                  ((i (tcl-register i "string" tcl-cmd-string)))
                                                  (let
                                                    ((i (tcl-register i "list" tcl-cmd-list)))
                                                    (let
                                                      ((i (tcl-register i "lindex" tcl-cmd-lindex)))
                                                      (let
                                                        ((i (tcl-register i "lrange" tcl-cmd-lrange)))
                                                        (let
                                                          ((i (tcl-register i "llength" tcl-cmd-llength)))
                                                          (let
                                                            ((i (tcl-register i "lreverse" tcl-cmd-lreverse)))
                                                            (let
                                                              ((i (tcl-register i "lsearch" tcl-cmd-lsearch)))
                                                              (let
                                                                ((i (tcl-register i "lsort" tcl-cmd-lsort)))
                                                                (let
                                                                  ((i (tcl-register i "lreplace" tcl-cmd-lreplace)))
                                                                  (let
                                                                    ((i (tcl-register i "linsert" tcl-cmd-linsert)))
                                                                    (let
                                                                      ((i (tcl-register i "concat" tcl-cmd-concat)))
                                                                      (let
                                                                        ((i (tcl-register i "split" tcl-cmd-split)))
                                                                        (let
                                                                          ((i (tcl-register i "join" tcl-cmd-join)))
                                                                          (let
                                                                            ((i (tcl-register i "dict" tcl-cmd-dict)))
                                                                            (let
                                                                              ((i (tcl-register i "proc" tcl-cmd-proc)))
                                                                              (let
                                                                                ((i (tcl-register i "uplevel" tcl-cmd-uplevel)))
                                                                                (let
                                                                                  ((i (tcl-register i "upvar" tcl-cmd-upvar)))
                                                                                  (let
                                                                                    ((i (tcl-register i "global" tcl-cmd-global)))
                                                                                    (let
                                                                                      ((i (tcl-register i "variable" tcl-cmd-variable)))
                                                                                      (tcl-register i "info" tcl-cmd-info))))))))))))))))))))))))))))))))))))))))))))