summaryrefslogtreecommitdiff
path: root/src/clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/clj')
-rw-r--r--src/clj/clojure/core_deftype.clj54
-rw-r--r--src/clj/clojure/core_print.clj28
2 files changed, 60 insertions, 22 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))
generated by cgit v1.2.3-18-g5258 (git 2.32.0) at 2025-08-05 00:48:28 +0000