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

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
Details

Browse Source 
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:
giles
2026-05-05 12:33:36 +00:00
parent 4f9da65b3d
commit 99f8ccb30e
5 changed files with 104 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
lib/common-lisp/eval.sx
View File

@@ -20,6 +20,22 @@
(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 ────────────────────────────────────────────────
;; cl-macro-registry: symbol-name -> (fn (form env) expanded-form)
(define cl-macro-registry (dict))
@@ -1029,7 +1045,9 @@
;; Function call: evaluate name → look up fns, builtins; evaluate args
(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)))
(cond
;; FUNCALL: (funcall fn arg...)
@@ -1048,17 +1066,26 @@
(lst (nth evaled 1)))
(if (= lst nil) (list)
(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-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
((cl-env-has-fn? cl-global-env name)
(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)
((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
{:cl-type "error" :message (str "Undefined function: " name)})))))
{:cl-type "error" :message (str "Undefined function: " name-raw)}))))))
;; ── main evaluator ────────────────────────────────────────────────
@@ -1079,14 +1106,16 @@
;; Symbol reference (variable or symbol-macro lookup)
((string? form)
(let ((uform (upcase form)))
(if (and (has-key? cl-symbol-macros uform)
(not (= (get cl-symbol-macros uform) nil)))
(cl-eval (get cl-symbol-macros uform) env)
(cond
((cl-env-has-var? env form) (cl-env-get-var env form))
((cl-env-has-var? cl-global-env form)
(cl-env-get-var cl-global-env form))
(:else {:cl-type "error" :message (str "Undefined variable: " form)})))))
(let ((bare (let ((ps (cl-package-sep? uform)))
(if ps (get ps "name") uform))))
(if (and (has-key? cl-symbol-macros bare)
(not (= (get cl-symbol-macros bare) nil)))
(cl-eval (get cl-symbol-macros bare) env)
(cond
((cl-env-has-var? env bare) (cl-env-get-var env bare))
((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? form) (cl-eval-list form env))
;; Anything else self-evaluates
@@ -1257,6 +1286,40 @@
((= head "DEFCONSTANT") (cl-eval-defvar args env true))
((= head "DECLAIM") 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 "MACROLET") (cl-eval-macrolet args env))
((= head "SYMBOL-MACROLET") (cl-eval-symbol-macrolet args env))