; Tcl-on-SX runtime evaluator
; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output}
; Requires lib/fiber.sx to be loaded first (provides make-fiber, fiber-resume, fiber-done?)

(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 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {} :current-ns "::" :coro-yield-fn nil}))

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

; True if name starts with "::" (absolute namespace reference; for now we
; treat any "::name" as the global variable `name`). Multi-level namespace
; paths like "::ns::var" are not yet split — they're stored under the
; literal name in the global frame.
; Hot path on every var-get/set; only one char-at on the typical fast path.
(define
  tcl-global-ref?
  (fn (name)
    (and
      (equal? (char-at name 0) ":")
      (equal? (char-at name 1) ":"))))

(define
  tcl-strip-global
  (fn (name)
    (substring name 2 (string-length name))))

(define
  tcl-var-get
  (fn
    (interp name)
    (if
      (tcl-global-ref? name)
      ; absolute reference — look up in global (root) frame
      (let
        ((root-frame
            (let ((stack (get interp :frame-stack)))
              (if (= 0 (len stack)) (get interp :frame) (first stack))))
          (gname (tcl-strip-global name)))
        (let ((val (frame-lookup root-frame gname)))
          (if
            (nil? val)
            (error (str "can't read \"" name "\": no such variable"))
            val)))
      (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)
    (cond
      ((tcl-global-ref? name)
        ; absolute reference — set in global (root) frame
        (let
          ((stack (get interp :frame-stack)) (gname (tcl-strip-global name)))
          (if
            (= 0 (len stack))
            ; no frame stack — current frame is the root
            (assoc interp :frame (frame-set-top (get interp :frame) gname val))
            (let
              ((root-frame (first stack))
                (rest-stack (rest stack)))
              (assoc
                interp
                :frame-stack
                (cons (frame-set-top root-frame gname val) rest-stack))))))
      (else
        (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-ns (let ((ns (get proc-def :ns))) (if (nil? ns) (get interp :current-ns) ns))))
              (let
              ((proc-interp
                (assoc interp
                  :frame bound-frame
                  :frame-stack (append (get interp :frame-stack) (list (get interp :frame)))
                  :output ""
                  :result ""
                  :code 0
                  :current-ns proc-ns))
                (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))))
                      ; Forward state that must escape the proc body —
                      ; :commands, :procs, :fileevents, :timers. Without this
                      ; fileevent registrations made inside a proc body are
                      ; lost on return (broke socket -async accept handlers).
                      (assoc interp
                        :frame updated-caller
                        :frame-stack updated-below
                        :result result-val
                        :output (str caller-output proc-output)
                        :code (if (= code 2) 0 code)
                        :commands (get result-interp :commands)
                        :procs (get result-interp :procs)
                        :fileevents (get result-interp :fileevents)
                        :timers (get result-interp :timers))))))))))))))

(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-entry (tcl-proc-lookup cur-interp cmd-name)))
                  (if
                    (nil? proc-entry)
                    (error (str "unknown command: \"" cmd-name "\""))
                    (tcl-call-proc cur-interp (get proc-entry :name) (get proc-entry :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
      ((no-nl (and (> (len args) 1) (equal? (first args) "-nonewline"))))
      (let
        ((args2 (if no-nl (rest args) args)))
        (let
          ((maybe-chan (if (> (len args2) 1) (first args2) nil))
            (is-chan
              (and
                (not (nil? maybe-chan))
                (or
                  (and
                    (>= (len maybe-chan) 4)
                    (equal? (slice maybe-chan 0 4) "file"))
                  (and
                    (>= (len maybe-chan) 4)
                    (equal? (slice maybe-chan 0 4) "sock"))))))
          (if
            is-chan
            (let
              ((chan (first args2))
                (text (last args2))
                (line (if no-nl text (str text "\n"))))
              (let
                ((_ (channel-write chan line)))
                (assoc interp :result "")))
            (let
              ((text (last args2)) (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) "" (tcl-var-get interp name)))))
        (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-num-float?
  (fn
    (s)
    (let
      loop
      ((i 0))
      (cond
        ((>= i (len s)) false)
        ((or (equal? (nth s i) ".") (equal? (nth s i) "e") (equal? (nth s i) "E"))
          true)
        (else (loop (+ i 1)))))))

(define
  tcl-parse-num
  (fn (s) (if (tcl-num-float? s) (parse-float s) (parse-int s))))

(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-float (first args)) 0))
        (a1 (if (> (len args) 1) (parse-float (nth args 1)) 0)))
      (cond
        ((equal? name "abs") (str (if (< a0 0) (- 0 a0) a0)))
        ((equal? name "int") (str (truncate a0)))
        ((equal? name "double") (str a0))
        ((equal? name "round") (str (round a0)))
        ((equal? name "floor") (str (floor a0)))
        ((equal? name "ceil") (str (ceil a0)))
        ((equal? name "sqrt") (str (sqrt a0)))
        ((equal? name "pow") (str (pow a0 a1)))
        ((equal? name "max") (str (if (>= a0 a1) a0 a1)))
        ((equal? name "min") (str (if (<= a0 a1) a0 a1)))
        ((equal? name "sin") (str (sin a0)))
        ((equal? name "cos") (str (cos a0)))
        ((equal? name "tan") (str (tan a0)))
        ((equal? name "atan") (str (atan a0)))
        ((equal? name "atan2") (str (atan2 a0 a1)))
        ((equal? name "exp") (str (exp a0)))
        ((equal? name "log") (str (log a0)))
        (else (error (str "expr: unknown function: " name)))))))

(define
  tcl-apply-binop
  (fn
    (op l r)
    (let
      ((fl (tcl-num-float? l))
        (fr (tcl-num-float? r))
        (nl (tcl-parse-num l))
        (nr (tcl-parse-num r)))
      (cond
        ((equal? op "+") (str (+ nl nr)))
        ((equal? op "-") (str (- nl nr)))
        ((equal? op "*") (str (* nl nr)))
        ((equal? op "/")
          (if (or fl fr) (str (/ nl nr)) (str (truncate (/ nl nr)))))
        ((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 (< nl nr) "1" "0"))
        ((equal? op ">") (if (> nl nr) "1" "0"))
        ((equal? op "<=") (if (<= nl nr) "1" "0"))
        ((equal? op ">=") (if (>= nl nr) "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 (pow nl nr)))
        (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) ")"))
                  {:tokens (rest after) :value (get inner :value)}
                  (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) ")"))
                  {:tokens (rest after-args) :value (tcl-apply-func tok (get args-r :args))}
                  (error (str "expr: missing ) after function call " tok))))))
          (else {:tokens rest-toks :value tok}))))))

(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)))) {:tokens (get r :tokens) :value (if (tcl-false? (get r :value)) "1" "0")}))
          ((equal? tok "-")
            (let ((r (tcl-expr-parse-unary (rest tokens)))) {:tokens (get r :tokens) :value (str (- 0 (tcl-parse-num (get r :value))))}))
          ((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))))
            {:tokens (get exp-r :tokens) :value (str (pow (tcl-parse-num base-val) (tcl-parse-num (get exp-r :value))))})
          {:tokens rest-toks :value base-val})))))

(define
  tcl-expr-parse-multiplicative-rest
  (fn
    (tokens left)
    (if
      (or
        (= 0 (len tokens))
        (not (contains? (list "*" "/" "%") (first tokens))))
      {:tokens tokens :value left}
      (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))))
      {:tokens tokens :value left}
      (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))))
      {:tokens tokens :value left}
      (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))))
      {:tokens tokens :value left}
      (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) "&&")))
      {:tokens tokens :value left}
      (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) "||")))
      {:tokens tokens :value left}
      (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)})))))))

; Parse -code name/number to integer
(define tcl-cmd-break (fn (interp args) (assoc interp :code 3)))

; Parse return options from args list
; Returns {:code N :result val :errorinfo str :errorcode str}
(define tcl-cmd-continue (fn (interp args) (assoc interp :code 4)))

(define
  tcl-return-code-num
  (fn
    (s)
    (cond
      ((equal? s "ok") 0)
      ((equal? s "error") 1)
      ((equal? s "return") 2)
      ((equal? s "break") 3)
      ((equal? s "continue") 4)
      (else (parse-int s)))))

(define
  tcl-parse-return-opts
  (fn
    (args)
    (let
      ((go (fn (remaining code ei ec) (if (or (= 0 (len remaining)) (not (equal? (substring (first remaining) 0 1) "-"))) {:result (if (> (len remaining) 0) (first remaining) "") :errorinfo ei :errorcode ec :code code} (let ((flag (first remaining)) (rest1 (rest remaining))) (cond ((equal? flag "-code") (if (= 0 (len rest1)) {:result "" :errorinfo ei :errorcode ec :code code} (go (rest rest1) (tcl-return-code-num (first rest1)) ei ec))) ((equal? flag "-errorinfo") (if (= 0 (len rest1)) {:result "" :errorinfo "" :errorcode ec :code code} (go (rest rest1) code (first rest1) ec))) ((equal? flag "-errorcode") (if (= 0 (len rest1)) {:result "" :errorinfo ei :errorcode "" :code code} (go (rest rest1) code ei (first rest1)))) ((equal? flag "-level") (if (= 0 (len rest1)) {:result "" :errorinfo ei :errorcode ec :code code} (go (rest rest1) code ei ec))) (else {:result flag :errorinfo ei :errorcode ec :code code})))))))
      (go args 2 "" ""))))

; --- catch command ---
; catch script ?resultVar? ?optionsVar?
(define
  tcl-cmd-return
  (fn
    (interp args)
    (let
      ((opts (tcl-parse-return-opts args)))
      (assoc
        interp
        :result (get opts :result)
        :code (get opts :code)
        :errorinfo (get opts :errorinfo)
        :errorcode (get opts :errorcode)))))

; --- throw command ---
; throw type message
(define
  tcl-cmd-error
  (fn
    (interp args)
    (let
      ((msg (if (> (len args) 0) (first args) "error"))
        (ei (if (> (len args) 1) (nth args 1) ""))
        (ec (if (> (len args) 2) (nth args 2) "")))
      (assoc interp :result msg :code 1 :errorinfo ei :errorcode ec))))

; --- try command ---
; try script ?on code var body? ... ?finally body?
(define
  tcl-cmd-catch
  (fn
    (interp args)
    (let
      ((script (first args))
        (result-var
          (if (> (len args) 1) (nth args 1) nil))
        (opts-var (if (> (len args) 2) (nth args 2) nil)))
      (let
        ((sub-interp (assoc interp :code 0 :result "" :output ""))
          (caller-output (get interp :output)))
        (let
          ((result-interp (tcl-eval-string sub-interp script)))
          (let
            ((rc (get result-interp :code))
              (rv (get result-interp :result))
              (rei (get result-interp :errorinfo))
              (rec (get result-interp :errorcode))
              (sub-output (get result-interp :output)))
            (let
              ((merged (assoc result-interp :code 0 :result (str rc) :output (str caller-output sub-output))))
              (let
                ((after-rv (if (nil? result-var) merged (tcl-var-set merged result-var rv))))
                (let
                  ((opts-str (str "-code " rc " -errorinfo " (if (equal? rei "") "{}" rei) " -errorcode " (if (equal? rec "") "{}" rec))))
                  (let
                    ((after-opts (if (nil? opts-var) after-rv (tcl-var-set after-rv opts-var opts-str))))
                    (assoc after-opts :result (str rc))))))))))))

