tcl: list commands — 12 commands (+26 tests, 182 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -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)))))))))))))))))))))))))))))))))))))
|
||||
|
||||
Reference in New Issue
Block a user