cl: Phase 6 stdlib — sequence/list/string functions, 508/508 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
mapc/mapcan/reduce/find/find-if/position/count/every/some/notany/ notevery/remove/remove-if/subst/member; assoc/rassoc/getf/last/ butlast/nthcdr/list*/cadr/caddr/cadddr; subseq/coerce/make-list. 44 new tests in tests/stdlib.sx. Helpers: cl-member-helper, cl-subst-helper, cl-position-helper. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -190,6 +190,40 @@
|
||||
(let ((e5 (cl-bind-aux aux-specs e4)))
|
||||
(cl-eval-body body e5)))))))))))))
|
||||
|
||||
|
||||
;; ── sequence/list helpers (needed by builtins) ───────────────────
|
||||
|
||||
(define cl-member-helper
|
||||
(fn (item lst)
|
||||
(if (= lst nil) nil
|
||||
(if (= (len lst) 0) nil
|
||||
(if (= (nth lst 0) item)
|
||||
lst
|
||||
(cl-member-helper item (rest lst)))))))
|
||||
|
||||
(define cl-subst-helper
|
||||
(fn (new old tree)
|
||||
(if (= tree old) new
|
||||
(if (and (list? tree) (> (len tree) 0))
|
||||
(map (fn (x) (cl-subst-helper new old x)) tree)
|
||||
tree))))
|
||||
|
||||
(define cl-position-helper
|
||||
(fn (item lst idx)
|
||||
(if (= lst nil) nil
|
||||
(if (= (len lst) 0) nil
|
||||
(if (= (nth lst 0) item)
|
||||
idx
|
||||
(cl-position-helper item (rest lst) (+ idx 1)))))))
|
||||
|
||||
(define cl-position-if-helper
|
||||
(fn (fn-obj lst idx)
|
||||
(if (= lst nil) nil
|
||||
(if (= (len lst) 0) nil
|
||||
(if (cl-apply fn-obj (list (nth lst 0)))
|
||||
idx
|
||||
(cl-position-if-helper fn-obj (rest lst) (+ idx 1)))))))
|
||||
|
||||
;; ── built-in functions ────────────────────────────────────────────
|
||||
|
||||
(define cl-builtins
|
||||
@@ -298,7 +332,229 @@
|
||||
"CONCATENATE" (fn (args) (reduce (fn (a b) (str a b)) "" (rest args)))
|
||||
"EQ" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
||||
"EQL" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
||||
"EQUAL" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))))
|
||||
"EQUAL" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
||||
;; sequence functions
|
||||
"MAPC" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(begin
|
||||
(for-each (fn (x) (cl-apply fn-obj (list x))) lst)
|
||||
(nth args 1))))
|
||||
"MAPCAN" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(reduce (fn (acc x)
|
||||
(let ((r (cl-apply fn-obj (list x))))
|
||||
(if (= r nil) acc
|
||||
(concat acc r))))
|
||||
(list) lst)))
|
||||
"REDUCE" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((iv-r (cl-find-kw-arg "INITIAL-VALUE" args 2)))
|
||||
(let ((has-iv (get iv-r "found"))
|
||||
(iv (get iv-r "value")))
|
||||
(if (= (len lst) 0)
|
||||
(if has-iv iv (cl-apply fn-obj (list)))
|
||||
(if has-iv
|
||||
(reduce (fn (acc x) (cl-apply fn-obj (list acc x))) iv lst)
|
||||
(reduce (fn (acc x) (cl-apply fn-obj (list acc x)))
|
||||
(nth lst 0) (rest lst))))))))
|
||||
"FIND" (fn (args)
|
||||
(let ((item (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((r (some (fn (x) (if (= x item) x false)) lst)))
|
||||
(if r r nil))))
|
||||
"FIND-IF" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((r (some (fn (x)
|
||||
(let ((res (cl-apply fn-obj (list x))))
|
||||
(if res x false)))
|
||||
lst)))
|
||||
(if r r nil))))
|
||||
"FIND-IF-NOT" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((r (some (fn (x)
|
||||
(let ((res (cl-apply fn-obj (list x))))
|
||||
(if res false x)))
|
||||
lst)))
|
||||
(if r r nil))))
|
||||
"POSITION" (fn (args)
|
||||
(cl-position-helper (nth args 0)
|
||||
(if (= (nth args 1) nil) (list) (nth args 1)) 0))
|
||||
"POSITION-IF" (fn (args)
|
||||
(cl-position-if-helper (nth args 0)
|
||||
(if (= (nth args 1) nil) (list) (nth args 1)) 0))
|
||||
"COUNT" (fn (args)
|
||||
(let ((item (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(len (filter (fn (x) (= x item)) lst))))
|
||||
"COUNT-IF" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(len (filter (fn (x) (cl-apply fn-obj (list x))) lst))))
|
||||
"EVERY" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(if (every? (fn (x) (cl-apply fn-obj (list x))) lst) true nil)))
|
||||
"SOME" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((r (some (fn (x) (cl-apply fn-obj (list x))) lst)))
|
||||
(if r r nil))))
|
||||
"NOTANY" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(if (some (fn (x) (cl-apply fn-obj (list x))) lst) nil true)))
|
||||
"NOTEVERY" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(if (every? (fn (x) (cl-apply fn-obj (list x))) lst) nil true)))
|
||||
"REMOVE" (fn (args)
|
||||
(let ((item (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(filter (fn (x) (not (= x item))) lst)))
|
||||
"REMOVE-IF" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(filter (fn (x) (not (cl-apply fn-obj (list x)))) lst)))
|
||||
"REMOVE-IF-NOT" (fn (args)
|
||||
(let ((fn-obj (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(filter (fn (x) (cl-apply fn-obj (list x))) lst)))
|
||||
"SUBST" (fn (args)
|
||||
(cl-subst-helper (nth args 0) (nth args 1)
|
||||
(if (= (nth args 2) nil) (list) (nth args 2))))
|
||||
"MEMBER" (fn (args)
|
||||
(cl-member-helper (nth args 0)
|
||||
(if (= (nth args 1) nil) nil (nth args 1))))
|
||||
;; list ops
|
||||
"ASSOC" (fn (args)
|
||||
(let ((key (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((r (some
|
||||
(fn (pair)
|
||||
(let ((k (if (and (dict? pair) (= (get pair "cl-type") "cons"))
|
||||
(get pair "car")
|
||||
(if (and (list? pair) (> (len pair) 0))
|
||||
(nth pair 0)
|
||||
nil))))
|
||||
(if (= k key) pair false)))
|
||||
lst)))
|
||||
(if r r nil))))
|
||||
"RASSOC" (fn (args)
|
||||
(let ((val (nth args 0))
|
||||
(lst (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(let ((r (some
|
||||
(fn (pair)
|
||||
(let ((v (if (and (dict? pair) (= (get pair "cl-type") "cons"))
|
||||
(get pair "cdr")
|
||||
(if (and (list? pair) (> (len pair) 1))
|
||||
(nth pair 1)
|
||||
nil))))
|
||||
(if (= v val) pair false)))
|
||||
lst)))
|
||||
(if r r nil))))
|
||||
"GETF" (fn (args)
|
||||
(let ((plist (if (= (nth args 0) nil) (list) (nth args 0)))
|
||||
(ind (nth args 1))
|
||||
(def (if (> (len args) 2) (nth args 2) nil)))
|
||||
(let ((ind-name (if (and (dict? ind) (= (get ind "cl-type") "keyword"))
|
||||
(get ind "name")
|
||||
(upcase (str ind)))))
|
||||
(let ((r (cl-find-kw-arg ind-name plist 0)))
|
||||
(if (get r "found") (get r "value") def)))))
|
||||
"LAST" (fn (args)
|
||||
(let ((lst (nth args 0)))
|
||||
(if (or (= lst nil) (= (len lst) 0)) nil
|
||||
(list (nth lst (- (len lst) 1))))))
|
||||
"BUTLAST" (fn (args)
|
||||
(let ((lst (nth args 0)))
|
||||
(if (or (= lst nil) (= (len lst) 0)) (list)
|
||||
(slice lst 0 (- (len lst) 1)))))
|
||||
"NTHCDR" (fn (args)
|
||||
(let ((n (nth args 0))
|
||||
(lst (nth args 1)))
|
||||
(if (= lst nil) nil
|
||||
(if (>= n (len lst)) nil
|
||||
(slice lst n (len lst))))))
|
||||
"COPY-LIST" (fn (args) (nth args 0))
|
||||
"LIST*" (fn (args)
|
||||
(if (= (len args) 0) nil
|
||||
(if (= (len args) 1) (nth args 0)
|
||||
(let ((head (slice args 0 (- (len args) 1)))
|
||||
(tail (nth args (- (len args) 1))))
|
||||
(concat head (if (list? tail) tail (list tail)))))))
|
||||
"CAAR" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(let ((c (if (and (list? x) (> (len x) 0)) (nth x 0) nil)))
|
||||
(if (and (list? c) (> (len c) 0)) (nth c 0) nil))))
|
||||
"CADR" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(if (and (list? x) (> (len x) 1)) (nth x 1) nil)))
|
||||
"CDAR" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(let ((c (if (and (list? x) (> (len x) 0)) (nth x 0) nil)))
|
||||
(if (and (list? c) (> (len c) 0)) (rest c) nil))))
|
||||
"CDDR" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(if (and (list? x) (> (len x) 2))
|
||||
(slice x 2 (len x))
|
||||
nil)))
|
||||
"CADDR" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(if (and (list? x) (> (len x) 2)) (nth x 2) nil)))
|
||||
"CADDDR" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(if (and (list? x) (> (len x) 3)) (nth x 3) nil)))
|
||||
"PAIRLIS" (fn (args)
|
||||
(let ((ks (if (= (nth args 0) nil) (list) (nth args 0)))
|
||||
(vs (if (= (nth args 1) nil) (list) (nth args 1))))
|
||||
(map (fn (i) (list (nth ks i) (nth vs i)))
|
||||
(range 0 (len ks)))))
|
||||
;; string ops
|
||||
"SUBSEQ" (fn (args)
|
||||
(let ((seq (nth args 0))
|
||||
(start (nth args 1))
|
||||
(end (if (> (len args) 2) (nth args 2) nil)))
|
||||
(if (string? seq)
|
||||
(if end (substr seq start (- end 1)) (substr seq start (- (len seq) 1)))
|
||||
(if (= seq nil) (list)
|
||||
(if end (slice seq start end) (slice seq start (len seq)))))))
|
||||
"STRING" (fn (args)
|
||||
(let ((x (nth args 0)))
|
||||
(if (string? x) x (str x))))
|
||||
"CHAR" (fn (args)
|
||||
(let ((s (nth args 0)) (i (nth args 1)))
|
||||
{:cl-type "char" :value (substr s i (+ i 1))}))
|
||||
"CHAR=" (fn (args)
|
||||
(let ((a (nth args 0)) (b (nth args 1)))
|
||||
(let ((av (if (dict? a) (get a "value") a))
|
||||
(bv (if (dict? b) (get b "value") b)))
|
||||
(if (= av bv) true nil))))
|
||||
"STRING-LENGTH" (fn (args) (len (nth args 0)))
|
||||
"STRING<" (fn (args) (if (< (nth args 0) (nth args 1)) true nil))
|
||||
"STRING>" (fn (args) (if (> (nth args 0) (nth args 1)) true nil))
|
||||
"STRING<=" (fn (args) (if (<= (nth args 0) (nth args 1)) true nil))
|
||||
"STRING>=" (fn (args) (if (>= (nth args 0) (nth args 1)) true nil))
|
||||
"WRITE-TO-STRING" (fn (args) (inspect (nth args 0)))
|
||||
"SYMBOL-NAME" (fn (args) (upcase (str (nth args 0))))
|
||||
"COERCE" (fn (args)
|
||||
(let ((x (nth args 0))
|
||||
(tp (upcase (str (nth args 1)))))
|
||||
(cond
|
||||
((= tp "LIST") (if (string? x)
|
||||
(map (fn (i) {:cl-type "char" :value (substr x i (+ i 1))})
|
||||
(range 0 (len x))) x))
|
||||
((= tp "STRING") (if (list? x)
|
||||
(reduce (fn (a c) (str a (if (dict? c) (get c "value") c))) "" x)
|
||||
(str x)))
|
||||
(:else x))))
|
||||
"MAKE-LIST" (fn (args)
|
||||
(let ((n (nth args 0)))
|
||||
(map (fn (_) nil) (range 0 n))))))
|
||||
|
||||
;; Register builtins in cl-global-env so (function #'name) resolves them
|
||||
(for-each
|
||||
|
||||
Reference in New Issue
Block a user