(define
  tcl-cmd-throw
  (fn
    (interp args)
    (let
      ((ec (if (> (len args) 0) (first args) ""))
        (msg (if (> (len args) 1) (nth args 1) "")))
      (assoc interp :result msg :code 1 :errorcode ec :errorinfo ""))))

(define
  tcl-try-code-matches?
  (fn
    (code-str rc)
    (cond
      ((equal? code-str "ok") (= rc 0))
      ((equal? code-str "error") (= rc 1))
      ((equal? code-str "return") (= rc 2))
      ((equal? code-str "break") (= rc 3))
      ((equal? code-str "continue") (= rc 4))
      (else (= rc (parse-int code-str))))))

; trap pattern is a list; matches errorcode list if pattern is a prefix.
(define tcl-try-trap-matches? (fn (pattern-str errorcode-str rc) (if (not (= rc 1)) false (let ((pat-elems (tcl-list-split pattern-str)) (ec-elems (tcl-list-split errorcode-str))) (if (> (len pat-elems) (len ec-elems)) false (let ((all-eq? (fn (i lim) (if (>= i lim) true (if (equal? (nth pat-elems i) (nth ec-elems i)) (all-eq? (+ i 1) lim) false))))) (all-eq? 0 (len pat-elems))))))))

; Brace if needs quoting for inclusion in a flat dict string.
(define tcl-try-brace-if-needed (fn (s) (if (or (equal? s "") (contains? (split s "") " ")) (str "{" s "}") s)))

; Build the -options dict that try clause varlist captures as 2nd arg.
(define tcl-try-build-opts (fn (rc rei rec) (str "-code " rc " -level 0 -errorcode " (tcl-try-brace-if-needed rec) " -errorinfo " (tcl-try-brace-if-needed rei))))

(define
  tcl-cmd-try
  (fn
    (interp args)
    (let
      ((script (first args)) (rest-args (rest args)))
      (let
        ((parse-clauses (fn (remaining acc) (if (= 0 (len remaining)) acc (let ((kw (first remaining))) (cond ((equal? kw "on") (if (< (len remaining) 4) acc (parse-clauses (slice remaining 4 (len remaining)) (append acc (list {:body (nth remaining 3) :code (nth remaining 1) :type "on" :var (nth remaining 2)}))))) ((equal? kw "trap") (if (< (len remaining) 4) acc (parse-clauses (slice remaining 4 (len remaining)) (append acc (list {:body (nth remaining 3) :pattern (nth remaining 1) :type "trap" :var (nth remaining 2)}))))) ((equal? kw "finally") (if (< (len remaining) 2) acc (parse-clauses (slice remaining 2 (len remaining)) (append acc (list {:body (nth remaining 1) :type "finally"}))))) (else acc))))))
          (clauses (parse-clauses rest-args (list))))
        (let
          ((sub-interp (assoc interp :code 0 :result ""))
            (caller-output (get interp :output)))
          (let
            ((result-interp (tcl-eval-string sub-interp script)))
            (let
              ((rc (get result-interp :code))
                (rv (get result-interp :result))
                (rei (get result-interp :errorinfo))
                (rec (get result-interp :errorcode))
                (sub-output (get result-interp :output)))
              (let
                ((find-clause (fn (cs) (if (= 0 (len cs)) nil (let ((c (first cs))) (cond ((and (equal? (get c :type) "on") (tcl-try-code-matches? (get c :code) rc)) c) ((and (equal? (get c :type) "trap") (tcl-try-trap-matches? (get c :pattern) rec rc)) c) (else (find-clause (rest cs))))))))
                  (matched (find-clause clauses))
                  (finally-clause
                    (reduce
                      (fn
                        (acc c)
                        (if (equal? (get c :type) "finally") c acc))
                      nil
                      clauses)))
                (let
                  ((after-handler (if (nil? matched) (assoc result-interp :output (str caller-output sub-output)) (let ((handler-interp (assoc result-interp :code 0 :output (str caller-output sub-output))) (vars (tcl-list-split (get matched :var)))) (let ((bound1 (if (>= (len vars) 1) (tcl-var-set handler-interp (first vars) rv) handler-interp))) (let ((bound2 (if (>= (len vars) 2) (tcl-var-set bound1 (nth vars 1) (tcl-try-build-opts rc rei rec)) bound1))) (tcl-eval-string bound2 (get matched :body))))))))
                  (let
                    ((final-result (if (nil? finally-clause) after-handler (let ((fi (tcl-eval-string (assoc after-handler :code 0) (get finally-clause :body)))) (if (= (get fi :code) 0) (assoc fi :code (get after-handler :code) :result (get after-handler :result)) fi)))))
                    final-result))))))))))

(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) "" (tcl-var-get interp name)))))
        (let
          ((quoted-items (map tcl-list-quote-elem items)))
          (let
            ((new-val (if (equal? cur "") (join " " quoted-items) (str cur " " (join " " quoted-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))))))

; Format helper: repeat char ch n times, building pad string
(define tcl-cmd-gets (fn (interp args) (assoc interp :result "")))

; Format helper: pad string s to width w
(define
  tcl-cmd-subst
  (fn (interp args) (assoc interp :result (last args))))

; Format helper: scan flag characters
(define
  tcl-fmt-make-pad
  (fn
    (ch cnt acc)
    (if
      (<= cnt 0)
      acc
      (tcl-fmt-make-pad ch (- cnt 1) (str ch acc)))))

; Format helper: scan digits for width/precision
(define
  tcl-fmt-pad
  (fn
    (s width zero-pad? left-align?)
    (let
      ((w (if (equal? width "") 0 (parse-int width))))
      (let
        ((pad-len (- w (string-length s))))
        (if
          (<= pad-len 0)
          s
          (let
            ((pad (tcl-fmt-make-pad (if zero-pad? "0" " ") pad-len "")))
            (if left-align? (str s pad) (str pad s))))))))

; Main format apply: process chars, produce output string
(define
  tcl-fmt-scan-flags
  (fn
    (chars j flags)
    (if
      (>= j (len chars))
      {:j j :flags flags}
      (let
        ((ch (nth chars j)))
        (if
          (contains? (list "-" "0" "+" " " "#") ch)
          (tcl-fmt-scan-flags chars (+ j 1) (str flags ch))
          {:j j :flags flags})))))

(define
  tcl-fmt-scan-num
  (fn
    (chars j acc-n)
    (if
      (>= j (len chars))
      {:num acc-n :j j}
      (let
        ((ch (nth chars j)))
        (if
          (tcl-expr-digit? ch)
          (tcl-fmt-scan-num chars (+ j 1) (str acc-n ch))
          {:num acc-n :j j})))))

; Walk format string char by char; dispatch each %spec to printf-spec.
(define
  tcl-fmt-apply
  (fn
    (chars n-len fmt-args i arg-idx acc)
    (if
      (>= i n-len)
      acc
      (let
        ((c (nth chars i)))
        (if
          (not (equal? c "%"))
          (tcl-fmt-apply
            chars
            n-len
            fmt-args
            (+ i 1)
            arg-idx
            (str acc c))
          (let
            ((i2 (+ i 1)))
            (if
              (>= i2 n-len)
              (str acc "%")
              (if
                (equal? (nth chars i2) "%")
                ; literal %%
                (tcl-fmt-apply chars n-len fmt-args (+ i2 1) arg-idx (str acc "%"))
                ; dispatch via printf-spec
                (let
                  ((j (tcl-fmt-find-end chars i2 n-len)))
                  (if
                    (>= j n-len)
                    (str acc "?")
                    (let
                      ((spec (str "%" (join "" (slice chars i2 (+ j 1)))))
                        (cur-arg
                          (if
                            (< arg-idx (len fmt-args))
                            (nth fmt-args arg-idx)
                            "")))
                      (tcl-fmt-apply
                        chars
                        n-len
                        fmt-args
                        (+ j 1)
                        (+ arg-idx 1)
                        (str acc (printf-spec spec cur-arg))))))))))))))

; --- string command helpers ---

; glob match: pattern chars list, string chars list
(define
  tcl-cmd-format
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "format: wrong # args")
      (let
        ((fmt-str (first args)) (fmt-args (rest args)))
        (let
          ((chars (split fmt-str "")) (n-len (string-length fmt-str)))
          (assoc
            interp
            :result (tcl-fmt-apply chars n-len fmt-args 0 0 "")))))))

; scan str fmt ?varName ...?  — printf-style parse.
; Returns count of successful conversions. If varNames given, sets each to
; its conversion result; otherwise returns the values as a list.
(define
  tcl-cmd-scan
  (fn
    (interp args)
    (if
      (< (len args) 2)
      (error "scan: wrong # args")
      (let
        ((input (first args))
          (fmt (nth args 1))
          (var-names (slice args 2 (len args))))
        (let
          ((parsed
              (tcl-scan-loop
                input
                (split fmt "")
                (string-length fmt)
                0
                0
                (list))))
          (if
            (= 0 (len var-names))
            (assoc interp :result (tcl-list-build parsed))
            (let
              ((bind-loop
                  (fn
                    (i-interp i)
                    (if
                      (>= i (len var-names))
                      i-interp
                      (let
                        ((v (if (< i (len parsed)) (str (nth parsed i)) "")))
                        (bind-loop (tcl-var-set i-interp (nth var-names i) v) (+ i 1)))))))
              (let ((bound (bind-loop interp 0)))
                (assoc bound :result (str (len parsed)))))))))))

; Loop helper: walk format chars, dispatch each %spec to scan-spec.
(define
  tcl-scan-loop
  (fn
    (input fmt-chars n-fmt fi pos values)
    (if
      (>= fi n-fmt)
      values
      (let
        ((c (nth fmt-chars fi)))
        (cond
          ((equal? c "%")
            (if
              (>= (+ fi 1) n-fmt)
              values
              (let
                ((j (tcl-fmt-find-end fmt-chars (+ fi 1) n-fmt)))
                (if
                  (>= j n-fmt)
                  values
                  (let
                    ((spec (str "%" (join "" (slice fmt-chars (+ fi 1) (+ j 1)))))
                      (rem-str (substring input pos (string-length input))))
                    (let
                      ((r (scan-spec spec rem-str)))
                      (if
                        (nil? r)
                        values
                        (tcl-scan-loop
                          input
                          fmt-chars
                          n-fmt
                          (+ j 1)
                          (+ pos (get r :consumed))
                          (append values (list (str (get r :value))))))))))))
          ((or (equal? c " ") (equal? c "\t") (equal? c "\n"))
            (tcl-scan-loop
              input
              fmt-chars
              n-fmt
              (+ fi 1)
              (tcl-skip-ws input pos)
              values))
          (else
            (if
              (and
                (< pos (string-length input))
                (equal? c (substring input pos (+ pos 1))))
              (tcl-scan-loop input fmt-chars n-fmt (+ fi 1) (+ pos 1) values)
              values)))))))

