defsl/macrolayer.lisp - Recently Written

macrolayer.lisp (2389 bytes)
1 ;;; DEFSL gives a name to the first available definition among forks.
2 ;;;
3 ;;; The macro only parses its arguments. RESOLVE makes the choice when the
4 ;;; expansion runs, from strings. Thus the reader needs none of the packages.
5 
6 (in-package :sl)
7 
8 (defun namespace (designator)
9   "Return the accessor and the bound-predicate that DESIGNATOR names."
10   (case designator
11     (:fn '(symbol-function fboundp))
12     (:sym '(symbol-value boundp))
13     (t designator)))
14 
15 (defun candidates (name spec)
16   "Return the (package-name symbol-name) pairs of SPEC, best first."
17   (cond ((eq (first spec) :eq)
18          (loop for package in (rest spec)
19                collect (list (string package) (string name))))
20         ((evenp (length spec))
21          (loop for (package symbol) on spec by #'cddr
22                collect (list (string package) (string symbol))))
23         (t (error "DEFSL ~S: a package in ~S has no symbol." name spec))))
24 
25 (defun resolve (name boundp candidates)
26   "Return the first of CANDIDATES that is a symbol which satisfies BOUNDP."
27   (loop for (package symbol-name) in candidates
28         for symbol = (and (find-package package)
29                           (find-symbol symbol-name package))
30         when (and symbol (funcall boundp symbol))
31           return symbol
32         finally (error "DEFSL ~S: no definition is available in ~
33                         ~{~{~A:~A~}~^, ~}."
34                        name candidates)))
35 
36 (defmacro defsl (name namespace &rest spec)
37   "Define NAME as the first available definition that SPEC lists.
38 
39 NAMESPACE is :FN for a function, :SYM for a variable, or a list
40 (ACCESSOR BOUNDP). ACCESSOR is a SETF-able function of a symbol. BOUNDP is a
41 predicate of a symbol.
42 
43 SPEC is :EQ and the packages that share NAME, or pairs of a package and a
44 symbol. A candidate is available if its package exists, the package has the
45 symbol, and the symbol satisfies BOUNDP.
46 
47   (defsl operator-arglist :fn :eq slynk swank)
48   (defsl gensymmer (macro-function macro-function)
49     utils with-unique-names
50     alexandria with-gensyms)
51 
52 The definition exists at compile time, so a file can use an alias of a macro
53 that it defines."
54   (destructuring-bind (accessor boundp) (namespace namespace)
55     `(eval-when (:compile-toplevel :load-toplevel :execute)
56        (setf (,accessor ',name)
57              (,accessor (resolve ',name #',boundp ',(candidates name spec))))
58        ',name)))