commit 6e74eb7c5f00794c15896a20b13df984f838ac69 Spenser Truex <truex@equwal.com> 2023-06-25 06:16:24 -0300 Overhaul: fix bugs. Make it work. Version 1.0 Previous version was totally unusable. Various bugs ironed out. The purpose of sl is now clearer. The user of defsl will import symbols from the sl package, as it stands. It would be nice to be able to define a separate package to store the symbols in though.
#macrolayer.lisp# | 71 ------------------------------------------------------- README.org | 1 + macrolayer.lisp | 55 ++++++++++++++++++++++-------------------- sl.asd | 2 +- sl.lisp | 2 +- 5 files changed, 33 insertions(+), 98 deletions(-)
diff --git a/#macrolayer.lisp# b/#macrolayer.lisp# deleted file mode 100644 index f6da759..0000000 --- a/#macrolayer.lisp# +++ /dev/null @@ -1,71 +0,0 @@ -: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/README.org b/README.org index bf31678..fdc29e2 100644 --- a/README.org +++ b/README.org @@ -4,6 +4,7 @@ [[https://github.com/equwal/sl][Github]] | [[https://spensertruex.com/sl--dependency-language][Homepage]] +Version 1.0 is out! SL is a Domain Specific Language (ie. simple programming language) for dealing with ambiguous dependency situations. It is more expressive than the standard diff --git a/macrolayer.lisp b/macrolayer.lisp index e4f7e19..ca5d7c2 100644 --- a/macrolayer.lisp +++ b/macrolayer.lisp @@ -22,10 +22,15 @@ (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))))) + (with-gensyms (symname package new-namespace) + `(let (,new-namespace) + (setf (symbol-function ',new-namespace) (symbol-function ',namespace)) + (multiple-value-bind (,symname ,package) + (select-preference ',boundp ',(group qualified-names 2)) + (setf (symbol-function (intern ,symname)) + (funcall (symbol-function ',new-namespace) + (intern ,symname ,package))))))) + #+5am (show-boundfn operator-arglist (defweak-strings symbol-function fboundp "OPERATOR-ARGLIST" "SWANK" "OPERATOR-ARGLIST" @@ -34,8 +39,9 @@ functions instead of this one, as it takes string arguments." (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)))) + ,@(loop for q in qualified-names + collect (symbol-name q)))) + #+5am (show-boundfn operator-arglist (defweak symbol-function fboundp operator-arglist swank operator-arglist @@ -43,29 +49,28 @@ functions instead of this one, as it takes string arguments." (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)))) + `(defweak ,namespace ,boundp ,sl-name ,@packages)) + #+5am (show-boundfn operator-arglist (defequivs symbol-function fboundp operator-arglist swank slynk)) -(defmacro defsl (sl-name fn-sym eq-ql &rest preflist) +(defmacro defsl (sl-name fn eq-ql &rest preflist) (with-gensyms (fs qq) - `(let ((,fs ,fn-sym) + `(let ((,fs (if (functionp ',fn) + ',fn + (symbol-function ',fn))) (,qq ,eq-ql)) + (cond ((eql `(,,fs ,,qq) '(:fn :eq)) + (defequivs symbol-function fboundp ,sl-name ,@preflist)) + ((eql `(,,fs ,,qq) '(:sym :eq)) + (defequivs symbol-value boundp ,sl-name ,@preflist)) + ((eql ,fs `(:fn ,,qq)) + (defweak symbol-function fboundp ,sl-name ,qq)) + ((eql ,fs `(:sym ,,qq)) + (defweak symbol-value boundp ,sl-name ,qq)) + (t (if (eql ,qq :eq) + (defequivs ,fn ,sl-name ,@preflist) + (defweak ,fs ,sl-name ,qq))))))) - `(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 fboundp :eq slynk swank) #+5am (defsl operator-arglist :fn :eq slynk swank) diff --git a/sl.asd b/sl.asd index 00e2903..8992a46 100644 --- a/sl.asd +++ b/sl.asd @@ -2,7 +2,7 @@ (in-package :sl-system) (defsystem :sl - :version "0.0.1" + :version "1.0" :description "Wrapper for the lowest common denominator of Sly and Slime" :author "Spenser Truex <truex@equwal.com>" :serial t diff --git a/sl.lisp b/sl.lisp index ba080dc..24e80dc 100644 --- a/sl.lisp +++ b/sl.lisp @@ -2,4 +2,4 @@ (in-package :sl) -(defequivsfn operator-arglist) +;(defequivsfn operator-arglist)