; Find end of a printf spec starting at fi (after '%'). Returns index of
; the conversion character.
(define
  tcl-fmt-find-end
  (fn
    (chars i n)
    (if
      (>= i n)
      i
      (let
        ((c (nth chars i)))
        (cond
          ((or (equal? c "-") (equal? c "+") (equal? c " ") (equal? c "0") (equal? c "#"))
            (tcl-fmt-find-end chars (+ i 1) n))
          ((or (equal? c ".") (and (>= c "0") (<= c "9")))
            (tcl-fmt-find-end chars (+ i 1) n))
          (else i))))))

(define
  tcl-skip-ws
  (fn
    (input pos)
    (if
      (>= pos (string-length input))
      pos
      (let
        ((c (substring input pos (+ pos 1))))
        (if
          (or (equal? c " ") (equal? c "\t") (equal? c "\n"))
          (tcl-skip-ws input (+ pos 1))
          pos)))))

(define
  tcl-glob-match
  (fn
    (pat-chars str-chars)
    (cond
      ((and (= 0 (len pat-chars)) (= 0 (len str-chars)))
        true)
      ((= 0 (len pat-chars)) false)
      ((equal? (first pat-chars) "*")
        (let
          ((rest-pat (rest pat-chars)))
          (if
            (tcl-glob-match rest-pat str-chars)
            true
            (if
              (= 0 (len str-chars))
              false
              (tcl-glob-match pat-chars (rest str-chars))))))
      ((= 0 (len str-chars)) false)
      ((equal? (first pat-chars) "?")
        (tcl-glob-match (rest pat-chars) (rest str-chars)))
      ((equal? (first pat-chars) (first str-chars))
        (tcl-glob-match (rest pat-chars) (rest str-chars)))
      (else false))))

; strip chars from left
(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))))

; strip chars from right (reverse, trim left, reverse)
(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))))

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

; default whitespace set
(define
  tcl-reverse-list
  (fn (lst) (reduce (fn (acc x) (append (list x) acc)) (list) lst)))

; string map: apply flat list of pairs old→new to string
(define
  tcl-trim-right-chars
  (fn
    (chars strip-set)
    (tcl-reverse-list
      (tcl-trim-left-chars (tcl-reverse-list chars) strip-set))))

; string first: index of needle in haystack starting at start
(define tcl-ws-set (list " " "\t" "\n" "\r"))

; string last: last index of needle in haystack up to end
(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 is: check string class
(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))))))

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


; --- list command helpers ---

; Quote a single list element: add braces if it contains a space or is empty
(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"))
        ((equal? class "true")
          (if
            (or (equal? s "1") (equal? s "true") (equal? s "yes") (equal? s "on"))
            "1"
            "0"))
        ((equal? class "false")
          (if
            (or (equal? s "0") (equal? s "false") (equal? s "no") (equal? s "off"))
            "1"
            "0"))
        ((equal? class "xdigit")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn
                  (ok c)
                  (and
                    ok
                    (or
                      (tcl-expr-digit? c)
                      (or
                        (and (>= c "a") (<= c "f"))
                        (and (>= c "A") (<= c "F"))))))
                true
                chars)
              "1"
              "0")))
        ((equal? class "ascii")
          (if
            (= n 0)
            "1"
            (if
              (reduce
                (fn (ok c) (and ok (and (>= c " ") (<= c "~"))))
                true
                chars)
              "1"
              "0")))
        (else "0")))))

; Build a Tcl list string from an SX list of string elements
(define
  tcl-cmd-string
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "string: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((equal? sub "length")
            (assoc interp :result (str (string-length (first rest-args)))))
          ((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)))))))
          ((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))))))))
          ((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")))))
          ((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"))))
          ((equal? sub "toupper")
            (let
              ((s (first rest-args)))
              (assoc
                interp
                :result (join "" (map tcl-upcase-char (split s ""))))))
          ((equal? sub "tolower")
            (let
              ((s (first rest-args)))
              (assoc
                interp
                :result (join "" (map tcl-downcase-char (split s ""))))))
          ((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))))))
          ((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)))))
          ((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)))))
          ((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)))))
          ((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 "")))))
          ((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))))
          ((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))))
          ((equal? sub "is")
            (let
              ((class (first rest-args)) (s (nth rest-args 1)))
              (assoc interp :result (tcl-string-is class s))))
          ((equal? sub "cat") (assoc interp :result (join "" rest-args)))
          ((equal? sub "equal")
            ; string equal ?-nocase? ?-length n? s1 s2
            (let
              ((nocase?
                  (reduce (fn (a w) (or a (equal? w "-nocase"))) false rest-args))
                (length-pos
                  (let ((find-loop (fn (i) (cond ((>= i (- (len rest-args) 1)) -1) ((equal? (nth rest-args i) "-length") i) (else (find-loop (+ i 1))))))) (find-loop 0)))
                (cleaned (filter (fn (w) (not (equal? w "-nocase"))) rest-args)))
              (let
                ((cleaned2
                    (if
                      (>= length-pos 0)
                      (filter
                        (fn (w) (and (not (equal? w "-length")) (not (equal? w (nth rest-args (+ length-pos 1))))))
                        cleaned)
                      cleaned)))
                (if
                  (< (len cleaned2) 2)
                  (error "string equal: wrong # args")
                  (let
                    ((s1 (first cleaned2)) (s2 (nth cleaned2 1)))
                    (let
                      ((c1 (if nocase? (join "" (map tcl-downcase-char (split s1 ""))) s1))
                        (c2 (if nocase? (join "" (map tcl-downcase-char (split s2 ""))) s2)))
                      (assoc interp :result (if (equal? c1 c2) "1" "0"))))))))
          ((equal? sub "totitle")
            (let
              ((s (first rest-args)))
              (let
                ((chars (split s "")))
                (assoc
                  interp
                  :result (if
                    (= 0 (len chars))
                    ""
                    (str
                      (tcl-upcase-char (first chars))
                      (join "" (map tcl-downcase-char (rest chars)))))))))
          ((equal? sub "reverse")
            (let
              ((s (first rest-args)))
              (assoc interp :result (join "" (reverse (split s ""))))))
          ((equal? sub "replace")
            ; string replace s first last ?newstring?
            (let
              ((s (first rest-args))
                (n (string-length (first rest-args)))
                (fi (parse-int (nth rest-args 1)))
                (li (parse-int (nth rest-args 2)))
                (newstr (if (> (len rest-args) 3) (nth rest-args 3) "")))
              (let
                ((f (if (< fi 0) 0 fi))
                  (l (if (>= li n) (- n 1) li)))
                (if
                  (or (> f l) (>= f n))
                  (assoc interp :result s)
                  (let
                    ((before (substring s 0 f))
                      (after (substring s (+ l 1) n)))
                    (assoc interp :result (str before newstr after)))))))
          (else (error (str "string: unknown subcommand: " sub))))))))

; Resolve "end" index to numeric value given list length
(define
  tcl-list-quote-elem
  (fn
    (elem)
    (if
      (or (equal? elem "") (contains? (split elem "") " "))
      (str "{" elem "}")
      elem)))

; Insertion sort for list commands (comparator: fn(a b) -> true if a before b)
(define
  tcl-list-build
  (fn (elems) (join " " (map tcl-list-quote-elem elems))))

(define
  tcl-end-index
  (fn (s n) (if (equal? s "end") (- n 1) (parse-int s))))

; --- list commands ---

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

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

; lassign list var ?var ...?  → assigns elements to vars; returns
; remaining unassigned elements as a list (empty string if all consumed)
(define
  tcl-cmd-lassign
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "lassign: wrong # args")
      (let
        ((elems (tcl-list-split (first args))) (vars (rest args)))
        (let
          ((bind-loop
              (fn
                (i-interp i)
                (if
                  (>= i (len vars))
                  i-interp
                  (let
                    ((var (nth vars i))
                      (val (if (< i (len elems)) (nth elems i) "")))
                    (bind-loop (tcl-var-set i-interp var val) (+ i 1)))))))
          (let
            ((bound (bind-loop interp 0)))
            (let
              ((leftover
                  (if
                    (> (len elems) (len vars))
                    (slice elems (len vars) (len elems))
                    (list))))
              (assoc bound :result (tcl-list-build leftover)))))))))

; lrepeat count ?elem ...?  → list with elem...  repeated count times
(define
  tcl-cmd-lrepeat
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "lrepeat: wrong # args")
      (let
        ((n (parse-int (first args))) (elems (rest args)))
        (if
          (or (< n 0) (= 0 (len elems)))
          (assoc interp :result "")
          (let
            ((build
                (fn
                  (i acc)
                  (if (= i 0) acc (build (- i 1) (append acc elems))))))
            (assoc interp :result (tcl-list-build (build n (list))))))))))

; lset varname index value  → set element at index in list-valued variable
(define
  tcl-cmd-lset
  (fn
    (interp args)
    (if
      (< (len args) 3)
      (error "lset: wrong # args")
      (let
        ((varname (first args))
          (idx (parse-int (nth args 1)))
          (val (nth args 2)))
        (let
          ((cur (tcl-var-get interp varname)))
          (let
            ((elems (tcl-list-split cur)))
            (if
              (or (< idx 0) (>= idx (len elems)))
              (error (str "lset: index out of range " idx))
              (let
                ((new-list (replace-at elems idx val)))
                (let
                  ((new-str (tcl-list-build new-list)))
                  (assoc
                    (tcl-var-set interp varname new-str)
                    :result new-str))))))))))

; lmap helper: like foreach-loop but collects body results
(define
  tcl-lmap-loop
  (fn
    (interp varname items body acc)
    (if
      (= 0 (len items))
      (assoc interp :result (tcl-list-build acc))
      (let
        ((body-result (tcl-eval-string (tcl-var-set interp varname (first items)) body)))
        (let
          ((code (get body-result :code)))
          (cond
            ((= code 3) (assoc (assoc body-result :code 0) :result (tcl-list-build acc)))
            ((= code 4) (tcl-lmap-loop (assoc body-result :code 0) varname (rest items) body acc))
            ((= code 2) body-result)
            ((= code 1) body-result)
            (else
              (tcl-lmap-loop
                (assoc body-result :code 0)
                varname
                (rest items)
                body
                (append acc (list (get body-result :result)))))))))))

(define
  tcl-cmd-lmap
  (fn
    (interp args)
    (if
      (< (len args) 3)
      (error "lmap: wrong # args")
      (let
        ((varname (first args))
          (list-str (nth args 1))
          (body (nth args 2)))
        (tcl-lmap-loop interp varname (tcl-list-split list-str) body (list))))))

; --- dict command helpers ---

; Parse flat dict string into SX list of [key val] pairs
(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))))))

; Build flat dict string from SX list of [key val] pairs
(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)))))

; Get value for key from flat dict string; returns nil if missing
(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))))))

; Set key=val in flat dict string; returns new flat dict string
(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))))

