repos
/
portaCL
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Initial checkin
Annotate for file /control-flow.lisp
2009-07-17 pix
1
(in-package #:portaCL)
05:24:52 '
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)))