new formats for defprotocol, reify, deftype

defprotocol no longer groups multiple arities in list
reify and deftype now take :as this-name option, protocols/interfaces interleaved, no longer [P1 P2] (method [this] ...)*,
now P1 (method[]...)* P2 (method[]...)* - see doc

3 files changed, 123 insertions, 65 deletions

diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index f7add067..2fb14dc1 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -4563,13 +4563,15 @@
   not yet finished, calls to deref/@ will block."
   [#^Callable f]
   (let [fut (.submit clojure.lang.Agent/soloExecutor f)]
-    (reify [clojure.lang.IDeref java.util.concurrent.Future]
-      (deref [_] (.get fut))
-      (get [_] (.get fut))
-      (get [_ timeout unit] (.get fut timeout unit))
-      (isCancelled [_] (.isCancelled fut))
-      (isDone [_] (.isDone fut))
-      (cancel [_ interrupt?] (.cancel fut interrupt?)))))
+    (reify 
+     clojure.lang.IDeref 
+      (deref [] (.get fut))
+     java.util.concurrent.Future
+      (get [] (.get fut))
+      (get [timeout unit] (.get fut timeout unit))
+      (isCancelled [] (.isCancelled fut))
+      (isDone [] (.isDone fut))
+      (cancel [interrupt?] (.cancel fut interrupt?)))))
   
 (defmacro future
   "Takes a body of expressions and yields a future object that will
@@ -4666,9 +4668,11 @@
   []
   (let [d (java.util.concurrent.CountDownLatch. 1)
         v (atom nil)]
-    (reify [clojure.lang.IFn clojure.lang.IDeref]
-      (deref [_] (.await d) @v)
-      (invoke [this x]
+    (reify :as this 
+     clojure.lang.IDeref
+      (deref [] (.await d) @v)
+     clojure.lang.IFn
+      (invoke [x]
         (locking d
           (if (pos? (.getCount d))
             (do (reset! v x)
diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index 401f0406..bede489c 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -8,22 +8,65 @@
 
 (in-ns 'clojure.core)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;; defclass/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- parse-opts [s]
+  (loop [opts {} [k v & rs :as s] s]
+    (if (keyword? k)
+      (recur (assoc opts k v) rs)
+      [opts s])))
+
+(defn- parse-impls [specs]
+  (loop [ret {} s specs]
+    (if (seq s)
+      (recur (assoc ret (first s) (take-while seq? (next s)))
+             (drop-while seq? (next s)))
+      ret)))
+
+(defn- parse-opts+specs [opts+specs]
+  (let [[opts specs] (parse-opts opts+specs)
+        impls (parse-impls specs)
+        interfaces (-> (map #(if (var? (resolve %)) 
+                               (:on (deref (resolve %)))
+                               %)
+                            (keys impls))
+                       set
+                       (disj 'Object 'java.lang.Object)
+                       vec)
+        methods (mapcat #(map (fn [[nm [& args] & body]]
+                                `(~nm [~(:as opts) ~@args] ~@body)) %) 
+                        (vals impls))]  
+    [interfaces methods]))
+
 (defmacro reify 
   "reify is a macro with the following structure:
 
- (reify [protocols-and-interfaces+]
-   (methodName [this-name args*] body)* )
+ (reify options* specs*)
+  
+  Currently there is only one option:
+
+  :as this-name
+
+  which can be used to provide a name to refer to the target
+  object ('this' in Java/C# parlance) within the method bodies, if
+  needed.
+
+  Each spec consists of the protocol or interface name followed by zero
+  or more method bodies:
+
+  protocol-or-interface-or-Object
+  (methodName [args*] body)*
 
   Methods should be supplied for all methods of the desired
   protocol(s) and interface(s). You can also define overrides for
-  methods of Object. Note that a parameter must be supplied to
-  correspond to the target object ('this' in Java parlance). It can
-  have any name whatsoever.
+  methods of Object. Note that no parameter is supplied to correspond
+  to the target object ('this' in Java parlance). Thus methods for
+  protocols will take one fewer arguments than do the
+  protocol functions.
 
   The return type can be indicated by a type hint on the method name,
   and arg types can be indicated by a type hint on arg names. If you
-  leave out all hints reify will try to match on same name/arity
+  leave out all hints, reify will try to match on same name/arity
   method in the protocol(s)/interface(s) - this is preferred. If you
   supply any hints at all, no inference is done, so all hints (or
   default of Object) must be correct, for both arguments and return
@@ -45,12 +88,9 @@
          (seq [_] (seq f)))))
   == (\\f \\o \\o)"
 
-  [[& interfaces] & methods]
-  (let [interfaces (map #(if (var? (resolve %)) 
-                           (:on (deref (resolve %)))
-                           %)
-                        interfaces)]
-    `(reify* ~(vec interfaces) ~@methods)))
+  [& opts+specs]
+  (let [[interfaces methods] (parse-opts+specs opts+specs)]
+    `(reify* ~interfaces ~@methods)))
 
 (defn hash-combine [x y] 
   (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y)))
@@ -74,7 +114,7 @@
         fields (conj fields '__meta '__extmap)]
     (letfn 
      [(eqhash [[i m]] 
-        (if (not (or (contains? methodname-set '.equals) (contains? methodname-set '.hashCode)))
+        (if (not (or (contains? methodname-set 'equals) (contains? methodname-set 'hashCode)))
           [i
            (conj m 
                  `(hashCode [~'this] (-> ~tag hash ~@(map #(list `hash-combine %) (remove #{'__meta} fields))))
@@ -94,7 +134,7 @@
                  `(withMeta [~'this ~'m] (new ~tagname ~@(replace {'__meta 'm} fields))))]
           [i m]))
       (ilookup [[i m]] 
-        (if (not (methodname-set '.valAt))
+        (if (not (methodname-set 'valAt))
           [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
            (conj m `(valAt [~'this k#] (.valAt ~'this k# nil))
                  `(valAt [~'this k# else#] 
@@ -120,7 +160,7 @@
                   (condp identical? k# ~@(mapcat (fn [fld] [(keyword fld) fld]) base-fields)
                          (get ~'__extmap k# else#))))])
       (imap [[i m]] 
-         (if (and (interface-set clojure.lang.IPersistentMap) (not (methodname-set '.assoc)))
+         (if (and (interface-set clojure.lang.IPersistentMap) (not (methodname-set 'assoc)))
            [i
             (conj m 
                   `(count [~'this] (+ ~(count base-fields) (count ~'__extmap)))
@@ -153,7 +193,21 @@
 (defmacro deftype
   "Alpha - subject to change
   
-  (deftype name [fields*] [protocols-and-interfaces*]? methods*)
+  (deftype name [fields*]  options* specs*)
+  
+  Currently there is only one option:
+
+  :as this-name
+
+  which can be used to provide a name to refer to the target
+  object ('this' in Java/C# parlance) within the method bodies, if
+  needed.
+
+  Each spec consists of a protocol or interface name followed by zero
+  or more method bodies:
+
+  protocol-or-interface-or-Object
+  (methodName [args*] body)*
 
   Dynamically generates compiled bytecode for an anonymous class with
   the given fields, and, optionally, methods for protocols and/or
@@ -172,17 +226,23 @@
   optional. The only methods that can be supplied are those declared
   in the protocols/interfaces.  Note that method bodies are not
   closures, the local environment includes only the named fields, and
-  those fields can be accessed directy, i.e. with just foo, instead
-  of (.foo this).
+  those fields can be accessed directy.
 
   Method definitions take the form:
 
-  (methodname [this-name args*] body)
+  (methodname [args*] body)
 
   The argument and return types can be hinted on the arg and
   methodname symbols. If not supplied, they will be inferred, so type
   hints should be reserved for disambiguation.
 
+  Methods should be supplied for all methods of the desired
+  protocol(s) and interface(s). You can also define overrides for
+  methods of Object. Note that no parameter is supplied to correspond
+  to the target object ('this' in Java parlance). Thus methods for
+  protocols will take one fewer arguments than do the
+  protocol functions.
+
   In the method bodies, the (unqualified) name can be used to name the
   class (for calls to new, instance? etc).
 
@@ -207,12 +267,9 @@
 
   When dynamically evaluated, the class will have a generated name."
 
-  [name [& fields] & [[& interfaces] & methods]]
+  [name [& fields] & opts+specs]
   (let [gname (if *compile-files* name (gensym (str name "__")))
-        interfaces (map #(if (var? (resolve %)) 
-                           (:on (deref (resolve %)))
-                           %)
-                        interfaces)
+        [interfaces methods] (parse-opts+specs opts+specs)
         classname (symbol (str *ns* "." gname))
         tag (keyword (str *ns*) (str name))
         hinted-fields fields
@@ -358,17 +415,17 @@
             [opts sigs]))
         sigs (reduce (fn [m s]
                        (let [mname (with-meta (first s) nil)
-                             arglists (if (vector? (second s)) (list (second s)) (second s))
-                             fx (nth s 2 nil)
-                             doc (when (string? fx) fx)
-                             mopts (apply hash-map (nthnext s (if (string? fx) 3 2)))]
+                             [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 mopts 
-                                       {:name (vary-meta mname assoc :doc doc :arglists arglists)
-                                        :arglists arglists
-                                        :doc doc}))))
+                         (assoc m (keyword mname)  
+                                {:name (vary-meta mname assoc :doc doc :arglists arglists)
+                                 :arglists arglists
+                                 :doc doc})))
                      {} sigs)
         meths (mapcat (fn [sig]
                         (let [m (munge (:name sig))]
@@ -410,7 +467,7 @@
 
   ;method signatures
     (bar [a b] \"bar docs\")
-    (baz ([a] [a b] [a b & c]) \"baz docs\"))
+    (baz [a] [a b] [a b c] \"baz docs\"))
 
   No implementations are provided. Docs can be specified for the
   protocol overall and for each method. The above yields a set of
@@ -423,31 +480,32 @@
   extend.
 
   defprotocol will automatically generate a corresponding interface,
-  with the same name as the protocol, i.e. given a protocol
-  my.ns/Protocol, an interface my.ns.Protocol. The interface will
+  with the same name as the protocol, i.e. given a protocol:
+  my.ns/Protocol, an interface: my.ns.Protocol. The interface will
   have methods corresponding to the protocol functions, and the
   protocol will automatically work with instances of the interface.
 
-  Note that you do not need to use this interface with deftype or
+  Note that you should not use this interface with deftype or
   reify, as they support the protocol directly:
 
   (defprotocol P 
     (foo [x]) 
-    (bar-me ([x] [x y])))
+    (bar-me [x] [x y]))
 
-  (deftype Foo [a b c] [P]
-    (foo [x] a)
-    (bar-me [x] b)
-    (bar-me [x y] (+ c y)))
+  (deftype Foo [a b c] 
+   P
+    (foo [] a)
+    (bar-me [] b)
+    (bar-me [y] (+ c y)))
   
   (bar-me (Foo 1 2 3) 42)
 
   (foo 
     (let [x 42]
-      (reify [P] 
-        (foo [this] 17)
-        (bar-me [this] x)
-        (bar-me [this y] x))))"
+      (reify P 
+        (foo [] 17)
+        (bar-me [] x)
+        (bar-me [y] x))))"
 
   [name & opts+sigs]
   (emit-protocol name opts+sigs))
@@ -496,13 +554,6 @@
   (doseq [[proto mmap] (partition 2 proto+mmaps)]
     (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap))))
 
-(defn- parse-impls [specs]
-  (loop [ret {} s specs]
-    (if (seq s)
-      (recur (assoc ret (first s) (take-while seq? (next s)))
-             (drop-while seq? (next s)))
-      ret)))
-
 (defn- emit-impl [[p fs]]
   [p (zipmap (map #(-> % first keyword) fs)
              (map #(cons 'fn (drop 1 %)) fs))])
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index 02f6fcc0..4c3c32f0 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -6119,6 +6119,8 @@ public static class NewInstanceMethod extends ObjMethod{
 	Class retClass;
 	Class[] exclasses;
 
+	static Symbol dummyThis = Symbol.intern(null,"dummy_this_dlskjsdfower");
+
 	public NewInstanceMethod(ObjExpr objx, ObjMethod parent){
 		super(objx, parent);
 	}
@@ -6148,6 +6150,7 @@ public static class NewInstanceMethod extends ObjMethod{
 	static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag,
 	                               Map overrideables) throws Exception{
 		//(methodname [this-name args*] body...)
+		//this-name might be nil
 		NewInstanceMethod method = new NewInstanceMethod(objx, (ObjMethod) METHOD.deref());
 		Symbol dotname = (Symbol)RT.first(form);
 		Symbol name = (Symbol) Symbol.intern(null,munge(dotname.name)).withMeta(RT.meta(dotname));
@@ -6171,7 +6174,7 @@ public static class NewInstanceMethod extends ObjMethod{
 							NEXT_LOCAL_NUM, 0));
 
 			//register 'this' as local 0
-			registerLocal(thisName,
+			registerLocal((thisName == null) ? dummyThis:thisName,
 			              thistag, null,false);
 
 			PersistentVector argLocals = PersistentVector.EMPTY;