; Remove key from flat dict string; returns new flat dict string
(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)))))

; --- dict command ---

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

; --- namespace helpers ---

; Normalize a namespace name to fully-qualified form: ::ns
; Accepts: "ns", "::ns", "ns::", "::ns::", "" → "::"
(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)))))

; Test whether string s starts with prefix p
(define
  tcl-cmd-dict
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "dict: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((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))))
          ((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)))))
          ((equal? sub "set")
            (let
              ((varname (first rest-args))
                (key (nth rest-args 1))
                (val (nth rest-args 2)))
              (let
                ((cur (let ((v (if (nil? (frame-lookup (get interp :frame) varname)) nil (tcl-var-get interp 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)))))
          ((equal? sub "unset")
            (let
              ((varname (first rest-args))
                (key (nth rest-args 1)))
              (let
                ((cur (let ((v (if (nil? (frame-lookup (get interp :frame) varname)) nil (tcl-var-get interp 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)))))
          ((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"))))
          ((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))))))
          ((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))))))
          ((equal? sub "size")
            (let
              ((dict-str (first rest-args)))
              (assoc
                interp
                :result (str (len (tcl-dict-to-pairs dict-str))))))
          ((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))))))
          ((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 (if (nil? (frame-lookup (get interp :frame) varname)) nil (tcl-var-get interp 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)))))))))
          ((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)))
          ((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 (if (nil? (frame-lookup (get interp :frame) varname)) nil (tcl-var-get interp 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)))))))
          ((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 (if (nil? (frame-lookup (get interp :frame) varname)) nil (tcl-var-get interp 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)))))))
          ((equal? sub "lappend")
            ; dict lappend dictVarName key elem ?elem ...?
            (let
              ((varname (first rest-args))
                (key (nth rest-args 1))
                (new-elems (slice rest-args 2 (len rest-args))))
              (let
                ((cur (let ((v (if (nil? (frame-lookup (get interp :frame) varname)) nil (tcl-var-get interp varname)))) (if (nil? v) "" v))))
                (let
                  ((old-val (let ((v (tcl-dict-get cur key))) (if (nil? v) "" v))))
                  (let
                    ((merged (tcl-list-build (append (tcl-list-split old-val) new-elems))))
                    (let
                      ((new-dict (tcl-dict-set-pair cur key merged)))
                      (assoc
                        (tcl-var-set interp varname new-dict)
                        :result new-dict)))))))
          ((equal? sub "remove")
            ; dict remove dict ?key ...?
            (let
              ((dict-str (first rest-args))
                (keys-to-remove (rest rest-args)))
              (assoc
                interp
                :result (reduce
                  (fn (acc k) (tcl-dict-unset-key acc k))
                  dict-str
                  keys-to-remove))))
          ((equal? sub "filter")
            ; dict filter dict key pattern  — only `key` filter supported
            (let
              ((dict-str (first rest-args))
                (mode (nth rest-args 1))
                (pattern (nth rest-args 2)))
              (if
                (not (equal? mode "key"))
                (error (str "dict filter: only key filter implemented, got " mode))
                (let
                  ((kept
                      (filter
                        (fn (pair) (tcl-glob-match (split pattern "") (split (first pair) "")))
                        (tcl-dict-to-pairs dict-str))))
                  (assoc
                    interp
                    :result (tcl-dict-from-pairs kept))))))
          (else (error (str "dict: unknown subcommand \"" sub "\""))))))))

; Qualify a proc name relative to current-ns.
; If name already starts with :: return as-is.
; Otherwise prepend current-ns:: (or :: if current-ns is ::).
(define
  tcl-ns-normalize
  (fn
    (ns)
    (if
      (or (equal? ns "") (equal? ns "::"))
      "::"
      (let
        ((stripped (if (equal? (substring ns (- (string-length ns) 2) (string-length ns)) "::") (substring ns 0 (- (string-length ns) 2)) ns)))
        (if
          (equal? (substring stripped 0 2) "::")
          stripped
          (str "::" stripped))))))

; Look up a command by name with namespace resolution.
; Try: exact name → ::current-ns::name → ::name
(define
  tcl-starts-with?
  (fn
    (s p)
    (let
      ((pl (string-length p)) (sl (string-length s)))
      (if (> pl sl) false (equal? (substring s 0 pl) p)))))

; Get all proc names in a namespace (returns list of fully-qualified names)
(define
  tcl-qualify-name
  (fn
    (name current-ns)
    (if
      (tcl-starts-with? name "::")
      name
      (if
        (equal? current-ns "::")
        (str "::" name)
        (str current-ns "::" name)))))

; Check if a namespace exists (has any procs)
(define
  tcl-proc-lookup
  (fn
    (interp name)
    (let
      ((procs (get interp :procs)) (current-ns (get interp :current-ns)))
      (let
        ((exact (get procs name)))
        (if
          (not (nil? exact))
          {:def exact :name name}
          (let
            ((qualified (tcl-qualify-name name current-ns)))
            (let
              ((qual-def (get procs qualified)))
              (if
                (not (nil? qual-def))
                {:def qual-def :name qualified}
                (let
                  ((global-name (str "::" name)))
                  (let
                    ((global-def (get procs global-name)))
                    (if (not (nil? global-def)) {:def global-def :name global-name} nil)))))))))))

; Extract last component from qualified name ::ns::foo → foo
(define
  tcl-ns-procs
  (fn
    (procs ns)
    (let
      ((prefix (if (equal? ns "::") "::" (str ns "::"))))
      (filter
        (fn
          (k)
          (if
            (equal? ns "::")
            (and
              (tcl-starts-with? k "::")
              (not
                (tcl-starts-with?
                  (substring k 2 (string-length k))
                  "::")))
            (tcl-starts-with? k prefix)))
        (keys procs)))))

; --- proc command ---

(define
  tcl-ns-exists?
  (fn (procs ns) (> (len (tcl-ns-procs procs ns)) 0)))

; --- parse uplevel/upvar level argument ---
; Returns absolute level number.
; current-level = len(frame-stack)
(define
  tcl-ns-tail
  (fn
    (name)
    (let
      ((parts (filter (fn (p) (not (equal? p ""))) (split name ":"))))
      (if
        (= 0 (len parts))
        name
        (nth parts (- (len parts) 1))))))

; --- uplevel command ---

(define
  tcl-cmd-proc
  (fn
    (interp args)
    (let
      ((raw-name (first args))
        (arg-spec (nth args 1))
        (body (nth args 2)))
      (let
        ((name (tcl-qualify-name raw-name (get interp :current-ns))))
        (let
          ((proc-ns (let ((parts (filter (fn (p) (not (equal? p ""))) (split name ":")))) (if (<= (len parts) 1) "::" (str "::" (join "::" (take-n parts (- (len parts) 1))))))))
          (assoc
            interp
            :procs (assoc (get interp :procs) name {:args arg-spec :body body :ns proc-ns})
            :result ""))))))

; --- upvar command ---

(define
  tcl-parse-level
  (fn
    (level-str current-level)
    (if
      (equal? (substring level-str 0 1) "#")
      (parse-int (substring level-str 1 (string-length level-str)))
      (- current-level (parse-int level-str)))))

; --- global command ---

(define
  tcl-cmd-uplevel
  (fn
    (interp args)
    (let
      ((current-level (len (get interp :frame-stack))))
      (let
        ((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))))))))))))))

; --- variable command ---

(define
  tcl-cmd-upvar
  (fn
    (interp args)
    (let
      ((current-level (len (get interp :frame-stack))))
      (let
        ((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-name remote-name :upvar-level target-level})) (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 "")))))))

; --- namespace command ---

; namespace ensemble dispatch fn for a given ns and map
(define
  tcl-cmd-global
  (fn
    (interp args)
    (reduce
      (fn (i name) (tcl-cmd-upvar i (list "#0" name name)))
      interp
      args)))

(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-make-ensemble
  (fn
    (procs ns map-dict)
    (fn
      (interp args)
      (if
        (= 0 (len args))
        (error (str "wrong # args: ensemble \"" ns "\" requires subcommand"))
        (let
          ((subcmd (first args)) (rest-args (rest args)))
          (let
            ((target-name (tcl-dict-get map-dict subcmd)))
            (if
              (not (nil? target-name))
              (let
                ((proc-entry (tcl-proc-lookup interp target-name)))
                (if
                  (nil? proc-entry)
                  (error
                    (str "ensemble: command \"" target-name "\" not found"))
                  (tcl-call-proc
                    interp
                    (get proc-entry :name)
                    (get proc-entry :def)
                    rest-args)))
              (error
                (str
                  "unknown or ambiguous subcommand \""
                  subcmd
                  "\": must be one of "
                  (join ", " (map first (tcl-dict-to-pairs map-dict))))))))))))

; --- coroutine support ---

; yield: inside a coroutine body, record a yielded value
(define
  tcl-cmd-namespace
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "namespace: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((equal? sub "eval")
            (let
              ((ns-raw (if (> (len rest-args) 0) (first rest-args) ""))
                (body
                  (if
                    (> (len rest-args) 1)
                    (nth rest-args 1)
                    "")))
              (let
                ((ns (let ((normalized (tcl-ns-normalize ns-raw)) (current-ns (get interp :current-ns))) (if (tcl-starts-with? ns-raw "::") normalized (if (equal? current-ns "::") normalized (str current-ns "::" (tcl-ns-tail normalized))))))
                  (saved-ns (get interp :current-ns)))
                (let
                  ((ns-interp (assoc interp :current-ns ns)))
                  (let
                    ((result-interp (tcl-eval-string ns-interp body)))
                    (assoc result-interp :current-ns saved-ns))))))
          ((equal? sub "current")
            (assoc interp :result (get interp :current-ns)))
          ((equal? sub "which")
            (let
              ((name (if (and (> (len rest-args) 0) (equal? (first rest-args) "-command")) (if (> (len rest-args) 1) (nth rest-args 1) "") (if (> (len rest-args) 0) (first rest-args) ""))))
              (let
                ((entry (tcl-proc-lookup interp name)))
                (if
                  (nil? entry)
                  (assoc interp :result "")
                  (assoc interp :result (get entry :name))))))
          ((equal? sub "exists")
            (let
              ((ns (tcl-ns-normalize (if (> (len rest-args) 0) (first rest-args) ""))))
              (assoc
                interp
                :result (if (tcl-ns-exists? (get interp :procs) ns) "1" "0"))))
          ((equal? sub "delete")
            (let
              ((ns (tcl-ns-normalize (if (> (len rest-args) 0) (first rest-args) ""))))
              (let
                ((prefix (if (equal? ns "::") "::" (str ns "::"))))
                (let
                  ((remaining-procs (reduce (fn (acc k) (if (tcl-starts-with? k prefix) acc (assoc acc k (get (get interp :procs) k)))) {} (keys (get interp :procs)))))
                  (assoc interp :procs remaining-procs :result "")))))
          ((equal? sub "export") (assoc interp :result ""))
          ((equal? sub "import")
            (let
              ((target-name (if (> (len rest-args) 0) (first rest-args) "")))
              (let
                ((tail (tcl-ns-tail target-name))
                  (entry (tcl-proc-lookup interp target-name)))
                (if
                  (nil? entry)
                  (error
                    (str "namespace import: \"" target-name "\" not found"))
                  (let
                    ((local-name (tcl-qualify-name tail (get interp :current-ns))))
                    (assoc
                      interp
                      :procs (assoc (get interp :procs) local-name (get entry :def))
                      :result ""))))))
          ((equal? sub "forget")
            (let
              ((name (if (> (len rest-args) 0) (first rest-args) "")))
              (let
                ((qualified (tcl-qualify-name name (get interp :current-ns))))
                (let
                  ((new-procs (reduce (fn (acc k) (if (equal? k qualified) acc (assoc acc k (get (get interp :procs) k)))) {} (keys (get interp :procs)))))
                  (assoc interp :procs new-procs :result "")))))
          ((equal? sub "path") (assoc interp :result ""))
          ((equal? sub "ensemble")
            (if
              (and
                (> (len rest-args) 0)
                (equal? (first rest-args) "create"))
              (let
                ((ens-args (rest rest-args))
                  (current-ns (get interp :current-ns)))
                (let
                  ((map-str (let ((go (fn (remaining) (if (< (len remaining) 2) nil (if (equal? (first remaining) "-map") (nth remaining 1) (go (rest remaining))))))) (go ens-args))))
                  (let
                    ((dispatch-map (if (nil? map-str) (let ((ns-proc-names (tcl-ns-procs (get interp :procs) current-ns))) (reduce (fn (acc qname) (let ((tail (tcl-ns-tail qname))) (tcl-dict-set-pair acc tail qname))) "" ns-proc-names)) map-str)))
                    (let
                      ((ens-name (tcl-ns-tail current-ns))
                        (ens-fn
                          (tcl-make-ensemble
                            (get interp :procs)
                            current-ns
                            dispatch-map)))
                      (assoc
                        interp
                        :commands (assoc (get interp :commands) ens-name ens-fn)
                        :result "")))))
              (error "namespace ensemble: unknown subcommand")))
          (else (error (str "namespace: unknown subcommand \"" sub "\""))))))))

