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

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

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

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

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

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

(define
  tcl-var-get
  (fn
    (interp name)
    (let
      ((val (frame-lookup (get interp :frame) name)))
      (if
        (nil? val)
        (error (str "can't read \"" name "\": no such variable"))
        val))))

(define
  tcl-var-set
  (fn
    (interp name val)
    (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)))

(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)
                (error (str "unknown command: \"" cmd-name "\""))
                (cmd-fn cur-interp cmd-args)))))))))

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

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

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

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

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

(define
  tcl-cmd-append
  (fn
    (interp args)
    (let
      ((name (first args)) (suffix (join "" (rest args))))
      (let
        ((cur (let ((v (frame-lookup (get interp :frame) name))) (if (nil? v) "" v))))
        (let
          ((new-val (str cur suffix)))
          (assoc (tcl-var-set interp name new-val) :result new-val))))))

(define
  tcl-true?
  (fn
    (s)
    (not
      (or (equal? s "0") (equal? s "") (equal? s "false") (equal? s "no")))))

(define tcl-false? (fn (s) (not (tcl-true? s))))

(define
  tcl-expr-digit?
  (fn
    (c)
    (contains? (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") c)))

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

(define
  tcl-expr-op-char?
  (fn
    (c)
    (contains?
      (list "+" "-" "*" "/" "%" "!" "~" "&" "|" "^" "<" ">" "=")
      c)))

(define
  tcl-expr-ws?
  (fn (c) (or (equal? c " ") (equal? c "\t") (equal? c "\n") (equal? c "\r"))))

(define
  tcl-pow
  (fn
    (base exp)
    (if
      (= exp 0)
      1
      (* base (tcl-pow base (- exp 1))))))

(define
  tcl-isqrt
  (fn
    (n)
    (if
      (<= n 0)
      0
      (let
        ((go (fn (x) (let ((x2 (/ (+ x (/ n x)) 2))) (if (>= x2 x) x (go x2))))))
        (go n)))))

(define
  tcl-apply-func
  (fn
    (name args)
    (let
      ((a0 (if (> (len args) 0) (parse-int (first args)) 0))
        (a1 (if (> (len args) 1) (parse-int (nth args 1)) 0)))
      (cond
        ((equal? name "abs") (str (if (< a0 0) (- 0 a0) a0)))
        ((equal? name "int") (str a0))
        ((equal? name "double") (str a0))
        ((equal? name "round") (str a0))
        ((equal? name "floor") (str a0))
        ((equal? name "ceil") (str a0))
        ((equal? name "sqrt") (str (tcl-isqrt a0)))
        ((equal? name "pow") (str (tcl-pow a0 a1)))
        ((equal? name "max") (str (if (>= a0 a1) a0 a1)))
        ((equal? name "min") (str (if (<= a0 a1) a0 a1)))
        ((equal? name "sin") "0")
        ((equal? name "cos") "1")
        ((equal? name "tan") "0")
        (else (error (str "expr: unknown function: " name)))))))

(define
  tcl-apply-binop
  (fn
    (op l r)
    (cond
      ((equal? op "+") (str (+ (parse-int l) (parse-int r))))
      ((equal? op "-") (str (- (parse-int l) (parse-int r))))
      ((equal? op "*") (str (* (parse-int l) (parse-int r))))
      ((equal? op "/") (str (/ (parse-int l) (parse-int r))))
      ((equal? op "%") (str (mod (parse-int l) (parse-int r))))
      ((equal? op "==") (if (equal? l r) "1" "0"))
      ((equal? op "!=") (if (equal? l r) "0" "1"))
      ((equal? op "<") (if (< (parse-int l) (parse-int r)) "1" "0"))
      ((equal? op ">") (if (> (parse-int l) (parse-int r)) "1" "0"))
      ((equal? op "<=") (if (<= (parse-int l) (parse-int r)) "1" "0"))
      ((equal? op ">=") (if (>= (parse-int l) (parse-int r)) "1" "0"))
      ((equal? op "&&") (if (and (tcl-true? l) (tcl-true? r)) "1" "0"))
      ((equal? op "||") (if (or (tcl-true? l) (tcl-true? r)) "1" "0"))
      ((equal? op "**") (str (tcl-pow (parse-int l) (parse-int r))))
      (else (error (str "expr: unknown op: " op))))))

(define
  tcl-expr-tokenize
  (fn
    (s)
    (let
      ((chars (split s ""))
        (n (len (split s ""))))
      (let
        ((go
          (fn
            (i acc cur mode)
            (if
              (>= i n)
              (if (> (len cur) 0) (append acc (list cur)) acc)
              (let
                ((c (nth chars i)))
                (cond
                  ((tcl-expr-ws? c)
                    (if
                      (> (len cur) 0)
                      (go (+ i 1) (append acc (list cur)) "" "none")
                      (go (+ i 1) acc "" "none")))
                  ((or (equal? c "(") (equal? c ")") (equal? c ","))
                    (let
                      ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
                      (go (+ i 1) (append acc2 (list c)) "" "none")))
                  ((equal? c "\"")
                    (let
                      ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
                      (let
                        ((read-str
                          (fn
                            (j s-acc)
                            (if
                              (>= j n)
                              {:tok s-acc :next j}
                              (let
                                ((sc (nth chars j)))
                                (if
                                  (equal? sc "\"")
                                  {:tok s-acc :next (+ j 1)}
                                  (read-str (+ j 1) (str s-acc sc))))))))
                        (let
                          ((sr (read-str (+ i 1) "")))
                          (go (get sr :next) (append acc2 (list (get sr :tok))) "" "none")))))
                  ((tcl-expr-op-char? c)
                    (let
                      ((acc2 (if (and (> (len cur) 0) (not (equal? mode "op"))) (append acc (list cur)) acc))
                        (cur2 (if (and (> (len cur) 0) (not (equal? mode "op"))) "" cur)))
                      (let
                        ((next-c (if (< (+ i 1) n) (nth chars (+ i 1)) "")))
                        (let
                          ((two (str c next-c)))
                          (if
                            (contains? (list "**" "==" "!=" "<=" ">=" "&&" "||") two)
                            (let
                              ((acc3 (if (> (len cur2) 0) (append acc2 (list cur2)) acc2)))
                              (go (+ i 2) (append acc3 (list two)) "" "none"))
                            (let
                              ((acc3 (if (> (len cur2) 0) (append acc2 (list cur2)) acc2)))
                              (go (+ i 1) (append acc3 (list c)) "" "none")))))))
                  ((tcl-expr-digit? c)
                    (if
                      (equal? mode "ident")
                      (go (+ i 1) acc (str cur c) "ident")
                      (if
                        (or (equal? mode "num") (equal? mode "none") (equal? mode ""))
                        (go (+ i 1) acc (str cur c) "num")
                        (let
                          ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
                          (go (+ i 1) acc2 c "num")))))
                  ((equal? c ".")
                    (go (+ i 1) acc (str cur c) "num"))
                  ((tcl-expr-alpha? c)
                    (if
                      (or (equal? mode "ident") (equal? mode "none") (equal? mode ""))
                      (go (+ i 1) acc (str cur c) "ident")
                      (let
                        ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
                        (go (+ i 1) acc2 c "ident"))))
                  (else
                    (let
                      ((acc2 (if (> (len cur) 0) (append acc (list cur)) acc)))
                      (go (+ i 1) (append acc2 (list c)) "" "none")))))))))
        (go 0 (list) "" "none")))))

(define
  tcl-expr-parse-args-rest
  (fn
    (tokens acc)
    (if
      (or (= 0 (len tokens)) (equal? (first tokens) ")"))
      {:args acc :tokens tokens}
      (if
        (equal? (first tokens) ",")
        (let
          ((r (tcl-expr-parse-or (rest tokens))))
          (tcl-expr-parse-args-rest
            (get r :tokens)
            (append acc (list (get r :value)))))
        {:args acc :tokens tokens}))))

(define
  tcl-expr-parse-args
  (fn
    (tokens)
    (if
      (or (= 0 (len tokens)) (equal? (first tokens) ")"))
      {:args (list) :tokens tokens}
      (let
        ((r (tcl-expr-parse-or tokens)))
        (tcl-expr-parse-args-rest
          (get r :tokens)
          (list (get r :value)))))))

(define
  tcl-expr-parse-primary
  (fn
    (tokens)
    (if
      (= 0 (len tokens))
      (error "expr: unexpected end of expression")
      (let
        ((tok (first tokens)) (rest-toks (rest tokens)))
        (cond
          ((equal? tok "(")
            (let
              ((inner (tcl-expr-parse-or rest-toks)))
              (let
                ((after (get inner :tokens)))
                (if
                  (and (> (len after) 0) (equal? (first after) ")"))
                  {:value (get inner :value) :tokens (rest after)}
                  (error "expr: missing closing paren")))))
          ((and
            (> (len rest-toks) 0)
            (equal? (first rest-toks) "("))
            (let
              ((args-r (tcl-expr-parse-args (rest rest-toks))))
              (let
                ((after-args (get args-r :tokens)))
                (if
                  (and (> (len after-args) 0) (equal? (first after-args) ")"))
                  {:value (tcl-apply-func tok (get args-r :args)) :tokens (rest after-args)}
                  (error (str "expr: missing ) after function call " tok))))))
          (else {:value tok :tokens rest-toks}))))))

(define
  tcl-expr-parse-unary
  (fn
    (tokens)
    (if
      (= 0 (len tokens))
      (error "expr: unexpected end in unary")
      (let
        ((tok (first tokens)))
        (cond
          ((equal? tok "!")
            (let
              ((r (tcl-expr-parse-unary (rest tokens))))
              {:value (if (tcl-false? (get r :value)) "1" "0") :tokens (get r :tokens)}))
          ((equal? tok "-")
            (let
              ((r (tcl-expr-parse-unary (rest tokens))))
              {:value (str (- 0 (parse-int (get r :value)))) :tokens (get r :tokens)}))
          ((equal? tok "+")
            (tcl-expr-parse-unary (rest tokens)))
          (else (tcl-expr-parse-primary tokens)))))))

(define
  tcl-expr-parse-power
  (fn
    (tokens)
    (let
      ((base-r (tcl-expr-parse-unary tokens)))
      (let
        ((base-val (get base-r :value)) (rest-toks (get base-r :tokens)))
        (if
          (and (> (len rest-toks) 0) (equal? (first rest-toks) "**"))
          (let
            ((exp-r (tcl-expr-parse-power (rest rest-toks))))
            {:value (str (tcl-pow (parse-int base-val) (parse-int (get exp-r :value)))) :tokens (get exp-r :tokens)})
          {:value base-val :tokens rest-toks})))))

(define
  tcl-expr-parse-multiplicative-rest
  (fn
    (tokens left)
    (if
      (or (= 0 (len tokens)) (not (contains? (list "*" "/" "%") (first tokens))))
      {:value left :tokens tokens}
      (let
        ((op (first tokens)))
        (let
          ((r (tcl-expr-parse-power (rest tokens))))
          (tcl-expr-parse-multiplicative-rest
            (get r :tokens)
            (tcl-apply-binop op left (get r :value))))))))

(define
  tcl-expr-parse-multiplicative
  (fn
    (tokens)
    (let
      ((r (tcl-expr-parse-power tokens)))
      (tcl-expr-parse-multiplicative-rest (get r :tokens) (get r :value)))))

(define
  tcl-expr-parse-additive-rest
  (fn
    (tokens left)
    (if
      (or (= 0 (len tokens)) (not (contains? (list "+" "-") (first tokens))))
      {:value left :tokens tokens}
      (let
        ((op (first tokens)))
        (let
          ((r (tcl-expr-parse-multiplicative (rest tokens))))
          (tcl-expr-parse-additive-rest
            (get r :tokens)
            (tcl-apply-binop op left (get r :value))))))))

(define
  tcl-expr-parse-additive
  (fn
    (tokens)
    (let
      ((r (tcl-expr-parse-multiplicative tokens)))
      (tcl-expr-parse-additive-rest (get r :tokens) (get r :value)))))

(define
  tcl-expr-parse-relational-rest
  (fn
    (tokens left)
    (if
      (or (= 0 (len tokens)) (not (contains? (list "<" ">" "<=" ">=") (first tokens))))
      {:value left :tokens tokens}
      (let
        ((op (first tokens)))
        (let
          ((r (tcl-expr-parse-additive (rest tokens))))
          (tcl-expr-parse-relational-rest
            (get r :tokens)
            (tcl-apply-binop op left (get r :value))))))))

(define
  tcl-expr-parse-relational
  (fn
    (tokens)
    (let
      ((r (tcl-expr-parse-additive tokens)))
      (tcl-expr-parse-relational-rest (get r :tokens) (get r :value)))))

(define
  tcl-expr-parse-equality-rest
  (fn
    (tokens left)
    (if
      (or (= 0 (len tokens)) (not (contains? (list "==" "!=") (first tokens))))
      {:value left :tokens tokens}
      (let
        ((op (first tokens)))
        (let
          ((r (tcl-expr-parse-relational (rest tokens))))
          (tcl-expr-parse-equality-rest
            (get r :tokens)
            (tcl-apply-binop op left (get r :value))))))))

(define
  tcl-expr-parse-equality
  (fn
    (tokens)
    (let
      ((r (tcl-expr-parse-relational tokens)))
      (tcl-expr-parse-equality-rest (get r :tokens) (get r :value)))))

(define
  tcl-expr-parse-and-rest
  (fn
    (tokens left)
    (if
      (or (= 0 (len tokens)) (not (equal? (first tokens) "&&")))
      {:value left :tokens tokens}
      (let
        ((r (tcl-expr-parse-equality (rest tokens))))
        (tcl-expr-parse-and-rest
          (get r :tokens)
          (tcl-apply-binop "&&" left (get r :value)))))))

(define
  tcl-expr-parse-and
  (fn
    (tokens)
    (let
      ((r (tcl-expr-parse-equality tokens)))
      (tcl-expr-parse-and-rest (get r :tokens) (get r :value)))))

(define
  tcl-expr-parse-or-rest
  (fn
    (tokens left)
    (if
      (or (= 0 (len tokens)) (not (equal? (first tokens) "||")))
      {:value left :tokens tokens}
      (let
        ((r (tcl-expr-parse-and (rest tokens))))
        (tcl-expr-parse-or-rest
          (get r :tokens)
          (tcl-apply-binop "||" left (get r :value)))))))

(define
  tcl-expr-parse-or
  (fn
    (tokens)
    (let
      ((r (tcl-expr-parse-and tokens)))
      (tcl-expr-parse-or-rest (get r :tokens) (get r :value)))))

(define
  tcl-expr-parse
  (fn
    (tokens)
    (if
      (= 0 (len tokens))
      "0"
      (get (tcl-expr-parse-or tokens) :value))))

(define
  tcl-expr-eval
  (fn
    (interp s)
    (let
      ((cmds (tcl-parse s)))
      (if
        (= 0 (len cmds))
        {:result "0" :interp interp}
        (let
          ((wr (tcl-eval-words (get (first cmds) :words) interp)))
          (let
            ((flat (join " " (get wr :values))))
            (let
              ((tokens (tcl-expr-tokenize flat)))
              {:result (tcl-expr-parse tokens) :interp (get wr :interp)})))))))

(define tcl-cmd-break (fn (interp args) (assoc interp :code 3)))

(define tcl-cmd-continue (fn (interp args) (assoc interp :code 4)))

(define
  tcl-cmd-return
  (fn
    (interp args)
    (let
      ((val (if (> (len args) 0) (last args) "")))
      (assoc (assoc interp :result val) :code 2))))

(define
  tcl-cmd-error
  (fn
    (interp args)
    (let
      ((msg (if (> (len args) 0) (first args) "error")))
      (assoc (assoc interp :result msg) :code 1))))

(define
  tcl-cmd-unset
  (fn
    (interp args)
    (reduce
      (fn
        (i name)
        (let
          ((frame (get i :frame)))
          (let
            ((new-locals (reduce (fn (acc k) (if (equal? k name) acc (assoc acc k (get (get frame :locals) k)))) {} (keys (get frame :locals)))))
            (assoc i :frame (assoc frame :locals new-locals)))))
      interp
      args)))

(define
  tcl-cmd-lappend
  (fn
    (interp args)
    (let
      ((name (first args)) (items (rest args)))
      (let
        ((cur (let ((v (frame-lookup (get interp :frame) name))) (if (nil? v) "" v))))
        (let
          ((new-val (if (equal? cur "") (join " " items) (str cur " " (join " " items)))))
          (assoc (tcl-var-set interp name new-val) :result new-val))))))

(define
  tcl-cmd-eval
  (fn (interp args) (tcl-eval-string interp (join " " args))))

(define
  tcl-while-loop
  (fn
    (interp cond-str body)
    (let
      ((er (tcl-expr-eval interp cond-str)))
      (if
        (tcl-false? (get er :result))
        (get er :interp)
        (let
          ((body-result (tcl-eval-string (get er :interp) body)))
          (let
            ((code (get body-result :code)))
            (cond
              ((= code 3) (assoc body-result :code 0))
              ((= code 2) body-result)
              ((= code 1) body-result)
              (else
                (tcl-while-loop
                  (assoc body-result :code 0)
                  cond-str
                  body)))))))))

(define
  tcl-cmd-while
  (fn
    (interp args)
    (tcl-while-loop interp (first args) (nth args 1))))

(define
  tcl-cmd-if
  (fn
    (interp args)
    (let
      ((er (tcl-expr-eval interp (first args))))
      (let
        ((cond-true (tcl-true? (get er :result)))
          (new-interp (get er :interp))
          (rest-args (rest args)))
        (let
          ((adj (if (and (> (len rest-args) 0) (equal? (first rest-args) "then")) (rest rest-args) rest-args)))
          (let
            ((then-body (first adj)) (rest2 (rest adj)))
            (if
              cond-true
              (tcl-eval-string new-interp then-body)
              (cond
                ((= 0 (len rest2)) new-interp)
                ((equal? (first rest2) "else")
                  (if
                    (> (len rest2) 1)
                    (tcl-eval-string new-interp (nth rest2 1))
                    new-interp))
                ((equal? (first rest2) "elseif")
                  (tcl-cmd-if new-interp (rest rest2)))
                (else new-interp)))))))))

(define
  tcl-for-loop
  (fn
    (interp cond-str step body)
    (let
      ((er (tcl-expr-eval interp cond-str)))
      (if
        (tcl-false? (get er :result))
        (get er :interp)
        (let
          ((body-result (tcl-eval-string (get er :interp) body)))
          (let
            ((code (get body-result :code)))
            (cond
              ((= code 3) (assoc body-result :code 0))
              ((= code 2) body-result)
              ((= code 1) body-result)
              (else
                (let
                  ((step-result (tcl-eval-string (assoc body-result :code 0) step)))
                  (tcl-for-loop
                    (assoc step-result :code 0)
                    cond-str
                    step
                    body))))))))))

(define
  tcl-cmd-for
  (fn
    (interp args)
    (let
      ((init-body (first args))
        (cond-str (nth args 1))
        (step (nth args 2))
        (body (nth args 3)))
      (let
        ((init-result (tcl-eval-string interp init-body)))
        (tcl-for-loop init-result cond-str step body)))))

(define
  tcl-foreach-loop
  (fn
    (interp var-name items body)
    (if
      (= 0 (len items))
      interp
      (let
        ((body-result (tcl-eval-string (tcl-var-set interp var-name (first items)) body)))
        (let
          ((code (get body-result :code)))
          (cond
            ((= code 3) (assoc body-result :code 0))
            ((= code 2) body-result)
            ((= code 1) body-result)
            (else
              (tcl-foreach-loop
                (assoc body-result :code 0)
                var-name
                (rest items)
                body))))))))

(define
  tcl-cmd-foreach
  (fn
    (interp args)
    (let
      ((var-name (first args))
        (list-str (nth args 1))
        (body (nth args 2)))
      (tcl-foreach-loop interp var-name (tcl-list-split list-str) body))))

(define
  tcl-cmd-switch
  (fn
    (interp args)
    (let
      ((str-val (first args)) (body (nth args 1)))
      (let
        ((pairs (tcl-list-split body)))
        (define
          try-pairs
          (fn
            (ps)
            (if
              (= 0 (len ps))
              interp
              (let
                ((pat (first ps)) (bdy (nth ps 1)))
                (if
                  (or (equal? pat str-val) (equal? pat "default"))
                  (if
                    (equal? bdy "-")
                    (try-pairs (rest (rest ps)))
                    (tcl-eval-string interp bdy))
                  (try-pairs (rest (rest ps))))))))
        (try-pairs pairs)))))

(define
  tcl-cmd-expr
  (fn
    (interp args)
    (let
      ((s (join " " args)))
      (let
        ((er (tcl-expr-eval interp s)))
        (assoc (get er :interp) :result (get er :result))))))

(define tcl-cmd-gets (fn (interp args) (assoc interp :result "")))

(define
  tcl-cmd-subst
  (fn (interp args) (assoc interp :result (last args))))

(define
  tcl-cmd-format
  (fn (interp args) (assoc interp :result (join "" args))))

(define tcl-cmd-scan (fn (interp args) (assoc interp :result "0")))

; --- string command helpers ---

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

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

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

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

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

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

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

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

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

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

; string is: check string class
(define
  tcl-string-is
  (fn
    (class s)
    (let
      ((chars (split s ""))
        (n (string-length s)))
      (cond
        ((equal? class "integer")
          (if
            (= n 0)
            "0"
            (let
              ((start (if (or (equal? (first chars) "-") (equal? (first chars) "+")) 1 0)))
              (if
                (= start n)
                "0"
                (if
                  (reduce
                    (fn (ok c) (and ok (tcl-expr-digit? c)))
                    true
                    (slice chars start n))
                  "1"
                  "0")))))
        ((equal? class "double")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn (ok c) (and ok (or (tcl-expr-digit? c) (equal? c ".") (equal? c "-") (equal? c "+") (equal? c "e") (equal? c "E"))))
                true
                chars)
              "1"
              "0")))
        ((equal? class "alpha")
          (if
            (= n 0)
            "0"
            (if
              (reduce (fn (ok c) (and ok (tcl-expr-alpha? c))) true chars)
              "1"
              "0")))
        ((equal? class "alnum")
          (if
            (= n 0)
            "0"
            (if
              (reduce (fn (ok c) (and ok (or (tcl-expr-alpha? c) (tcl-expr-digit? c)))) true chars)
              "1"
              "0")))
        ((equal? class "digit")
          (if
            (= n 0)
            "0"
            (if
              (reduce (fn (ok c) (and ok (tcl-expr-digit? c))) true chars)
              "1"
              "0")))
        ((equal? class "space")
          (if
            (= n 0)
            "1"
            (if
              (reduce (fn (ok c) (and ok (tcl-expr-ws? c))) true chars)
              "1"
              "0")))
        ((equal? class "upper")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn
                  (ok c)
                  (and
                    ok
                    (contains?
                      (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
                            "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z")
                      c)))
                true
                chars)
              "1"
              "0")))
        ((equal? class "lower")
          (if
            (= n 0)
            "0"
            (if
              (reduce
                (fn
                  (ok c)
                  (and
                    ok
                    (contains?
                      (list "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m"
                            "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z")
                      c)))
                true
                chars)
              "1"
              "0")))
        ((equal? class "boolean")
          (if
            (or (equal? s "0") (equal? s "1")
                (equal? s "true") (equal? s "false")
                (equal? s "yes") (equal? s "no")
                (equal? s "on") (equal? s "off"))
            "1"
            "0"))
        (else "0")))))

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


