Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 858 lines (749 sloc) 35.626 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
4784f4c Tassilo Horn Add docstring and :added metadata to definterface.
tsdh authored
20 (defmacro definterface
21 "Creates a new Java interface with the given name and method sigs.
22 The method return types and parameter types may be specified with type hints,
23 defaulting to Object if omitted.
24
25 (definterface MyInterface
26 (^int method1 [x])
27 (^Bar method2 [^Baz b ^Quux q]))"
28 {:added "1.2"} ;; Present since 1.2, but made public in 1.5.
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
29 [name & sigs]
30 (let [tag (fn [x] (or (:tag (meta x)) Object))
31 psig (fn [[name [& args]]]
db3466e Rich Hickey support type and parameter annotations in definterface
richhickey authored
32 (vector name (vec (map tag args)) (tag name) (map meta args)))
33 cname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))]
2ac9319 Rich Hickey prevent dynamic classes from being flushed before use
richhickey authored
34 `(let []
35 (gen-interface :name ~cname :methods ~(vec (map psig sigs)))
36 (import ~cname))))
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
37
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39
40 (defn- parse-opts [s]
41 (loop [opts {} [k v & rs :as s] s]
42 (if (keyword? k)
43 (recur (assoc opts k v) rs)
44 [opts s])))
45
46 (defn- parse-impls [specs]
47 (loop [ret {} s specs]
48 (if (seq s)
49 (recur (assoc ret (first s) (take-while seq? (next s)))
50 (drop-while seq? (next s)))
51 ret)))
52
53 (defn- parse-opts+specs [opts+specs]
54 (let [[opts specs] (parse-opts opts+specs)
55 impls (parse-impls specs)
56 interfaces (-> (map #(if (var? (resolve %))
57 (:on (deref (resolve %)))
58 %)
59 (keys impls))
60 set
61 (disj 'Object 'java.lang.Object)
62 vec)
bf8bb79 Rich Hickey added parameter destructuring support to reify and deftype/record
richhickey authored
63 methods (map (fn [[name params & body]]
64 (cons name (maybe-destructured params body)))
65 (apply concat (vals impls)))]
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
66 (when-let [bad-opts (seq (remove #{:no-print} (keys opts)))]
67 (throw (IllegalArgumentException. (apply print-str "Unsupported option(s) -" bad-opts))))
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
68 [interfaces methods opts]))
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
69
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
70 (defmacro reify
71 "reify is a macro with the following structure:
72
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
73 (reify options* specs*)
74
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
75 Currently there are no options.
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
76
77 Each spec consists of the protocol or interface name followed by zero
78 or more method bodies:
79
80 protocol-or-interface-or-Object
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
81 (methodName [args+] body)*
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
82
83 Methods should be supplied for all methods of the desired
84 protocol(s) and interface(s). You can also define overrides for
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
85 methods of Object. Note that the first parameter must be supplied to
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
86 correspond to the target object ('this' in Java parlance). Thus
87 methods for interfaces will take one more argument than do the
88 interface declarations. Note also that recur calls to the method
89 head should *not* pass the target object, it will be supplied
90 automatically and can not be substituted.
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
91
92 The return type can be indicated by a type hint on the method name,
93 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
94 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
95 method in the protocol(s)/interface(s) - this is preferred. If you
96 supply any hints at all, no inference is done, so all hints (or
97 default of Object) must be correct, for both arguments and return
98 type. If a method is overloaded in a protocol/interface, multiple
99 independent method definitions must be supplied. If overloaded with
100 same arity in an interface you must specify complete hints to
101 disambiguate - a missing hint implies Object.
102
103 recur works to method heads The method bodies of reify are lexical
104 closures, and can refer to the surrounding local scope:
105
106 (str (let [f \"foo\"]
a3e95cf Rich Hickey update example in reify doc
richhickey authored
107 (reify Object
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
108 (toString [this] f))))
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
109 == \"foo\"
110
111 (seq (let [f \"foo\"]
a3e95cf Rich Hickey update example in reify doc
richhickey authored
112 (reify clojure.lang.Seqable
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
113 (seq [this] (seq f)))))
9dd6c81 Meikel Brandmeyer Fix docstring of reify
kotarak authored
114 == (\\f \\o \\o))
115
116 reify always implements clojure.lang.IObj and transfers meta
117 data of the form to the created object.
118
119 (meta ^{:k :v} (reify Object (toString [this] \"foo\")))
120 == {:k :v}"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
121 {:added "1.2"}
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
122 [& opts+specs]
123 (let [[interfaces methods] (parse-opts+specs opts+specs)]
67864eb Rich Hickey added IObj and metadata propagation support for reify, so #^{:my :meta} ...
richhickey authored
124 (with-meta `(reify* ~interfaces ~@methods) (meta &form))))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
125
126 (defn hash-combine [x y]
127 (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y)))
128
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
129 (defn munge [s]
130 ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s))))
131
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
132 (defn- imap-cons
7879383 Rich Hickey replace #^s with ^s
richhickey authored
133 [^IPersistentMap this o]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
134 (cond
135 (instance? java.util.Map$Entry o)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
136 (let [^java.util.Map$Entry pair o]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
137 (.assoc this (.getKey pair) (.getValue pair)))
138 (instance? clojure.lang.IPersistentVector o)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
139 (let [^clojure.lang.IPersistentVector vec o]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
140 (.assoc this (.nth vec 0) (.nth vec 1)))
141 :else (loop [this this
142 o o]
143 (if (seq o)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
144 (let [^java.util.Map$Entry pair (first o)]
e0e0b6a Stuart Halloway make defrecord .cons work, #231
stuarthalloway authored
145 (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o)))
146 this))))
147
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
148 (defn- emit-defrecord
149 "Do not use this directly - use defrecord"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
150 {:added "1.2"}
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
151 [tagname name fields interfaces methods]
ca1d49a Stuart Halloway get rid of spurious tags on deftype/defrecord (again!)
stuarthalloway authored
152 (let [classname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
153 interfaces (vec interfaces)
154 interface-set (set (map resolve interfaces))
155 methodname-set (set (map first methods))
a3d4274 Rich Hickey don't propagate field hints into method bodies
richhickey authored
156 hinted-fields fields
157 fields (vec (map #(with-meta % nil) fields))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
158 base-fields fields
f75d47e Brenton Ashworth CLJ-867: Records implement IHashEq to incorporate record name into hash ...
brentonashworth authored
159 fields (conj fields '__meta '__extmap)
160 type-hash (hash classname)]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
161 (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields))
162 (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
163 (let [gs (gensym)]
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
164 (letfn
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
165 [(irecord [[i m]]
166 [(conj i 'clojure.lang.IRecord)
167 m])
168 (eqhash [[i m]]
f75d47e Brenton Ashworth CLJ-867: Records implement IHashEq to incorporate record name into hash ...
brentonashworth authored
169 [(conj i 'clojure.lang.IHashEq)
170 (conj m
6fd7b77 Christophe Grand make hasheq coherent with equiv for records
cgrand authored
171 `(hasheq [this#] (bit-xor ~type-hash (clojure.lang.APersistentMap/mapHasheq this#)))
ac484ba Rich Hickey fix record equality with other maps, = includes type, .equals doesn't. s...
richhickey authored
172 `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#))
173 `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))])
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
174 (iobj [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
175 [(conj i 'clojure.lang.IObj)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
176 (conj m `(meta [this#] ~'__meta)
177 `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))])
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
178 (ilookup [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
179 [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
180 (conj m `(valAt [this# k#] (.valAt this# k# nil))
181 `(valAt [this# k# else#]
182 (case k# ~@(mapcat (fn [fld] [(keyword fld) fld])
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
183 base-fields)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
184 (get ~'__extmap k# else#)))
185 `(getLookupThunk [this# k#]
186 (let [~'gclass (class this#)]
187 (case k#
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
188 ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})]
189 (mapcat
190 (fn [fld]
595d0f7 CLJ-872 Add support for prop lookup, refs CLJS-89
Michael Fogus and Alan Dipert authored
191 [(keyword fld)
192 `(reify clojure.lang.ILookupThunk
193 (get [~'thunk ~'gtarget]
194 (if (identical? (class ~'gtarget) ~'gclass)
195 (. ~hinted-target ~(symbol (str "-" fld)))
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
196 ~'thunk)))])
197 base-fields))
198 nil))))])
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
199 (imap [[i m]]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
200 [(conj i 'clojure.lang.IPersistentMap)
201 (conj m
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
202 `(count [this#] (+ ~(count base-fields) (count ~'__extmap)))
203 `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
204 `(cons [this# e#] ((var imap-cons) this# e#))
ac484ba Rich Hickey fix record equality with other maps, = includes type, .equals doesn't. s...
richhickey authored
205 `(equiv [this# ~gs]
206 (boolean
207 (or (identical? this# ~gs)
208 (when (identical? (class this#) (class ~gs))
209 (let [~gs ~(with-meta gs {:tag tagname})]
595d0f7 CLJ-872 Add support for prop lookup, refs CLJS-89
Michael Fogus and Alan Dipert authored
210 (and ~@(map (fn [fld] `(= ~fld (. ~gs ~(symbol (str "-" fld))))) base-fields)
ac484ba Rich Hickey fix record equality with other maps, = includes type, .equals doesn't. s...
richhickey authored
211 (= ~'__extmap (. ~gs ~'__extmap))))))))
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
212 `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#))))
213 `(entryAt [this# k#] (let [v# (.valAt this# k# this#)]
214 (when-not (identical? this# v#)
215 (clojure.lang.MapEntry. k# v#))))
ec2037e Stuart Halloway fix degenerate defrecords, #402
stuarthalloway authored
216 `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)]
217 ~'__extmap)))
4e64fa2 Rich Hickey deftype failed to implement Iterable
richhickey authored
218 `(iterator [this#] (clojure.lang.SeqIterator. (.seq this#)))
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
219 `(assoc [this# k# ~gs]
220 (condp identical? k#
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
221 ~@(mapcat (fn [fld]
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
222 [(keyword fld) (list* `new tagname (replace {fld gs} fields))])
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
223 base-fields)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
224 (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs))))
225 `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
226 (dissoc (with-meta (into {} this#) ~'__meta) k#)
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
227 (new ~tagname ~@(remove #{'__extmap} fields)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
228 (not-empty (dissoc ~'__extmap k#))))))])
c487e48 Stuart Halloway java.util.Map for defrecord, #313
stuarthalloway authored
229 (ijavamap [[i m]]
f0cfe0a Rich Hickey made defrecords Serializable
richhickey authored
230 [(conj i 'java.util.Map 'java.io.Serializable)
c487e48 Stuart Halloway java.util.Map for defrecord, #313
stuarthalloway authored
231 (conj m
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
232 `(size [this#] (.count this#))
233 `(isEmpty [this#] (= 0 (.count this#)))
ec2037e Stuart Halloway fix degenerate defrecords, #402
stuarthalloway authored
234 `(containsValue [this# v#] (boolean (some #{v#} (vals this#))))
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
235 `(get [this# k#] (.valAt this# k#))
236 `(put [this# k# v#] (throw (UnsupportedOperationException.)))
237 `(remove [this# k#] (throw (UnsupportedOperationException.)))
238 `(putAll [this# m#] (throw (UnsupportedOperationException.)))
239 `(clear [this#] (throw (UnsupportedOperationException.)))
240 `(keySet [this#] (set (keys this#)))
241 `(values [this#] (vals this#))
242 `(entrySet [this#] (set this#)))])
c487e48 Stuart Halloway java.util.Map for defrecord, #313
stuarthalloway authored
243 ]
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
244 (let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)]
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
245 `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap)
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
246 :implements ~(vec i)
c2b229e khinsen Remove potential conflicts between field names and method argument names...
khinsen authored
247 ~@m))))))
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
248
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
249 (defn- build-positional-factory
250 "Used to build a positional factory for a given type/record. Because of the
251 limitation of 20 arguments to Clojure functions, this factory needs to be
252 constructed to deal with more arguments. It does this by building a straight
253 forward type/record ctor call in the <=20 case, and a call to the same
254 ctor pulling the extra args out of the & overage parameter. Finally, the
255 arity is constrained to the number of expected fields and an ArityException
256 will be thrown at runtime if the actual arg count does not match."
257 [nom classname fields]
258 (let [fn-name (symbol (str '-> nom))
259 [field-args over] (split-at 20 fields)
260 field-count (count fields)
261 arg-count (count field-args)
9e28ced Chris Perkins Docstrings for generated factory functions.
grammati authored
262 over-count (count over)
263 docstring (str "Positional factory function for class " classname ".")]
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
264 `(defn ~fn-name
9e28ced Chris Perkins Docstrings for generated factory functions.
grammati authored
265 ~docstring
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
266 [~@field-args ~@(if (seq over) '[& overage] [])]
267 ~(if (seq over)
268 `(if (= (count ~'overage) ~over-count)
269 (new ~classname
270 ~@field-args
271 ~@(for [i (range 0 (count over))]
272 (list `nth 'overage i)))
273 (throw (clojure.lang.ArityException. (+ ~arg-count (count ~'overage)) (name '~fn-name))))
274 `(new ~classname ~@field-args)))))
275
3155746 Fogus Fixes CLJ-837 by allowing any field prefixed with double-underscores exc...
fogus authored
276 (defn- validate-fields
277 ""
b8181b7 Andy Fingerhut CLJ-1261: Better error msg for bad fields in defrecord, deftype
jafingerhut authored
278 [fields name]
d50cebb Tassilo Horn Don't use descructuring in defrecord/deftype arglists to get a slightly ...
tsdh authored
279 (when-not (vector? fields)
280 (throw (AssertionError. "No fields vector given.")))
3155746 Fogus Fixes CLJ-837 by allowing any field prefixed with double-underscores exc...
fogus authored
281 (let [specials #{'__meta '__extmap}]
282 (when (some specials fields)
b8181b7 Andy Fingerhut CLJ-1261: Better error msg for bad fields in defrecord, deftype
jafingerhut authored
283 (throw (AssertionError. (str "The names in " specials " cannot be used as field names for types or records.")))))
284 (let [non-syms (remove symbol? fields)]
285 (when (seq non-syms)
286 (throw (clojure.lang.Compiler$CompilerException.
287 *file*
288 (.deref clojure.lang.Compiler/LINE)
289 (.deref clojure.lang.Compiler/COLUMN)
290 (AssertionError.
291 (str "defrecord and deftype fields must be symbols, "
292 *ns* "." name " had: "
293 (apply str (interpose ", " non-syms)))))))))
3155746 Fogus Fixes CLJ-837 by allowing any field prefixed with double-underscores exc...
fogus authored
294
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
295 (defmacro defrecord
93d13d0 Alex Miller Remove Alpha designation from many features.
puredanger authored
296 "(defrecord name [fields*] options* specs*)
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
297
ba6cc3b Rich Hickey reify/deftype methods now take target ('this') object as explicit first ...
richhickey authored
298 Currently there are no options.
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
299
300 Each spec consists of a protocol or interface name followed by zero
301 or more method bodies:
302
303 protocol-or-interface-or-Object
304 (methodName [args*] body)*
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
305
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
306 Dynamically generates compiled bytecode for class with the given
307 name, in a package with the same name as the current namespace, the
308 given fields, and, optionally, methods for protocols and/or
309 interfaces.
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
310
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
311 The class will have the (immutable) fields named by
23f612e Rich Hickey added :volatile-mutable and :unsynchronized-mutable options to deftype f...
richhickey authored
312 fields, which can have type hints. Protocols/interfaces and methods
313 are optional. The only methods that can be supplied are those
314 declared in the protocols/interfaces. Note that method bodies are
315 not closures, the local environment includes only the named fields,
5fcdc6e Gabriel Horner fix typos in docstrings and docs
cldwalker authored
316 and those fields can be accessed directly.
9c3e97a Rich Hickey methodnames now take form (.methodname [args] body) in reify/deftype/cla...
richhickey authored
317
318 Method definitions take the form:
319
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
320 (methodname [args*] body)
9c3e97a Rich Hickey methodnames now take form (.methodname [args] body) in reify/deftype/cla...
richhickey authored
321
322 The argument and return types can be hinted on the arg and
323 methodname symbols. If not supplied, they will be inferred, so type
324 hints should be reserved for disambiguation.
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
325
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
326 Methods should be supplied for all methods of the desired
327 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
328 methods of Object. Note that a parameter must be supplied to
329 correspond to the target object ('this' in Java parlance). Thus
330 methods for interfaces will take one more argument than do the
331 interface declarations. Note also that recur calls to the method
332 head should *not* pass the target object, it will be supplied
333 automatically and can not be substituted.
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
334
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
335 In the method bodies, the (unqualified) name can be used to name the
336 class (for calls to new, instance? etc).
337
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
338 The class will have implementations of several (clojure.lang)
339 interfaces generated automatically: IObj (metadata support) and
340 IPersistentMap, and all of their superinterfaces.
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
341
6d84867 Stuart Halloway CLJ-736 docfix
stuarthalloway authored
342 In addition, defrecord will define type-and-value-based =,
343 and will defined Java .hashCode and .equals consistent with the
344 contract for java.util.Map.
eea980a Rich Hickey IPersistentMap opt-in, dissoc support, doc tweaks
richhickey authored
345
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
346 When AOT compiling, generates compiled bytecode for a class with the
347 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
348 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
349
350 Two constructors will be defined, one taking the designated fields
351 followed by a metadata map (nil for none) and an extension field
352 map (nil for none), and one taking only the fields (using nil for
3155746 Fogus Fixes CLJ-837 by allowing any field prefixed with double-underscores exc...
fogus authored
353 meta and extension fields). Note that the field names __meta
354 and __extmap are currently reserved and should not be used when
9e28ced Chris Perkins Docstrings for generated factory functions.
grammati authored
355 defining your own records.
356
357 Given (defrecord TypeName ...), two factory functions will be
358 defined: ->TypeName, taking positional parameters for the fields,
359 and map->TypeName, taking a map of keywords to field values."
d50cebb Tassilo Horn Don't use descructuring in defrecord/deftype arglists to get a slightly ...
tsdh authored
360 {:added "1.2"
361 :arglists '([name [& fields] & opts+specs])}
5f090a0 Rich Hickey first cut at defclass/deftype
richhickey authored
362
d50cebb Tassilo Horn Don't use descructuring in defrecord/deftype arglists to get a slightly ...
tsdh authored
363 [name fields & opts+specs]
b8181b7 Andy Fingerhut CLJ-1261: Better error msg for bad fields in defrecord, deftype
jafingerhut authored
364 (validate-fields fields name)
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
365 (let [gname name
f612ecf Rich Hickey inlined bit shifts, added definterface (undocumented for now)
richhickey authored
366 [interfaces methods opts] (parse-opts+specs opts+specs)
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
367 ns-part (namespace-munge *ns*)
368 classname (symbol (str ns-part "." gname))
a3d4274 Rich Hickey don't propagate field hints into method bodies
richhickey authored
369 hinted-fields fields
292836f Rich Hickey got rid of defclass. deftype now can refer to self-type, will emit same-...
richhickey authored
370 fields (vec (map #(with-meta % nil) fields))]
2ac9319 Rich Hickey prevent dynamic classes from being flushed before use
richhickey authored
371 `(let []
8a0482d Kurt Harriger declare record factory functions for use within defrecord implementation
kurtharriger authored
372 (declare ~(symbol (str '-> gname)))
373 (declare ~(symbol (str 'map-> gname)))
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
374 ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
375 (import ~classname)
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
376 ~(build-positional-factory gname classname fields)
377 (defn ~(symbol (str 'map-> gname))
9e28ced Chris Perkins Docstrings for generated factory functions.
grammati authored
378 ~(str "Factory function for class " classname ", taking a map of keywords to field values.")
62acc2a Steve Miner CLJ-1388 record equality and map->record factory
miner authored
379 ([m#] (~(symbol (str classname "/create"))
380 (if (instance? clojure.lang.MapEquivalence m#) m# (into {} m#)))))
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
381 ~classname)))
766b248 Rich Hickey first cut at protocols
richhickey authored
382
f7215fd Devin Walters Add record? via IRecord
devn authored
383 (defn record?
384 "Returns true if x is a record"
385 {:added "1.6"
386 :static true}
387 [x]
388 (instance? clojure.lang.IRecord x))
389
390 (defn- emit-deftype*
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
391 "Do not use this directly - use deftype"
392 [tagname name fields interfaces methods]
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
393 (let [classname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))
394 interfaces (conj interfaces 'clojure.lang.IType)]
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
395 `(deftype* ~tagname ~classname ~fields
396 :implements ~interfaces
397 ~@methods)))
398
399 (defmacro deftype
93d13d0 Alex Miller Remove Alpha designation from many features.
puredanger authored
400 "(deftype name [fields*] options* specs*)
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
401
402 Currently there are no options.
403
404 Each spec consists of a protocol or interface name followed by zero
405 or more method bodies:
406
407 protocol-or-interface-or-Object
408 (methodName [args*] body)*
409
410 Dynamically generates compiled bytecode for class with the given
411 name, in a package with the same name as the current namespace, the
412 given fields, and, optionally, methods for protocols and/or
413 interfaces.
414
415 The class will have the (by default, immutable) fields named by
416 fields, which can have type hints. Protocols/interfaces and methods
417 are optional. The only methods that can be supplied are those
418 declared in the protocols/interfaces. Note that method bodies are
419 not closures, the local environment includes only the named fields,
6fba517 Bozhidar Batsov Fix a typo
bbatsov authored
420 and those fields can be accessed directly. Fields can be qualified
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
421 with the metadata :volatile-mutable true or :unsynchronized-mutable
422 true, at which point (set! afield aval) will be supported in method
423 bodies. Note well that mutable fields are extremely difficult to use
424 correctly, and are present only to facilitate the building of higher
425 level constructs, such as Clojure's reference types, in Clojure
426 itself. They are for experts only - if the semantics and
427 implications of :volatile-mutable or :unsynchronized-mutable are not
428 immediately apparent to you, you should not be using them.
429
430 Method definitions take the form:
431
432 (methodname [args*] body)
433
434 The argument and return types can be hinted on the arg and
435 methodname symbols. If not supplied, they will be inferred, so type
436 hints should be reserved for disambiguation.
437
438 Methods should be supplied for all methods of the desired
439 protocol(s) and interface(s). You can also define overrides for
440 methods of Object. Note that a parameter must be supplied to
441 correspond to the target object ('this' in Java parlance). Thus
442 methods for interfaces will take one more argument than do the
443 interface declarations. Note also that recur calls to the method
444 head should *not* pass the target object, it will be supplied
445 automatically and can not be substituted.
446
447 In the method bodies, the (unqualified) name can be used to name the
448 class (for calls to new, instance? etc).
449
450 When AOT compiling, generates compiled bytecode for a class with the
451 given name (a symbol), prepends the current ns as the package, and
452 writes the .class file to the *compile-path* directory.
453
3155746 Fogus Fixes CLJ-837 by allowing any field prefixed with double-underscores exc...
fogus authored
454 One constructor will be defined, taking the designated fields. Note
455 that the field names __meta and __extmap are currently reserved and
9e28ced Chris Perkins Docstrings for generated factory functions.
grammati authored
456 should not be used when defining your own types.
457
458 Given (deftype TypeName ...), a factory function called ->TypeName
459 will be defined, taking positional parameters for the fields"
d50cebb Tassilo Horn Don't use descructuring in defrecord/deftype arglists to get a slightly ...
tsdh authored
460 {:added "1.2"
461 :arglists '([name [& fields] & opts+specs])}
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
462
d50cebb Tassilo Horn Don't use descructuring in defrecord/deftype arglists to get a slightly ...
tsdh authored
463 [name fields & opts+specs]
b8181b7 Andy Fingerhut CLJ-1261: Better error msg for bad fields in defrecord, deftype
jafingerhut authored
464 (validate-fields fields name)
1eb8786 Rich Hickey doc fix, remove reference to factory fns
richhickey authored
465 (let [gname name
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
466 [interfaces methods opts] (parse-opts+specs opts+specs)
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
467 ns-part (namespace-munge *ns*)
468 classname (symbol (str ns-part "." gname))
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
469 hinted-fields fields
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
470 fields (vec (map #(with-meta % nil) fields))
471 [field-args over] (split-at 20 fields)]
2ac9319 Rich Hickey prevent dynamic classes from being flushed before use
richhickey authored
472 `(let []
12b5c59 Rich Hickey first cut of deftype/defrecord split
richhickey authored
473 ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
474 (import ~classname)
21175bc Fogus Changes to shore up the shortcomings and fix bugs found in defrecord rea...
fogus authored
475 ~(build-positional-factory gname classname fields)
ac1e8ad Fogus Changes to support defrecord and deftype literals. See CLJ-374
fogus authored
476 ~classname)))
477
766b248 Rich Hickey first cut at protocols
richhickey authored
478 ;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;
479
7879383 Rich Hickey replace #^s with ^s
richhickey authored
480 (defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f]
8b94a54 Fix CLJ-801: protocol's method cache falls back to using a map when shif...
Alexander Taggart authored
481 (if (.map cache)
482 (let [cs (assoc (.map cache) c (clojure.lang.MethodImplCache$Entry. c f))]
483 (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) cs))
484 (let [cs (into1 {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache)))))
485 cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f))]
486 (if-let [[shift mask] (maybe-min-hash (map hash (keys cs)))]
487 (let [table (make-array Object (* 2 (inc mask)))
488 table (reduce1 (fn [^objects t [c e]]
489 (let [i (* 2 (int (shift-mask shift mask (hash c))))]
490 (aset t i c)
491 (aset t (inc i) e)
492 t))
493 table cs)]
494 (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table))
495 (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) cs)))))
766b248 Rich Hickey first cut at protocols
richhickey authored
496
7879383 Rich Hickey replace #^s with ^s
richhickey authored
497 (defn- super-chain [^Class c]
bebb1ff Rich Hickey use hierarchy to determine impl given multiple extends in superclasses o...
richhickey authored
498 (when c
499 (cons c (super-chain (.getSuperclass c)))))
500
eba23db Rich Hickey prefer more derived interface in protocol, fixes #302
richhickey authored
501 (defn- pref
502 ([] nil)
503 ([a] a)
7879383 Rich Hickey replace #^s with ^s
richhickey authored
504 ([^Class a ^Class b]
eba23db Rich Hickey prefer more derived interface in protocol, fixes #302
richhickey authored
505 (if (.isAssignableFrom a b) b a)))
506
766b248 Rich Hickey first cut at protocols
richhickey authored
507 (defn find-protocol-impl [protocol x]
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
508 (if (instance? (:on-interface protocol) x)
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
509 x
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
510 (let [c (class x)
511 impl #(get (:impls protocol) %)]
512 (or (impl c)
513 (and c (or (first (remove nil? (map impl (butlast (super-chain c)))))
3f74c9f Rich Hickey re-enable protocol-based reduce
richhickey authored
514 (when-let [t (reduce1 pref (filter impl (disj (supers c) Object)))]
eba23db Rich Hickey prefer more derived interface in protocol, fixes #302
richhickey authored
515 (impl t))
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
516 (impl Object)))))))
766b248 Rich Hickey first cut at protocols
richhickey authored
517
518 (defn find-protocol-method [protocol methodk x]
519 (get (find-protocol-impl protocol x) methodk))
520
33a3759 Stuart Halloway more protocol tests, fixed NPE in extend, #239
stuarthalloway authored
521 (defn- protocol?
522 [maybe-p]
523 (boolean (:on-interface maybe-p)))
524
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
525 (defn- implements? [protocol atype]
7879383 Rich Hickey replace #^s with ^s
richhickey authored
526 (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype)))
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
527
766b248 Rich Hickey first cut at protocols
richhickey authored
528 (defn extends?
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
529 "Returns true if atype extends protocol"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
530 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
531 [protocol atype]
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
532 (boolean (or (implements? protocol atype)
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
533 (get (:impls protocol) atype))))
766b248 Rich Hickey first cut at protocols
richhickey authored
534
535 (defn extenders
536 "Returns a collection of the types explicitly extending protocol"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
537 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
538 [protocol]
539 (keys (:impls protocol)))
540
541 (defn satisfies?
542 "Returns true if x satisfies the protocol"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
543 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
544 [protocol x]
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
545 (boolean (find-protocol-impl protocol x)))
766b248 Rich Hickey first cut at protocols
richhickey authored
546
7879383 Rich Hickey replace #^s with ^s
richhickey authored
547 (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
548 (let [cache (.__methodImplCache pf)
e660e46 Rich Hickey new perf for protocols
richhickey authored
549 f (if (.isInstance c x)
550 interf
551 (find-protocol-method (.protocol cache) (.methodk cache) x))]
766b248 Rich Hickey first cut at protocols
richhickey authored
552 (when-not f
553 (throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache)
554 " of protocol: " (:var (.protocol cache))
6347631 Rich Hickey make protocol cache/satisfies? nil-tolerant, ditto supers/bases
richhickey authored
555 " 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
556 (set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f))
766b248 Rich Hickey first cut at protocols
richhickey authored
557 f))
558
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
559 (defn- emit-method-builder [on-interface method on-method arglists]
766b248 Rich Hickey first cut at protocols
richhickey authored
560 (let [methodk (keyword method)
e660e46 Rich Hickey new perf for protocols
richhickey authored
561 gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction})
562 ginterf (gensym)]
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
563 `(fn [cache#]
e660e46 Rich Hickey new perf for protocols
richhickey authored
564 (let [~ginterf
565 (fn
566 ~@(map
567 (fn [args]
568 (let [gargs (map #(gensym (str "gf__" % "__")) args)
569 target (first gargs)]
570 `([~@gargs]
98437ff Alan Malloy Fix CLJ-1202.
amalloy authored
571 (. ~(with-meta target {:tag on-interface}) (~(or on-method method) ~@(rest gargs))))))
e660e46 Rich Hickey new perf for protocols
richhickey authored
572 arglists))
7879383 Rich Hickey replace #^s with ^s
richhickey authored
573 ^clojure.lang.AFunction f#
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
574 (fn ~gthis
575 ~@(map
576 (fn [args]
19dd3c5 Rich Hickey Remove perf hacks from MethodImplCache, restore new reduce impl
richhickey authored
577 (let [gargs (map #(gensym (str "gf__" % "__")) args)
8c16415 Rich Hickey put method impl cache on fns themselves, get rid of box
richhickey authored
578 target (first gargs)]
579 `([~@gargs]
e660e46 Rich Hickey new perf for protocols
richhickey authored
580 (let [cache# (.__methodImplCache ~gthis)
581 f# (.fnFor cache# (clojure.lang.Util/classOf ~target))]
582 (if f#
583 (f# ~@gargs)
584 ((-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
585 arglists))]
586 (set! (.__methodImplCache f#) cache#)
587 f#))))
766b248 Rich Hickey first cut at protocols
richhickey authored
588
589 (defn -reset-methods [protocol]
7879383 Rich Hickey replace #^s with ^s
richhickey authored
590 (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
591 (let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))]
592 (.bindRoot v (build cache)))))
766b248 Rich Hickey first cut at protocols
richhickey authored
593
1efc495 Chris Houser defprotocol now warns when it overwrites an exising method var
Chouser authored
594 (defn- assert-same-protocol [protocol-var method-syms]
595 (doseq [m method-syms]
596 (let [v (resolve m)
597 p (:protocol (meta v))]
8eebaa1 Rich Hickey don't warn on unbound protocol vars
richhickey authored
598 (when (and v (bound? v) (not= protocol-var p))
1efc495 Chris Houser defprotocol now warns when it overwrites an exising method var
Chouser authored
599 (binding [*out* *err*]
600 (println "Warning: protocol" protocol-var "is overwriting"
601 (if p
602 (str "method " (.sym v) " of protocol " (.sym p))
603 (str "function " (.sym v)))))))))
604
766b248 Rich Hickey first cut at protocols
richhickey authored
605 (defn- emit-protocol [name opts+sigs]
c6e7e57 Chas Emerick properly munge namespaces -> java package names for protocols and deftyp...
cemerick authored
606 (let [iname (symbol (str (munge (namespace-munge *ns*)) "." (munge name)))
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
607 [opts sigs]
dd152ae Rich Hickey add :on-interface for code requiring class, since :on now symbol
richhickey authored
608 (loop [opts {:on (list 'quote iname) :on-interface iname} sigs opts+sigs]
766b248 Rich Hickey first cut at protocols
richhickey authored
609 (condp #(%1 %2) (first sigs)
610 string? (recur (assoc opts :doc (first sigs)) (next sigs))
611 keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs))
612 [opts sigs]))
2bc8b1f Nicola Mometto Added support for marker protocols
Bronsa authored
613 sigs (when sigs
614 (reduce1 (fn [m s]
615 (let [name-meta (meta (first s))
616 mname (with-meta (first s) nil)
617 [arglists doc]
618 (loop [as [] rs (rest s)]
619 (if (vector? (first rs))
620 (recur (conj as (first rs)) (next rs))
621 [(seq as) (first rs)]))]
622 (when (some #{0} (map count arglists))
f979290 Alex Miller CLJ-1056: improves defprotocol error messages for no args and redefined ...
puredanger authored
623 (throw (IllegalArgumentException. (str "Definition of function " mname " in protocol " name " must take at least one arg."))))
624 (when (m (keyword mname))
625 (throw (IllegalArgumentException. (str "Function " mname " in protocol " name " was redefined. Specify all arities in single definition."))))
2bc8b1f Nicola Mometto Added support for marker protocols
Bronsa authored
626 (assoc m (keyword mname)
627 (merge name-meta
628 {:name (vary-meta mname assoc :doc doc :arglists arglists)
629 :arglists arglists
630 :doc doc}))))
631 {} sigs))
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
632 meths (mapcat (fn [sig]
633 (let [m (munge (:name sig))]
634 (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object)
635 (:arglists sig))))
636 (vals sigs))]
766b248 Rich Hickey first cut at protocols
richhickey authored
637 `(do
638 (defonce ~name {})
77173bb Rich Hickey protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.Pro...
richhickey authored
639 (gen-interface :name ~iname :methods ~meths)
1efc495 Chris Houser defprotocol now warns when it overwrites an exising method var
Chouser authored
640 (alter-meta! (var ~name) assoc :doc ~(:doc opts))
2bc8b1f Nicola Mometto Added support for marker protocols
Bronsa authored
641 ~(when sigs
642 `(#'assert-same-protocol (var ~name) '~(map :name (vals sigs))))
766b248 Rich Hickey first cut at protocols
richhickey authored
643 (alter-var-root (var ~name) merge
644 (assoc ~opts
645 :sigs '~sigs
646 :var (var ~name)
d923bb2 Rich Hickey direct calls through to on interface methods
richhickey authored
647 :method-map
648 ~(and (:on opts)
649 (apply hash-map
650 (mapcat
651 (fn [s]
652 [(keyword (:name s)) (keyword (or (:on s) (:name s)))])
653 (vals sigs))))
766b248 Rich Hickey first cut at protocols
richhickey authored
654 :method-builders
655 ~(apply hash-map
656 (mapcat
8c9b057 Stuart Halloway propagate useful metadata to protocol fns #349
stuarthalloway authored
657 (fn [s]
658 [`(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
659 (emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))])
766b248 Rich Hickey first cut at protocols
richhickey authored
660 (vals sigs)))))
661 (-reset-methods ~name)
662 '~name)))
663
664 (defmacro defprotocol
665 "A protocol is a named set of named methods and their signatures:
666 (defprotocol AProtocolName
667
2c25d62 Rich Hickey doc fix
richhickey authored
668 ;optional doc string
669 \"A doc string for AProtocol abstraction\"
766b248 Rich Hickey first cut at protocols
richhickey authored
670
671 ;method signatures
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
672 (bar [this a b] \"bar docs\")
673 (baz [this a] [this a b] [this a b c] \"baz docs\"))
766b248 Rich Hickey first cut at protocols
richhickey authored
674
675 No implementations are provided. Docs can be specified for the
676 protocol overall and for each method. The above yields a set of
677 polymorphic functions and a protocol object. All are
678 namespace-qualified by the ns enclosing the definition The resulting
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
679 functions dispatch on the type of their first argument, which is
680 required and corresponds to the implicit target object ('this' in
681 Java parlance). defprotocol is dynamic, has no special compile-time
682 effect, and defines no new types or classes. Implementations of
683 the protocol methods can be provided using extend.
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
684
685 defprotocol will automatically generate a corresponding interface,
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
686 with the same name as the protocol, i.e. given a protocol:
687 my.ns/Protocol, an interface: my.ns.Protocol. The interface will
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
688 have methods corresponding to the protocol functions, and the
689 protocol will automatically work with instances of the interface.
690
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
691 Note that you should not use this interface with deftype or
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
692 reify, as they support the protocol directly:
693
694 (defprotocol P
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
695 (foo [this])
696 (bar-me [this] [this y]))
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
697
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
698 (deftype Foo [a b c]
699 P
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
700 (foo [this] a)
701 (bar-me [this] b)
702 (bar-me [this y] (+ c y)))
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
703
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
704 (bar-me (Foo. 1 2 3) 42)
705 => 45
a84a4e1 Rich Hickey deftype and reify support direct implementation of protocols
richhickey authored
706
707 (foo
708 (let [x 42]
4d3c5e9 Rich Hickey new formats for defprotocol, reify, deftype
richhickey authored
709 (reify P
befba00 Fixes missing this arg on the reify and defprotocol docstrings #340
Fogus authored
710 (foo [this] 17)
711 (bar-me [this] x)
712 (bar-me [this y] x))))
713 => 17"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
714 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
715 [name & opts+sigs]
716 (emit-protocol name opts+sigs))
717
718 (defn extend
719 "Implementations of protocol methods can be provided using the extend construct:
720
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
721 (extend AType
766b248 Rich Hickey first cut at protocols
richhickey authored
722 AProtocol
723 {:foo an-existing-fn
724 :bar (fn [a b] ...)
725 :baz (fn ([a]...) ([a b] ...)...)}
726 BProtocol
727 {...}
728 ...)
729
730 extend takes a type/class (or interface, see below), and one or more
731 protocol + method map pairs. It will extend the polymorphism of the
732 protocol's methods to call the supplied methods when an AType is
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
733 provided as the first argument.
766b248 Rich Hickey first cut at protocols
richhickey authored
734
735 Method maps are maps of the keyword-ized method names to ordinary
736 fns. This facilitates easy reuse of existing fns and fn maps, for
737 code reuse/mixins without derivation or composition. You can extend
738 an interface to a protocol. This is primarily to facilitate interop
739 with the host (e.g. Java) but opens the door to incidental multiple
740 inheritance of implementation since a class can inherit from more
741 than one interface, both of which extend the protocol. It is TBD how
742 to specify which impl to use. You can extend a protocol on nil.
743
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
744 If you are supplying the definitions explicitly (i.e. not reusing
745 exsting functions or mixin maps), you may find it more convenient to
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
746 use the extend-type or extend-protocol macros.
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
747
766b248 Rich Hickey first cut at protocols
richhickey authored
748 Note that multiple independent extend clauses can exist for the same
749 type, not all protocols need be defined in a single extend call.
750
751 See also:
752 extends?, satisfies?, extenders"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
753 {:added "1.2"}
766b248 Rich Hickey first cut at protocols
richhickey authored
754 [atype & proto+mmaps]
755 (doseq [[proto mmap] (partition 2 proto+mmaps)]
33a3759 Stuart Halloway more protocol tests, fixed NPE in extend, #239
stuarthalloway authored
756 (when-not (protocol? proto)
757 (throw (IllegalArgumentException.
758 (str proto " is not a protocol"))))
f47895a Rich Hickey check that type does not already implement protocol interface when exten...
richhickey authored
759 (when (implements? proto atype)
760 (throw (IllegalArgumentException.
761 (str atype " already directly implements " (:on-interface proto) " for protocol:"
762 (:var proto)))))
766b248 Rich Hickey first cut at protocols
richhickey authored
763 (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap))))
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
764
765 (defn- emit-impl [[p fs]]
766 [p (zipmap (map #(-> % first keyword) fs)
767 (map #(cons 'fn (drop 1 %)) fs))])
768
769 (defn- emit-hinted-impl [c [p fs]]
770 (let [hint (fn [specs]
771 (let [specs (if (vector? (first specs))
772 (list specs)
773 specs)]
774 (map (fn [[[target & args] & body]]
775 (cons (apply vector (vary-meta target assoc :tag c) args)
776 body))
777 specs)))]
0cd1dc8 Fix CLJ-845: Ignoring namespace portion of symbols used to name methods ...
Alexander Taggart authored
778 [p (zipmap (map #(-> % first name keyword) fs)
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
779 (map #(cons 'fn (hint (drop 1 %))) fs))]))
780
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
781 (defn- emit-extend-type [c specs]
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
782 (let [impls (parse-impls specs)]
783 `(extend ~c
784 ~@(mapcat (partial emit-hinted-impl c) impls))))
785
786 (defmacro extend-type
787 "A macro that expands into an extend call. Useful when you are
788 supplying the definitions explicitly inline, extend-type
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
789 automatically creates the maps required by extend. Propagates the
790 class as a type hint on the first argument of all fns.
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
791
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
792 (extend-type MyType
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
793 Countable
794 (cnt [c] ...)
795 Foo
796 (bar [x y] ...)
797 (baz ([x] ...) ([x y & zs] ...)))
798
799 expands into:
800
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
801 (extend MyType
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
802 Countable
803 {:cnt (fn [c] ...)}
804 Foo
805 {:baz (fn ([x] ...) ([x y & zs] ...))
806 :bar (fn [x y] ...)})"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
807 {:added "1.2"}
18f1c96 Rich Hickey added extend-type and extend-class
richhickey authored
808 [t & specs]
809 (emit-extend-type t specs))
810
75cd050 Rich Hickey added extend-protocol
richhickey authored
811 (defn- emit-extend-protocol [p specs]
812 (let [impls (parse-impls specs)]
813 `(do
814 ~@(map (fn [[t fs]]
ba9b792 Rich Hickey remove IDynamicType and type tags
richhickey authored
815 `(extend-type ~t ~p ~@fs))
75cd050 Rich Hickey added extend-protocol
richhickey authored
816 impls))))
817
818 (defmacro extend-protocol
819 "Useful when you want to provide several implementations of the same
820 protocol all at once. Takes a single protocol and the implementation
821 of that protocol for one or more types. Expands into calls to
4d89325 David Powell fixed extend-protocol doc
djpowell authored
822 extend-type:
75cd050 Rich Hickey added extend-protocol
richhickey authored
823
824 (extend-protocol Protocol
4d89325 David Powell fixed extend-protocol doc
djpowell authored
825 AType
75cd050 Rich Hickey added extend-protocol
richhickey authored
826 (foo [x] ...)
827 (bar [x y] ...)
4d89325 David Powell fixed extend-protocol doc
djpowell authored
828 BType
75cd050 Rich Hickey added extend-protocol
richhickey authored
829 (foo [x] ...)
830 (bar [x y] ...)
831 AClass
832 (foo [x] ...)
833 (bar [x y] ...)
834 nil
835 (foo [x] ...)
836 (bar [x y] ...))
837
838 expands into:
839
840 (do
4d89325 David Powell fixed extend-protocol doc
djpowell authored
841 (clojure.core/extend-type AType Protocol
75cd050 Rich Hickey added extend-protocol
richhickey authored
842 (foo [x] ...)
843 (bar [x y] ...))
4d89325 David Powell fixed extend-protocol doc
djpowell authored
844 (clojure.core/extend-type BType Protocol
75cd050 Rich Hickey added extend-protocol
richhickey authored
845 (foo [x] ...)
846 (bar [x y] ...))
4d89325 David Powell fixed extend-protocol doc
djpowell authored
847 (clojure.core/extend-type AClass Protocol
75cd050 Rich Hickey added extend-protocol
richhickey authored
848 (foo [x] ...)
849 (bar [x y] ...))
850 (clojure.core/extend-type nil Protocol
851 (foo [x] ...)
852 (bar [x y] ...)))"
c1c3916 Stuart Halloway metadata for :added
stuarthalloway authored
853 {:added "1.2"}
75cd050 Rich Hickey added extend-protocol
richhickey authored
854
855 [p & specs]
856 (emit-extend-protocol p specs))
857
Something went wrong with that request. Please try again.