; yieldto: stub — yield empty string
(define
  tcl-cmd-info
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "info: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((equal? sub "level")
            (assoc interp :result (str (len (get interp :frame-stack)))))
          ((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))))))
          ((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)))))))
          ((equal? sub "commands")
            (assoc
              interp
              :result (tcl-list-build (keys (get interp :commands)))))
          ((equal? sub "procs")
            (let
              ((current-ns (get interp :current-ns)))
              (let
                ((ns-proc-names (tcl-ns-procs (get interp :procs) current-ns)))
                (assoc
                  interp
                  :result (tcl-list-build (map tcl-ns-tail ns-proc-names))))))
          ((equal? sub "args")
            (let
              ((pname (first rest-args)))
              (let
                ((entry (tcl-proc-lookup interp pname)))
                (if
                  (nil? entry)
                  (error (str "info args: \"" pname "\" isn't a procedure"))
                  (assoc interp :result (get (get entry :def) :args))))))
          ((equal? sub "body")
            (let
              ((pname (first rest-args)))
              (let
                ((entry (tcl-proc-lookup interp pname)))
                (if
                  (nil? entry)
                  (error (str "info body: \"" pname "\" isn't a procedure"))
                  (assoc interp :result (get (get entry :def) :body))))))
          ((equal? sub "exists")
            (let
              ((varname (first rest-args)))
              (let
                ((val (tcl-var-lookup-or-nil interp varname)))
                (assoc interp :result (if (nil? val) "0" "1")))))
          ((equal? sub "hostname") (assoc interp :result "localhost"))
          ((equal? sub "script") (assoc interp :result ""))
          ((equal? sub "tclversion") (assoc interp :result "8.6"))
          (else (error (str "info: unknown subcommand \"" sub "\""))))))))

; tcl-cmd-yield: suspend the current coroutine fiber, returning val to the resumer
(define
  tcl-cmd-yield
  (fn
    (interp args)
    (let
      ((val (if (> (len args) 0) (first args) "")))
      (let
        ((yield-fn (get interp :coro-yield-fn)))
        (if
          (nil? yield-fn)
          (error "yield called outside coroutine")
          (let
            ((resume-val (yield-fn val)))
            (assoc interp :result (if (nil? resume-val) "" resume-val))))))))

; tcl-cmd-yieldto: suspend the current coroutine fiber (simplified: yields "" to resumer)
(define
  tcl-cmd-yieldto
  (fn
    (interp args)
    (let
      ((yield-fn (get interp :coro-yield-fn)))
      (if
        (nil? yield-fn)
        (error "yieldto called outside coroutine")
        (let
          ((resume-val (yield-fn "")))
          (assoc interp :result (if (nil? resume-val) "" resume-val)))))))

; --- clock command (stubs) ---

(define
  make-coro-cmd
  (fn
    (fiber)
    (fn
      (interp args)
      (let
        ((resume-val (if (> (len args) 0) (first args) "")))
        (let
          ((yielded (fiber-resume fiber resume-val)))
          (assoc interp :result (if (nil? yielded) "" yielded)))))))

; --- file I/O stubs ---

(define
  tcl-cmd-coroutine
  (fn
    (interp args)
    (if
      (< (len args) 2)
      (error "coroutine: wrong # args")
      (let
        ((coro-name (first args))
          (cmd-name (nth args 1))
          (call-args (rest (rest args))))
        (let
          ((base-interp (assoc interp :result "" :code 0 :coro-yield-fn nil)))
          (let
            ((fiber
                (make-fiber
                  (fn
                    (fiber-yield _)
                    (let
                      ((coro-interp (assoc base-interp :coro-yield-fn fiber-yield)))
                      (let
                        ((cmd-fn (get (get coro-interp :commands) cmd-name)))
                        (if
                          (nil? cmd-fn)
                          (let
                            ((proc-entry (tcl-proc-lookup coro-interp cmd-name)))
                            (if
                              (nil? proc-entry)
                              (error
                                (str "coroutine: unknown command \"" cmd-name "\""))
                              (tcl-call-proc
                                coro-interp
                                (get proc-entry :name)
                                (get proc-entry :def)
                                call-args)))
                          (cmd-fn coro-interp call-args))))))))
            (let
              ((new-commands
                  (assoc (get interp :commands) coro-name (make-coro-cmd fiber))))
              (assoc interp :commands new-commands :result ""))))))))

(define
  tcl-cmd-clock
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "clock: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((equal? sub "seconds") (assoc interp :result (str (clock-seconds))))
          ((equal? sub "milliseconds") (assoc interp :result (str (clock-milliseconds))))
          ((equal? sub "format")
            ; clock format $secs ?-format $fmt? ?-timezone $tz? ?-gmt 0|1?
            (let
              ((t (floor (parse-int (first rest-args))))
                (opts (rest rest-args)))
              (let
                ((fmt (tcl-clock-opt opts "-format" "%a %b %e %H:%M:%S %Z %Y"))
                  (tz (tcl-clock-tz opts)))
                (assoc interp :result (clock-format t fmt tz)))))
          ((equal? sub "scan")
            ; clock scan $str ?-format $fmt? ?-timezone $tz? ?-gmt 0|1?
            (let
              ((s (first rest-args)) (opts (rest rest-args)))
              (let
                ((fmt (tcl-clock-opt opts "-format" "%Y-%m-%d %H:%M:%S"))
                  (tz (tcl-clock-tz opts)))
                (assoc interp :result (str (clock-scan s fmt tz))))))
          (else (error (str "clock: unknown subcommand \"" sub "\""))))))))

; Helper: extract a -flag $val pair from clock args.
(define
  tcl-clock-opt
  (fn
    (opts flag default)
    (cond
      ((< (len opts) 2) default)
      ((equal? (first opts) flag) (nth opts 1))
      (else (tcl-clock-opt (rest (rest opts)) flag default)))))

; Helper: derive tz string from clock opts (-timezone or -gmt).
(define
  tcl-clock-tz
  (fn
    (opts)
    (let
      ((tz-explicit (tcl-clock-opt opts "-timezone" nil))
        (gmt-flag (tcl-clock-opt opts "-gmt" nil)))
      (cond
        ((not (nil? tz-explicit))
          (cond
            ((equal? tz-explicit ":UTC") "utc")
            ((equal? tz-explicit "UTC") "utc")
            ((equal? tz-explicit "GMT") "utc")
            (else "local")))
        ((equal? gmt-flag "1") "utc")
        ((equal? gmt-flag "true") "utc")
        ((not (nil? gmt-flag)) "local")
        (else "utc")))))

(define
  tcl-cmd-open
  (fn
    (interp args)
    (let
      ((path (first args))
        (mode (if (> (len args) 1) (nth args 1) "r")))
      (assoc interp :result (channel-open path mode)))))

; gets channel ?varname?
(define
  tcl-cmd-close
  (fn
    (interp args)
    (let ((_ (channel-close (first args)))) (assoc interp :result ""))))

(define
  tcl-cmd-read
  (fn
    (interp args)
    (let
      ((chan (first args))
        (n (if (> (len args) 1) (parse-int (nth args 1)) -1)))
      (assoc
        interp
        :result (if (< n 0) (channel-read chan) (channel-read chan n))))))

(define
  tcl-cmd-gets-chan
  (fn
    (interp args)
    (let
      ((chan (first args)) (line (channel-read-line chan)))
      (if
        (nil? line)
        (if
          (> (len args) 1)
          (assoc (tcl-var-set interp (nth args 1) "") :result "-1")
          (assoc interp :result ""))
        (if
          (> (len args) 1)
          (assoc
            (tcl-var-set interp (nth args 1) line)
            :result (str (len line)))
          (assoc interp :result line))))))

(define
  tcl-cmd-eof
  (fn
    (interp args)
    (assoc interp :result (if (channel-eof? (first args)) "1" "0"))))

(define
  tcl-cmd-seek
  (fn
    (interp args)
    (let
      ((chan (first args))
        (off (parse-int (nth args 1)))
        (whence (if (> (len args) 2) (nth args 2) "start")))
      (let ((_ (channel-seek chan off whence))) (assoc interp :result "")))))

; file command dispatcher
(define
  tcl-cmd-tell
  (fn
    (interp args)
    (assoc interp :result (str (channel-tell (first args))))))

(define
  tcl-cmd-flush
  (fn
    (interp args)
    (let ((_ (channel-flush (first args)))) (assoc interp :result ""))))

; exec cmd ?arg ...? ?| cmd2 arg ...? ?> file? ?< file? ?2>@1?
;   Runs external process(es), returns stdout. Pipelines via |, stdout
;   redirection >/>>, stdin redirection <, stderr-to-stdout via 2>@1,
;   stderr redirection 2> file. Routes through exec-pipeline if any
;   shell metacharacter is present, else exec-process.
(define
  tcl-cmd-exec
  (fn
    (interp args)
    (let
      ((has-pipeline?
          (reduce
            (fn
              (acc w)
              (or
                acc
                (or
                  (equal? w "|")
                  (or
                    (equal? w ">")
                    (or
                      (equal? w ">>")
                      (or
                        (equal? w "<")
                        (or (equal? w "2>") (equal? w "2>@1"))))))))
            false
            args)))
      (assoc
        interp
        :result
        (if has-pipeline? (exec-pipeline args) (exec-process args))))))
