Changes to support defrecord and deftype literals. See CLJ-374

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>

8 files changed, 572 insertions, 48 deletions

diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index 97ccd05b..f7fb67f4 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -148,7 +148,10 @@
       (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields")))
     (let [gs (gensym)]
     (letfn 
-     [(eqhash [[i m]] 
+     [(irecord [[i m]]
+        [(conj i 'clojure.lang.IRecord)
+         m])
+      (eqhash [[i m]] 
         [i
          (conj m 
                `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#))
@@ -222,7 +225,7 @@
                        `(values [this#] (vals this#))
                        `(entrySet [this#] (set this#)))])
       ]
-     (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap ijavamap)]
+     (let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)]
        `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap) 
           :implements ~(vec i) 
           ~@m))))))
@@ -292,26 +295,20 @@
   [name [& fields] & opts+specs]
   (let [gname name
         [interfaces methods opts] (parse-opts+specs opts+specs)
-        classname (symbol (str (namespace-munge *ns*) "." gname))
+        ns-part (namespace-munge *ns*)
+        classname (symbol (str ns-part "." gname))
         tag (keyword (str *ns*) (str name))
         hinted-fields fields
         fields (vec (map #(with-meta % nil) fields))]
     `(let []
        ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
-       (defmethod print-method ~classname [o# w#]
-           ((var print-defrecord) o# w#))
        (import ~classname)
-       #_(defn ~name
+       (defn ~(symbol (str '-> name))
          ([~@fields] (new ~classname ~@fields nil nil))
-         ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#))))))
-
-(defn- print-defrecord [o ^Writer w]
-  (print-meta o w)
-  (.write w "#:")
-  (.write w (.getName (class o)))
-  (print-map
-    o
-    pr-on w))
+         ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#)))
+       (defn ~(symbol (str 'map-> name))
+         ([m#] (~(symbol (str classname "/create")) m#)))
+       ~classname)))
 
 (defn- emit-deftype* 
   "Do not use this directly - use deftype"
@@ -384,16 +381,35 @@
   [name [& fields] & opts+specs]
   (let [gname name
         [interfaces methods opts] (parse-opts+specs opts+specs)
-        classname (symbol (str (namespace-munge *ns*) "." gname))
+        ns-part (namespace-munge *ns*)
+        classname (symbol (str ns-part "." gname))
         tag (keyword (str *ns*) (str name))
         hinted-fields fields
         fields (vec (map #(with-meta % nil) fields))]
     `(let []
        ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
-       (import ~classname))))
-
-
+       (import ~classname)
+       (defmethod print-method ~classname [o# w#]
+         ((var print-deftype) o# w#))
+       (defmethod print-dup ~classname [o# w#]
+         ((var printdup-deftype) o# w#))
+       (defn ~(symbol (str '-> name))
+         ([~@fields] (new ~classname ~@fields)))
+       ~classname)))
+
+(defn- print-deftype [o ^Writer w]
+  (.write w "#")
+  (.write w (.getName (class o)))
+  (let [basii (for [fld (map str (clojure.lang.Reflector/invokeStaticMethod (class o) "getBasis" (to-array [])))]
+                (clojure.lang.Reflector/getInstanceField o fld))]
+    (print-sequential "[" pr-on ", " "]" basii w)))
 
+(defn- printdup-deftype [o ^Writer w]
+  (.write w "#")
+  (.write w (.getName (class o)))
+  (let [basii (for [fld (map str (clojure.lang.Reflector/invokeStaticMethod (class o) "getBasis" (to-array [])))]
+                (clojure.lang.Reflector/getInstanceField o fld))]
+    (print-sequential "[" pr-on ", " "]" basii w)))
 
 ;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj
index bde2af9e..f38e6e40 100644
--- a/src/clj/clojure/core_print.clj
+++ b/src/clj/clojure/core_print.clj
@@ -33,7 +33,9 @@
   *print-level*, the printer prints '#' to represent it. The root binding
   is nil indicating no limit."
    :added "1.0"}
-*print-level* nil)
+ *print-level* nil)
+
+(def ^:dynamic *verbose-defrecords* false)
 
 (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]
   (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
@@ -150,6 +152,7 @@
  (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
 
 (defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]
+  (print " ipcpd ")
   (print-meta o w)
   (.write w "#=(")
   (.write w (.getName ^Class (class o)))
@@ -191,7 +194,7 @@
 (defn- print-map [m print-one w]
   (print-sequential 
    "{"
-   (fn [e  ^Writer w] 
+   (fn [e  ^Writer w]
      (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
    ", "
    "}"
@@ -212,7 +215,26 @@
   (print-map m print-dup w)
   (.write w ")"))
 
+(defmethod print-method clojure.lang.IRecord [r, ^Writer w]
+  (print-meta r w)
+  (.write w "#")
+  (.write w (.getName (class r)))
+  (print-map r pr-on w))
+
+(defmethod print-dup clojure.lang.IRecord [r, ^Writer w]
+  (print-meta r w)
+  (.write w "#")
+  (.write w (.getName (class r)))
+  (if *verbose-defrecords*
+    (print-map r print-dup w)
+    (print-sequential "[" pr-on ", " "]" (vals r) w)))
+
+(prefer-method print-method clojure.lang.IRecord java.util.Map)
+(prefer-method print-method clojure.lang.IRecord clojure.lang.IPersistentMap)
+(prefer-method print-dup clojure.lang.IRecord clojure.lang.IPersistentMap)
 (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
+(prefer-method print-dup clojure.lang.IRecord clojure.lang.IPersistentCollection)
+(prefer-method print-dup clojure.lang.IRecord java.util.Map)
 
 (defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]
   (print-meta s w)
@@ -244,7 +266,7 @@
 (defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
 (defmethod print-dup clojure.lang.BigInt [o w] (print-method o w))
 (defmethod print-dup java.math.BigInteger [o w] (print-method o w))
-(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))
+(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print " phmpd ") (print-method o w))
 (defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))
 (defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))
 (defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index bbaa0a12..e4ef205e 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -15,8 +15,15 @@ package clojure.lang;
 //*
 
 import clojure.asm.*;
-import clojure.asm.commons.Method;
 import clojure.asm.commons.GeneratorAdapter;
+import clojure.asm.commons.Method;
+
+import java.io.*;
+import java.lang.reflect.Constructor;
+import java.lang.reflect.Modifier;
+import java.util.*;
+import java.util.regex.Pattern;
+
 //*/
 /*
 
@@ -27,13 +34,6 @@ import org.objectweb.asm.util.TraceClassVisitor;
 import org.objectweb.asm.util.CheckClassAdapter;
 //*/
 
-import java.io.*;
-import java.lang.reflect.InvocationTargetException;
-import java.util.*;
-import java.lang.reflect.Constructor;
-import java.lang.reflect.Modifier;
-import java.util.regex.Pattern;
-
 public class Compiler implements Opcodes{
 
 static final Symbol DEF = Symbol.intern("def");
@@ -1723,6 +1723,7 @@ static class ConstantExpr extends LiteralExpr{
 
 	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 		objx.emitConstant(gen, id);
+
 		if(context == C.STATEMENT)
 			{
 			gen.pop();
@@ -3692,6 +3693,9 @@ static public class ObjExpr implements Expr{
 	//symbol->lb
 	IPersistentMap fields = null;
 
+	//hinted fields
+	IPersistentVector hintedFields = PersistentVector.EMPTY;
+
 	//Keyword->KeywordExpr
 	IPersistentMap keywords = PersistentHashMap.EMPTY;
 	IPersistentMap vars = PersistentHashMap.EMPTY;
@@ -4052,7 +4056,7 @@ static public class ObjExpr implements Expr{
 
 		if(supportsMeta())
 			{
-					//ctor that takes closed-overs but not meta
+			//ctor that takes closed-overs but not meta
 			Type[] ctorTypes = ctorTypes();
 			Type[] noMetaCtorTypes = new Type[ctorTypes.length-1];
 			for(int i=1;i<ctorTypes.length;i++)
@@ -4119,7 +4123,8 @@ static public class ObjExpr implements Expr{
 			gen.returnValue();
 			gen.endMethod();
 			}
-		
+
+		emitStatics(cv);
 		emitMethods(cv);
 
 		if(keywordCallsites.count() > 0)
@@ -4182,6 +4187,9 @@ static public class ObjExpr implements Expr{
 			}
 	}
 
+	protected void emitStatics(ClassVisitor gen){
+	}
+
 	protected void emitMethods(ClassVisitor gen){
 	}
 
@@ -4286,6 +4294,19 @@ static public class ObjExpr implements Expr{
 			gen.push(var.sym.toString());
 			gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
 			}
+		else if(value instanceof IRecord)
+			{
+			Method createMethod = Method.getMethod(value.getClass().getName() + " create(clojure.lang.IPersistentMap)");
+			List entries = new ArrayList();
+			for(Map.Entry entry : (Set<Map.Entry>) ((Map) value).entrySet())
+				{
+				entries.add(entry.getKey());
+				entries.add(entry.getValue());
+				}
+			emitListAsObjectArray(entries, gen);
+			gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.IPersistentMap map(Object[])"));
+			gen.invokeStatic(getType(value.getClass()), createMethod);
+			}
 		else if(value instanceof IPersistentMap)
 			{
 			List entries = new ArrayList();
@@ -6111,6 +6132,8 @@ private static Expr analyze(C context, Object form, String name) {
 				return analyzeSeq(context, (ISeq) form, name);
 		else if(form instanceof IPersistentVector)
 				return VectorExpr.parse(context, (IPersistentVector) form);
+		else if(form instanceof IRecord)
+				return new ConstantExpr(form);
 		else if(form instanceof IPersistentMap)
 				return MapExpr.parse(context, (IPersistentMap) form);
 		else if(form instanceof IPersistentSet)
@@ -7174,6 +7197,8 @@ static public class NewInstanceExpr extends ObjExpr{
 				                              LOCAL_ENV, ret.fields
 						, COMPILE_STUB_SYM, Symbol.intern(null, tagName)
 						, COMPILE_STUB_CLASS, stub));
+
+				ret.hintedFields = RT.subvec(fieldSyms, 0, fieldSyms.count() - ret.altCtorDrops);
 				}
 
 			//now (methodname [args] body)*
@@ -7302,6 +7327,82 @@ static public class NewInstanceExpr extends ObjExpr{
 		return c.getName().replace('.', '/');
 	}
 
+	protected void emitStatics(ClassVisitor cv) {
+		if(this.isDeftype())
+			{
+			//getBasis()
+			Method meth = Method.getMethod("clojure.lang.IPersistentVector getBasis()");
+			GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
+												meth,
+												null,
+												null,
+												cv);
+			emitValue(hintedFields, gen);
+			gen.returnValue();
+			gen.endMethod();
+
+			if (this.isDeftype() && this.fields.count() > this.hintedFields.count())
+				{
+				//create(IPersistentMap)
+				String className = name.replace('.', '/');
+				int i = 1;
+				int fieldCount = hintedFields.count();
+
+				MethodVisitor mv = cv.visitMethod(ACC_PUBLIC + ACC_STATIC, "create", "(Lclojure/lang/IPersistentMap;)L"+className+";", null, null);
+				mv.visitCode();
+
+				for(ISeq s = RT.seq(hintedFields); s!=null; s=s.next(), i++)
+					{
+					String bName = ((Symbol)s.first()).name;
+					Class k = tagClass(tagOf(s.first()));
+
+					mv.visitVarInsn(ALOAD, 0);
+					mv.visitLdcInsn(bName);
+					mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/Keyword", "intern", "(Ljava/lang/String;)Lclojure/lang/Keyword;");
+					mv.visitInsn(ACONST_NULL);
+					mv.visitMethodInsn(INVOKEINTERFACE, "clojure/lang/IPersistentMap", "valAt", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;");
+					if(k.isPrimitive())
+						{
+						mv.visitTypeInsn(CHECKCAST, Type.getType(boxClass(k)).getInternalName());
+						}
+					mv.visitVarInsn(ASTORE, i);
+					mv.visitVarInsn(ALOAD, 0);
+					mv.visitLdcInsn(bName);
+					mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/Keyword", "intern", "(Ljava/lang/String;)Lclojure/lang/Keyword;");
+					mv.visitMethodInsn(INVOKEINTERFACE, "clojure/lang/IPersistentMap", "without", "(Ljava/lang/Object;)Lclojure/lang/IPersistentMap;");
+					mv.visitVarInsn(ASTORE, 0);
+					}
+
+				mv.visitTypeInsn(Opcodes.NEW, className);
+				mv.visitInsn(DUP);
+
+				Method ctor = new Method("<init>", Type.VOID_TYPE, ctorTypes());
+
+				if(hintedFields.count() > 0)
+					for(i=1; i<=fieldCount; i++)
+						{
+						mv.visitVarInsn(ALOAD, i);
+						Class k = tagClass(tagOf(hintedFields.nth(i-1)));
+						if(k.isPrimitive())
+							{
+							String b = Type.getType(boxClass(k)).getInternalName();
+							String p = Type.getType(k).getDescriptor();
+							String n = k.getName();
+
+							mv.visitMethodInsn(INVOKEVIRTUAL, b, n+"Value", "()"+p);
+							}
+						}
+
+				mv.visitInsn(ACONST_NULL);
+				mv.visitVarInsn(ALOAD, 0);
+				mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/RT", "seqOrElse", "(Ljava/lang/Object;)Ljava/lang/Object;");
+				mv.visitMethodInsn(INVOKESPECIAL, className, "<init>", ctor.getDescriptor());
+				mv.visitInsn(ARETURN);
+				mv.visitMaxs(4+fieldCount, 1+fieldCount);
+				mv.visitEnd();
+				}
+			}
+	}
 
 	protected void emitMethods(ClassVisitor cv){
 		for(ISeq s = RT.seq(methods); s != null; s = s.next())
@@ -7695,6 +7796,33 @@ public static class NewInstanceMethod extends ObjMethod{
 		return c.isPrimitive()?c:Object.class;
 	}
 
+	static Class boxClass(Class p) {
+		if(!p.isPrimitive())
+			return p;
+
+		Class c = null;
+		Type  t = Type.getType(p);
+
+		if(t == Type.INT_TYPE)
+			c = Integer.class;
+		else if(t == Type.LONG_TYPE)
+			c = Long.class;
+		else if(t == Type.FLOAT_TYPE)
+			c = Float.class;
+		else if(t == Type.DOUBLE_TYPE)
+			c = Double.class;
+		else if(t == Type.CHAR_TYPE)
+			c = Character.class;
+		else if(t == Type.SHORT_TYPE)
+			c = Short.class;
+		else if(t == Type.BYTE_TYPE)
+			c = Byte.class;
+		else if(t == Type.BOOLEAN_TYPE)
+			c = Boolean.class;
+
+		return c;
+	}
+
 static public class MethodParamExpr implements Expr, MaybePrimitiveExpr{
 	final Class c;
 
diff --git a/src/jvm/clojure/lang/IRecord.java b/src/jvm/clojure/lang/IRecord.java
new file mode 100644
index 00000000..343da6c1
--- /dev/null
+++ b/src/jvm/clojure/lang/IRecord.java
@@ -0,0 +1,14 @@
+/**
+ *   Copyright (c) Rich Hickey. All rights reserved.
+ *   The use and distribution terms for this software are covered by the
+ *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+ *   which can be found in the file epl-v10.html at the root of this distribution.
+ *   By using this software in any fashion, you are agreeing to be bound by
+ * 	 the terms of this license.
+ *   You must not remove this notice, or any other, from this software.
+ **/
+
+package clojure.lang;
+
+public interface IRecord {
+}
diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java
index 17b73e13..07ed6487 100644
--- a/src/jvm/clojure/lang/LispReader.java
+++ b/src/jvm/clojure/lang/LispReader.java
@@ -10,15 +10,31 @@
 
 package clojure.lang;
 
-import java.io.*;
-import java.util.regex.Pattern;
-import java.util.regex.Matcher;
+import java.io.IOException;
+import java.io.PushbackReader;
+import java.io.Reader;
+import java.lang.Character;
+import java.lang.Class;
+import java.lang.Exception;
+import java.lang.IllegalArgumentException;
+import java.lang.IllegalStateException;
+import java.lang.Integer;
+import java.lang.Number;
+import java.lang.NumberFormatException;
+import java.lang.Object;
+import java.lang.RuntimeException;
+import java.lang.String;
+import java.lang.StringBuilder;
+import java.lang.Throwable;
+import java.lang.UnsupportedOperationException;
+import java.lang.reflect.Constructor;
+import java.math.BigDecimal;
+import java.math.BigInteger;
 import java.util.ArrayList;
 import java.util.List;
 import java.util.Map;
-import java.math.BigInteger;
-import java.math.BigDecimal;
-import java.lang.*;
+import java.util.regex.Matcher;
+import java.util.regex.Pattern;
 
 public class LispReader{
 
@@ -61,6 +77,7 @@ static final Symbol CLOJURE_SLASH = Symbol.intern("clojure.core","/");
 static Var GENSYM_ENV = Var.create(null).setDynamic();
 //sorted-map num->gensymbol
 static Var ARG_ENV = Var.create(null).setDynamic();
+static IFn ctorReader = new CtorReader();
 
     static
 	{
@@ -587,8 +604,17 @@ public static class DispatchReader extends AFn{
 		if(ch == -1)
 			throw Util.runtimeException("EOF while reading character");
 		IFn fn = dispatchMacros[ch];
-		if(fn == null)
-			throw Util.runtimeException(String.format("No dispatch macro for: %c", (char) ch));
+
+		// Try the ctor reader first
+		if(fn == null) {
+			unread((PushbackReader) reader, ch);
+			Object result = ctorReader.invoke(reader, ch);
+
+			if(result != null)
+				return result;
+			else
+				throw Util.runtimeException(String.format("No dispatch macro for: %c", (char) ch));
+		}
 		return fn.invoke(reader, ch);
 	}
 }
@@ -946,6 +972,7 @@ public static class ListReader extends AFn{
 
 }
 
+/*
 static class CtorReader extends AFn{
 	static final Symbol cls = Symbol.intern("class");
 
@@ -974,8 +1001,8 @@ static class CtorReader extends AFn{
 			return Reflector.invokeConstructor(RT.classForName(s.name), args);
 			}
 	}
-
 }
+*/
 
 public static class EvalReader extends AFn{
 	public Object invoke(Object reader, Object eq) {
@@ -1115,6 +1142,99 @@ public static List readDelimitedList(char delim, PushbackReader r, boolean isRec
 	return a;
 }
 
+public static class CtorReader extends AFn{
+	public Object invoke(Object reader, Object firstChar){
+		PushbackReader r = (PushbackReader) reader;
+
+		Object recordName = read(r, true, null, false);
+		Class recordClass = RT.classForName(recordName.toString());
+		int ch = read1(r);
+		char endch;
+		boolean shortForm = true;
+
+		// A defrecord ctor can take two forms. Check for map->R version first.
+		if(ch == '{')
+			{
+				endch = '}';
+				shortForm = false;
+			}
+		else if (ch == '[')
+			endch = ']';
+		else
+			throw Util.runtimeException("Unreadable constructor form starting with \"#" + recordName + (char) ch + "\"");
+
+		Object[] recordEntries = readDelimitedList(endch, r, true).toArray();
+		Object ret = null;
+		Constructor[] allctors = ((Class)recordClass).getConstructors();
+
+		if(shortForm)
+			{
+			boolean ctorFound = false;
+			for (Constructor ctor : allctors)
+				if(ctor.getParameterTypes().length == recordEntries.length)
+					ctorFound = true;
+
+			if(!ctorFound)
+				throw Util.runtimeException("Unexpected number of constructor arguments to " + recordClass.toString() + ": got " + recordEntries.length);
+
+            ret = Reflector.invokeConstructor(recordClass, RT.seqToArray(resolveEach(recordEntries)));
+			}
+		else
+			{
+            ret = Reflector.invokeStaticMethod(recordClass, "create", new Object[]{RT.map(RT.seqToArray(resolveEach(recordEntries)))});
+			}
+
+	return ret;
+	}
+
+	static public ISeq resolveEach(Object[] a) {
+		ISeq ret = null;
+		for(int i = a.length - 1; i >= 0; --i)
+			ret = (ISeq) RT.cons(resolve(a[i]), ret);
+		return ret;
+	}
+
+	static private Object resolve(Object o) {
+		if(o instanceof Symbol)
+			{
+			try
+				{
+				return RT.classForName(o.toString());
+				}
+			catch(Exception cfe)
+				{
+				throw new IllegalArgumentException("Constructor literal can only contain constants or statics. "
+													+ o.toString()
+													+ " does not name a known class.");
+				}
+            }
+		else if(o instanceof ISeq)
+			{
+			Symbol fs = (Symbol) RT.first(o);
+
+			if(fs == null && o == PersistentList.EMPTY)
+				{
+				return o;
+				}
+
+			throw new IllegalArgumentException("Constructor literal can only contain constants or statics. " + o.toString());
+			}
+		else if(o instanceof IPersistentCollection && ((IPersistentCollection) o).count() == 0 ||
+				o instanceof IPersistentCollection ||
+				o instanceof Number  ||
+				o instanceof String  ||
+				o instanceof Keyword ||
+				o instanceof Symbol  ||
+				o == Boolean.TRUE    ||
+				o == Boolean.FALSE   ||
+				o == null) {
+			return o;
+		}
+		else
+			throw new IllegalArgumentException("Constructor literal can only contain constants or statics. " + o.toString());
+	}
+}
+
 /*
 public static void main(String[] args) throws Exception{
 	//RT.init();
diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java
index 21e81b3e..62923f67 100644
--- a/src/jvm/clojure/lang/RT.java
+++ b/src/jvm/clojure/lang/RT.java
@@ -488,6 +488,10 @@ static ISeq seqFrom(Object coll){
 	}
 }
 
+static public Object seqOrElse(Object o) {
+	return seq(o) == null ? null : o;
+}
+
 static public ISeq keys(Object coll){
 	return APersistentMap.KeySeq.create(seq(coll));
 }
diff --git a/src/jvm/clojure/lang/Reflector.java b/src/jvm/clojure/lang/Reflector.java
index 74e58777..a57c32b2 100644
--- a/src/jvm/clojure/lang/Reflector.java
+++ b/src/jvm/clojure/lang/Reflector.java
@@ -12,11 +12,13 @@
 
 package clojure.lang;
 
-import java.lang.reflect.*;
+import java.lang.reflect.Constructor;
+import java.lang.reflect.Field;
+import java.lang.reflect.Method;
+import java.lang.reflect.Modifier;
 import java.util.ArrayList;
 import java.util.Iterator;
 import java.util.List;
-import java.util.Arrays;
 
 public class Reflector{
 
@@ -105,8 +107,7 @@ public static Method getAsMethodOfPublicBase(Class c, Method m){
 		{
 		for(Method im : iface.getMethods())
 			{
-			if(im.getName().equals(m.getName())
-			   && Arrays.equals(m.getParameterTypes(), im.getParameterTypes()))
+			if(isMatch(im, m))
 				{
 				return im;
 				}
@@ -117,9 +118,7 @@ public static Method getAsMethodOfPublicBase(Class c, Method m){
 		return null;
 	for(Method scm : sc.getMethods())
 		{
-		if(scm.getName().equals(m.getName())
-		   && Arrays.equals(m.getParameterTypes(), scm.getParameterTypes())
-		   && Modifier.isPublic(scm.getDeclaringClass().getModifiers()))
+		if(isMatch(scm, m))
 			{
 			return scm;
 			}
@@ -127,6 +126,30 @@ public static Method getAsMethodOfPublicBase(Class c, Method m){
 	return getAsMethodOfPublicBase(sc, m);
 }
 
+public static boolean isMatch(Method lhs, Method rhs) {
+	if(!lhs.getName().equals(rhs.getName())
+			|| !Modifier.isPublic(lhs.getDeclaringClass().getModifiers()))
+		{
+		return false;
+		}
+
+		Class[] types1 = lhs.getParameterTypes();
+		Class[] types2 = rhs.getParameterTypes();
+		if(types1.length != types2.length)
+			return false;
+
+		boolean match = true;
+		for (int i=0; i<types1.length; ++i)
+			{
+			if(!types1[i].isAssignableFrom(types2[i]))
+				{
+				match = false;
+				break;
+				}
+			}
+		return match;
+}
+
 public static Object invokeConstructor(Class c, Object[] args) {
 	try
 		{
diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj
index c04a47d9..917b8c5e 100644
--- a/test/clojure/test_clojure/protocols.clj
+++ b/test/clojure/test_clojure/protocols.clj
@@ -231,6 +231,203 @@
     (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))
     (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))
 
+(defrecord RecordToTestStatics1 [a])
+(defrecord RecordToTestStatics2 [a b])
+(defrecord RecordToTestStatics3 [a b c])
+(defrecord RecordToTestBasis [a b c])
+(defrecord RecordToTestBasisHinted [^String a ^Long b c])
+
+(deftest defrecord-statics
+  (testing "that a record has its generated static methods"
+    (let [r1 (RecordToTestStatics1. 1)
+          r2 (RecordToTestStatics2. 1 2)
+          r3 (RecordToTestStatics3. 1 2 3)
+          rn (RecordToTestStatics3. 1 nil nil)]
+      (testing "that a record created with the ctor equals one by the static factory method"
+        (is (= r1    (RecordToTestStatics1/create {:a 1})))
+        (is (= r2    (RecordToTestStatics2/create {:a 1 :b 2})))
+        (is (= r3    (RecordToTestStatics3/create {:a 1 :b 2 :c 3})))
+        (is (= rn    (RecordToTestStatics3/create {:a 1}))))
+      (testing "that a literal record equals one by the static factory method"
+        (is (= #clojure.test_clojure.protocols.RecordToTestStatics1{:a 1} (RecordToTestStatics1/create {:a 1})))
+        (is (= #clojure.test_clojure.protocols.RecordToTestStatics2{:a 1 :b 2} (RecordToTestStatics2/create {:a 1 :b 2})))
+        (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b 2 :c 3} (RecordToTestStatics3/create {:a 1 :b 2 :c 3})))
+        (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1} (RecordToTestStatics3/create {:a 1})))
+        (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b nil :c nil} (RecordToTestStatics3/create {:a 1}))))))
+  (testing "that a record has a sane generated basis method"
+    (let [b  (clojure.test_clojure.protocols.RecordToTestBasis/getBasis)
+          bh (clojure.test_clojure.protocols.RecordToTestBasisHinted/getBasis)]
+      (is (= '[a b c] b))
+      (is (= (:tag (meta (bh 0))) 'String))
+      (is (= (:tag (meta (bh 1))) 'Long))
+      (is (nil? (:tag (meta (bh 2))))))))
+
+(defrecord RecordToTestFactories [a b c])
+(deftest defrecord-factory-fns
+  (testing "if the definition of a defrecord generates the appropriate factory funcitons"
+    (let [r   (RecordToTestFactories. 1 2 3)
+          r-n (RecordToTestFactories. nil nil nil)]
+      (testing "that a record created with the ctor equals one by the positional factory fn"
+        (is (= r    (->RecordToTestFactories 1 2 3)))
+        (is (= r    (->RecordToTestFactories 1 2 3 nil nil)))
+        (is (= r    (->RecordToTestFactories 1 2 3 {:something true} nil)))
+        (is (not= r (->RecordToTestFactories 1 2 3 nil {:d 4}))))
+      (testing "that a record created with the ctor equals one by the map-> factory fn"
+        (is (= r    (map->RecordToTestFactories {:a 1 :b 2 :c 3})))
+        (is (= r-n  (map->RecordToTestFactories {}))))
+      (testing "that a literal record equals one by the positional factory fn"
+        (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (->RecordToTestFactories 1 2 3)))
+        (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (->RecordToTestFactories 1 nil nil)))
+        (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a [] :b {} :c ()} (->RecordToTestFactories [] {} ()))))      
+      (testing "that a literal record equals one by the map-> factory fn"
+        (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (map->RecordToTestFactories {:a 1 :b 2 :c 3})))
+        (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (map->RecordToTestFactories {:a 1})))
+        (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a nil :b nil :c nil} (map->RecordToTestFactories {})))))))
+
+(deftype TypeToTestFactory [a])
+(deftest deftype-factory-fn
+  (testing "that the ->T factory is gen'd for a deftype and that it works"
+    (is (= (.a (TypeToTestFactory. 42)) (.a (->TypeToTestFactory 42))))))
+
+(deftest ctor-literals
+  (testing "that constructor calls to print-dup'able classes are supported as literals"
+    (is (= "Hi" #java.lang.String["Hi"]))
+    (is (= 42 #java.lang.Long[42]))
+    (is (= 42 #java.lang.Long["42"]))
+    (is (= [:a 42] #clojure.lang.MapEntry[:a 42])))
+  (testing "that constructor literals are embeddable"
+    (is (= 42 #java.lang.Long[#java.lang.String["42"]])))
+  (testing "that constructor literals work for deftypes too"
+    (is (= (.a (TypeToTestFactory. 42)) (.a (->TypeToTestFactory 42))))))
+
+(defrecord RecordToTestLiterals [a])
+(defrecord TestNode [v l r])
+(deftype TypeToTestLiterals [a])
+(def lang-str "en")
+(deftest exercise-literals
+  (testing "that ctor literals can be used in common 'places'"
+    (is (= (RecordToTestLiterals. ()) #clojure.test_clojure.protocols.RecordToTestLiterals[()]))
+    (is (= (.a (TypeToTestLiterals. ())) (.a #clojure.test_clojure.protocols.TypeToTestLiterals[()])))
+    (is (= (RecordToTestLiterals. 42) (into #clojure.test_clojure.protocols.RecordToTestLiterals[0] {:a 42})))
+    (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))  (RecordToTestLiterals. #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
+    (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))  (->RecordToTestLiterals #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
+    (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+           #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]]))
+    (is (= (TestNode. 1
+                      (TestNode. 2
+                                 (TestNode. 3
+                                            nil
+                                            nil)
+                                 nil)
+                      (TestNode. 4
+                                 (TestNode. 5
+                                            (TestNode. 6
+                                                       nil
+                                                       nil)
+                                            nil)
+                                 (TestNode. 7
+                                            nil
+                                            nil)))
+           #clojure.test_clojure.protocols.TestNode{:v 1
+                                                    :l #clojure.test_clojure.protocols.TestNode{:v 2
+                                                                                                :l #clojure.test_clojure.protocols.TestNode{:v 3 :l nil :r nil}
+                                                                                                :r nil}
+                                                    :r #clojure.test_clojure.protocols.TestNode{:v 4
+                                                                                                :l #clojure.test_clojure.protocols.TestNode{:v 5
+                                                                                                                                            :l #clojure.test_clojure.protocols.TestNode{:v 6 :l nil :r nil}
+                                                                                                                                            :r nil}
+                                                                                                :r #clojure.test_clojure.protocols.TestNode{:v 7 :l nil :r nil}}})))
+
+  (testing "that records and types are evalable"
+    (is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
+    (is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a 42})))
+    (is (= (RecordToTestLiterals. 42) (eval (RecordToTestLiterals. 42))))
+    (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+           (eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]])))
+    (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+           (eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals{:a 42}])))
+    (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+           (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a #clojure.test_clojure.protocols.RecordToTestLiterals[42]})))
+    (is (= 42 (.a (eval #clojure.test_clojure.protocols.TypeToTestLiterals[42])))))
+  
+  (testing "that ctor literals only work with constants or statics"
+    (is (thrown? Exception (read-string "#java.util.Locale[(str 'en)]")))
+    (is (thrown? Exception (read-string "(let [s \"en\"] #java.util.Locale[(str 'en)])")))
+    (is (thrown? Exception (read-string "#clojure.test_clojure.protocols.RecordToTestLiterals{(keyword \"a\") 42}"))))
+  
+  (testing "that the correct errors are thrown with malformed literals"
+    (is (thrown-with-msg?
+          Exception
+          #"Unreadable constructor form.*"
+          (read-string "#java.util.Locale(\"en\")")))
+    (is (thrown-with-msg?
+          Exception
+          #"Unexpected number of constructor arguments.*"
+          (read-string "#java.util.Locale[\"\" \"\" \"\" \"\"]")))
+    (is (thrown-with-msg?
+          Exception
+          #"Constructor literal can only contain constants or statics.*"
+          (read-string "#clojure.lang.Ref[#clojure.lang.Ref[(+ 1 2)]]")))
+    (is (thrown? Exception (read-string "#java.util.Nachos(\"en\")")))))
+
+(defrecord RecordToTestPrinting [a b])
+(deftest defrecord-printing
+  (testing "that the default printer gives the proper representation"
+    (let [r   (RecordToTestPrinting. 1 2)]
+      (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
+             (pr-str r)))
+      (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting[#=(java.lang.Long. \"1\"), #=(java.lang.Long. \"2\")]"
+             (binding [*print-dup* true] (pr-str r))))
+      (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a #=(java.lang.Long. \"1\"), :b #=(java.lang.Long. \"2\")}"
+             (binding [*print-dup* true *verbose-defrecords* true] (pr-str r))))
+      (is (= "#clojure.test_clojure.protocols.TypeToTestLiterals[#=(java.lang.Long. \"42\")]"
+             (binding [*print-dup* true] (pr-str (TypeToTestLiterals. 42))))))))
+
+(defrecord RecordToTestLongHint [^long a])
+(defrecord RecordToTestByteHint [^byte a])
+(defrecord RecordToTestBoolHint [^boolean a])
+(defrecord RecordToTestCovariantHint [^String a]) ;; same for arrays also
+
+(deftest defrecord-hinting
+  (testing "that primitive hinting requiring no coercion works as expected"
+    (is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint{:a 42}))
+    (is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint[42]))
+    (is (= (RecordToTestLongHint. 42) (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a 42})))
+    (is (= (RecordToTestLongHint. 42) (map->RecordToTestLongHint {:a 42})))
+    (is (= (RecordToTestLongHint. 42) (->RecordToTestLongHint 42)))
+    (testing "that invalid primitive types on hinted defrecord fields fails"
+      (is (thrown-with-msg?
+            ClassCastException
+            #"java.lang.String cannot be cast to java.lang.Long.*"
+            (read-string "#clojure.test_clojure.protocols.RecordToTestLongHint{:a \"\"}")))
+      (is (thrown-with-msg?
+            IllegalArgumentException
+            #"Unexpected param type, expected: long, given: java.lang.String.*"
+            (read-string "#clojure.test_clojure.protocols.RecordToTestLongHint[\"\"]")))
+      (is (thrown-with-msg?
+            ClassCastException
+            #"java.lang.String cannot be cast to java.lang.Long.*"
+            (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a ""})))
+      (is (thrown-with-msg?
+            ClassCastException
+            #"java.lang.String cannot be cast to java.lang.Long.*"
+            (map->RecordToTestLongHint {:a ""})))
+      (is (thrown-with-msg?
+