commit cf61feb32ade3afb2b6f0a94f06ebcee03f8de23 Spenser Truex <truex@equwal.com> 2023-06-25 02:43:58 -0300 minor edits
#macrolayer.lisp# | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ package.lisp | 2 +- sl.asd | 5 +++- 3 files changed, 76 insertions(+), 2 deletions(-)
diff --git a/#macrolayer.lisp# b/#macrolayer.lisp# new file mode 100644 index 0000000..f6da759 --- /dev/null +++ b/#macrolayer.lisp# @@ -0,0 +1,71 @@ +:q!;;; THISu FILE is meant to provide a macro layer for Sly and Slime + + +;;; This contains a few things: +;;; - 5AM is used for testing, but only if it is a *features* member. + +;;; The abstraction gets more specific as you go to the end of the file. + +(in-package :sl) + +#+5am (defmacro show-bound (unbind predicate thing &body body) + `(progn (,unbind ',thing) + ,@body + (,predicate ',thing))) +#+5am (defmacro show-boundfn (fn &body body) + `(show-bound fmakunbound fboundp ,fn ,@body)) +#+5am (defmacro show-boundvar (var &body body) + `(show-bound makunbound boundp ,var ,@body)) + +#+5am (select-preference 'fboundp '(("SLYNK" "OPERATOR-ARGLIST"))) + +(defmacro defweak-strings (namespace boundp sl-name &rest qualified-names) + "Make a weak definition, based on preferences. Probably should use wrapper +functions instead of this one, as it takes string arguments." + `(setf (,namespace (intern ,sl-name)) + (multiple-value-bind (symname package) + (select-preference ',boundp ',(group qualified-names 2)) + (,namespace (intern symname package))))) +#+5am (show-boundfn operator-arglist + (defweak-strings symbol-function fboundp "OPERATOR-ARGLIST" + "SWANK" "OPERATOR-ARGLIST" + "SLYNK" "OPERATOR-ARGLIST")) + +(defmacro defweak (namespace boundp sl-name &rest qualified-names) + "Symbol wrapper for defweak-strings." + `(defweak-strings ,namespace ,boundp ,(symbol-name sl-name) + ,@(loop for q in qualified-names + collect (symbol-name q)))) +#+5am (show-boundfn operator-arglist + (defweak symbol-function fboundp operator-arglist + swank operator-arglist + slynk operator-arglist)) + +(defmacro defequivs (namespace boundp sl-name &rest packages) + "Define a name which is already the same in multiple packages." + `(defweak ,namespace ,boundp ,sl-name + ,@(append (interpol sl-name packages) (list ,sl-name)))) +#+5am (show-boundfn operator-arglist (defequivs symbol-function fboundp operator-arglist swank slynk)) + + +(defmacro defsl (sl-name fn-sym eq-ql &rest preflist) + (with-gensyms (fs qq) + `(let ((,fs ,fn-sym) + (,qq ,eq-ql)) + + `(case ,(list ,fs ,qq) + ;; raw case + ((:fn :eq) (defequivs symbol-function fboundp ,sl-name ,@preflist)) + ((:sym :eq) (defequivs symbol-value boundp ,sl-name ,@preflist)) + + ;; car cases + (otherwise + (case ,fs + ((:fn ,qq) (defweak symbol-function fboundp ,sl-name ,@(pack qq))) + ((:sym ,qq) (defweak symbol-value boundp ,sl-name ,@(pack qq))) + (otherwise + (if (eql ,qq :eq) + (defequivs ,@(pack fn-sym) ,sl-name ,@preflist) + (defweak ,@(pack fs) ,sl-name ,@(pack qq)))))))))) +#+5am (defsl operator-arglist (symbol-function 'fboundp) :eq slynk swank) +#+5am (defsl operator-arglist :fn :eq slynk swank) diff --git a/package.lisp b/package.lisp index beb032b..51a1e28 100644 --- a/package.lisp +++ b/package.lisp @@ -1,3 +1,3 @@ (defpackage #:sl - (:use #:cl #:rte) + (:use #:cl) (:export :defsl)) diff --git a/sl.asd b/sl.asd index 882c2e4..00e2903 100644 --- a/sl.asd +++ b/sl.asd @@ -1,7 +1,10 @@ +(defpackage :sl-system (:use :cl :asdf)) +(in-package :sl-system) + (defsystem :sl :version "0.0.1" :description "Wrapper for the lowest common denominator of Sly and Slime" - :author "Spenser Truex <web@spensertruex.com>" + :author "Spenser Truex <truex@equwal.com>" :serial t :license "GNU GPL v3" :components ((:file "package")