(define
  tcl-cmd-fconfigure
  (fn
    (interp args)
    (let
      ((chan (first args)) (rest-args (rest args)))
      (cond
        ((= 0 (len rest-args))
          (assoc
            interp
            :result (str "-blocking " (if (channel-blocking? chan) "1" "0"))))
        ((and
           (= 2 (len rest-args))
           (equal? (first rest-args) "-blocking"))
          (let
            ((b (nth rest-args 1)))
            (let
              ((_
                  (channel-set-blocking!
                    chan
                    (not (or (equal? b "0") (equal? b "false"))))))
              (assoc interp :result ""))))
        ((and
           (= 1 (len rest-args))
           (equal? (first rest-args) "-blocking"))
          (assoc interp :result (if (channel-blocking? chan) "1" "0")))
        ((and
           (= 1 (len rest-args))
           (equal? (first rest-args) "-error"))
          (assoc interp :result (channel-async-error chan)))
        (else (assoc interp :result ""))))))


; ============================================================
; Event loop: fileevent / after / vwait / update (Phase 5b)
; ============================================================

; :fileevents is list of (chan event script) tuples
; :timers is list of (expiry-ms script) tuples, sorted ascending by expiry

(define
  tcl-fileevent-set
  (fn
    (interp chan event script)
    (let
      ((existing (or (get interp :fileevents) (list))))
      (let
        ((filtered
            (filter
              (fn (e) (not (and (equal? (first e) chan) (equal? (nth e 1) event))))
              existing)))
        (let
          ((new-list
              (if (equal? script "")
                filtered
                (append filtered (list (list chan event script))))))
          (assoc interp :fileevents new-list))))))

(define
  tcl-fileevent-get
  (fn
    (interp chan event)
    (let
      ((events (or (get interp :fileevents) (list))))
      (let
        ((matches
            (filter
              (fn (e) (and (equal? (first e) chan) (equal? (nth e 1) event)))
              events)))
        (if (= 0 (len matches)) "" (nth (first matches) 2))))))

(define
  tcl-timer-insert
  (fn
    (timers new-timer)
    (cond
      ((= 0 (len timers)) (list new-timer))
      ((<= (first new-timer) (first (first timers))) (cons new-timer timers))
      (else (cons (first timers) (tcl-timer-insert (rest timers) new-timer))))))

(define
  tcl-timer-add
  (fn
    (interp ms script)
    (let
      ((expiry (+ (clock-milliseconds) ms)))
      (let
        ((existing (or (get interp :timers) (list))))
        (assoc interp :timers (tcl-timer-insert existing (list expiry script)))))))

; Run one iteration of the event loop.
; poll-timeout-ms: -1 = block indefinitely, 0 = poll, N>0 = wait up to N ms.
; Returns updated interp.
(define
  tcl-event-step
  (fn
    (interp poll-timeout-ms)
    (let
      ((timers (or (get interp :timers) (list))) (now-ms (clock-milliseconds)))
      (let
        ((expired (filter (fn (t) (<= (first t) now-ms)) timers))
          (remaining (filter (fn (t) (> (first t) now-ms)) timers)))
        (let
          ((interp1
              (reduce
                (fn (acc t) (tcl-eval-string acc (nth t 1)))
                (assoc interp :timers remaining)
                expired)))
          (let
            ((events (or (get interp1 :fileevents) (list))))
            (let
              ((read-chans
                  (map
                    (fn (e) (first e))
                    (filter (fn (e) (equal? (nth e 1) "readable")) events)))
                (write-chans
                  (map
                    (fn (e) (first e))
                    (filter (fn (e) (equal? (nth e 1) "writable")) events)))
                (next-timer-delta
                  (if
                    (= 0 (len remaining))
                    -1
                    (- (first (first remaining)) (clock-milliseconds)))))
              (let
                ((effective-timeout
                    (cond
                      ((and (>= poll-timeout-ms 0) (>= next-timer-delta 0))
                        (min poll-timeout-ms next-timer-delta))
                      ((>= poll-timeout-ms 0) poll-timeout-ms)
                      ((>= next-timer-delta 0) next-timer-delta)
                      (else -1))))
                (if
                  (and
                    (= 0 (len read-chans))
                    (= 0 (len write-chans)))
                  ; nothing to select on; if timeout > 0, do a no-op wait via select
                  (if
                    (> effective-timeout 0)
                    (let
                      ((_ (io-select-channels (list) (list) effective-timeout)))
                      interp1)
                    interp1)
                  (let
                    ((select-result
                        (io-select-channels read-chans write-chans effective-timeout)))
                    (let
                      ((ready-r (or (get select-result :readable) (list)))
                        (ready-w (or (get select-result :writable) (list))))
                      (let
                        ((interp2
                            (reduce
                              (fn (acc chan)
                                (let
                                  ((script (tcl-fileevent-get acc chan "readable")))
                                  (if (equal? script "") acc (tcl-eval-string acc script))))
                              interp1
                              ready-r)))
                        (reduce
                          (fn (acc chan)
                            (let
                              ((script (tcl-fileevent-get acc chan "writable")))
                              (if (equal? script "") acc (tcl-eval-string acc script))))
                          interp2
                          ready-w)))))))))))))

(define
  tcl-cmd-fileevent
  (fn
    (interp args)
    (let
      ((chan (first args)) (event (nth args 1)))
      (if
        (= 2 (len args))
        (assoc interp :result (tcl-fileevent-get interp chan event))
        (let
          ((script (nth args 2)))
          (assoc (tcl-fileevent-set interp chan event script) :result ""))))))

(define
  tcl-cmd-after
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "after: wrong # args")
      (let
        ((ms (parse-int (first args))))
        (if
          (= 1 (len args))
          ; pure sleep — drive event loop until ms elapsed
          (let
            ((target-ms (+ (clock-milliseconds) ms)))
            (assoc (tcl-after-sleep-loop interp target-ms) :result ""))
          ; schedule timer
          (let
            ((script (join " " (rest args))))
            (assoc (tcl-timer-add interp ms script) :result "")))))))

(define
  tcl-after-sleep-loop
  (fn
    (interp target-ms)
    (let
      ((now (clock-milliseconds)))
      (if
        (>= now target-ms)
        interp
        (tcl-after-sleep-loop
          (tcl-event-step interp (- target-ms now))
          target-ms)))))

; Look up a Tcl var by name, returning nil instead of erroring if missing.
; Handles `::var` global-prefix routing the same way tcl-var-get does.
(define
  tcl-var-lookup-or-nil
  (fn
    (interp name)
    (if
      (tcl-global-ref? name)
      (let
        ((root-frame
            (let ((stack (get interp :frame-stack)))
              (if (= 0 (len stack)) (get interp :frame) (first stack))))
          (gname (tcl-strip-global name)))
        (frame-lookup root-frame gname))
      (frame-lookup (get interp :frame) name))))

(define
  tcl-cmd-vwait
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "vwait: wrong # args")
      (let
        ((name (first args)))
        (let
          ((initial (tcl-var-lookup-or-nil interp name)))
          (assoc (tcl-vwait-loop interp name initial) :result ""))))))

(define
  tcl-vwait-loop
  (fn
    (interp name initial)
    (let
      ((cur (tcl-var-lookup-or-nil interp name)))
      (if
        (and (not (nil? cur)) (not (equal? cur initial)))
        interp
        (tcl-vwait-loop (tcl-event-step interp 1000) name initial)))))

(define
  tcl-cmd-update
  (fn
    (interp args)
    (assoc (tcl-event-step interp 0) :result "")))

; ============================================================
; TclOO — minimal oo::class / oo::object (Phase 7d)
; ============================================================

; Class storage: interp :classes is a dict {name: class-record}
;   class-record: {:methods (dict name => {:args :body}) :ctor :dtor :super}
; Object storage: interp :oo-objects is a dict {objname: {:class :slots}}
; Counter: interp :oo-counter — int for unique object names.

; Extract a literal value from a parsed Tcl word (compound, braced, quoted).
; Returns nil if the word is not literal (e.g., contains $-substitution).
(define
  tcl-oo-word-value
  (fn
    (word)
    (let
      ((t (get word :type)))
      (cond
        ((equal? t "braced") (get word :value))
        ((equal? t "quoted") (get word :value))
        ((equal? t "compound")
          (let
            ((parts (get word :parts)))
            (let
              ((all-text?
                  (reduce
                    (fn (a p) (and a (equal? (get p :type) "text")))
                    true
                    parts)))
              (if
                all-text?
                (join "" (map (fn (p) (get p :value)) parts))
                nil))))
        (else (get word :value))))))

; Recursive scan over parsed Tcl commands building a class record.
; Top-level so the recursive call resolves correctly.
(define
  tcl-oo-scan-class-body
  (fn
    (cmds rec)
    (if
      (= 0 (len cmds))
      rec
      (let
        ((cmd (first cmds)))
        (let
          ((words (get cmd :words)))
          (if
            (= 0 (len words))
            (tcl-oo-scan-class-body (rest cmds) rec)
            (let
              ((kw (tcl-oo-word-value (first words))))
              (cond
                ((equal? kw "superclass")
                  (tcl-oo-scan-class-body
                    (rest cmds)
                    (assoc rec :super (tcl-oo-word-value (nth words 1)))))
                ((equal? kw "constructor")
                  (tcl-oo-scan-class-body
                    (rest cmds)
                    (assoc rec :ctor {:args (tcl-oo-word-value (nth words 1)) :body (tcl-oo-word-value (nth words 2))})))
                ((equal? kw "destructor")
                  (tcl-oo-scan-class-body
                    (rest cmds)
                    (assoc rec :dtor {:body (tcl-oo-word-value (nth words 1))})))
                ((equal? kw "method")
                  (let
                    ((mname (tcl-oo-word-value (nth words 1)))
                      (margs (tcl-oo-word-value (nth words 2)))
                      (mbody (tcl-oo-word-value (nth words 3))))
                    (tcl-oo-scan-class-body
                      (rest cmds)
                      (assoc
                        rec
                        :methods
                        (assoc (or (get rec :methods) {}) mname {:args margs :body mbody})))))
                (else (tcl-oo-scan-class-body (rest cmds) rec))))))))))

; Parse class body — a Tcl script with commands `superclass NAME`,
; `constructor {args} {body}`, `destructor {body}`, `method NAME {args} {body}`.
; Returns a class record dict.
(define
  tcl-oo-parse-class-body
  (fn
    (body)
    (tcl-oo-scan-class-body
      (tcl-tokenize body)
      {:methods {} :ctor nil :dtor nil :super nil})))

