Interim checkin - DO NOT USE!!

Unless you are interested in helping test:
new print-dup functionality for replica generation of compilation constants
new *print-dup* flag, prints duplicators
back to simplified readably printing for repl
readable fns, as long as they are not closures

10 files changed, 165 insertions, 37 deletions

diff --git a/src/clj/clojure/boot.clj b/src/clj/clojure/boot.clj
index 4f51ace9..e0d74509 100644
--- a/src/clj/clojure/boot.clj
+++ b/src/clj/clojure/boot.clj
@@ -1565,7 +1565,7 @@
   array [& items]
     (into-array items))
 
-(defn class
+(defn #^Class class
   "Returns the Class of x"
   [#^Object x] (if (nil? x) x (. x (getClass))))
 
@@ -1629,7 +1629,18 @@
   {:tag BigDecimal}
   [x] (. BigDecimal valueOf x))
 
+(def #^{:private true} print-initialized false)
+
 (defmulti print-method (fn [x writer] (class x)))
+(defmulti print-dup (fn [x writer] (class x)))
+
+(defn pr-on 
+  {:private true}
+  [x w]
+  (if *print-dup*
+    (print-dup x w)
+    (print-method x w))
+  nil)
 
 (defn pr
   "Prints the object(s) to the output stream that is the current value
@@ -1638,8 +1649,7 @@
   can be read by the reader"
   ([] nil)
   ([x]
-   (print-method x *out*)
-   nil)
+     (pr-on x *out*))
   ([x & more]
    (pr x)
    (. *out* (append \space))
@@ -3453,13 +3463,13 @@
 *print-level* nil)
 
 (defn- print-sequential [#^String begin, print-one, #^String sep, #^String end, sequence, #^Writer w]
-  (binding [*print-level* (and *print-level* (dec *print-level*))]
+  (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
     (if (and *print-level* (neg? *print-level*))
       (.write w "#")
       (do
         (.write w begin)
         (when-let xs (seq sequence)
-          (if *print-length*
+          (if (and (not *print-dup*) *print-length*)
             (loop [[x & xs] xs
                    print-length *print-length*]
               (if (zero? print-length)
@@ -3478,37 +3488,68 @@
 
 (defn- print-meta [o, #^Writer w]
   (when-let m (meta o)
-    (when (and *print-meta* *print-readably* (pos? (count m)))
+    (when (and (pos? (count m))
+               (or *print-dup*
+                   (and *print-meta* *print-readably*)))
       (.write w "#^")
       (if (and (= (count m) 1) (:tag m))
-          (print-method (:tag m) w)
-          (print-method m w))
+          (pr-on (:tag m) w)
+          (pr-on m w))
       (.write w " "))))
 
 (defmethod print-method nil [o, #^Writer w]
   (.write w "nil"))
 
+(defmethod print-dup nil [o w] (print-method o w))
+
 (defn print-ctor [o print-args #^Writer w]
   (.write w "#=(")
-  (.write w (.getName (class o)))
+  (.write w (.getName #^Class (class o)))
   (.write w ". ")
   (print-args o w)
   (.write w ")"))
 
 (defmethod print-method :default [o, #^Writer w]
   (.write w "#<")
+  (.write w (.getSimpleName (class o)))
+  (.write w " ")
   (.write w (str o))
   (.write w ">"))
 
 (defmethod print-method clojure.lang.Keyword [o, #^Writer w]
   (.write w (str o)))
 
+(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))
+
 (defmethod print-method Number [o, #^Writer w]
   (.write w (str o)))
 
+(defmethod print-dup Number [o, #^Writer w]
+  (print-ctor o
+              (fn [o w]
+                  (print-dup (str o) w))
+              w))
+
+(defmethod print-dup clojure.lang.AFn [o, #^Writer w]
+  (print-ctor o (fn [o w]) w))
+
+(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.AFn)
+(prefer-method print-dup java.util.Map clojure.lang.AFn)
+(prefer-method print-dup java.util.Collection clojure.lang.AFn)
+
+(defmethod print-dup clojure.lang.Ratio [o, #^Writer w]
+  (print-ctor o
+              (fn [#^clojure.lang.Ratio o #^Writer w]
+                (print-dup (.numerator o) w)
+                (.write w " ")
+                (print-dup (.numerator o) w))
+              w))
+
 (defmethod print-method Boolean [o, #^Writer w]
   (.write w (str o)))
 
+(defmethod print-dup Boolean [o w] (print-method o w))
+
 (defn print-simple [o, #^Writer w]
   (print-meta o w)
   (.write w (str o)))
@@ -3516,9 +3557,14 @@
 (defmethod print-method clojure.lang.Symbol [o, #^Writer w]
   (print-simple o w))
 
+(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))
+
 (defmethod print-method clojure.lang.Var [o, #^Writer w]
   (print-simple o w))
 
+(defmethod print-dup clojure.lang.Var [#^clojure.lang.Var o, #^Writer w]
+  (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")")))
+
 (defmethod print-method clojure.lang.ISeq [o, #^Writer w]
   (print-meta o w)
   (print-sequential "(" print-method " " ")" o w))
@@ -3529,12 +3575,24 @@
 
 (prefer-method print-method clojure.lang.IPersistentList clojure.lang.ISeq)
 
-
 (defmethod print-method java.util.Collection [o, #^Writer w]
  (print-ctor o #(print-sequential "[" print-method " " "]" %1 %2) w))
 
 (prefer-method print-method clojure.lang.IPersistentCollection java.util.Collection)
 
+(defmethod print-dup java.util.Collection [o, #^Writer w]
+ (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
+
+(defmethod print-dup clojure.lang.IPersistentCollection [o, #^Writer w]
+  (print-meta o w)
+  (.write w "#=(")
+  (.write w (.getName #^Class (class o)))
+  (.write w "/create ")
+  (print-sequential "[" print-dup " " "]" o w)
+  (.write w ")"))
+
+(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection)
+
 (def #^{:tag String 
         :doc "Returns escape string for char or nil if none"}
   char-escape-string
@@ -3547,7 +3605,7 @@
      \backspace "\\b"})
 
 (defmethod print-method String [#^String s, #^Writer w]
-  (if *print-readably*
+  (if (or *print-dup* *print-readably*)
     (do (.append w \")
       (dotimes n (count s)
         (let [c (.charAt s n)
@@ -3557,36 +3615,46 @@
     (.write w s))
   nil)
 
+(defmethod print-dup String [s w] (print-method s w))
+
 (defmethod print-method clojure.lang.IPersistentVector [v, #^Writer w]
   (print-meta v w)
-  (print-sequential "[" print-method " " "]" v w))
+  (print-sequential "[" pr-on " " "]" v w))
 
-(defmethod print-method clojure.lang.IPersistentMap [m, #^Writer w]
-  (print-meta m w)
+(defn- print-map [m print-one w]
   (print-sequential 
    "{"
    (fn [e  #^Writer w] 
-     (do (print-method (key e) w) (.append w \space) (print-method (val e) w)))
+     (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
    ", "
    "}"
    (seq m) w))
 
+(defmethod print-method clojure.lang.IPersistentMap [m, #^Writer w]
+  (print-meta m w)
+  (print-map m pr-on w))
+
 (defmethod print-method java.util.Map [m, #^Writer w]
-  (print-ctor m 
-              #(print-sequential 
-                "{"
-                (fn [e  #^Writer w] 
-                  (do (print-method (key e) w) (.append w \space) (print-method (val e) w)))
-                ", "
-                "}"
-                (seq %1) %2) 
-              w))
+  (print-ctor m #(print-map (seq %1) print-method %2) w))
 
 (prefer-method print-method clojure.lang.IPersistentMap java.util.Map)
 
+(defmethod print-dup java.util.Map [m, #^Writer w]
+  (print-ctor m #(print-map (seq %1) print-dup %2) w))
+
+(defmethod print-dup clojure.lang.IPersistentMap [m, #^Writer w]
+  (print-meta m w)
+  (.write w "#=(")
+  (.write w (.getName (class m)))
+  (.write w "/create ")
+  (print-map m print-dup w)
+  (.write w ")"))
+
+(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
+
 (defmethod print-method clojure.lang.IPersistentSet [s, #^Writer w]
   (print-meta s w)
-  (print-sequential "#{" print-method " " "}" (seq s) w))
+  (print-sequential "#{" pr-on " " "}" (seq s) w))
 
 (defmethod print-method java.util.Set [s, #^Writer w]
   (print-ctor s
@@ -3606,13 +3674,21 @@
     \return "return"})
 
 (defmethod print-method java.lang.Character [#^Character c, #^Writer w]
-  (if *print-readably*
+  (if (or *print-dup* *print-readably*)
     (do (.append w \\)
         (let [n (char-name-string c)]
           (if n (.write w n) (.append w c))))
     (.append w c))
   nil)
 
+(defmethod print-dup java.lang.Character [c w] (print-method c w))
+(defmethod print-dup java.lang.Integer [o w] (print-method o w))
+(defmethod print-dup java.lang.Double [o w] (print-method o w))
+(defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
+(defmethod print-dup clojure.lang.PersistentHashMap [o w] (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))
+
 (def primitives-classnames
   {Float/TYPE "Float/TYPE"
    Integer/TYPE "Integer/TYPE"
@@ -3624,10 +3700,13 @@
    Short/TYPE "Short/TYPE"})
 
 (defmethod print-method Class [#^Class c, #^Writer w]
+  (.write w (.getName c)))
+
+(defmethod print-dup Class [#^Class c, #^Writer w]
   (cond
     (.isPrimitive c) (do
                        (.write w "#=(identity ")
-                       (.write w (primitives-classnames c))
+                       (.write w #^String (primitives-classnames c))
                        (.write w ")"))
     (.isArray c) (do
                    (.write w "#=(java.lang.Class/forName \"")
@@ -3663,9 +3742,11 @@
                    (recur r qmode)))))
   (.append w \"))
 
-(defmethod print-method clojure.lang.Namespace [n #^Writer w]
+(defmethod print-dup java.util.regex.Pattern [p #^Writer w] (print-method p w))
+
+(defmethod print-dup clojure.lang.Namespace [#^clojure.lang.Namespace n #^Writer w]
   (.write w "#=(find-ns ")
-  (print-method (.name n) w)
+  (print-dup (.name n) w)
   (.write w ")"))
 
 (def #^{:private true} print-initialized true)
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index 925cf639..4ee53cef 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -3042,10 +3042,15 @@ static public class FnExpr implements Expr{
 //			clinitgen.checkCast(DYNAMIC_CLASSLOADER_TYPE);
 //			clinitgen.push(constantsID);
 //			clinitgen.invokeVirtual(DYNAMIC_CLASSLOADER_TYPE, getConstantsMethod);
+			try{
+			Var.pushThreadBindings(RT.map(RT.PRINT_DUP, RT.T));
 
 			for(int i = 0; i < constants.count(); i++)
 				{
 				String cs = RT.printString(constants.nth(i));
+				if(cs.length() == 0)
+					throw new RuntimeException("Can't embed unreadable object in code: " + constants.nth(i));
+
 				if(cs.startsWith("#<"))
 					throw new RuntimeException("Can't embed unreadable object in code: " + cs);
 				clinitgen.push(cs);
@@ -3057,6 +3062,10 @@ static public class FnExpr implements Expr{
 				clinitgen.putStatic(fntype, constantName(i), constantType(i));
 				}
 			}
+			finally{
+				Var.popThreadBindings();
+			}
+			}
 //		for(ISeq s = RT.keys(keywords); s != null; s = s.rest())
 //			{
 //			Keyword k = (Keyword) s.first();
diff --git a/src/jvm/clojure/lang/PersistentArrayMap.java b/src/jvm/clojure/lang/PersistentArrayMap.java
index 969ec701..070fe1bf 100644
--- a/src/jvm/clojure/lang/PersistentArrayMap.java
+++ b/src/jvm/clojure/lang/PersistentArrayMap.java
@@ -11,6 +11,7 @@
 package clojure.lang;

 

 import java.util.Iterator;

+import java.util.Map;

 

 /**

  * Simple implementation of persistent map on an array

@@ -30,6 +31,16 @@ static final int HASHTABLE_THRESHOLD = 8;
 

 public static final PersistentArrayMap EMPTY = new PersistentArrayMap();

 

+static public IPersistentMap create(Map other){

+	IPersistentMap ret = EMPTY;

+	for(Object o : other.entrySet())

+		{

+		Map.Entry e = (Entry) o;

+		ret = ret.assoc(e.getKey(), e.getValue());

+		}

+	return ret;

+}

+

 protected PersistentArrayMap(){

 	this.array = new Object[]{};

 }

diff --git a/src/jvm/clojure/lang/PersistentHashMap.java b/src/jvm/clojure/lang/PersistentHashMap.java
index 9d9e8a7b..173d1ecf 100644
--- a/src/jvm/clojure/lang/PersistentHashMap.java
+++ b/src/jvm/clojure/lang/PersistentHashMap.java
@@ -32,6 +32,16 @@ final INode root;
 
 final public static PersistentHashMap EMPTY = new PersistentHashMap(0, new EmptyNode());
 
+static public IPersistentMap create(Map other){
+	IPersistentMap ret = EMPTY;
+	for(Object o : other.entrySet())
+		{
+		Map.Entry e = (Entry) o;
+		ret = ret.assoc(e.getKey(), e.getValue());
+		}
+	return ret;
+}
+
 /*
  * @param init {key1,val1,key2,val2,...}
  */
diff --git a/src/jvm/clojure/lang/PersistentHashSet.java b/src/jvm/clojure/lang/PersistentHashSet.java
index 9f216010..c84929fe 100644
--- a/src/jvm/clojure/lang/PersistentHashSet.java
+++ b/src/jvm/clojure/lang/PersistentHashSet.java
@@ -14,6 +14,7 @@ package clojure.lang;
 
 import java.util.List;
 import java.util.Iterator;
+import java.util.Collection;
 
 public class PersistentHashSet extends APersistentSet{
 
@@ -30,9 +31,8 @@ public static PersistentHashSet create(Object... init){
 
 public static PersistentHashSet create(List init){
 	PersistentHashSet ret = EMPTY;
-	for(Iterator i = init.iterator(); i.hasNext();)
+	for(Object key : init)
 		{
-		Object key = i.next();
 		ret = (PersistentHashSet) ret.cons(key);
 		}
 	return ret;
diff --git a/src/jvm/clojure/lang/PersistentTreeMap.java b/src/jvm/clojure/lang/PersistentTreeMap.java
index f1f960cf..51eeb01d 100644
--- a/src/jvm/clojure/lang/PersistentTreeMap.java
+++ b/src/jvm/clojure/lang/PersistentTreeMap.java
@@ -30,6 +30,16 @@ public final int _count;
 
 final static public PersistentTreeMap EMPTY = new PersistentTreeMap();
 
+static public IPersistentMap create(Map other){
+	IPersistentMap ret = EMPTY;
+	for(Object o : other.entrySet())
+		{
+		Map.Entry e = (Entry) o;
+		ret = ret.assoc(e.getKey(), e.getValue());
+		}
+	return ret;
+}
+
 public PersistentTreeMap(){
 	this(RT.DEFAULT_COMPARATOR);
 }
diff --git a/src/jvm/clojure/lang/PersistentTreeSet.java b/src/jvm/clojure/lang/PersistentTreeSet.java
index 9055a05f..69bd6a63 100644
--- a/src/jvm/clojure/lang/PersistentTreeSet.java
+++ b/src/jvm/clojure/lang/PersistentTreeSet.java
@@ -15,6 +15,7 @@ package clojure.lang;
 import java.util.List;
 import java.util.Iterator;
 import java.util.Comparator;
+import java.util.Collection;
 
 public class PersistentTreeSet extends APersistentSet implements Reversible, Sorted{
 static public final PersistentTreeSet EMPTY = new PersistentTreeSet(null, PersistentTreeMap.EMPTY);
@@ -30,9 +31,8 @@ public static PersistentTreeSet create(Object... init){
 
 public static PersistentTreeSet create(List init){
 	PersistentTreeSet ret = EMPTY;
-	for(Iterator i = init.iterator(); i.hasNext();)
+	for(Object key : init)
 		{
-		Object key = i.next();
 		ret = (PersistentTreeSet) ret.cons(key);
 		}
 	return ret;
diff --git a/src/jvm/clojure/lang/PersistentVector.java b/src/jvm/clojure/lang/PersistentVector.java
index f6158791..f94a0564 100644
--- a/src/jvm/clojure/lang/PersistentVector.java
+++ b/src/jvm/clojure/lang/PersistentVector.java
@@ -13,6 +13,7 @@
 package clojure.lang;
 
 import java.util.List;
+import java.util.Collection;
 
 public class PersistentVector extends APersistentVector{
 final int cnt;
diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java
index 2cb519cd..9ab615e5 100644
--- a/src/jvm/clojure/lang/RT.java
+++ b/src/jvm/clojure/lang/RT.java
@@ -200,13 +200,14 @@ final public static Var CURRENT_NS = Var.intern(CLOJURE_NS, Symbol.create("*ns*"
 final static Var FLUSH_ON_NEWLINE = Var.intern(CLOJURE_NS, Symbol.create("*flush-on-newline*"), T);
 final static Var PRINT_META = Var.intern(CLOJURE_NS, Symbol.create("*print-meta*"), F);
 final static Var PRINT_READABLY = Var.intern(CLOJURE_NS, Symbol.create("*print-readably*"), T);
+final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.create("*print-dup*"), F);
 final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.create("*warn-on-reflection*"), F);
 final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.create("*allow-unresolved-vars*"), F);
 
 final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("in-ns"), F);
 final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("ns"), F);
 static final Var PRINT_INITIALIZED = Var.intern(CLOJURE_NS, Symbol.create("print-initialized"));
-static final Var PRINT_METHOD = Var.intern(CLOJURE_NS, Symbol.create("print-method"));
+static final Var PR_ON = Var.intern(CLOJURE_NS, Symbol.create("pr-on"));
 //final static Var IMPORTS = Var.intern(CLOJURE_NS, Symbol.create("*imports*"), DEFAULT_IMPORTS);
 final static IFn inNamespace = new AFn(){
 	public Object invoke(Object arg1) throws Exception{
@@ -1191,8 +1192,8 @@ static public Object readString(String s){
 
 static public void print(Object x, Writer w) throws Exception{
 	//call multimethod
-	if(PRINT_INITIALIZED.isBound())
-		PRINT_METHOD.invoke(x, w);
+	if(PRINT_INITIALIZED.isBound() && RT.booleanCast(PRINT_INITIALIZED.get()))
+		PR_ON.invoke(x, w);
 //*
 	else{
 	boolean readably = booleanCast(PRINT_READABLY.get());
@@ -1356,6 +1357,11 @@ static public void print(Object x, Writer w) throws Exception{
 		w.write(x.toString());
 		w.write('M');
 		}
+	else if(x instanceof Var)
+		{
+		Var v = (Var) x;
+		w.write("#=(var " + v.ns.name + "/" + v.sym + ")");
+		}
 	else w.write(x.toString());
 	}
 	//*/
diff --git a/src/jvm/clojure/lang/Var.java b/src/jvm/clojure/lang/Var.java
index a84ff663..fcbd746f 100644
--- a/src/jvm/clojure/lang/Var.java
+++ b/src/jvm/clojure/lang/Var.java
@@ -72,7 +72,7 @@ public static Var intern(Namespace ns, Symbol sym, Object root, boolean replaceR
 
 public String toString(){
 	if(ns != null)
-		return "#=(var " + ns.name + "/" + sym + ")";
+		return "#'" + ns.name + "/" + sym;
 	return "#<Var: " + (sym != null ? sym.toString() : "--unnamed--") + ">";
 }