; --- list command helpers ---

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

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

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

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

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

; --- list commands ---

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

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

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

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

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

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

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

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

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

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

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

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

(define
  make-default-tcl-interp
  (fn
    ()
    (let
      ((i (make-tcl-interp)))
      (let
        ((i (tcl-register i "set" tcl-cmd-set)))
        (let
          ((i (tcl-register i "puts" tcl-cmd-puts)))
          (let
            ((i (tcl-register i "incr" tcl-cmd-incr)))
            (let
              ((i (tcl-register i "append" tcl-cmd-append)))
              (let
                ((i (tcl-register i "unset" tcl-cmd-unset)))
                (let
                  ((i (tcl-register i "lappend" tcl-cmd-lappend)))
                  (let
                    ((i (tcl-register i "eval" tcl-cmd-eval)))
                    (let
                      ((i (tcl-register i "if" tcl-cmd-if)))
                      (let
                        ((i (tcl-register i "while" tcl-cmd-while)))
                        (let
                          ((i (tcl-register i "for" tcl-cmd-for)))
                          (let
                            ((i (tcl-register i "foreach" tcl-cmd-foreach)))
                            (let
                              ((i (tcl-register i "switch" tcl-cmd-switch)))
                              (let
                                ((i (tcl-register i "break" tcl-cmd-break)))
                                (let
                                  ((i (tcl-register i "continue" tcl-cmd-continue)))
                                  (let
                                    ((i (tcl-register i "return" tcl-cmd-return)))
                                    (let
                                      ((i (tcl-register i "error" tcl-cmd-error)))
                                      (let
                                        ((i (tcl-register i "expr" tcl-cmd-expr)))
                                        (let
                                          ((i (tcl-register i "gets" tcl-cmd-gets)))
                                          (let
                                            ((i (tcl-register i "subst" tcl-cmd-subst)))
                                            (let
                                              ((i (tcl-register i "format" tcl-cmd-format)))
                                              (let
                                                ((i (tcl-register i "scan" tcl-cmd-scan)))
                                                (let
                                                  ((i (tcl-register i "string" tcl-cmd-string)))
                                                  (let
                                                    ((i (tcl-register i "list" tcl-cmd-list)))
                                                    (let
                                                      ((i (tcl-register i "lindex" tcl-cmd-lindex)))
                                                      (let
                                                        ((i (tcl-register i "lrange" tcl-cmd-lrange)))
                                                        (let
                                                          ((i (tcl-register i "llength" tcl-cmd-llength)))
                                                          (let
                                                            ((i (tcl-register i "lreverse" tcl-cmd-lreverse)))
                                                            (let
                                                              ((i (tcl-register i "lsearch" tcl-cmd-lsearch)))
                                                              (let
                                                                ((i (tcl-register i "lsort" tcl-cmd-lsort)))
                                                                (let
                                                                  ((i (tcl-register i "lreplace" tcl-cmd-lreplace)))
                                                                  (let
                                                                    ((i (tcl-register i "linsert" tcl-cmd-linsert)))
                                                                    (let
                                                                      ((i (tcl-register i "concat" tcl-cmd-concat)))
                                                                      (let
                                                                        ((i (tcl-register i "split" tcl-cmd-split)))
                                                                        (tcl-register i "join" tcl-cmd-join)))))))))))))))))))))))))))))))))))))