; Find a method by walking class chain (this->super->...).
; Returns the method record {:args :body} or nil.
(define
  tcl-oo-find-method
  (fn
    (interp class-name mname)
    (let
      ((classes (or (get interp :classes) {})))
      (let
        ((cls (get classes class-name)))
        (if
          (nil? cls)
          nil
          (let
            ((m (get (or (get cls :methods) {}) mname)))
            (if
              (not (nil? m))
              m
              (let
                ((super (get cls :super)))
                (if
                  (nil? super)
                  nil
                  (tcl-oo-find-method interp super mname))))))))))

; Dispatch a method call on object. Sets up `self`, `my`, `class` in proc body.
(define
  tcl-oo-call-method
  (fn
    (interp objname mname call-args)
    (let
      ((objects (or (get interp :oo-objects) {})))
      (let
        ((obj (get objects objname)))
        (if
          (nil? obj)
          (error (str "oo: no such object: " objname))
          (let
            ((cls-name (get obj :class)))
            (let
              ((m (tcl-oo-find-method interp cls-name mname)))
              (if
                (nil? m)
                (error (str "oo: object \"" objname "\" has no method \"" mname "\""))
                ; Wrap method as a proc-call; bind self, args
                (let
                  ((pdef {:args (get m :args) :body (get m :body)}))
                  (let
                    ((interp-with-self (tcl-var-set interp "self" objname)))
                    (tcl-call-proc interp-with-self mname pdef call-args)))))))))))

; Dispatcher registered as the object's command: handles `obj method ?args ...?`
; Uses a closure-style approach by having the dispatcher take obj-name baked in.
(define
  tcl-oo-make-obj-dispatcher
  (fn
    (objname)
    (fn
      (interp args)
      (if
        (= 0 (len args))
        (error (str "oo: " objname ": method name required"))
        (tcl-oo-call-method interp objname (first args) (rest args))))))

; Class dispatcher — handles `ClsName new ?args ...?` and similar.
(define
  tcl-oo-make-class-dispatcher
  (fn
    (cname)
    (fn
      (interp args)
      (if
        (= 0 (len args))
        (error (str "oo: class " cname ": subcommand required"))
        (let
          ((sub (first args)) (rest-args (rest args)))
          (cond
            ((equal? sub "new")
              ; Allocate object; call constructor if present
              (let
                ((counter (or (get interp :oo-counter) 0)))
                (let
                  ((objname (str "::oo::object" counter)))
                  (let
                    ((classes (or (get interp :classes) {})))
                    (let
                      ((cls (get classes cname)))
                      (let
                        ((interp1
                            (assoc
                              interp
                              :oo-counter
                              (+ counter 1)
                              :oo-objects
                              (assoc (or (get interp :oo-objects) {}) objname {:class cname :slots {}}))))
                        (let
                          ((dispatcher (tcl-oo-make-obj-dispatcher objname)))
                          (let
                            ((interp2 (tcl-register interp1 objname dispatcher)))
                            (let
                              ((interp3
                                  (if
                                    (nil? (get cls :ctor))
                                    interp2
                                    (let
                                      ((ctor (get cls :ctor)))
                                      (let
                                        ((interp-with-self (tcl-var-set interp2 "self" objname)))
                                        (let
                                          ((cr (tcl-call-proc interp-with-self "constructor" ctor rest-args)))
                                          (assoc cr :result objname)))))))
                              (assoc interp3 :result objname))))))))))
            (else (error (str "oo: class " cname " unknown subcommand: " sub)))))))))

; oo::class create NAME body
;   args = (create NAME body)
(define
  tcl-cmd-oo-class
  (fn
    (interp args)
    (if
      (< (len args) 2)
      (error "oo::class: wrong # args")
      (let
        ((sub (first args)))
        (cond
          ((equal? sub "create")
            (let
              ((cname (nth args 1))
                (body (if (> (len args) 2) (nth args 2) "")))
              (let
                ((rec (tcl-oo-parse-class-body body)))
                (let
                  ((classes (or (get interp :classes) {})))
                  (let
                    ((with-class (assoc interp :classes (assoc classes cname rec))))
                    (let
                      ((dispatcher (tcl-oo-make-class-dispatcher cname)))
                      (assoc
                        (tcl-register with-class cname dispatcher)
                        :result cname)))))))
          (else (error (str "oo::class: unknown subcommand: " sub))))))))

; oo::object — placeholder; rarely used directly
(define
  tcl-cmd-oo-object
  (fn
    (interp args)
    (error "oo::object: not implemented as direct command")))

; ============================================================
; Socket: TCP client and server (Phase 5c)
; ============================================================

; Internal command invoked by the auto-registered fileevent on a server
; channel. Args: (server-chan callback-word ...).  Accepts one client and
; calls the user callback with (client-chan peer-host peer-port).
(define
  tcl-cmd-_sock-do-accept
  (fn
    (interp args)
    (let
      ((server-chan (first args)) (cb-parts (rest args)))
      (let
        ((info (socket-accept server-chan)))
        (let
          ((client-chan (get info :channel))
            (peer-host (get info :host))
            (peer-port (str (get info :port))))
          (let
            ((cmd
                (join
                  " "
                  (append
                    cb-parts
                    (list client-chan peer-host peer-port)))))
            (assoc (tcl-eval-string interp cmd) :result "")))))))

; socket host port           — TCP client; returns "sockN"
; socket -server cb port     — TCP server; auto-fires cb on each accept
(define
  tcl-cmd-socket
  (fn
    (interp args)
    (cond
      ((= 0 (len args)) (error "socket: wrong # args"))
      ((equal? (first args) "-server")
        (if
          (< (len args) 3)
          (error "socket: usage: socket -server cb port")
          (let
            ((cb (nth args 1)) (port (parse-int (nth args 2))))
            (let
              ((server-chan (socket-server port)))
              (let
                ((handler (str "_sock-do-accept " server-chan " " cb)))
                (assoc
                  (tcl-fileevent-set interp server-chan "readable" handler)
                  :result server-chan))))))
      ((equal? (first args) "-async")
        (if
          (< (len args) 3)
          (error "socket: usage: socket -async host port")
          (let
            ((host (nth args 1)) (port (parse-int (nth args 2))))
            (assoc interp :result (socket-connect-async host port)))))
      ((= 2 (len args))
        (let
          ((host (first args)) (port (parse-int (nth args 1))))
          (assoc interp :result (socket-connect host port))))
      (else (error "socket: wrong # args")))))


(define
  tcl-cmd-array
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "array: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((equal? sub "get")
            (if
              (= 0 (len rest-args))
              (error "array get: wrong # args")
              (let
                ((arr-name (first rest-args))
                  (pattern
                    (if
                      (> (len rest-args) 1)
                      (nth rest-args 1)
                      nil)))
                (let
                  ((prefix (str arr-name "("))
                    (locals (get (get interp :frame) :locals)))
                  (let
                    ((pl (string-length prefix)))
                    (let
                      ((arr-keys (filter (fn (k) (tcl-starts-with? k prefix)) (keys locals))))
                      (let
                        ((filtered (if (nil? pattern) arr-keys (filter (fn (k) (let ((kn (substring k pl (- (string-length k) 1)))) (tcl-glob-match (split pattern "") (split kn "")))) arr-keys))))
                        (assoc
                          interp
                          :result (join
                            " "
                            (reduce
                              (fn
                                (acc k)
                                (let
                                  ((kn (substring k pl (- (string-length k) 1))))
                                  (append
                                    acc
                                    (list kn)
                                    (list (get locals k)))))
                              (list)
                              filtered))))))))))
          ((equal? sub "set")
            (if
              (< (len rest-args) 2)
              (error "array set: wrong # args")
              (let
                ((arr-name (first rest-args))
                  (flat (tcl-list-split (nth rest-args 1))))
                (let
                  loop
                  ((pairs flat) (acc interp))
                  (if
                    (< (len pairs) 2)
                    (assoc acc :result "")
                    (loop
                      (rest (rest pairs))
                      (tcl-var-set
                        acc
                        (str arr-name "(" (first pairs) ")")
                        (nth pairs 1))))))))
          ((equal? sub "names")
            (if
              (= 0 (len rest-args))
              (error "array names: wrong # args")
              (let
                ((arr-name (first rest-args))
                  (pattern
                    (if
                      (> (len rest-args) 1)
                      (nth rest-args 1)
                      nil)))
                (let
                  ((prefix (str arr-name "("))
                    (locals (get (get interp :frame) :locals)))
                  (let
                    ((pl (string-length prefix)))
                    (let
                      ((arr-keys (filter (fn (k) (tcl-starts-with? k prefix)) (keys locals))))
                      (let
                        ((filtered (if (nil? pattern) arr-keys (filter (fn (k) (let ((kn (substring k pl (- (string-length k) 1)))) (tcl-glob-match (split pattern "") (split kn "")))) arr-keys))))
                        (assoc
                          interp
                          :result (join
                            " "
                            (map
                              (fn
                                (k)
                                (substring
                                  k
                                  pl
                                  (- (string-length k) 1)))
                              filtered))))))))))
          ((equal? sub "size")
            (if
              (= 0 (len rest-args))
              (error "array size: wrong # args")
              (let
                ((prefix (str (first rest-args) "("))
                  (locals (get (get interp :frame) :locals)))
                (assoc
                  interp
                  :result (str
                    (len
                      (filter
                        (fn (k) (tcl-starts-with? k prefix))
                        (keys locals))))))))
          ((equal? sub "exists")
            (if
              (= 0 (len rest-args))
              (error "array exists: wrong # args")
              (let
                ((prefix (str (first rest-args) "("))
                  (locals (get (get interp :frame) :locals)))
                (assoc
                  interp
                  :result (if
                    (>
                      (len
                        (filter
                          (fn (k) (tcl-starts-with? k prefix))
                          (keys locals)))
                      0)
                    "1"
                    "0")))))
          ((equal? sub "unset")
            (if
              (= 0 (len rest-args))
              (error "array unset: wrong # args")
              (let
                ((arr-name (first rest-args))
                  (pattern
                    (if
                      (> (len rest-args) 1)
                      (nth rest-args 1)
                      nil)))
                (let
                  ((prefix (str arr-name "("))
                    (locals (get (get interp :frame) :locals)))
                  (let
                    ((pl (string-length prefix)))
                    (let
                      ((to-delete (filter (fn (k) (if (tcl-starts-with? k prefix) (if (nil? pattern) true (let ((kn (substring k pl (- (string-length k) 1)))) (tcl-glob-match (split pattern "") (split kn "")))) false)) (keys locals))))
                      (let
                        ((new-locals (reduce (fn (acc k) (if (contains? to-delete k) acc (assoc acc k (get locals k)))) {} (keys locals))))
                        (assoc
                          interp
                          :frame (assoc (get interp :frame) :locals new-locals)
                          :result ""))))))))
          (else (error (str "array: unknown subcommand \"" sub "\""))))))))


