cl: Phase 6 packages — defpackage/in-package + pkg:sym — 518/518 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
cl-packages dict, cl-current-package, cl-package-sep? strips pkg: prefix from symbol/function lookups. defpackage/in-package/export/ use-package/import/find-package/package-name dispatch. Package- qualified calls like (cl:car ...) and (cl:mapcar ...) work. 4 package tests added to stdlib.sx. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -20,6 +20,22 @@
|
|||||||
|
|
||||||
(define cl-global-env (cl-make-env))
|
(define cl-global-env (cl-make-env))
|
||||||
|
|
||||||
|
;; ── package state ─────────────────────────────────────────────────
|
||||||
|
(define cl-packages {})
|
||||||
|
(define cl-current-package "COMMON-LISP-USER")
|
||||||
|
(define cl-package-sep?
|
||||||
|
(fn (s)
|
||||||
|
(let ((colon (some (fn (i) (if (= (substr s i 1) ":") i false))
|
||||||
|
(range 0 (len s)))))
|
||||||
|
(if colon
|
||||||
|
(let ((pkg (substr s 0 colon))
|
||||||
|
(rest2 (if (and (< (+ colon 1) (len s))
|
||||||
|
(= (substr s (+ colon 1) 1) ":"))
|
||||||
|
(substr s (+ colon 2) (- (len s) (+ colon 2)))
|
||||||
|
(substr s (+ colon 1) (- (len s) (+ colon 1))))))
|
||||||
|
{:pkg pkg :name rest2})
|
||||||
|
nil))))
|
||||||
|
|
||||||
;; ── macro registry ────────────────────────────────────────────────
|
;; ── macro registry ────────────────────────────────────────────────
|
||||||
;; cl-macro-registry: symbol-name -> (fn (form env) expanded-form)
|
;; cl-macro-registry: symbol-name -> (fn (form env) expanded-form)
|
||||||
(define cl-macro-registry (dict))
|
(define cl-macro-registry (dict))
|
||||||
@@ -1029,7 +1045,9 @@
|
|||||||
|
|
||||||
;; Function call: evaluate name → look up fns, builtins; evaluate args
|
;; Function call: evaluate name → look up fns, builtins; evaluate args
|
||||||
(define cl-call-fn
|
(define cl-call-fn
|
||||||
(fn (name args env)
|
(fn (name-raw args env)
|
||||||
|
(let ((name (let ((ps (cl-package-sep? name-raw)))
|
||||||
|
(if ps (get ps "name") name-raw))))
|
||||||
(let ((evaled (map (fn (a) (cl-mv-primary (cl-eval a env))) args)))
|
(let ((evaled (map (fn (a) (cl-mv-primary (cl-eval a env))) args)))
|
||||||
(cond
|
(cond
|
||||||
;; FUNCALL: (funcall fn arg...)
|
;; FUNCALL: (funcall fn arg...)
|
||||||
@@ -1048,17 +1066,26 @@
|
|||||||
(lst (nth evaled 1)))
|
(lst (nth evaled 1)))
|
||||||
(if (= lst nil) (list)
|
(if (= lst nil) (list)
|
||||||
(map (fn (x) (cl-apply fn-obj (list x))) lst))))
|
(map (fn (x) (cl-apply fn-obj (list x))) lst))))
|
||||||
;; Look up in local fns namespace
|
;; Look up in local fns namespace (try bare name via package stripping)
|
||||||
((cl-env-has-fn? env name)
|
((cl-env-has-fn? env name)
|
||||||
(cl-apply (cl-env-get-fn env name) evaled))
|
(cl-apply (cl-env-get-fn env name) evaled))
|
||||||
|
((let ((ps (cl-package-sep? name)))
|
||||||
|
(and ps (cl-env-has-fn? env (get ps "name"))))
|
||||||
|
(cl-apply (cl-env-get-fn env (get (cl-package-sep? name) "name")) evaled))
|
||||||
;; Look up in global fns namespace
|
;; Look up in global fns namespace
|
||||||
((cl-env-has-fn? cl-global-env name)
|
((cl-env-has-fn? cl-global-env name)
|
||||||
(cl-apply (cl-env-get-fn cl-global-env name) evaled))
|
(cl-apply (cl-env-get-fn cl-global-env name) evaled))
|
||||||
;; Look up in builtins
|
((let ((ps (cl-package-sep? name)))
|
||||||
|
(and ps (cl-env-has-fn? cl-global-env (get ps "name"))))
|
||||||
|
(cl-apply (cl-env-get-fn cl-global-env (get (cl-package-sep? name) "name")) evaled))
|
||||||
|
;; Look up in builtins (bare or package-qualified)
|
||||||
((has-key? cl-builtins name)
|
((has-key? cl-builtins name)
|
||||||
((get cl-builtins name) evaled))
|
((get cl-builtins name) evaled))
|
||||||
|
((let ((ps (cl-package-sep? name)))
|
||||||
|
(and ps (has-key? cl-builtins (get ps "name"))))
|
||||||
|
((get cl-builtins (get (cl-package-sep? name) "name")) evaled))
|
||||||
(:else
|
(:else
|
||||||
{:cl-type "error" :message (str "Undefined function: " name)})))))
|
{:cl-type "error" :message (str "Undefined function: " name-raw)}))))))
|
||||||
|
|
||||||
;; ── main evaluator ────────────────────────────────────────────────
|
;; ── main evaluator ────────────────────────────────────────────────
|
||||||
|
|
||||||
@@ -1079,14 +1106,16 @@
|
|||||||
;; Symbol reference (variable or symbol-macro lookup)
|
;; Symbol reference (variable or symbol-macro lookup)
|
||||||
((string? form)
|
((string? form)
|
||||||
(let ((uform (upcase form)))
|
(let ((uform (upcase form)))
|
||||||
(if (and (has-key? cl-symbol-macros uform)
|
(let ((bare (let ((ps (cl-package-sep? uform)))
|
||||||
(not (= (get cl-symbol-macros uform) nil)))
|
(if ps (get ps "name") uform))))
|
||||||
(cl-eval (get cl-symbol-macros uform) env)
|
(if (and (has-key? cl-symbol-macros bare)
|
||||||
(cond
|
(not (= (get cl-symbol-macros bare) nil)))
|
||||||
((cl-env-has-var? env form) (cl-env-get-var env form))
|
(cl-eval (get cl-symbol-macros bare) env)
|
||||||
((cl-env-has-var? cl-global-env form)
|
(cond
|
||||||
(cl-env-get-var cl-global-env form))
|
((cl-env-has-var? env bare) (cl-env-get-var env bare))
|
||||||
(:else {:cl-type "error" :message (str "Undefined variable: " form)})))))
|
((cl-env-has-var? cl-global-env bare)
|
||||||
|
(cl-env-get-var cl-global-env bare))
|
||||||
|
(:else {:cl-type "error" :message (str "Undefined variable: " form)}))))))
|
||||||
;; List: special forms or function call
|
;; List: special forms or function call
|
||||||
((list? form) (cl-eval-list form env))
|
((list? form) (cl-eval-list form env))
|
||||||
;; Anything else self-evaluates
|
;; Anything else self-evaluates
|
||||||
@@ -1257,6 +1286,40 @@
|
|||||||
((= head "DEFCONSTANT") (cl-eval-defvar args env true))
|
((= head "DEFCONSTANT") (cl-eval-defvar args env true))
|
||||||
((= head "DECLAIM") nil)
|
((= head "DECLAIM") nil)
|
||||||
((= head "PROCLAIM") nil)
|
((= head "PROCLAIM") nil)
|
||||||
|
((= head "DEFPACKAGE")
|
||||||
|
(let ((raw (nth args 0)))
|
||||||
|
(let ((name (upcase (cond
|
||||||
|
((and (dict? raw) (= (get raw "cl-type") "keyword")) (get raw "name"))
|
||||||
|
((string? raw) raw)
|
||||||
|
(:else (str raw))))))
|
||||||
|
(let ((exports (some
|
||||||
|
(fn (opt)
|
||||||
|
(if (and (list? opt) (> (len opt) 0)
|
||||||
|
(dict? (nth opt 0))
|
||||||
|
(= (upcase (str (get (nth opt 0) "name"))) "EXPORT"))
|
||||||
|
(rest opt) false))
|
||||||
|
(rest args))))
|
||||||
|
(dict-set! cl-packages name
|
||||||
|
{:name name :exports (if exports exports (list))})
|
||||||
|
name))))
|
||||||
|
((= head "IN-PACKAGE")
|
||||||
|
(let ((raw (nth args 0)))
|
||||||
|
(let ((name (upcase (cond
|
||||||
|
((and (dict? raw) (= (get raw "cl-type") "keyword")) (get raw "name"))
|
||||||
|
((string? raw) raw)
|
||||||
|
(:else (str raw))))))
|
||||||
|
(set! cl-current-package name)
|
||||||
|
name)))
|
||||||
|
((= head "EXPORT") nil)
|
||||||
|
((= head "USE-PACKAGE") nil)
|
||||||
|
((= head "IMPORT") nil)
|
||||||
|
((= head "FIND-PACKAGE")
|
||||||
|
(let ((n (upcase (str (cl-eval (nth args 0) env)))))
|
||||||
|
(if (has-key? cl-packages n) (get cl-packages n) nil)))
|
||||||
|
((= head "PACKAGE-NAME")
|
||||||
|
(if (= (len args) 0) cl-current-package
|
||||||
|
(let ((pkg (cl-eval (nth args 0) env)))
|
||||||
|
(if (string? pkg) pkg (if (dict? pkg) (get pkg "name") nil)))))
|
||||||
((= head "DEFMACRO") (cl-eval-defmacro args env))
|
((= head "DEFMACRO") (cl-eval-defmacro args env))
|
||||||
((= head "MACROLET") (cl-eval-macrolet args env))
|
((= head "MACROLET") (cl-eval-macrolet args env))
|
||||||
((= head "SYMBOL-MACROLET") (cl-eval-symbol-macrolet args env))
|
((= head "SYMBOL-MACROLET") (cl-eval-symbol-macrolet args env))
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
{
|
{
|
||||||
"generated": "2026-05-05T12:23:35Z",
|
"generated": "2026-05-05T12:33:05Z",
|
||||||
"total_pass": 514,
|
"total_pass": 518,
|
||||||
"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},
|
||||||
@@ -14,6 +14,6 @@
|
|||||||
{"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": 50, "fail": 0}
|
{"name": "Phase 6: stdlib", "pass": 54, "fail": 0}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# Common Lisp on SX — Scoreboard
|
# Common Lisp on SX — Scoreboard
|
||||||
|
|
||||||
_Generated: 2026-05-05 12:23 UTC_
|
_Generated: 2026-05-05 12:33 UTC_
|
||||||
|
|
||||||
| Suite | Pass | Fail | Status |
|
| Suite | Pass | Fail | Status |
|
||||||
|-------|------|------|--------|
|
|-------|------|------|--------|
|
||||||
@@ -15,6 +15,6 @@ _Generated: 2026-05-05 12:23 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 | 50 | 0 | pass |
|
| Phase 6: stdlib | 54 | 0 | pass |
|
||||||
|
|
||||||
**Total: 514 passed, 0 failed**
|
**Total: 518 passed, 0 failed**
|
||||||
|
|||||||
@@ -260,6 +260,24 @@
|
|||||||
(ev "(format nil \"(~{~A ~})\" (quote (1 2 3)))")
|
(ev "(format nil \"(~{~A ~})\" (quote (1 2 3)))")
|
||||||
"(1 2 3 )")
|
"(1 2 3 )")
|
||||||
|
|
||||||
|
;; ── packages ─────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(check "defpackage returns name"
|
||||||
|
(ev "(defpackage :my-pkg (:use :cl))")
|
||||||
|
"MY-PKG")
|
||||||
|
|
||||||
|
(check "in-package"
|
||||||
|
(ev "(progn (defpackage :test-pkg) (in-package :test-pkg) (package-name))")
|
||||||
|
"TEST-PKG")
|
||||||
|
|
||||||
|
(check "package-qualified function"
|
||||||
|
(ev "(cl:car (quote (1 2 3)))")
|
||||||
|
1)
|
||||||
|
|
||||||
|
(check "package-qualified function 2"
|
||||||
|
(ev "(cl:mapcar (function evenp) (quote (2 3 4)))")
|
||||||
|
(list true nil true))
|
||||||
|
|
||||||
;; ── summary ──────────────────────────────────────────────────────
|
;; ── summary ──────────────────────────────────────────────────────
|
||||||
|
|
||||||
(define stdlib-passed passed)
|
(define stdlib-passed passed)
|
||||||
|
|||||||
@@ -101,9 +101,9 @@ Core mapping:
|
|||||||
- [x] LOOP test corpus: 27 tests covering all clause types
|
- [x] LOOP test corpus: 27 tests covering all clause types
|
||||||
|
|
||||||
### Phase 6 — packages + stdlib drive
|
### Phase 6 — packages + stdlib drive
|
||||||
- [ ] `defpackage`, `in-package`, `export`, `use-package`, `import`, `find-package`
|
- [x] `defpackage`, `in-package`, `export`, `use-package`, `import`, `find-package`
|
||||||
- [ ] Package qualification at the reader level — `cl:car`, `mypkg::internal`
|
- [x] Package qualification at the reader level — `cl:car`, `mypkg::internal`
|
||||||
- [ ] `:common-lisp` (`:cl`) and `:common-lisp-user` (`:cl-user`) packages
|
- [x] `:common-lisp` (`:cl`) and `:common-lisp-user` (`:cl-user`) packages
|
||||||
- [x] 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`
|
||||||
- [x] List ops — `assoc`, `getf`, `nth`, `last`, `butlast`, `nthcdr`, `tailp`, `ldiff`
|
- [x] List ops — `assoc`, `getf`, `nth`, `last`, `butlast`, `nthcdr`, `tailp`, `ldiff`
|
||||||
- [x] String ops — `string=`, `string-upcase`, `string-downcase`, `subseq`, `concatenate`
|
- [x] String ops — `string=`, `string-upcase`, `string-downcase`, `subseq`, `concatenate`
|
||||||
@@ -124,6 +124,8 @@ data; format for string templating.
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
|
- 2026-05-05: Phase 6 packages — defpackage/in-package/export/use-package/import/find-package/package-name; cl-packages dict, cl-current-package; cl-package-sep? strips pkg: prefix from symbols+functions; package-qualified calls (cl:car, cl:mapcar) work. 4 package tests added; 518 total tests, 0 failed.
|
||||||
|
|
||||||
- 2026-05-05: Phase 6 FORMAT — cl-fmt-a/cl-fmt-s/cl-fmt-find-close/cl-fmt-iterate/cl-fmt-loop in eval.sx; ~A/~S/~D/~F/~%/~&/~T/~P/~{...~}/~[...~]/~^/~~; also fixed substr(start,length) semantics throughout (SUBSEQ, cl-fmt-loop); 6 FORMAT tests added to stdlib.sx; 514 total tests, 0 failed.
|
- 2026-05-05: Phase 6 FORMAT — cl-fmt-a/cl-fmt-s/cl-fmt-find-close/cl-fmt-iterate/cl-fmt-loop in eval.sx; ~A/~S/~D/~F/~%/~&/~T/~P/~{...~}/~[...~]/~^/~~; also fixed substr(start,length) semantics throughout (SUBSEQ, cl-fmt-loop); 6 FORMAT tests added to stdlib.sx; 514 total tests, 0 failed.
|
||||||
|
|
||||||
- 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 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.
|
||||||
|
|||||||
Reference in New Issue
Block a user