|
rlm@10
|
1 ;; Macrolet and symbol-macrolet
|
|
rlm@10
|
2
|
|
rlm@10
|
3 ;; by Konrad Hinsen
|
|
rlm@10
|
4 ;; last updated January 14, 2010
|
|
rlm@10
|
5
|
|
rlm@10
|
6 ;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved. The use
|
|
rlm@10
|
7 ;; and distribution terms for this software are covered by the Eclipse
|
|
rlm@10
|
8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
9 ;; which can be found in the file epl-v10.html at the root of this
|
|
rlm@10
|
10 ;; distribution. By using this software in any fashion, you are
|
|
rlm@10
|
11 ;; agreeing to be bound by the terms of this license. You must not
|
|
rlm@10
|
12 ;; remove this notice, or any other, from this software.
|
|
rlm@10
|
13
|
|
rlm@10
|
14 (ns
|
|
rlm@10
|
15 ^{:author "Konrad Hinsen"
|
|
rlm@10
|
16 :doc "Local macros and symbol macros
|
|
rlm@10
|
17
|
|
rlm@10
|
18 Local macros are defined by a macrolet form. They are usable only
|
|
rlm@10
|
19 inside its body. Symbol macros can be defined globally
|
|
rlm@10
|
20 (defsymbolmacro) or locally (symbol-macrolet). A symbol
|
|
rlm@10
|
21 macro defines a form that replaces a symbol during macro
|
|
rlm@10
|
22 expansion. Function arguments and symbols bound in let
|
|
rlm@10
|
23 forms are not subject to symbol macro expansion.
|
|
rlm@10
|
24
|
|
rlm@10
|
25 Local macros are most useful in the definition of the expansion
|
|
rlm@10
|
26 of another macro, they may be used anywhere. Global symbol
|
|
rlm@10
|
27 macros can be used only inside a with-symbol-macros form."}
|
|
rlm@10
|
28 clojure.contrib.macro-utils
|
|
rlm@10
|
29 (:use [clojure.contrib.def :only (defvar-)]))
|
|
rlm@10
|
30
|
|
rlm@10
|
31 ; A set of all special forms. Special forms are not macro-expanded, making
|
|
rlm@10
|
32 ; it impossible to shadow them by macro definitions. For most special
|
|
rlm@10
|
33 ; forms, all the arguments are simply macro-expanded, but some forms
|
|
rlm@10
|
34 ; get special treatment.
|
|
rlm@10
|
35 (defvar- special-forms
|
|
rlm@10
|
36 (into #{} (keys clojure.lang.Compiler/specials)))
|
|
rlm@10
|
37 ; Value in the Clojure 1.2 branch:
|
|
rlm@10
|
38 ; #{deftype* new quote & var set! monitor-enter recur . case* clojure.core/import* reify* do fn* throw monitor-exit letfn* finally let* loop* try catch if def}
|
|
rlm@10
|
39
|
|
rlm@10
|
40 ; The following three vars are constantly redefined using the binding
|
|
rlm@10
|
41 ; form, imitating dynamic scoping.
|
|
rlm@10
|
42 ;
|
|
rlm@10
|
43 ; Local macros.
|
|
rlm@10
|
44 (defvar- macro-fns {})
|
|
rlm@10
|
45 ; Local symbol macros.
|
|
rlm@10
|
46 (defvar- macro-symbols {})
|
|
rlm@10
|
47 ; Symbols defined inside let forms or function arguments.
|
|
rlm@10
|
48 (defvar- protected-symbols #{})
|
|
rlm@10
|
49
|
|
rlm@10
|
50 (defn- reserved?
|
|
rlm@10
|
51 [symbol]
|
|
rlm@10
|
52 "Return true if symbol is a reserved symbol (starting or ending with a dot)."
|
|
rlm@10
|
53 (let [s (str symbol)]
|
|
rlm@10
|
54 (or (= "." (subs s 0 1))
|
|
rlm@10
|
55 (= "." (subs s (dec (count s)))))))
|
|
rlm@10
|
56
|
|
rlm@10
|
57 (defn- expand-symbol
|
|
rlm@10
|
58 "Expand symbol macros"
|
|
rlm@10
|
59 [symbol]
|
|
rlm@10
|
60 (cond (contains? protected-symbols symbol) symbol
|
|
rlm@10
|
61 (reserved? symbol) symbol
|
|
rlm@10
|
62 (contains? macro-symbols symbol) (get macro-symbols symbol)
|
|
rlm@10
|
63 :else (let [v (resolve symbol)
|
|
rlm@10
|
64 m (meta v)]
|
|
rlm@10
|
65 (if (:symbol-macro m)
|
|
rlm@10
|
66 (var-get v)
|
|
rlm@10
|
67 symbol))))
|
|
rlm@10
|
68
|
|
rlm@10
|
69 (defn- expand-1
|
|
rlm@10
|
70 "Perform a single non-recursive macro expansion of form."
|
|
rlm@10
|
71 [form]
|
|
rlm@10
|
72 (cond
|
|
rlm@10
|
73 (seq? form)
|
|
rlm@10
|
74 (let [f (first form)]
|
|
rlm@10
|
75 (cond (contains? special-forms f) form
|
|
rlm@10
|
76 (contains? macro-fns f) (apply (get macro-fns f) (rest form))
|
|
rlm@10
|
77 (symbol? f) (let [exp (expand-symbol f)]
|
|
rlm@10
|
78 (if (= exp f)
|
|
rlm@10
|
79 (clojure.core/macroexpand-1 form)
|
|
rlm@10
|
80 (cons exp (rest form))))
|
|
rlm@10
|
81 ; handle defmacro macros and Java method special forms
|
|
rlm@10
|
82 :else (clojure.core/macroexpand-1 form)))
|
|
rlm@10
|
83 (symbol? form)
|
|
rlm@10
|
84 (expand-symbol form)
|
|
rlm@10
|
85 :else
|
|
rlm@10
|
86 form))
|
|
rlm@10
|
87
|
|
rlm@10
|
88 (defn- expand
|
|
rlm@10
|
89 "Perform repeated non-recursive macro expansion of form, until it no
|
|
rlm@10
|
90 longer changes."
|
|
rlm@10
|
91 [form]
|
|
rlm@10
|
92 (let [ex (expand-1 form)]
|
|
rlm@10
|
93 (if (identical? ex form)
|
|
rlm@10
|
94 form
|
|
rlm@10
|
95 (recur ex))))
|
|
rlm@10
|
96
|
|
rlm@10
|
97 (declare expand-all)
|
|
rlm@10
|
98
|
|
rlm@10
|
99 (defn- expand-args
|
|
rlm@10
|
100 "Recursively expand the arguments of form, leaving its first
|
|
rlm@10
|
101 n elements unchanged."
|
|
rlm@10
|
102 ([form]
|
|
rlm@10
|
103 (expand-args form 1))
|
|
rlm@10
|
104 ([form n]
|
|
rlm@10
|
105 (doall (concat (take n form) (map expand-all (drop n form))))))
|
|
rlm@10
|
106
|
|
rlm@10
|
107 (defn- expand-bindings
|
|
rlm@10
|
108 [bindings exprs]
|
|
rlm@10
|
109 (if (empty? bindings)
|
|
rlm@10
|
110 (list (doall (map expand-all exprs)))
|
|
rlm@10
|
111 (let [[[s b] & bindings] bindings]
|
|
rlm@10
|
112 (let [b (expand-all b)]
|
|
rlm@10
|
113 (binding [protected-symbols (conj protected-symbols s)]
|
|
rlm@10
|
114 (doall (cons [s b] (expand-bindings bindings exprs))))))))
|
|
rlm@10
|
115
|
|
rlm@10
|
116 (defn- expand-with-bindings
|
|
rlm@10
|
117 "Handle let* and loop* forms. The symbols defined in them are protected
|
|
rlm@10
|
118 from symbol macro expansion, the definitions and the body expressions
|
|
rlm@10
|
119 are expanded recursively."
|
|
rlm@10
|
120 [form]
|
|
rlm@10
|
121 (let [f (first form)
|
|
rlm@10
|
122 bindings (partition 2 (second form))
|
|
rlm@10
|
123 exprs (rest (rest form))
|
|
rlm@10
|
124 expanded (expand-bindings bindings exprs)
|
|
rlm@10
|
125 bindings (vec (apply concat (butlast expanded)))
|
|
rlm@10
|
126 exprs (last expanded)]
|
|
rlm@10
|
127 (cons f (cons bindings exprs))))
|
|
rlm@10
|
128
|
|
rlm@10
|
129 (defn- expand-fn-body
|
|
rlm@10
|
130 [[args & exprs]]
|
|
rlm@10
|
131 (binding [protected-symbols (reduce conj protected-symbols
|
|
rlm@10
|
132 (filter #(not (= % '&)) args))]
|
|
rlm@10
|
133 (cons args (doall (map expand-all exprs)))))
|
|
rlm@10
|
134
|
|
rlm@10
|
135 (defn- expand-fn
|
|
rlm@10
|
136 "Handle fn* forms. The arguments are protected from symbol macro
|
|
rlm@10
|
137 expansion, the bodies are expanded recursively."
|
|
rlm@10
|
138 [form]
|
|
rlm@10
|
139 (let [[f & bodies] form
|
|
rlm@10
|
140 name (when (symbol? (first bodies)) (first bodies))
|
|
rlm@10
|
141 bodies (if (symbol? (first bodies)) (rest bodies) bodies)
|
|
rlm@10
|
142 bodies (if (vector? (first bodies)) (list bodies) bodies)
|
|
rlm@10
|
143 bodies (doall (map expand-fn-body bodies))]
|
|
rlm@10
|
144 (if (nil? name)
|
|
rlm@10
|
145 (cons f bodies)
|
|
rlm@10
|
146 (cons f (cons name bodies)))))
|
|
rlm@10
|
147
|
|
rlm@10
|
148 (defn- expand-method
|
|
rlm@10
|
149 "Handle a method in a deftype* or reify* form."
|
|
rlm@10
|
150 [m]
|
|
rlm@10
|
151 (rest (expand-fn (cons 'fn* m))))
|
|
rlm@10
|
152
|
|
rlm@10
|
153 (defn- expand-deftype
|
|
rlm@10
|
154 "Handle deftype* forms."
|
|
rlm@10
|
155 [[symbol typename classname fields implements interfaces & methods]]
|
|
rlm@10
|
156 (assert (= implements :implements))
|
|
rlm@10
|
157 (let [expanded-methods (map expand-method methods)]
|
|
rlm@10
|
158 (concat
|
|
rlm@10
|
159 (list symbol typename classname fields implements interfaces)
|
|
rlm@10
|
160 expanded-methods)))
|
|
rlm@10
|
161
|
|
rlm@10
|
162 (defn- expand-reify
|
|
rlm@10
|
163 "Handle reify* forms."
|
|
rlm@10
|
164 [[symbol interfaces & methods]]
|
|
rlm@10
|
165 (let [expanded-methods (map expand-method methods)]
|
|
rlm@10
|
166 (cons symbol (cons interfaces expanded-methods))))
|
|
rlm@10
|
167
|
|
rlm@10
|
168 ; Handlers for special forms that require special treatment. The default
|
|
rlm@10
|
169 ; is expand-args.
|
|
rlm@10
|
170 (defvar- special-form-handlers
|
|
rlm@10
|
171 {'quote identity
|
|
rlm@10
|
172 'var identity
|
|
rlm@10
|
173 'def #(expand-args % 2)
|
|
rlm@10
|
174 'new #(expand-args % 2)
|
|
rlm@10
|
175 'let* expand-with-bindings
|
|
rlm@10
|
176 'loop* expand-with-bindings
|
|
rlm@10
|
177 'fn* expand-fn
|
|
rlm@10
|
178 'deftype* expand-deftype
|
|
rlm@10
|
179 'reify* expand-reify})
|
|
rlm@10
|
180
|
|
rlm@10
|
181 (defn- expand-list
|
|
rlm@10
|
182 "Recursively expand a form that is a list or a cons."
|
|
rlm@10
|
183 [form]
|
|
rlm@10
|
184 (let [f (first form)]
|
|
rlm@10
|
185 (if (symbol? f)
|
|
rlm@10
|
186 (if (contains? special-forms f)
|
|
rlm@10
|
187 ((get special-form-handlers f expand-args) form)
|
|
rlm@10
|
188 (expand-args form))
|
|
rlm@10
|
189 (doall (map expand-all form)))))
|
|
rlm@10
|
190
|
|
rlm@10
|
191 (defn- expand-all
|
|
rlm@10
|
192 "Expand a form recursively."
|
|
rlm@10
|
193 [form]
|
|
rlm@10
|
194 (let [exp (expand form)]
|
|
rlm@10
|
195 (cond (symbol? exp) exp
|
|
rlm@10
|
196 (seq? exp) (expand-list exp)
|
|
rlm@10
|
197 (vector? exp) (into [] (map expand-all exp))
|
|
rlm@10
|
198 (map? exp) (into {} (map expand-all (seq exp)))
|
|
rlm@10
|
199 :else exp)))
|
|
rlm@10
|
200
|
|
rlm@10
|
201 (defmacro macrolet
|
|
rlm@10
|
202 "Define local macros that are used in the expansion of exprs. The
|
|
rlm@10
|
203 syntax is the same as for letfn forms."
|
|
rlm@10
|
204 [fn-bindings & exprs]
|
|
rlm@10
|
205 (let [names (map first fn-bindings)
|
|
rlm@10
|
206 name-map (into {} (map (fn [n] [(list 'quote n) n]) names))
|
|
rlm@10
|
207 macro-map (eval `(letfn ~fn-bindings ~name-map))]
|
|
rlm@10
|
208 (binding [macro-fns (merge macro-fns macro-map)
|
|
rlm@10
|
209 macro-symbols (apply dissoc macro-symbols names)]
|
|
rlm@10
|
210 `(do ~@(doall (map expand-all exprs))))))
|
|
rlm@10
|
211
|
|
rlm@10
|
212 (defmacro symbol-macrolet
|
|
rlm@10
|
213 "Define local symbol macros that are used in the expansion of exprs.
|
|
rlm@10
|
214 The syntax is the same as for let forms."
|
|
rlm@10
|
215 [symbol-bindings & exprs]
|
|
rlm@10
|
216 (let [symbol-map (into {} (map vec (partition 2 symbol-bindings)))
|
|
rlm@10
|
217 names (keys symbol-map)]
|
|
rlm@10
|
218 (binding [macro-fns (apply dissoc macro-fns names)
|
|
rlm@10
|
219 macro-symbols (merge macro-symbols symbol-map)]
|
|
rlm@10
|
220 `(do ~@(doall (map expand-all exprs))))))
|
|
rlm@10
|
221
|
|
rlm@10
|
222 (defmacro defsymbolmacro
|
|
rlm@10
|
223 "Define a symbol macro. Because symbol macros are not part of
|
|
rlm@10
|
224 Clojure's built-in macro expansion system, they can be used only
|
|
rlm@10
|
225 inside a with-symbol-macros form."
|
|
rlm@10
|
226 [symbol expansion]
|
|
rlm@10
|
227 (let [meta-map (if (meta symbol) (meta symbol) {})
|
|
rlm@10
|
228 meta-map (assoc meta-map :symbol-macro true)]
|
|
rlm@10
|
229 `(def ~(with-meta symbol meta-map) (quote ~expansion))))
|
|
rlm@10
|
230
|
|
rlm@10
|
231 (defmacro with-symbol-macros
|
|
rlm@10
|
232 "Fully expand exprs, including symbol macros."
|
|
rlm@10
|
233 [& exprs]
|
|
rlm@10
|
234 `(do ~@(doall (map expand-all exprs))))
|
|
rlm@10
|
235
|
|
rlm@10
|
236 (defmacro deftemplate
|
|
rlm@10
|
237 "Define a macro that expands into forms after replacing the
|
|
rlm@10
|
238 symbols in params (a vector) by the corresponding parameters
|
|
rlm@10
|
239 given in the macro call."
|
|
rlm@10
|
240 [name params & forms]
|
|
rlm@10
|
241 (let [param-map (for [p params] (list (list 'quote p) (gensym)))
|
|
rlm@10
|
242 template-params (vec (map second param-map))
|
|
rlm@10
|
243 param-map (vec (apply concat param-map))
|
|
rlm@10
|
244 expansion (list 'list (list 'quote `symbol-macrolet) param-map
|
|
rlm@10
|
245 (list 'quote (cons 'do forms)))]
|
|
rlm@10
|
246 `(defmacro ~name ~template-params ~expansion)))
|
|
rlm@10
|
247
|
|
rlm@10
|
248 (defn mexpand-1
|
|
rlm@10
|
249 "Like clojure.core/macroexpand-1, but takes into account symbol macros."
|
|
rlm@10
|
250 [form]
|
|
rlm@10
|
251 (binding [macro-fns {}
|
|
rlm@10
|
252 macro-symbols {}
|
|
rlm@10
|
253 protected-symbols #{}]
|
|
rlm@10
|
254 (expand-1 form)))
|
|
rlm@10
|
255
|
|
rlm@10
|
256 (defn mexpand
|
|
rlm@10
|
257 "Like clojure.core/macroexpand, but takes into account symbol macros."
|
|
rlm@10
|
258 [form]
|
|
rlm@10
|
259 (binding [macro-fns {}
|
|
rlm@10
|
260 macro-symbols {}
|
|
rlm@10
|
261 protected-symbols #{}]
|
|
rlm@10
|
262 (expand form)))
|
|
rlm@10
|
263
|
|
rlm@10
|
264 (defn mexpand-all
|
|
rlm@10
|
265 "Perform a full recursive macro expansion of a form."
|
|
rlm@10
|
266 [form]
|
|
rlm@10
|
267 (binding [macro-fns {}
|
|
rlm@10
|
268 macro-symbols {}
|
|
rlm@10
|
269 protected-symbols #{}]
|
|
rlm@10
|
270 (expand-all form)))
|
