Browse files

Added support for marker protocols

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>
  • Loading branch information...
1 parent f5f4faf commit 2bc8b1f5e5ec98b19bd2f203bbf19fc36c7ba73e @Bronsa Bronsa committed with stuarthalloway Apr 5, 2012
View
36 src/clj/clojure/core_deftype.clj
@@ -588,22 +588,23 @@
string? (recur (assoc opts :doc (first sigs)) (next sigs))
keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs))
[opts sigs]))
- sigs (reduce1 (fn [m s]
- (let [name-meta (meta (first s))
- mname (with-meta (first s) nil)
- [arglists doc]
- (loop [as [] rs (rest s)]
- (if (vector? (first rs))
- (recur (conj as (first rs)) (next rs))
- [(seq as) (first rs)]))]
- (when (some #{0} (map count arglists))
- (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg"))))
- (assoc m (keyword mname)
- (merge name-meta
- {:name (vary-meta mname assoc :doc doc :arglists arglists)
- :arglists arglists
- :doc doc}))))
- {} sigs)
+ sigs (when sigs
+ (reduce1 (fn [m s]
+ (let [name-meta (meta (first s))
+ mname (with-meta (first s) nil)
+ [arglists doc]
+ (loop [as [] rs (rest s)]
+ (if (vector? (first rs))
+ (recur (conj as (first rs)) (next rs))
+ [(seq as) (first rs)]))]
+ (when (some #{0} (map count arglists))
+ (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg"))))
+ (assoc m (keyword mname)
+ (merge name-meta
+ {:name (vary-meta mname assoc :doc doc :arglists arglists)
+ :arglists arglists
+ :doc doc}))))
+ {} sigs))
meths (mapcat (fn [sig]
(let [m (munge (:name sig))]
(map #(vector m (vec (repeat (dec (count %))'Object)) 'Object)
@@ -613,7 +614,8 @@
(defonce ~name {})
(gen-interface :name ~iname :methods ~meths)
(alter-meta! (var ~name) assoc :doc ~(:doc opts))
- (#'assert-same-protocol (var ~name) '~(map :name (vals sigs)))
+ ~(when sigs
+ `(#'assert-same-protocol (var ~name) '~(map :name (vals sigs))))
(alter-var-root (var ~name) merge
(assoc ~opts
:sigs '~sigs
View
4 test/clojure/test_clojure/protocols.clj
@@ -76,7 +76,9 @@
(eval '(defprotocol Elusive (new-method [x])))
(is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))
(is (fails-with-cause? IllegalArgumentException #"No method of interface: .*\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)"
- (eval '(old-method (reify Elusive (new-method [x] :new-method))))))))
+ (eval '(old-method (reify Elusive (new-method [x] :new-method)))))))
+ (testing "you can define a marker protocol"
+ (is (= '() (method-names clojure.test_clojure.protocols.examples.MarkerProtocol)))))
(deftype ExtendTestWidget [name])
(deftype HasProtocolInline []
View
3 test/clojure/test_clojure/protocols/examples.clj
@@ -8,6 +8,9 @@
(^String baz [a] [a b] "method with multiple arities")
(with-quux [a] "method name with a hyphen"))
+(defprotocol MarkerProtocol
+ "a protocol with no methods")
+
(definterface ExampleInterface
(hinted [^int i])
(hinted [^String s]))

0 comments on commit 2bc8b1f

Please sign in to comment.