1 (in-package #:portaCL)
 2 
 3 (defmacro feature-cond (&body clauses)
 4   "Some things are best shown by example.  Suppose you have:
 5   #+clisp (do-clisp-thing-1)
 6   #+clisp (do-clisp-thing-2)
 7   #+sbcl (do-sbcl-thing)
 8   #-(or clisp sbcl) (error \"not implemented\")
 9 Using feature-cond, that would be:
10   (feature-cond
11     (:clisp (do-clisp-thing-1)
12             (do-clisp-thing-2))
13     (:sbcl (do-sbcl-thing))
14     (t (error \"not implemented\")))
15 
16 Accordingly, putting cl:t into *features* is not recommended.
17 
18 In general, this probably won't be very useful: read-time conditionals are
19 often used to read symbols from packages which may not exist across
20 implementations.  And, of course, because this is a macro, it cannot appear
21 in places where it won't be macroexpanded (e.g., the conditions of case).
22 
23 By the time you're in a position where this is actually useful,
24   #-(or a b c) (otherwise-clause)
25 doesn't seem so bad.  At least it'll look the same as your other feature
26 conditionals!
27 
28 Note also that this does NOT provide a run-time check of *features*, but is
29 instead a macroexpansion-time check."
30   (let* ((last-clause (car (last clauses)))
31          (otherwise-clause (when (member (car last-clause) '(t otherwise) :test #'eq)
32                              last-clause)))
33     (when otherwise-clause (setf clauses (butlast clauses)))
34     `(progn
35        ,@(or (loop :for (cond . body) :in clauses
36                    :when (featurep cond)
37                      :return body)
38              (cdr otherwise-clause)))))
39 
40 (defmacro feature-econd (&body clauses)
41   "Like feature-cond, but automatically adds a final clause issuing a
42 not-implemented error."
43   `(feature-cond ,@clauses (t (error 'not-implemented))))
44 
45 (defmacro feature-if (feature-expression true-form &optional else-form)
46   `(if (featurep ,feature-expression)
47        ,true-form
48        ,else-form))
49 
50 (defmacro feature-when (feature-expression &body body)
51   `(when (featurep ,feature-expression) ,@body))
52 
53 (defmacro feature-unless (feature-expression &body body)
54   `(unless (featurep ,feature-expression) ,@body))
55 
56 #+nil
57 (feature-cond
58   (:clisp (do-clisp-thing-1)
59           (do-clisp-thing-2))
60   (:sbcl (do-sbcl-thing))
61   (t (error "not implemented")))
62 
63 #+nil
64 (feature-cond
65   ((not :clisp) (do-clisp-thing-1)
66                 (do-clisp-thing-2))
67   (:sbcl (do-sbcl-thing))
68   (t (error "not implemented")))
69 
70 #+nil
71 (feature-cond
72   ((or :sbcl :clisp) (do-clisp-thing-1)
73                      (do-clisp-thing-2))
74   (:clisp (do-sbcl-thing))
75   (t (error "not implemented")))
76 
77 #+nil
78 (feature-cond
79   ((and (not :windows) :sbcl)
80    (do-sbcl-thing))
81   ((and (or :windows :win32) :clisp)
82    (do-clisp-thing-1)
83    (do-clisp-thing-2))
84   (t (error "not implemented")))
85 
86 #+nil
87 (feature-econd
88   (:sbcl (do-sbcl-thing))
89   (:posix (do-posix-thing)))