(define
  tcl-cmd-apply
  (fn
    (interp args)
    (if
      (< (len args) 1)
      (error "apply: wrong # args: should be " apply lambdaList ?arg ...? "")
      (let
        ((func-list (tcl-list-split (first args)))
          (call-args (rest args)))
        (if
          (< (len func-list) 2)
          (error "apply: lambdaList must be a 2 or 3 element list")
          (let
            ((param-spec (first func-list))
              (body (nth func-list 1))
              (ns
                (if
                  (> (len func-list) 2)
                  (nth func-list 2)
                  nil)))
            (let
              ((proc-def {:args param-spec :body body :ns ns}))
              (tcl-call-proc interp "#apply" proc-def call-args))))))))

(define
  tcl-cmd-regexp
  (fn
    (interp args)
    (define
      parse-flags
      (fn
        (as nocase? all? inline?)
        (if
          (= 0 (len as))
          {:rest as :nocase nocase? :inline inline? :all all?}
          (cond
            ((equal? (first as) "-nocase")
              (parse-flags (rest as) true all? inline?))
            ((equal? (first as) "-all")
              (parse-flags (rest as) nocase? true inline?))
            ((equal? (first as) "-inline")
              (parse-flags (rest as) nocase? all? true))
            (else {:rest as :nocase nocase? :inline inline? :all all?})))))
    (let
      ((pf (parse-flags args false false false)))
      (let
        ((nocase (get pf :nocase))
          (all-mode (get pf :all))
          (inline-mode (get pf :inline))
          (ra (get pf :rest)))
        (if
          (< (len ra) 2)
          (error "regexp: wrong # args")
          (let
            ((pattern (first ra))
              (str-val (nth ra 1))
              (var-args
                (if (> (len ra) 2) (rest (rest ra)) (list))))
            (let
              ((re (make-regexp pattern (if nocase "i" ""))))
              (if
                all-mode
                (assoc
                  interp
                  :result (str (len (regexp-match-all re str-val))))
                (if
                  inline-mode
                  (assoc
                    interp
                    :result (join
                      " "
                      (map
                        (fn (m) (get m :match))
                        (regexp-match-all re str-val))))
                  (let
                    ((m (regexp-match re str-val)))
                    (if
                      (nil? m)
                      (assoc interp :result "0")
                      (let
                        ((interp2 (if (> (len var-args) 0) (tcl-var-set interp (first var-args) (get m :match)) interp)))
                        (let
                          ((interp3 (let loop ((vi 1) (gs (get m :groups)) (acc interp2)) (if (or (= 0 (len gs)) (>= vi (len var-args))) acc (loop (+ vi 1) (rest gs) (tcl-var-set acc (nth var-args vi) (first gs)))))))
                          (assoc interp3 :result "1"))))))))))))))



(define
  tcl-cmd-regsub
  (fn
    (interp args)
    (define
      parse-flags
      (fn
        (as all? nocase?)
        (if
          (= 0 (len as))
          {:rest as :nocase nocase? :all all?}
          (cond
            ((equal? (first as) "-all")
              (parse-flags (rest as) true nocase?))
            ((equal? (first as) "-nocase")
              (parse-flags (rest as) all? true))
            (else {:rest as :nocase nocase? :all all?})))))
    (let
      ((pf (parse-flags args false false)))
      (let
        ((all-mode (get pf :all))
          (nocase (get pf :nocase))
          (ra (get pf :rest)))
        (if
          (< (len ra) 3)
          (error "regsub: wrong # args")
          (let
            ((pattern (first ra))
              (str-val (nth ra 1))
              (replacement (nth ra 2))
              (var-name
                (if (> (len ra) 3) (nth ra 3) nil)))
            (let
              ((re (make-regexp pattern (if nocase "i" ""))))
              (let
                ((result (if all-mode (regexp-replace-all re str-val replacement) (regexp-replace re str-val replacement))))
                (if
                  (nil? var-name)
                  (assoc interp :result result)
                  (let
                    ((count (if all-mode (len (regexp-match-all re str-val)) (if (nil? (regexp-match re str-val)) 0 1))))
                    (assoc
                      (tcl-var-set interp var-name result)
                      :result (str count))))))))))))

(define
  tcl-cmd-file
  (fn
    (interp args)
    (if
      (= 0 (len args))
      (error "file: wrong # args")
      (let
        ((sub (first args)) (rest-args (rest args)))
        (cond
          ((equal? sub "exists")
            (assoc
              interp
              :result (if (file-exists? (first rest-args)) "1" "0")))
          ((equal? sub "join") (assoc interp :result (join "/" rest-args)))
          ((equal? sub "split")
            (assoc
              interp
              :result (tcl-list-build
                (filter
                  (fn (s) (not (equal? s "")))
                  (split (first rest-args) "/")))))
          ((equal? sub "tail")
            (let
              ((parts (filter (fn (s) (not (equal? s ""))) (split (first rest-args) "/"))))
              (assoc
                interp
                :result (if (= 0 (len parts)) "" (last parts)))))
          ((equal? sub "dirname")
            (let
              ((parts (filter (fn (s) (not (equal? s ""))) (split (first rest-args) "/"))))
              (assoc
                interp
                :result (if
                  (<= (len parts) 1)
                  "."
                  (str
                    "/"
                    (join "/" (take-n parts (- (len parts) 1))))))))
          ((equal? sub "extension")
            (let
              ((nm (first rest-args)))
              (let
                ((dot-idx (tcl-string-last "." nm (- (string-length nm) 1))))
                (assoc
                  interp
                  :result (if
                    (equal? dot-idx "-1")
                    ""
                    (substring nm (parse-int dot-idx) (string-length nm)))))))
          ((equal? sub "rootname")
            (let
              ((nm (first rest-args)))
              (let
                ((dot-idx (tcl-string-last "." nm (- (string-length nm) 1))))
                (assoc
                  interp
                  :result (if
                    (equal? dot-idx "-1")
                    nm
                    (substring nm 0 (parse-int dot-idx)))))))
          ((equal? sub "isfile")
            (assoc interp :result (if (file-isfile? (first rest-args)) "1" "0")))
          ((equal? sub "isdir")
            (assoc interp :result (if (file-isdir? (first rest-args)) "1" "0")))
          ((equal? sub "isdirectory")
            (assoc interp :result (if (file-isdir? (first rest-args)) "1" "0")))
          ((equal? sub "readable")
            (assoc interp :result (if (file-readable? (first rest-args)) "1" "0")))
          ((equal? sub "writable")
            (assoc interp :result (if (file-writable? (first rest-args)) "1" "0")))
          ((equal? sub "size")
            (assoc interp :result (str (file-size (first rest-args)))))
          ((equal? sub "mtime")
            (assoc interp :result (str (file-mtime (first rest-args)))))
          ((equal? sub "atime")
            (let ((s (file-stat (first rest-args))))
              (assoc interp :result (if (nil? s) "0" (str (get s :atime))))))
          ((equal? sub "type")
            (let ((s (file-stat (first rest-args))))
              (assoc interp :result (if (nil? s) "" (get s :type)))))
          ((equal? sub "mkdir")
            (let ((_ (file-mkdir (first rest-args))))
              (assoc interp :result "")))
          ((equal? sub "copy")
            (let
              ((paths
                  (filter (fn (a) (not (equal? (slice a 0 1) "-"))) rest-args)))
              (let ((_ (file-copy (first paths) (nth paths 1))))
                (assoc interp :result ""))))
          ((equal? sub "rename")
            (let
              ((paths
                  (filter (fn (a) (not (equal? (slice a 0 1) "-"))) rest-args)))
              (let ((_ (file-rename (first paths) (nth paths 1))))
                (assoc interp :result ""))))
          ((equal? sub "delete")
            (let
              ((paths
                  (filter (fn (a) (not (equal? (slice a 0 1) "-"))) rest-args)))
              (let
                ((_
                    (reduce
                      (fn (acc p) (let ((_ (file-delete p))) acc))
                      nil
                      paths)))
                (assoc interp :result ""))))
          (else (error (str "file: 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-chan)))
                                          (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 "lassign" tcl-cmd-lassign)))
                                                                      (let
                                                                        ((i (tcl-register i "lrepeat" tcl-cmd-lrepeat)))
                                                                      (let
                                                                        ((i (tcl-register i "lset" tcl-cmd-lset)))
                                                                      (let
                                                                        ((i (tcl-register i "lmap" tcl-cmd-lmap)))
                                                                      (let
                                                                        ((i (tcl-register i "exec" tcl-cmd-exec)))
                                                                      (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)))
                                                                                      (let
                                                                                        ((i (tcl-register i "info" tcl-cmd-info)))
                                                                                        (let
                                                                                          ((i (tcl-register i "catch" tcl-cmd-catch)))
                                                                                          (let
                                                                                            ((i (tcl-register i "throw" tcl-cmd-throw)))
                                                                                            (let
                                                                                              ((i (tcl-register i "try" tcl-cmd-try)))
                                                                                              (let
                                                                                                ((i (tcl-register i "namespace" tcl-cmd-namespace)))
                                                                                                (let
                                                                                                  ((i (tcl-register i "coroutine" tcl-cmd-coroutine)))
                                                                                                  (let
                                                                                                    ((i (tcl-register i "yield" tcl-cmd-yield)))
                                                                                                    (let
                                                                                                      ((i (tcl-register i "yieldto" tcl-cmd-yieldto)))
                                                                                                      (let
                                                                                                        ((i (tcl-register i "clock" tcl-cmd-clock)))
                                                                                                        (let
                                                                                                          ((i (tcl-register i "open" tcl-cmd-open)))
                                                                                                          (let
                                                                                                            ((i (tcl-register i "close" tcl-cmd-close)))
                                                                                                            (let
                                                                                                              ((i (tcl-register i "read" tcl-cmd-read)))
                                                                                                              (let
                                                                                                                ((i (tcl-register i "eof" tcl-cmd-eof)))
                                                                                                                (let
                                                                                                                  ((i (tcl-register i "seek" tcl-cmd-seek)))
                                                                                                                  (let
                                                                                                                    ((i (tcl-register i "tell" tcl-cmd-tell)))
                                                                                                                    (let
                                                                                                                      ((i (tcl-register i "flush" tcl-cmd-flush)))
                                                                                                                      (let
                                                                                                                        ((i (tcl-register i "fconfigure" tcl-cmd-fconfigure)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "fileevent" tcl-cmd-fileevent)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "after" tcl-cmd-after)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "vwait" tcl-cmd-vwait)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "update" tcl-cmd-update)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "socket" tcl-cmd-socket)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "_sock-do-accept" tcl-cmd-_sock-do-accept)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "oo::class" tcl-cmd-oo-class)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "oo::object" tcl-cmd-oo-object)))
                                                                                                                        (let
                                                                                                                          ((i (tcl-register i "file" tcl-cmd-file)))
                                                                                                                          (let
                                                                                                                            ((i (tcl-register i "regexp" tcl-cmd-regexp)))
                                                                                                                            (let
                                                                                                                              ((i (tcl-register i "regsub" tcl-cmd-regsub)))
                                                                                                                              (let
                                                                                                                                ((i (tcl-register i "apply" tcl-cmd-apply)))
                                                                                                                                (tcl-register
                                                                                                                                  i
                                                                                                                                  "array"
                                                                                                                                  tcl-cmd-array))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))