commit eb93cfed3441f27ca89975811a63dd998b350a68 Spenser Truex <spensertruexonline@gmail.com> 2019-07-02 23:05:08 -0700 README + BNF.
README.org | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++ macrolayer.lisp | 81 ++++++++++++++++++++++++++++++--------------------------- package.lisp | 3 ++- 3 files changed, 117 insertions(+), 39 deletions(-)
diff --git a/README.org b/README.org new file mode 100644 index 0000000..75efb33 --- /dev/null +++ b/README.org @@ -0,0 +1,72 @@ +#+TITLE: SL: A Package Dependency Language +#+AUTHOR: Spenser Truex +#+EMAIL: web@spensertruex.com + +SL is a Domain Specific Language (ie. simple programming language) for dealing +with ambiguous dependency situations. It is more expressive than the standard +method in Common Lisp: the use of reader macros. +* Examples + The only external macro is =defsl=. There is BNF below, though some examples are in order: +** Simple example +This defines =sl::operator-arglist= as =slynk:operator-arglist=, unless =slynk= is unavailable, in which case =swank:operator-arglist= is used. +#+BEGIN_SRC lisp +(defsl operator-arglist :fn :eq slynk swank) +#+END_SRC +The =:fn= shows that a FUNCTION is being defined, as opposed to a =:sym= symbol; +To define another namespace a list is required: =(accessor-fn boundp-fn)=. =:eq= +denotes that the packages have the same name for this function; to define different names for each package, they must be "qualified". + +For this simplest of examples, consider the reader macro alternative. +#+BEGIN_SRC lisp +#+(and slynk swank) (setf (symbol-function 'operator-arglist) + slynk:operator-arglist) +#+(and slynk (not swank)) (setf (symbol-function 'operator-arglist) + slynk:operator-arglist) +#+(and (not slynk) swank) (setf (symbol-function 'operator-arglist) + swank:operator-arglist) +# +#+END_SRC +** Complex example +#+BEGIN_SRC lisp +(defsl gensymmer (macro-function macro-function) + utils with-unique-names + alexandria with-gensyms) +#+END_SRC +To break this down: +- =sl::gensymmer= is now defined as =utils:with-unique-names=. +- =macro-function= was used twice: once as a =setfable= place, and once as a +predicate. +- If the =utils= package does not exist, then =sl::gensymmer= is defined as + =alexanrdia:with-gensyms=. +* Install + Use ASDF to install. Usually this should work: +#+BEGIN_SRC sh +$ cd ~/common-lisp/ +$ git clone git@github.com:equwal/sl.git +CL-USER> (asdf:load-system :sl) +#+END_SRC + +* BNF +#+BEGIN_EXAMPLE +(defsl <sl-name> <fnsym> {<eq> | <packages>} +<eq> ::= :eq <preflist> +<fnsym> ::= :fn + | :sym + | <fnpair> + +<fnpair> ::= (<setfable place> <bound predicate>) +<setfable place> ::= a setf function like symbol-function, symbol-name, etc. +<bound predicate> ::= a function that returns NIL or otherwise like fboundp, boundp, etc. +<packages> ::= <package> <fn name> <more packages> +<package> ::= symbol +<fn name> ::= symbol +<preflist> ::= <package> <more packages> +<more packages> ::= ε + | <package> + | <package> <more packages> +#+END_EXAMPLE +* Issues: +- This is a new thing. +- =defsl= is quite possibly the world's most unhygenic macro: +don't expect anything about evaluation order or number of evaluations to be +true. diff --git a/macrolayer.lisp b/macrolayer.lisp index c0762bd..dbaced1 100644 --- a/macrolayer.lisp +++ b/macrolayer.lisp @@ -4,8 +4,27 @@ ;;; This contains a few things: ;;; - 5AM is used for testing, but only if it is a *features* member. -;;; The macros get more specific as you go to the end of the file. +;;; The abstraction gets more specific as you go to the end of the file. + (in-package :sl) +(eval-when (:compile-toplevel :load-toplevel :execute) + (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))))) #+5am (defmacro show-bound (unbind predicate thing &body body) `(progn (,unbind ',thing) @@ -16,22 +35,6 @@ #+5am (defmacro show-boundvar (var &body body) `(show-bound makunbound boundp ,var ,@body)) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defvar *preference-list* '(slynk swank) - "The order in which to choose the IDE for pinging. Use the name of the CL -interface, not the Emacs name (ie sly->slynk, slime->swank).")) - -(defun select-preference (boundp qnames &optional (preflist *preference-list*)) - "Choose the function to use based on user preference." - (when preflist - (let* ((res (select (lambda (x) (string-equal (car x) (symbol-name - (car preflist)))) - qnames)) - (package (car res)) - (symname (cadr res))) - (if (and res (find-package package)) - (values symname package) - (select-preference boundp qnames (cdr preflist)))))) #+5am (select-preference 'fboundp '(("SLYNK" "OPERATOR-ARGLIST"))) (defmacro defweak-strings (namespace boundp sl-name &rest qualified-names) @@ -52,13 +55,13 @@ functions instead of this one, as it takes string arguments." ,@(loop for q in qualified-names collect (symbol-name q)))) #+5am (show-boundfn operator-arglist - (defweak-syms symbol-function fboundp 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-syms ,namespace ,boundp ,sl-name + `(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)) @@ -69,15 +72,13 @@ functions instead of this one, as it takes string arguments." (cdr p))))) #+5am (andcond (((eql t nil) (eql t t)) 'x) ((t nil) 'y)) - -(defun gen-case (base ex) - (if (symbolp ex) - (list 'eql base ex) - (append ex (list base)))) #+5am (and (gen-case :fn :fn) (not (gen-case :fn '(listp)))) (defmacro bicase (a b &rest cases) + "Cover a CASE with two objects, and insert them into predicates." + ;; FIXME: the predicate insertion is fragile: only flat lists allowed + ;; FIXME: This should be generatlized for n cases (not just two). `(cond ,@(loop for c in cases collect (list* (and (gen-case a (car c)) (gen-case b (cadr c))) @@ -85,19 +86,23 @@ functions instead of this one, as it takes string arguments." #+5am (bicase :a :b ((eql :a) (eql :b) t) (:a :b 'h)) -(defmacro defsl (sl-name fn-sym eq-ql &optional (preflist *preference-list*)) - "Magic macro to associate a name with functions in other packages, based on the preferences." + +(defun neql (a b) + "Not eql." + ;; KLUDGE: this thing only exists to keep `bicase' flat. + (not (eql a b))) +(defmacro defsl (sl-name fn-sym eq-ql &rest preflist) +"Magic macro to associate a name with functions in other packages, based on the preferences." + ;; FIXME: This thing generates invalid--though inaccessible code. This makes + ;; those compilation errors. + ;; FIXME: This thing is way unhygienic. Once-only, and in-order would be nice. `(bicase ,fn-sym ,eq-ql - (:fn :eq (defequivs symbol-function fboundp ,sl-name ,@preflist)) - (:fn (not :eq) (defweak symbol-function fboundp ,sl-name ,@eq-ql)) - (:sym :eq (defequivs symbol-name boundp ,sl-name ,@preflist)) - (:sym (not :eq) (defweak symbol-name boundp ,sl-name ,@eq-ql)) - ((listp) :eq (defequivs ,@(pack fn-sym) ,sl-name ,@preflist)) - ((listp) (not :eq) (defweak ,@(pack fn-sym) ,sl-name ,@eq-ql)))) -#+5am (defsl operator-arglist (symbol-function fboundp) :eq) -#+5am (defsl operator-arglist :fn :eq) - ;; (defmacro defmagic (sl-name &key fn var sl-only packages) - ;; "Attempt to magically use the right macro with minimum information." - ;; ()) -;; (defweakequiv defweakfn "operator-arglist") + (:fn :eq (defequivs symbol-function fboundp ,sl-name ,@preflist)) + (:fn (neql :eq) (defweak symbol-function fboundp ,sl-name ,@(pack eq-ql))) + (:sym :eq (defequivs symbol-value boundp ,sl-name ,@preflist)) + (:sym (neql :eq) (defweak symbol-value boundp ,sl-name ,@(pack eq-ql))) + ((listp) :eq (defequivs ,@(pack fn-sym) ,sl-name ,@preflist)) + ((listp) (neql :eq) (defweak ,@(pack fn-sym) ,sl-name ,@(pack eq-ql))))) +#+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 ab4ebc0..51a1e28 100644 --- a/package.lisp +++ b/package.lisp @@ -1,2 +1,3 @@ (defpackage #:sl - (:use #:cl)) + (:use #:cl) + (:export :defsl))