Skip to content

HTTPS clone URL

Subversion checkout URL

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