tcl: list commands — 12 commands (+26 tests, 182 total)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/tcl/runtime.sx

@@ -1334,6 +1334,270 @@
           (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
@@ -1382,7 +1646,28 @@
                                               ((i (tcl-register i "format" tcl-cmd-format)))
                                               (let
                                                 ((i (tcl-register i "scan" tcl-cmd-scan)))
-                                                (tcl-register
+                                                (let
-                                                  i
+                                                  ((i (tcl-register i "string" tcl-cmd-string)))
-                                                  "string"
+                                                  (let
-                                                  tcl-cmd-string)))))))))))))))))))))))))
+                                                    ((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)))))))))))))))))))))))))))))))))))))

lib/tcl/tests/eval.sx

@@ -234,6 +234,33 @@
     (ok "str-is-alpha-no" (get (run "string is alpha hello1") :result) "0")
     (ok "str-is-boolean" (get (run "string is boolean true") :result) "1")
     (ok "str-cat" (get (run "string cat foo bar baz") :result) "foobarbaz")
+    ; --- list command tests ---
+    (ok "list-simple" (get (run "list a b c") :result) "a b c")
+    (ok "list-brace-elem" (get (run "list {a b} c") :result) "{a b} c")
+    (ok "list-empty" (get (run "list") :result) "")
+    (ok "lindex-1" (get (run "lindex {a b c} 1") :result) "b")
+    (ok "lindex-0" (get (run "lindex {a b c} 0") :result) "a")
+    (ok "lindex-oob" (get (run "lindex {a b c} 5") :result) "")
+    (ok "lrange" (get (run "lrange {a b c d} 1 2") :result) "b c")
+    (ok "lrange-full" (get (run "lrange {a b c} 0 end") :result) "a b c")
+    (ok "llength" (get (run "llength {a b c}") :result) "3")
+    (ok "llength-empty" (get (run "llength {}") :result) "0")
+    (ok "lreverse" (get (run "lreverse {1 2 3}") :result) "3 2 1")
+    (ok "lsearch-found" (get (run "lsearch {a b c} b") :result) "1")
+    (ok "lsearch-missing" (get (run "lsearch {a b c} z") :result) "-1")
+    (ok "lsearch-exact" (get (run "lsearch -exact {foo bar} foo") :result) "0")
+    (ok "lsort-asc" (get (run "lsort {banana apple cherry}") :result) "apple banana cherry")
+    (ok "lsort-int" (get (run "lsort -integer {10 2 30 5}") :result) "2 5 10 30")
+    (ok "lsort-dec" (get (run "lsort -decreasing {c a b}") :result) "c b a")
+    (ok "lreplace" (get (run "lreplace {a b c d} 1 2 X Y") :result) "a X Y d")
+    (ok "linsert" (get (run "linsert {a b c} 1 X Y") :result) "a X Y b c")
+    (ok "linsert-end" (get (run "linsert {a b} end Z") :result) "a b Z")
+    (ok "concat" (get (run "concat {a b} {c d}") :result) "a b c d")
+    (ok "split-sep" (get (run "split {a:b:c} :") :result) "a b c")
+    (ok "split-ws" (get (run "split {a b c}") :result) "a b c")
+    (ok "join-sep" (get (run "join {a b c} -") :result) "a-b-c")
+    (ok "join-default" (get (run "join {a b c}") :result) "a b c")
+    (ok "list-var" (get (run "set L {x y z}\nllength $L") :result) "3")
     (dict
       "passed"
       tcl-eval-pass