Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 768 lines (661 sloc) 30.718 kb
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
1 ; Copyright (c) Rich Hickey. All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (in-ns 'clojure.core)
10
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; definterface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12
1f70ed9 Stuart Halloway munge package names in definterface, #306
stuarthalloway authored
13 (defn namespace-munge
14 "Convert a Clojure namespace name to a legal Java package name."
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
15 {:added "1.2"}
1f70ed9 Stuart Halloway munge package names in definterface, #306
stuarthalloway authored
16 [ns]
17 (.replace (str ns) \- \_))
18
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
19 ;for now, built on gen-interface
20 (defmacro definterface
21 [name & sigs]
22 (let [tag (fn [x] (or (:tag (meta x)) Object))
23 psig (fn [[name [& args]]]
db3466e Rich Hickey support type and parameter annotations in definterface
richhickey authored
24 (vector name (vec (map tag args)) (tag name) (map meta args)))
25 cname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))]
2ac9319 Rich Hickey prevent dynamic classes from being flushed before use
richhickey authored
26 `(let []
27 (gen-interface :name ~cname :methods ~(vec (map psig sigs)))
28 (import ~cname))))
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
29
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31
32 (defn- parse-opts [s]
33 (loop [opts {} [k v & rs :as s] s]
34 (if (keyword? k)
35 (recur (assoc opts k v) rs)
36 [opts s])))
37
38 (defn- parse-impls [specs]
39 (loop [ret {} s specs]
40 (if (seq s)
41 (recur (assoc ret (first s) (take-while seq? (next s)))
42 (drop-while seq? (next s)))
43 ret)))
44
45 (defn- parse-opts+specs [opts+specs]
46 (let [[opts specs] (parse-opts opts+specs)
47 impls (parse-impls specs)
48 interfaces (-> (map #(if (var? (resolve %))
49 (:on (deref (resolve %)))
50 %)
51 (keys impls))
52 set
53 (disj 'Object 'java.lang.Object)
54 vec)
bf8bb79 Rich Hickey added parameter destructuring support to reify and deftype/record
richhickey authored
55 methods (map (fn [[name params & body]]
56 (cons name (maybe-destructured params body)))
57 (apply concat (vals impls)))]
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
58 (when-let [bad-opts (seq (remove #{:no-print} (keys opts)))]
59 (throw (IllegalArgumentException. (apply print-str "Unsupported option(s) -" bad-opts))))
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
60 [interfaces methods opts]))
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
61
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
62 (defmacro reify
63 "reify is a macro with the following structure:
64
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
65 (reify options* specs*)
66
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
67 Currently there are no options.
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
68
69 Each spec consists of the protocol or interface name followed by zero
70 or more method bodies:
71
72 protocol-or-interface-or-Object
73 (methodName [args*] body)*
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
74
75 Methods should be supplied for all methods of the desired
76 protocol(s) and interface(s). You can also define overrides for
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
77 methods of Object. Note that a parameter must be supplied to
78 correspond to the target object ('this' in Java parlance). Thus
79 methods for interfaces will take one more argument than do the
80 interface declarations. Note also that recur calls to the method
81 head should *not* pass the target object, it will be supplied
82 automatically and can not be substituted.
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
83
84 The return type can be indicated by a type hint on the method name,
85 and arg types can be indicated by a type hint on arg names. If you
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
86 leave out all hints, reify will try to match on same name/arity
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
87 method in the protocol(s)/interface(s) - this is preferred. If you
88 supply any hints at all, no inference is done, so all hints (or
89 default of Object) must be correct, for both arguments and return
90 type. If a method is overloaded in a protocol/interface, multiple
91 independent method definitions must be supplied. If overloaded with
92 same arity in an interface you must specify complete hints to
93 disambiguate - a missing hint implies Object.
94
95 recur works to method heads The method bodies of reify are lexical
96 closures, and can refer to the surrounding local scope:
97
98 (str (let [f \"foo\"]
a3e95cf Rich Hickey update example in reify doc
richhickey authored
99 (reify Object
100 (toString [] f))))
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
101 == \"foo\"
102
103 (seq (let [f \"foo\"]
a3e95cf Rich Hickey update example in reify doc
richhickey authored
104 (reify clojure.lang.Seqable
105 (seq [] (seq f)))))
106 == (\\f \\o \\o))"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
107 {:added "1.2"}
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
108 [& opts+specs]
109 (let [[interfaces methods] (parse-opts+specs opts+specs)]
67864eb Rich Hickey added IObj and metadata propagation support for reify, so #^{:my :meta} ...
richhickey authored
110 (with-meta `(reify* ~interfaces ~@methods) (meta &form))))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
111
112 (defn hash-combine [x y]
113 (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y)))
114
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
115 (defn munge [s]
116 ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s))))
117
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
118 (defn- imap-cons
7879383 Rich Hickey replace #^s with ^s
richhickey authored
119 [^IPersistentMap this o]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
120 (cond
121 (instance? java.util.Map$Entry o)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
122 (let [^java.util.Map$Entry pair o]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
123 (.assoc this (.getKey pair) (.getValue pair)))
124 (instance? clojure.lang.IPersistentVector o)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
125 (let [^clojure.lang.IPersistentVector vec o]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
126 (.assoc this (.nth vec 0) (.nth vec 1)))
127 :else (loop [this this
128 o o]
129 (if (seq o)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
130 (let [^java.util.Map$Entry pair (first o)]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
131 (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o)))
132 this))))
133
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
134 (defn- emit-defrecord
135 "Do not use this directly - use defrecord"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
136 {:added "1.2"}
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
137 [tagname name fields interfaces methods]
138 (let [tag (keyword (str *ns*) (str tagname))
5916e9e Rich Hickey propagate metadata to classnames in definterface/type/record
richhickey authored
139 classname (with-meta (symbol (str *ns* "." name)) (meta name))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
140 interfaces (vec interfaces)
141 interface-set (set (map resolve interfaces))
142 methodname-set (set (map first methods))
a3d4274 Rich Hickey don't propagate field hints into method bodies
richhickey authored
143 hinted-fields fields
144 fields (vec (map #(with-meta % nil) fields))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
145 base-fields fields
146 fields (conj fields '__meta '__extmap)]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
147 (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields))
148 (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields")))
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
149 (let [gs (gensym)]
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
150 (letfn
151 [(eqhash [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
152 [i
153 (conj m
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
154 `(hashCode [this#] (-> ~tag hash ~@(map #(list `hash-combine %) (remove #{'__meta} fields))))
155 `(equals [this# ~gs]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
156 (boolean
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
157 (or (identical? this# ~gs)
158 (when (identical? (class this#) (class ~gs))
159 (let [~gs ~(with-meta gs {:tag tagname})]
160 (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields)
161 (= ~'__extmap (. ~gs ~'__extmap)))))))))])
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
162 (iobj [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
163 [(conj i 'clojure.lang.IObj)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
164 (conj m `(meta [this#] ~'__meta)
165 `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))])
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
166 (ilookup [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
167 [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
168 (conj m `(valAt [this# k#] (.valAt this# k# nil))
169 `(valAt [this# k# else#]
170 (case k# ~@(mapcat (fn [fld] [(keyword fld) fld])
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
171 base-fields)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
172 (get ~'__extmap k# else#)))
173 `(getLookupThunk [this# k#]
174 (let [~'gclass (class this#)]
175 (case k#
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
176 ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})]
177 (mapcat
178 (fn [fld]
179 [(keyword fld)
180 `(reify clojure.lang.ILookupThunk
181 (get [~'thunk ~'gtarget]
182 (if (identical? (class ~'gtarget) ~'gclass)
762d153 Rich Hickey Fix defrecord keyword lookup on fields matching no-arg methods, fixes #3...
richhickey authored
183 (. ~hinted-target ~(keyword fld))
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
184 ~'thunk)))])
185 base-fields))
186 nil))))])
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
187 (imap [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
188 [(conj i 'clojure.lang.IPersistentMap)
189 (conj m
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
190 `(count [this#] (+ ~(count base-fields) (count ~'__extmap)))
191 `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
192 `(cons [this# e#] ((var imap-cons) this# e#))
193 `(equiv [this# o#] (.equals this# o#))
194 `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#))))
195 `(entryAt [this# k#] (let [v# (.valAt this# k# this#)]
196 (when-not (identical? this# v#)
197 (clojure.lang.MapEntry. k# v#))))
198 `(seq [this#] (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
199 ~'__extmap))
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
200 `(assoc [this# k# ~gs]
201 (condp identical? k#
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
202 ~@(mapcat (fn [fld]
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
203 [(keyword fld) (list* `new tagname (replace {fld gs} fields))])
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
204 base-fields)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
205 (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs))))
206 `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
207 (dissoc (with-meta (into {} this#) ~'__meta) k#)
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
208 (new ~tagname ~@(remove #{'__extmap} fields)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
209 (not-empty (dissoc ~'__extmap k#))))))])
c487e48 Stuart Halloway java.util.Map for defrecord, #313
stuarthalloway authored
210 (ijavamap [[i m]]
f0cfe0a Rich Hickey made defrecords Serializable
richhickey authored
211 [(conj i 'java.util.Map 'java.io.Serializable)
c487e48 Stuart Halloway java.util.Map for defrecord, #313
stuarthalloway authored
212 (conj m
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
213 `(size [this#] (.count this#))
214 `(isEmpty [this#] (= 0 (.count this#)))
215 `(containsValue [this# v#] (-> this# vals (.contains v#)))
216 `(get [this# k#] (.valAt this# k#))
217 `(put [this# k# v#] (throw (UnsupportedOperationException.)))
218 `(remove [this# k#] (throw (UnsupportedOperationException.)))
219 `(putAll [this# m#] (throw (UnsupportedOperationException.)))
220 `(clear [this#] (throw (UnsupportedOperationException.)))
221 `(keySet [this#] (set (keys this#)))
222 `(values [this#] (vals this#))
223 `(entrySet [this#] (set this#)))])
c487e48 Stuart Halloway java.util.Map for defrecord, #313
stuarthalloway authored
224 ]
225 (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap ijavamap)]
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
226 `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap)
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
227 :implements ~(vec i)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
228 ~@m))))))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
229
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
230 (defmacro defrecord
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
231 "Alpha - subject to change
232
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
233 (defrecord name [fields*] options* specs*)
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
234
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
235 Currently there are no options.
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
236
237 Each spec consists of a protocol or interface name followed by zero
238 or more method bodies:
239
240 protocol-or-interface-or-Object
241 (methodName [args*] body)*
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
242
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
243 Dynamically generates compiled bytecode for class with the given
244 name, in a package with the same name as the current namespace, the
245 given fields, and, optionally, methods for protocols and/or
246 interfaces.
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
247
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
248 The class will have the (immutable) fields named by
23f612e Rich Hickey added :volatile-mutable and :unsynchronized-mutable options to deftype f...
richhickey authored
249 fields, which can have type hints. Protocols/interfaces and methods
250 are optional. The only methods that can be supplied are those
251 declared in the protocols/interfaces. Note that method bodies are
252 not closures, the local environment includes only the named fields,
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
253 and those fields can be accessed directy.
9c3e97a Rich Hickey methodnames now take form (.methodname [args] body) in reify/deftype/cla...
richhickey authored
254
255 Method definitions take the form:
256
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
257 (methodname [args*] body)
9c3e97a Rich Hickey methodnames now take form (.methodname [args] body) in reify/deftype/cla...
richhickey authored
258
259 The argument and return types can be hinted on the arg and
260 methodname symbols. If not supplied, they will be inferred, so type
261 hints should be reserved for disambiguation.
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
262
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
263 Methods should be supplied for all methods of the desired
264 protocol(s) and interface(s). You can also define overrides for
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
265 methods of Object. Note that a parameter must be supplied to
266 correspond to the target object ('this' in Java parlance). Thus
267 methods for interfaces will take one more argument than do the
268 interface declarations. Note also that recur calls to the method
269 head should *not* pass the target object, it will be supplied
270 automatically and can not be substituted.
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
271
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
272 In the method bodies, the (unqualified) name can be used to name the
273 class (for calls to new, instance? etc).
274
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
275 The class will have implementations of several (clojure.lang)
276 interfaces generated automatically: IObj (metadata support) and
277 IPersistentMap, and all of their superinterfaces.
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
278
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
279 In addition, defrecord will define type-and-value-based equality and
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
280 hashCode.
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
281
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
282 When AOT compiling, generates compiled bytecode for a class with the
283 given name (a symbol), prepends the current ns as the package, and
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
284 writes the .class file to the *compile-path* directory.
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
285
286 Two constructors will be defined, one taking the designated fields
287 followed by a metadata map (nil for none) and an extension field
288 map (nil for none), and one taking only the fields (using nil for
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
289 meta and extension fields)."
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
290 {:added "1.2"}
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
291
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
292 [name [& fields] & opts+specs]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
293 (let [gname name
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
294 [interfaces methods opts] (parse-opts+specs opts+specs)
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
295 classname (symbol (str *ns* "." gname))
296 tag (keyword (str *ns*) (str name))
a3d4274 Rich Hickey don't propagate field hints into method bodies
richhickey authored
297 hinted-fields fields
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
298 fields (vec (map #(with-meta % nil) fields))]
2ac9319 Rich Hickey prevent dynamic classes from being flushed before use
richhickey authored
299 `(let []
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
300 ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
301 (defmethod print-method ~classname [o# w#]
302 ((var print-defrecord) o# w#))
303 (import ~classname)
304 #_(defn ~name
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
305 ([~@fields] (new ~classname ~@fields nil nil))
306 ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#))))))
69494ba Chris Houser Add print-method handlers for deftype and defclass objects
Chouser authored
307
7879383 Rich Hickey replace #^s with ^s
richhickey authored
308 (defn- print-defrecord [o ^Writer w]
69494ba Chris Houser Add print-method handlers for deftype and defclass objects
Chouser authored
309 (print-meta o w)
310 (.write w "#:")
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
311 (.write w (.getName (class o)))
69494ba Chris Houser Add print-method handlers for deftype and defclass objects
Chouser authored
312 (print-map
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
313 o
69494ba Chris Houser Add print-method handlers for deftype and defclass objects
Chouser authored
314 pr-on w))
766b248 Rich Hickey first cut at protocols
richhickey authored
315
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
316 (defn- emit-deftype*
317 "Do not use this directly - use deftype"
318 [tagname name fields interfaces methods]
5916e9e Rich Hickey propagate metadata to classnames in definterface/type/record
richhickey authored
319 (let [classname (with-meta (symbol (str *ns* "." name)) (meta name))]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
320 `(deftype* ~tagname ~classname ~fields
321 :implements ~interfaces
322 ~@methods)))
323
324 (defmacro deftype
325 "Alpha - subject to change
326
327 (deftype name [fields*] options* specs*)
328
329 Currently there are no options.
330
331 Each spec consists of a protocol or interface name followed by zero
332 or more method bodies:
333
334 protocol-or-interface-or-Object
335 (methodName [args*] body)*
336
337 Dynamically generates compiled bytecode for class with the given
338 name, in a package with the same name as the current namespace, the
339 given fields, and, optionally, methods for protocols and/or
340 interfaces.
341
342 The class will have the (by default, immutable) fields named by
343 fields, which can have type hints. Protocols/interfaces and methods
344 are optional. The only methods that can be supplied are those
345 declared in the protocols/interfaces. Note that method bodies are
346 not closures, the local environment includes only the named fields,
347 and those fields can be accessed directy. Fields can be qualified
348 with the metadata :volatile-mutable true or :unsynchronized-mutable
349 true, at which point (set! afield aval) will be supported in method
350 bodies. Note well that mutable fields are extremely difficult to use
351 correctly, and are present only to facilitate the building of higher
352 level constructs, such as Clojure's reference types, in Clojure
353 itself. They are for experts only - if the semantics and
354 implications of :volatile-mutable or :unsynchronized-mutable are not
355 immediately apparent to you, you should not be using them.
356
357 Method definitions take the form:
358
359 (methodname [args*] body)
360
361 The argument and return types can be hinted on the arg and
362 methodname symbols. If not supplied, they will be inferred, so type
363 hints should be reserved for disambiguation.
364
365 Methods should be supplied for all methods of the desired
366 protocol(s) and interface(s). You can also define overrides for
367 methods of Object. Note that a parameter must be supplied to
368 correspond to the target object ('this' in Java parlance). Thus
369 methods for interfaces will take one more argument than do the
370 interface declarations. Note also that recur calls to the method
371 head should *not* pass the target object, it will be supplied
372 automatically and can not be substituted.
373
374 In the method bodies, the (unqualified) name can be used to name the
375 class (for calls to new, instance? etc).
376
377 When AOT compiling, generates compiled bytecode for a class with the
378 given name (a symbol), prepends the current ns as the package, and
379 writes the .class file to the *compile-path* directory.
380
381 One constructors will be defined, taking the designated fields."
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
382 {:added "1.2"}
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
383
384 [name [& fields] & opts+specs]
1eb8786 Rich Hickey doc fix, remove reference to factory fns
richhickey authored
385 (let [gname name
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
386 [interfaces methods opts] (parse-opts+specs opts+specs)
387 classname (symbol (str *ns* "." gname))
388 tag (keyword (str *ns*) (str name))
389 hinted-fields fields
390 fields (vec (map #(with-meta % nil) fields))]
2ac9319 Rich Hickey prevent dynamic classes from being flushed before use
richhickey authored
391 `(let []
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
392 ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
393 (import ~classname))))
394
395
396
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
397
766b248 Rich Hickey first cut at protocols
richhickey authored
398 ;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;
399
7879383 Rich Hickey replace #^s with ^s
richhickey authored
400 (defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f]
3f74c9f Rich Hickey re-enable protocol-based reduce
richhickey authored
401 (let [cs (into1 {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache)))))
e660e46 Rich Hickey new perf for protocols
richhickey authored
402 cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f))
766b248 Rich Hickey first cut at protocols
richhickey authored
403 [shift mask] (min-hash (keys cs))
404 table (make-array Object (* 2 (inc mask)))
3f74c9f Rich Hickey re-enable protocol-based reduce
richhickey authored
405 table (reduce1 (fn [^objects t [c e]]
8b93c4f Rich Hickey fix cache table setup
richhickey authored
406 (let [i (* 2 (int (shift-mask shift mask (hash c))))]
766b248 Rich Hickey first cut at protocols
richhickey authored
407 (aset t i c)
e660e46 Rich Hickey new perf for protocols
richhickey authored
408 (aset t (inc i) e)
766b248 Rich Hickey first cut at protocols
richhickey authored
409 t))
410 table cs)]
411 (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table)))
412
7879383 Rich Hickey replace #^s with ^s
richhickey authored
413 (defn- super-chain [^Class c]
bebb1ff Rich Hickey use hierarchy to determine impl given multiple extends in superclasses o...
richhickey authored
414 (when c
415 (cons c (super-chain (.getSuperclass c)))))
416
eba23db Rich Hickey prefer more derived interface in protocol, fixes #302
richhickey authored
417 (defn- pref
418 ([] nil)
419 ([a] a)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
420 ([^Class a ^Class b]
eba23db Rich Hickey prefer more derived interface in protocol, fixes #302
richhickey authored
421 (if (.isAssignableFrom a b) b a)))
422
766b248 Rich Hickey first cut at protocols
richhickey authored
423 (defn find-protocol-impl [protocol x]
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
424 (if (instance? (:on-interface protocol) x)
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
425 x
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
426 (let [c (class x)
427 impl #(get (:impls protocol) %)]
428 (or (impl c)
429 (and c (or (first (remove nil? (map impl (butlast (super-chain c)))))
3f74c9f Rich Hickey re-enable protocol-based reduce
richhickey authored
430 (when-let [t (reduce1 pref (filter impl (disj (supers c) Object)))]
eba23db Rich Hickey prefer more derived interface in protocol, fixes #302
richhickey authored
431 (impl t))
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
432 (impl Object)))))))
766b248 Rich Hickey first cut at protocols
richhickey authored
433
434 (defn find-protocol-method [protocol methodk x]
435 (get (find-protocol-impl protocol x) methodk))
436
33a3759 Stuart Halloway more protocol tests, fixed NPE in extend, #239
stuarthalloway authored
437 (defn- protocol?
438 [maybe-p]
439 (boolean (:on-interface maybe-p)))
440
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
441 (defn- implements? [protocol atype]
7879383 Rich Hickey replace #^s with ^s
richhickey authored
442 (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype)))
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
443
766b248 Rich Hickey first cut at protocols
richhickey authored
444 (defn extends?
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
445 "Returns true if atype extends protocol"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
446 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
447 [protocol atype]
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
448 (boolean (or (implements? protocol atype)
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
449 (get (:impls protocol) atype))))
766b248 Rich Hickey first cut at protocols
richhickey authored
450
451 (defn extenders
452 "Returns a collection of the types explicitly extending protocol"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
453 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
454 [protocol]
455 (keys (:impls protocol)))
456
457 (defn satisfies?
458 "Returns true if x satisfies the protocol"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
459 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
460 [protocol x]
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
461 (boolean (find-protocol-impl protocol x)))
766b248 Rich Hickey first cut at protocols
richhickey authored
462
7879383 Rich Hickey replace #^s with ^s
richhickey authored
463 (defn -cache-protocol-fn [^clojure.lang.AFunction pf x ^Class c ^clojure.lang.IFn interf]
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
464 (let [cache (.__methodImplCache pf)
e660e46 Rich Hickey new perf for protocols
richhickey authored
465 f (if (.isInstance c x)
466 interf
467 (find-protocol-method (.protocol cache) (.methodk cache) x))]
766b248 Rich Hickey first cut at protocols
richhickey authored
468 (when-not f
469 (throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache)
470 " of protocol: " (:var (.protocol cache))
6347631 Rich Hickey make protocol cache/satisfies? nil-tolerant, ditto supers/bases
richhickey authored
471 " found for class: " (if (nil? x) "nil" (.getName (class x)))))))
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
472 (set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f))
766b248 Rich Hickey first cut at protocols
richhickey authored
473 f))
474
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
475 (defn- emit-method-builder [on-interface method on-method arglists]
766b248 Rich Hickey first cut at protocols
richhickey authored
476 (let [methodk (keyword method)
e660e46 Rich Hickey new perf for protocols
richhickey authored
477 gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction})
478 ginterf (gensym)]
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
479 `(fn [cache#]
e660e46 Rich Hickey new perf for protocols
richhickey authored
480 (let [~ginterf
481 (fn
482 ~@(map
483 (fn [args]
484 (let [gargs (map #(gensym (str "gf__" % "__")) args)
485 target (first gargs)]
486 `([~@gargs]
487 (. ~(with-meta target {:tag on-interface}) ~(or on-method method) ~@(rest gargs)))))
488 arglists))
7879383 Rich Hickey replace #^s with ^s
richhickey authored
489 ^clojure.lang.AFunction f#
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
490 (fn ~gthis
491 ~@(map
492 (fn [args]
19dd3c5 Rich Hickey Remove perf hacks from MethodImplCache, restore new reduce impl
richhickey authored
493 (let [gargs (map #(gensym (str "gf__" % "__")) args)
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
494 target (first gargs)]
495 `([~@gargs]
e660e46 Rich Hickey new perf for protocols
richhickey authored
496 (let [cache# (.__methodImplCache ~gthis)
497 f# (.fnFor cache# (clojure.lang.Util/classOf ~target))]
498 (if f#
499 (f# ~@gargs)
500 ((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs))))))
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
501 arglists))]
502 (set! (.__methodImplCache f#) cache#)
503 f#))))
766b248 Rich Hickey first cut at protocols
richhickey authored
504
505 (defn -reset-methods [protocol]
7879383 Rich Hickey replace #^s with ^s
richhickey authored
506 (doseq [[^clojure.lang.Var v build] (:method-builders protocol)]
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
507 (let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))]
508 (.bindRoot v (build cache)))))
766b248 Rich Hickey first cut at protocols
richhickey authored
509
1efc495 Chris Houser defprotocol now warns when it overwrites an exising method var
Chouser authored
510 (defn- assert-same-protocol [protocol-var method-syms]
511 (doseq [m method-syms]
512 (let [v (resolve m)
513 p (:protocol (meta v))]
8eebaa1 Rich Hickey don't warn on unbound protocol vars
richhickey authored
514 (when (and v (bound? v) (not= protocol-var p))
1efc495 Chris Houser defprotocol now warns when it overwrites an exising method var
Chouser authored
515 (binding [*out* *err*]
516 (println "Warning: protocol" protocol-var "is overwriting"
517 (if p
518 (str "method " (.sym v) " of protocol " (.sym p))
519 (str "function " (.sym v)))))))))
520
766b248 Rich Hickey first cut at protocols
richhickey authored
521 (defn- emit-protocol [name opts+sigs]
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
522 (let [iname (symbol (str (munge *ns*) "." (munge name)))
523 [opts sigs]
dd152ae Rich Hickey add :on-interface for code requiring class, since :on now symbol
richhickey authored
524 (loop [opts {:on (list 'quote iname) :on-interface iname} sigs opts+sigs]
766b248 Rich Hickey first cut at protocols
richhickey authored
525 (condp #(%1 %2) (first sigs)
526 string? (recur (assoc opts :doc (first sigs)) (next sigs))
527 keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs))
528 [opts sigs]))
3f74c9f Rich Hickey re-enable protocol-based reduce
richhickey authored
529 sigs (reduce1 (fn [m s]
8c9b057 Stuart Halloway propagate useful metadata to protocol fns #349
stuarthalloway authored
530 (let [name-meta (meta (first s))
531 mname (with-meta (first s) nil)
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
532 [arglists doc]
533 (loop [as [] rs (rest s)]
534 (if (vector? (first rs))
535 (recur (conj as (first rs)) (next rs))
536 [(seq as) (first rs)]))]
451390f Rich Hickey throw on protocol sig with no args, must be at least one
richhickey authored
537 (when (some #{0} (map count arglists))
538 (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg"))))
8c9b057 Stuart Halloway propagate useful metadata to protocol fns #349
stuarthalloway authored
539 (assoc m (keyword mname)
540 (merge name-meta
541 {:name (vary-meta mname assoc :doc doc :arglists arglists)
542 :arglists arglists
543 :doc doc}))))
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
544 {} sigs)
545 meths (mapcat (fn [sig]
546 (let [m (munge (:name sig))]
547 (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object)
548 (:arglists sig))))
549 (vals sigs))]
766b248 Rich Hickey first cut at protocols
richhickey authored
550 `(do
551 (defonce ~name {})
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
552 (gen-interface :name ~iname :methods ~meths)
1efc495 Chris Houser defprotocol now warns when it overwrites an exising method var
Chouser authored
553 (alter-meta! (var ~name) assoc :doc ~(:doc opts))
554 (#'assert-same-protocol (var ~name) '~(map :name (vals sigs)))
766b248 Rich Hickey first cut at protocols
richhickey authored
555 (alter-var-root (var ~name) merge
556 (assoc ~opts
557 :sigs '~sigs
558 :var (var ~name)
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
559 :method-map
560 ~(and (:on opts)
561 (apply hash-map
562 (mapcat
563 (fn [s]
564 [(keyword (:name s)) (keyword (or (:on s) (:name s)))])
565 (vals sigs))))
766b248 Rich Hickey first cut at protocols
richhickey authored
566 :method-builders
567 ~(apply hash-map
568 (mapcat
8c9b057 Stuart Halloway propagate useful metadata to protocol fns #349
stuarthalloway authored
569 (fn [s]
570 [`(intern *ns* (with-meta '~(:name s) (merge '~s {:protocol (var ~name)})))
dd152ae Rich Hickey add :on-interface for code requiring class, since :on now symbol
richhickey authored
571 (emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))])
766b248 Rich Hickey first cut at protocols
richhickey authored
572 (vals sigs)))))
573 (-reset-methods ~name)
574 '~name)))
575
576 (defmacro defprotocol
577 "A protocol is a named set of named methods and their signatures:
578 (defprotocol AProtocolName
579
2c25d62 Rich Hickey doc fix
richhickey authored
580 ;optional doc string
581 \"A doc string for AProtocol abstraction\"
766b248 Rich Hickey first cut at protocols
richhickey authored
582
583 ;method signatures
2c25d62 Rich Hickey doc fix
richhickey authored
584 (bar [a b] \"bar docs\")
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
585 (baz [a] [a b] [a b c] \"baz docs\"))
766b248 Rich Hickey first cut at protocols
richhickey authored
586
587 No implementations are provided. Docs can be specified for the
588 protocol overall and for each method. The above yields a set of
589 polymorphic functions and a protocol object. All are
590 namespace-qualified by the ns enclosing the definition The resulting
591 functions dispatch on the type of their first argument, and thus
592 must have at least one argument. defprotocol is dynamic, has no
593 special compile-time effect, and defines no new types or classes
594 Implementations of the protocol methods can be provided using
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
595 extend.
596
597 defprotocol will automatically generate a corresponding interface,
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
598 with the same name as the protocol, i.e. given a protocol:
599 my.ns/Protocol, an interface: my.ns.Protocol. The interface will
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
600 have methods corresponding to the protocol functions, and the
601 protocol will automatically work with instances of the interface.
602
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
603 Note that you should not use this interface with deftype or
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
604 reify, as they support the protocol directly:
605
606 (defprotocol P
607 (foo [x])
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
608 (bar-me [x] [x y]))
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
609
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
610 (deftype Foo [a b c]
611 P
612 (foo [] a)
613 (bar-me [] b)
614 (bar-me [y] (+ c y)))
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
615
616 (bar-me (Foo 1 2 3) 42)
617
618 (foo
619 (let [x 42]
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
620 (reify P
621 (foo [] 17)
622 (bar-me [] x)
623 (bar-me [y] x))))"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
624 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
625 [name & opts+sigs]
626 (emit-protocol name opts+sigs))
627
628 (defn extend
629 "Implementations of protocol methods can be provided using the extend construct:
630
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
631 (extend AType
766b248 Rich Hickey first cut at protocols
richhickey authored
632 AProtocol
633 {:foo an-existing-fn
634 :bar (fn [a b] ...)
635 :baz (fn ([a]...) ([a b] ...)...)}
636 BProtocol
637 {...}
638 ...)
639
640 extend takes a type/class (or interface, see below), and one or more
641 protocol + method map pairs. It will extend the polymorphism of the
642 protocol's methods to call the supplied methods when an AType is
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
643 provided as the first argument.
766b248 Rich Hickey first cut at protocols
richhickey authored
644
645 Method maps are maps of the keyword-ized method names to ordinary
646 fns. This facilitates easy reuse of existing fns and fn maps, for
647 code reuse/mixins without derivation or composition. You can extend
648 an interface to a protocol. This is primarily to facilitate interop
649 with the host (e.g. Java) but opens the door to incidental multiple
650 inheritance of implementation since a class can inherit from more
651 than one interface, both of which extend the protocol. It is TBD how
652 to specify which impl to use. You can extend a protocol on nil.
653
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
654 If you are supplying the definitions explicitly (i.e. not reusing
655 exsting functions or mixin maps), you may find it more convenient to
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
656 use the extend-type or extend-protocol macros.
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
657
766b248 Rich Hickey first cut at protocols
richhickey authored
658 Note that multiple independent extend clauses can exist for the same
659 type, not all protocols need be defined in a single extend call.
660
661 See also:
662 extends?, satisfies?, extenders"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
663 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
664 [atype & proto+mmaps]
665 (doseq [[proto mmap] (partition 2 proto+mmaps)]
33a3759 Stuart Halloway more protocol tests, fixed NPE in extend, #239
stuarthalloway authored
666 (when-not (protocol? proto)
667 (throw (IllegalArgumentException.
668 (str proto " is not a protocol"))))
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
669 (when (implements? proto atype)
670 (throw (IllegalArgumentException.
671 (str atype " already directly implements " (:on-interface proto) " for protocol:"
672 (:var proto)))))
766b248 Rich Hickey first cut at protocols
richhickey authored
673 (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap))))
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
674
675 (defn- emit-impl [[p fs]]
676 [p (zipmap (map #(-> % first keyword) fs)
677 (map #(cons 'fn (drop 1 %)) fs))])
678
679 (defn- emit-hinted-impl [c [p fs]]
680 (let [hint (fn [specs]
681 (let [specs (if (vector? (first specs))
682 (list specs)
683 specs)]
684 (map (fn [[[target & args] & body]]
685 (cons (apply vector (vary-meta target assoc :tag c) args)
686 body))
687 specs)))]
688 [p (zipmap (map #(-> % first keyword) fs)
689 (map #(cons 'fn (hint (drop 1 %))) fs))]))
690
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
691 (defn- emit-extend-type [c specs]
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
692 (let [impls (parse-impls specs)]
693 `(extend ~c
694 ~@(mapcat (partial emit-hinted-impl c) impls))))
695
696 (defmacro extend-type
697 "A macro that expands into an extend call. Useful when you are
698 supplying the definitions explicitly inline, extend-type
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
699 automatically creates the maps required by extend. Propagates the
700 class as a type hint on the first argument of all fns.
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
701
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
702 (extend-type MyType
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
703 Countable
704 (cnt [c] ...)
705 Foo
706 (bar [x y] ...)
707 (baz ([x] ...) ([x y & zs] ...)))
708
709 expands into:
710
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
711 (extend MyType
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
712 Countable
713 {:cnt (fn [c] ...)}
714 Foo
715 {:baz (fn ([x] ...) ([x y & zs] ...))
716 :bar (fn [x y] ...)})"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
717 {:added "1.2"}
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
718 [t & specs]
719 (emit-extend-type t specs))
720
75cd050 Rich Hickey added extend-protocol
richhickey authored
721 (defn- emit-extend-protocol [p specs]
722 (let [impls (parse-impls specs)]
723 `(do
724 ~@(map (fn [[t fs]]
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
725 `(extend-type ~t ~p ~@fs))
75cd050 Rich Hickey added extend-protocol
richhickey authored
726 impls))))
727
728 (defmacro extend-protocol
729 "Useful when you want to provide several implementations of the same
730 protocol all at once. Takes a single protocol and the implementation
731 of that protocol for one or more types. Expands into calls to
732 extend-type and extend-class:
733
734 (extend-protocol Protocol
735 ::AType
736 (foo [x] ...)
737 (bar [x y] ...)
738 ::BType
739 (foo [x] ...)
740 (bar [x y] ...)
741 AClass
742 (foo [x] ...)
743 (bar [x y] ...)
744 nil
745 (foo [x] ...)
746 (bar [x y] ...))
747
748 expands into:
749
750 (do
751 (clojure.core/extend-type ::AType Protocol
752 (foo [x] ...)
753 (bar [x y] ...))
754 (clojure.core/extend-type ::BType Protocol
755 (foo [x] ...)
756 (bar [x y] ...))
757 (clojure.core/extend-class AClass Protocol
758 (foo [x] ...)
759 (bar [x y] ...))
760 (clojure.core/extend-type nil Protocol
761 (foo [x] ...)
762 (bar [x y] ...)))"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
763 {:added "1.2"}
75cd050 Rich Hickey added extend-protocol
richhickey authored
764
765 [p & specs]
766 (emit-extend-protocol p specs))
767
Something went wrong with that request. Please try again.