Permalink
Browse files

fix definterface+ interaction with AOT compilation

  • Loading branch information...
ztellman committed Apr 5, 2013
1 parent 2a0abc1 commit 6f5dc3d6ce3bf968e77c1b73ecd55d3146cf1efe
Showing with 57 additions and 49 deletions.
  1. +44 −36 src/potemkin/types.clj
  2. +13 −13 test/potemkin/test/types.clj
View
@@ -134,8 +134,6 @@
;;;
-(def interface-bodies (atom {}))
-
(def clojure-fn-subs
[[#"\?" "_QMARK_"]
[#"\-" "_"]
@@ -161,46 +159,56 @@
n))
(defmacro definterface+
- "An interface that won't evaluate if an equivalent interface already exists.
+ "An interface that won't evaluate if an interface with that name already exists.
Self parameters and multiple arities are defined like defprotocol, as well as wrapping
functions for each, so it can be used to replace defprotocol seamlessly."
[name & body]
- (let [prev-body (get @interface-bodies name)]
- (when-not (equivalent? prev-body body)
- (swap! interface-bodies assoc name body)
-
- (let [fn-names (map first body)
- unrolled-body (mapcat
- (fn [[fn-name & arg-lists+doc-string]]
- (let [arg-lists (remove string? arg-lists+doc-string)]
- (map
- #(list (munge-fn-name fn-name)
- (vec (map resolve-tags (rest %))))
- arg-lists)))
- body)]
-
- `(let [p# (definterface
+ (let [fn-names (map first body)
+ unrolled-body (mapcat
+ (fn [[fn-name & arg-lists+doc-string]]
+ (let [arg-lists (remove string? arg-lists+doc-string)]
+ (map
+ #(list (munge-fn-name fn-name)
+ (vec (map resolve-tags (rest %))))
+ arg-lists)))
+ body)]
+
+ `(let [p# ~(if (try
+ (Class/forName (str *ns* "." name))
+ true
+ (catch Exception _
+ false))
+
+ ;; already exists, just re-import it
+ `(do
+ (import ~(symbol (str *ns* "." name)))
+ nil)
+
+ ;; define the interface
+ `(definterface
~name
- ~@unrolled-body)]
- ~@(map
- (fn [[fn-name & arg-lists+doc-string]]
- (let [arg-lists (remove string? arg-lists+doc-string)
- doc-string (filter string? arg-lists+doc-string)]
- `(defn ~fn-name
- ~@doc-string
- ~@(map
- (fn [args]
- `(~args
- (~(symbol (str "." (munge-fn-name fn-name)))
- ~(with-meta
- (first args)
- {:tag (str (ns-name *ns*) "." name)})
- ~@(rest args))))
- arg-lists))))
- body)
- p#)))))
+ ~@unrolled-body))]
+
+ ~@(map
+ (fn [[fn-name & arg-lists+doc-string]]
+ (let [arg-lists (remove string? arg-lists+doc-string)
+ doc-string (filter string? arg-lists+doc-string)]
+ `(defn ~fn-name
+ ~@doc-string
+ ~@(map
+ (fn [args]
+ `(~args
+ (~(symbol (str "." (munge-fn-name fn-name)))
+ ~(with-meta
+ (first args)
+ {:tag (str (ns-name *ns*) "." name)})
+ ~@(rest args))))
+ arg-lists))))
+ body)
+
+ p#)))
;;;
@@ -6,27 +6,27 @@
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
-(ns potemkin.test.collections
+(ns potemkin.test.types
(:use
[clojure test]
[potemkin]))
(deftest test-defrecord+
- (is (not= nil (eval '(defrecord+ Foo [x y]))))
- (is (= nil (eval '(defrecord+ Foo [x y]))))
- (is (not= nil (eval '(defrecord+ Foo [x y z])))))
+ (is (not= nil (eval '(potemkin/defrecord+ FooR [x y]))))
+ (is (= nil (eval '(potemkin/defrecord+ FooR [x y]))))
+ (is (not= nil (eval '(potemkin/defrecord+ FooR [x y z])))))
(deftest test-deftype+
- (is (not= nil (eval '(deftype+ Foo [x y]))))
- (is (= nil (eval '(deftype+ Foo [x y]))))
- (is (not= nil (eval '(deftype+ Foo [x y z])))))
+ (is (not= nil (eval '(potemkin/deftype+ FooT [x y]))))
+ (is (= nil (eval '(potemkin/deftype+ FooT [x y]))))
+ (is (not= nil (eval '(potemkin/deftype+ FooT [x y z])))))
(deftest test-defprotocol+
- (is (not= nil (eval '(defprotocol+ Bar (bar [x y])))))
- (is (= nil (eval '(defprotocol+ Bar (bar [x y])))))
- (is (not= nil (eval '(defprotocol+ Bar (bar [x y z]))))))
+ (is (not= nil (eval '(potemkin/defprotocol+ BarP (bar [x y])))))
+ (is (= nil (eval '(potemkin/defprotocol+ BarP (bar [x y])))))
+ (is (not= nil (eval '(potemkin/defprotocol+ BarP (bar [x y z]))))))
(deftest test-definterface+
- (is (not= nil (eval '(definterface+ Bar (bar-baz [x y])))))
- (is (= nil (eval '(definterface+ Bar (bar-baz [x y])))))
- (is (not= nil (eval '(definterface+ Bar (bar-baz [x y z]))))))
+ (is (not= nil (eval '(potemkin/definterface+ IBar (bar-baz [x y])))))
+ (is (= nil (eval '(potemkin/definterface+ IBar (bar-baz [x y])))))
+ (is (= nil (eval '(potemkin/definterface+ IBar (bar-baz [x y z]))))))

0 comments on commit 6f5dc3d

Please sign in to comment.