coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tcl: list commands — 12 commands (+26 tests, 182 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source 
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-06 08:54:24 +00:00
parent a26be0bfd0
commit 7b11f3d44a
2 changed files with 316 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

293
lib/tcl/runtime.sx
View File

@@ -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
i
"string"
tcl-cmd-string)))))))))))))))))))))))))
(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)))))))))))))))))))))))))))))))))))))

27
lib/tcl/tests/eval.sx
View File

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