summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/clj/clojure/boot.clj139
-rw-r--r--src/jvm/clojure/lang/Compiler.java9
-rw-r--r--src/jvm/clojure/lang/PersistentArrayMap.java11
-rw-r--r--src/jvm/clojure/lang/PersistentHashMap.java10
-rw-r--r--src/jvm/clojure/lang/PersistentHashSet.java4
-rw-r--r--src/jvm/clojure/lang/PersistentTreeMap.java10
-rw-r--r--src/jvm/clojure/lang/PersistentTreeSet.java4
-rw-r--r--src/jvm/clojure/lang/PersistentVector.java1
-rw-r--r--src/jvm/clojure/lang/RT.java12
-rw-r--r--src/jvm/clojure/lang/Var.java2
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--") + ">";
}
generated by cgit v1.2.3-18-g5258 (git 2.32.0) at 2025-07-18 00:14:33 +0000