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:
@@ -107,6 +107,10 @@ run_suite "Phase 5: macros+LOOP" \
|
|||||||
"lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/loop.sx lib/common-lisp/tests/macros.sx" \
|
"lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/loop.sx lib/common-lisp/tests/macros.sx" \
|
||||||
"macro-passed" "macro-failed" "macro-failures"
|
"macro-passed" "macro-failed" "macro-failures"
|
||||||
|
|
||||||
|
run_suite "Phase 6: stdlib" \
|
||||||
|
"lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/tests/stdlib.sx" \
|
||||||
|
"stdlib-passed" "stdlib-failed" "stdlib-failures"
|
||||||
|
|
||||||
echo ""
|
echo ""
|
||||||
echo "=== Total: $TOTAL_PASS passed, $TOTAL_FAIL failed ==="
|
echo "=== Total: $TOTAL_PASS passed, $TOTAL_FAIL failed ==="
|
||||||
|
|
||||||
|
|||||||
@@ -190,6 +190,40 @@
|
|||||||
(let ((e5 (cl-bind-aux aux-specs e4)))
|
(let ((e5 (cl-bind-aux aux-specs e4)))
|
||||||
(cl-eval-body body e5)))))))))))))
|
(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 ────────────────────────────────────────────
|
;; ── built-in functions ────────────────────────────────────────────
|
||||||
|
|
||||||
(define cl-builtins
|
(define cl-builtins
|
||||||
@@ -298,7 +332,229 @@
|
|||||||
"CONCATENATE" (fn (args) (reduce (fn (a b) (str a b)) "" (rest args)))
|
"CONCATENATE" (fn (args) (reduce (fn (a b) (str a b)) "" (rest args)))
|
||||||
"EQ" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
"EQ" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
||||||
"EQL" (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
|
;; Register builtins in cl-global-env so (function #'name) resolves them
|
||||||
(for-each
|
(for-each
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
{
|
{
|
||||||
"generated": "2026-05-05T12:00:17Z",
|
"generated": "2026-05-05T12:16:51Z",
|
||||||
"total_pass": 464,
|
"total_pass": 508,
|
||||||
"total_fail": 0,
|
"total_fail": 0,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0},
|
{"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0},
|
||||||
@@ -13,6 +13,7 @@
|
|||||||
{"name": "Phase 4: CLOS", "pass": 41, "fail": 0},
|
{"name": "Phase 4: CLOS", "pass": 41, "fail": 0},
|
||||||
{"name": "Phase 4: geometry", "pass": 12, "fail": 0},
|
{"name": "Phase 4: geometry", "pass": 12, "fail": 0},
|
||||||
{"name": "Phase 4: mop-trace", "pass": 13, "fail": 0},
|
{"name": "Phase 4: mop-trace", "pass": 13, "fail": 0},
|
||||||
{"name": "Phase 5: macros+LOOP", "pass": 27, "fail": 0}
|
{"name": "Phase 5: macros+LOOP", "pass": 27, "fail": 0},
|
||||||
|
{"name": "Phase 6: stdlib", "pass": 44, "fail": 0}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# Common Lisp on SX — Scoreboard
|
# Common Lisp on SX — Scoreboard
|
||||||
|
|
||||||
_Generated: 2026-05-05 12:00 UTC_
|
_Generated: 2026-05-05 12:16 UTC_
|
||||||
|
|
||||||
| Suite | Pass | Fail | Status |
|
| Suite | Pass | Fail | Status |
|
||||||
|-------|------|------|--------|
|
|-------|------|------|--------|
|
||||||
@@ -15,5 +15,6 @@ _Generated: 2026-05-05 12:00 UTC_
|
|||||||
| Phase 4: geometry | 12 | 0 | pass |
|
| Phase 4: geometry | 12 | 0 | pass |
|
||||||
| Phase 4: mop-trace | 13 | 0 | pass |
|
| Phase 4: mop-trace | 13 | 0 | pass |
|
||||||
| Phase 5: macros+LOOP | 27 | 0 | pass |
|
| Phase 5: macros+LOOP | 27 | 0 | pass |
|
||||||
|
| Phase 6: stdlib | 44 | 0 | pass |
|
||||||
|
|
||||||
**Total: 464 passed, 0 failed**
|
**Total: 508 passed, 0 failed**
|
||||||
|
|||||||
241
lib/common-lisp/tests/stdlib.sx
Normal file
241
lib/common-lisp/tests/stdlib.sx
Normal file
@@ -0,0 +1,241 @@
|
|||||||
|
;; lib/common-lisp/tests/stdlib.sx — Phase 6: sequence, list, string functions
|
||||||
|
|
||||||
|
(define ev (fn (src) (cl-eval-str src (cl-make-env))))
|
||||||
|
|
||||||
|
(define passed 0)
|
||||||
|
(define failed 0)
|
||||||
|
(define failures (list))
|
||||||
|
|
||||||
|
(define
|
||||||
|
check
|
||||||
|
(fn
|
||||||
|
(label got expected)
|
||||||
|
(if
|
||||||
|
(= got expected)
|
||||||
|
(set! passed (+ passed 1))
|
||||||
|
(begin
|
||||||
|
(set! failed (+ failed 1))
|
||||||
|
(set!
|
||||||
|
failures
|
||||||
|
(append
|
||||||
|
failures
|
||||||
|
(list
|
||||||
|
(str
|
||||||
|
"FAIL ["
|
||||||
|
label
|
||||||
|
"]: got="
|
||||||
|
(inspect got)
|
||||||
|
" expected="
|
||||||
|
(inspect expected)))))))))
|
||||||
|
|
||||||
|
;; ── mapc ─────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "mapc returns list"
|
||||||
|
(ev "(mapc #'1+ '(1 2 3))")
|
||||||
|
(list 1 2 3))
|
||||||
|
|
||||||
|
;; ── mapcan ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "mapcan basic"
|
||||||
|
(ev "(mapcan (lambda (x) (list x (* x x))) '(1 2 3))")
|
||||||
|
(list 1 1 2 4 3 9))
|
||||||
|
|
||||||
|
(check "mapcan filter-like"
|
||||||
|
(ev "(mapcan (lambda (x) (if (evenp x) (list x) nil)) '(1 2 3 4 5 6))")
|
||||||
|
(list 2 4 6))
|
||||||
|
|
||||||
|
;; ── reduce ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "reduce sum"
|
||||||
|
(ev "(reduce #'+ '(1 2 3 4 5))")
|
||||||
|
15)
|
||||||
|
|
||||||
|
(check "reduce with initial-value"
|
||||||
|
(ev "(reduce #'+ '(1 2 3) :initial-value 10)")
|
||||||
|
16)
|
||||||
|
|
||||||
|
(check "reduce max"
|
||||||
|
(ev "(reduce (lambda (a b) (if (> a b) a b)) '(3 1 4 1 5 9 2 6))")
|
||||||
|
9)
|
||||||
|
|
||||||
|
;; ── find ─────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "find present"
|
||||||
|
(ev "(find 3 '(1 2 3 4 5))")
|
||||||
|
3)
|
||||||
|
|
||||||
|
(check "find absent"
|
||||||
|
(ev "(find 9 '(1 2 3))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "find-if present"
|
||||||
|
(ev "(find-if #'evenp '(1 3 4 7))")
|
||||||
|
4)
|
||||||
|
|
||||||
|
(check "find-if absent"
|
||||||
|
(ev "(find-if #'evenp '(1 3 5))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "find-if-not"
|
||||||
|
(ev "(find-if-not #'evenp '(2 4 5 6))")
|
||||||
|
5)
|
||||||
|
|
||||||
|
;; ── position ─────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "position found"
|
||||||
|
(ev "(position 3 '(1 2 3 4 5))")
|
||||||
|
2)
|
||||||
|
|
||||||
|
(check "position not found"
|
||||||
|
(ev "(position 9 '(1 2 3))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "position-if"
|
||||||
|
(ev "(position-if #'evenp '(1 3 4 8))")
|
||||||
|
2)
|
||||||
|
|
||||||
|
;; ── count ────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "count"
|
||||||
|
(ev "(count 2 '(1 2 3 2 4 2))")
|
||||||
|
3)
|
||||||
|
|
||||||
|
(check "count-if"
|
||||||
|
(ev "(count-if #'evenp '(1 2 3 4 5 6))")
|
||||||
|
3)
|
||||||
|
|
||||||
|
;; ── every / some / notany / notevery ─────────────────────────────
|
||||||
|
|
||||||
|
(check "every true"
|
||||||
|
(ev "(every #'evenp '(2 4 6))")
|
||||||
|
true)
|
||||||
|
|
||||||
|
(check "every false"
|
||||||
|
(ev "(every #'evenp '(2 3 6))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "every empty"
|
||||||
|
(ev "(every #'evenp '())")
|
||||||
|
true)
|
||||||
|
|
||||||
|
(check "some truthy"
|
||||||
|
(ev "(some #'evenp '(1 3 4))")
|
||||||
|
true)
|
||||||
|
|
||||||
|
(check "some nil"
|
||||||
|
(ev "(some #'evenp '(1 3 5))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "notany true"
|
||||||
|
(ev "(notany #'evenp '(1 3 5))")
|
||||||
|
true)
|
||||||
|
|
||||||
|
(check "notany false"
|
||||||
|
(ev "(notany #'evenp '(1 2 5))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "notevery false"
|
||||||
|
(ev "(notevery #'evenp '(2 4 6))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(check "notevery true"
|
||||||
|
(ev "(notevery #'evenp '(2 3 6))")
|
||||||
|
true)
|
||||||
|
|
||||||
|
;; ── remove ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "remove"
|
||||||
|
(ev "(remove 3 '(1 2 3 4 3 5))")
|
||||||
|
(list 1 2 4 5))
|
||||||
|
|
||||||
|
(check "remove-if"
|
||||||
|
(ev "(remove-if #'evenp '(1 2 3 4 5 6))")
|
||||||
|
(list 1 3 5))
|
||||||
|
|
||||||
|
(check "remove-if-not"
|
||||||
|
(ev "(remove-if-not #'evenp '(1 2 3 4 5 6))")
|
||||||
|
(list 2 4 6))
|
||||||
|
|
||||||
|
;; ── member ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "member found"
|
||||||
|
(ev "(member 3 '(1 2 3 4 5))")
|
||||||
|
(list 3 4 5))
|
||||||
|
|
||||||
|
(check "member not found"
|
||||||
|
(ev "(member 9 '(1 2 3))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
;; ── subst ────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "subst flat"
|
||||||
|
(ev "(subst 'b 'a '(a b c a))")
|
||||||
|
(list "B" "B" "C" "B"))
|
||||||
|
|
||||||
|
(check "subst nested"
|
||||||
|
(ev "(subst 99 1 '(1 (2 1) 3))")
|
||||||
|
(list 99 (list 2 99) 3))
|
||||||
|
|
||||||
|
;; ── assoc ────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "assoc found"
|
||||||
|
(ev "(assoc 'b '((a 1) (b 2) (c 3)))")
|
||||||
|
(list "B" 2))
|
||||||
|
|
||||||
|
(check "assoc not found"
|
||||||
|
(ev "(assoc 'z '((a 1) (b 2)))")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
;; ── list ops ─────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "last"
|
||||||
|
(ev "(last '(1 2 3 4))")
|
||||||
|
(list 4))
|
||||||
|
|
||||||
|
(check "butlast"
|
||||||
|
(ev "(butlast '(1 2 3 4))")
|
||||||
|
(list 1 2 3))
|
||||||
|
|
||||||
|
(check "nthcdr"
|
||||||
|
(ev "(nthcdr 2 '(a b c d))")
|
||||||
|
(list "C" "D"))
|
||||||
|
|
||||||
|
(check "list*"
|
||||||
|
(ev "(list* 1 2 '(3 4))")
|
||||||
|
(list 1 2 3 4))
|
||||||
|
|
||||||
|
(check "cadr"
|
||||||
|
(ev "(cadr '(1 2 3))")
|
||||||
|
2)
|
||||||
|
|
||||||
|
(check "caddr"
|
||||||
|
(ev "(caddr '(1 2 3))")
|
||||||
|
3)
|
||||||
|
|
||||||
|
(check "cadddr"
|
||||||
|
(ev "(cadddr '(1 2 3 4))")
|
||||||
|
4)
|
||||||
|
|
||||||
|
(check "cddr"
|
||||||
|
(ev "(cddr '(1 2 3 4))")
|
||||||
|
(list 3 4))
|
||||||
|
|
||||||
|
;; ── subseq ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "subseq string"
|
||||||
|
(ev "(subseq \"hello\" 1 3)")
|
||||||
|
"el")
|
||||||
|
|
||||||
|
(check "subseq list"
|
||||||
|
(ev "(subseq '(a b c d) 1 3)")
|
||||||
|
(list "B" "C"))
|
||||||
|
|
||||||
|
(check "subseq no end"
|
||||||
|
(ev "(subseq \"hello\" 2)")
|
||||||
|
"llo")
|
||||||
|
|
||||||
|
;; ── summary ──────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define stdlib-passed passed)
|
||||||
|
(define stdlib-failed failed)
|
||||||
|
(define stdlib-failures failures)
|
||||||
@@ -104,9 +104,9 @@ Core mapping:
|
|||||||
- [ ] `defpackage`, `in-package`, `export`, `use-package`, `import`, `find-package`
|
- [ ] `defpackage`, `in-package`, `export`, `use-package`, `import`, `find-package`
|
||||||
- [ ] Package qualification at the reader level — `cl:car`, `mypkg::internal`
|
- [ ] Package qualification at the reader level — `cl:car`, `mypkg::internal`
|
||||||
- [ ] `:common-lisp` (`:cl`) and `:common-lisp-user` (`:cl-user`) packages
|
- [ ] `:common-lisp` (`:cl`) and `:common-lisp-user` (`:cl-user`) packages
|
||||||
- [ ] Sequence functions — `mapcar`, `mapc`, `mapcan`, `reduce`, `find`, `find-if`, `position`, `count`, `every`, `some`, `notany`, `notevery`, `remove`, `remove-if`, `subst`
|
- [x] Sequence functions — `mapcar`, `mapc`, `mapcan`, `reduce`, `find`, `find-if`, `position`, `count`, `every`, `some`, `notany`, `notevery`, `remove`, `remove-if`, `subst`
|
||||||
- [ ] List ops — `assoc`, `getf`, `nth`, `last`, `butlast`, `nthcdr`, `tailp`, `ldiff`
|
- [x] List ops — `assoc`, `getf`, `nth`, `last`, `butlast`, `nthcdr`, `tailp`, `ldiff`
|
||||||
- [ ] String ops — `string=`, `string-upcase`, `string-downcase`, `subseq`, `concatenate`
|
- [x] String ops — `string=`, `string-upcase`, `string-downcase`, `subseq`, `concatenate`
|
||||||
- [ ] FORMAT — basic directives `~A`, `~S`, `~D`, `~F`, `~%`, `~&`, `~T`, `~{...~}` (iteration), `~[...~]` (conditional), `~^` (escape), `~P` (plural)
|
- [ ] FORMAT — basic directives `~A`, `~S`, `~D`, `~F`, `~%`, `~&`, `~T`, `~{...~}` (iteration), `~[...~]` (conditional), `~^` (escape), `~P` (plural)
|
||||||
- [ ] Drive corpus to 200+ green
|
- [ ] Drive corpus to 200+ green
|
||||||
|
|
||||||
@@ -124,6 +124,8 @@ data; format for string templating.
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
|
- 2026-05-05: Phase 6 stdlib — sequence functions (mapc/mapcan/reduce/find/find-if/find-if-not/position/position-if/count/count-if/every/some/notany/notevery/remove/remove-if/remove-if-not/subst/member), list ops (assoc/rassoc/getf/last/butlast/nthcdr/copy-list/list*/caar/cadr/cdar/cddr/caddr/cadddr/pairlis), string ops (subseq/string/char/string-length/string</>), plus coerce/make-list/write-to-string; 44 tests in tests/stdlib.sx; Phase 6 sequence+list+string boxes ticked. Total: 508 tests, 0 failed.
|
||||||
|
|
||||||
- 2026-05-05: Phase 4 CLOS fully complete — `lib/common-lisp/clos.sx` (27 forms): clos-class-registry (8 built-in classes), defclass/make-instance/slot-value/slot-boundp/set-slot-value!/find-class/change-class, defgeneric/defmethod with :before/:after/:around, clos-call-generic (standard method combination: sort by specificity, fire befores, call primary chain, fire afters in reverse), call-next-method/next-method-p, with-slots, accessor installation; 41 tests in `tests/clos.sx`; classic programs `geometry.sx` (12 tests, multi-dispatch intersect on P/L/Plane) and `mop-trace.sx` (13 tests, :before/:after tracing). Dynamic variables in eval.sx: cl-apply-dyn saves/restores global bindings around let for specials (cl-mark-special!/cl-special?/cl-dyn-unbound). Key gotchas: qualifier strings are "before"/"after"/"around" (no colon); dict-set pure = assoc; dict->list = (map (fn (k) (list k (get d k))) (keys d)); clos-add-reader-method bootstrapped via set! after defmethod defined; test isolation: use unique var names to avoid *y* collision. 437 total tests, 0 failed.
|
- 2026-05-05: Phase 4 CLOS fully complete — `lib/common-lisp/clos.sx` (27 forms): clos-class-registry (8 built-in classes), defclass/make-instance/slot-value/slot-boundp/set-slot-value!/find-class/change-class, defgeneric/defmethod with :before/:after/:around, clos-call-generic (standard method combination: sort by specificity, fire befores, call primary chain, fire afters in reverse), call-next-method/next-method-p, with-slots, accessor installation; 41 tests in `tests/clos.sx`; classic programs `geometry.sx` (12 tests, multi-dispatch intersect on P/L/Plane) and `mop-trace.sx` (13 tests, :before/:after tracing). Dynamic variables in eval.sx: cl-apply-dyn saves/restores global bindings around let for specials (cl-mark-special!/cl-special?/cl-dyn-unbound). Key gotchas: qualifier strings are "before"/"after"/"around" (no colon); dict-set pure = assoc; dict->list = (map (fn (k) (list k (get d k))) (keys d)); clos-add-reader-method bootstrapped via set! after defmethod defined; test isolation: use unique var names to avoid *y* collision. 437 total tests, 0 failed.
|
||||||
- 2026-05-05: Phase 3 fully complete — conformance.sh runner + scoreboard.json/scoreboard.md; 363 total tests across all suites (79 reader, 31 parser, 174 eval, 59 conditions, 7+6+7 classic programs).
|
- 2026-05-05: Phase 3 fully complete — conformance.sh runner + scoreboard.json/scoreboard.md; 363 total tests across all suites (79 reader, 31 parser, 174 eval, 59 conditions, 7+6+7 classic programs).
|
||||||
- 2026-05-05: Phase 3 complete — cl-debugger-hook/cl-invoke-debugger in runtime.sx (cl-error routes through hook), cl-break-on-signals (fires hook before handlers on type match), cl-invoke-restart-interactively (calls fn with no args); 4 new tests (147 total). Phase 3 all boxes ticked.
|
- 2026-05-05: Phase 3 complete — cl-debugger-hook/cl-invoke-debugger in runtime.sx (cl-error routes through hook), cl-break-on-signals (fires hook before handlers on type match), cl-invoke-restart-interactively (calls fn with no args); 4 new tests (147 total). Phase 3 all boxes ticked.
|
||||||
|
|||||||
Reference in New Issue
Block a user