commit 28a2c3b7e37e995c3ef36088b77d56e3b9f462b7 equwal <13551856+equwal@users.noreply.github.com> 2026-10-03 17:33:25 -0700 Rewrite defsl as a thin macro over a resolver function The old defsl never worked. Its COND compared fresh lists with EQL, and DEFEQUIVS read two package names as one (package symbol) pair. With FiveAM loaded, the system did not load: "The function SWANK::SLYNK is undefined". Now the macro only parses its arguments. RESOLVE makes the choice when the expansion runs. It takes the first candidate whose package exists, whose symbol exists, and whose symbol satisfies the bound-predicate. The old code accepted the predicate and ignored it. - The alias is the symbol that the caller writes, so it goes in the package of the caller. The old code interned the name of the fork's symbol in *PACKAGE* at load time. - The lookup uses FIND-SYMBOL on strings. It interns nothing, and the reader needs none of the packages. - EVAL-WHEN defines the alias at compile time, so a file can use an alias of a macro that it defines. - A spec with a package and no symbol is an error at macroexpansion. - The expansion binds no variable, so the hygiene claim is now true. Delete utils.lisp and the Alexandria dependency. Nothing uses them. Add the sl/test system (FiveAM). It tests each subset of three fixture forks, and these real forks: SLYNK/SWANK/MICROS, SB-MD5/MD5, Eos/FiveAM, and cl-utilities/Alexandria. Run it with (asdf:test-system :sl).
utils.lisp | 61 ------------------------------------------------------------- 1 file changed, 61 deletions(-)
diff --git a/utils.lisp b/utils.lisp deleted file mode 100644 index 36a9ce6..0000000 --- a/utils.lisp +++ /dev/null @@ -1,61 +0,0 @@ -(in-package :sl) - -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; From Graham's OnLisp - (defun pack (obj) - "Ensure obj is a cons." - (if (consp obj) obj (list obj))) - (defun shuffle (x y) - "Interpolate lists x and y with the first item being from x." - (cond ((null x) y) - ((null y) x) - (t (list* (car x) (car y) - (shuffle (cdr x) (cdr y)))))) - (defun interpol (obj lst) - "Intersperse an object in a list." - (shuffle lst (loop for #1=#.(gensym) in (cdr lst) - collect obj))) - (defun group (source n) - (labels ((rec (source acc) - (let ((rest (nthcdr n source))) - (if (consp rest) - (rec rest (cons - (subseq source 0 n) - acc)) - (nreverse - (cons source acc)))))) - (if source (rec source nil) nil))) - - (defun select (fn lst) - "Return the first element that matches the function." - (if (null lst) - nil - (let ((val (funcall fn (car lst)))) - (if val - (values (car lst) val) - (select fn (cdr lst)))))) - - (defun gen-case (base ex) - (if (symbolp ex) - (list 'eql base ex) - (append ex (list base)))) - - (defun select-preference (boundp qnames) - "Choose the function to use based on user preference." - (labels ((select-preference-aux (boundp qnames preflist) - (when preflist - (let* ((res (select (lambda (x) - (string-equal (car x) (car preflist))) - qnames)) - (package (car res)) - (symname (cadr res))) - (if (and res (find-package package)) - (values symname package) - (select-preference-aux boundp qnames (cdr preflist))))))) - (select-preference-aux boundp qnames (mapcar #'car qnames)))) - - (defmacro with-gensyms (symbols &body body) - "Create gensyms for those symbols." - `(let (,@(mapcar #'(lambda (sym) - `(,sym ',(gensym))) symbols)) - ,@body)))