diff --git a/host/chez/natives-meta.ss b/host/chez/natives-meta.ss index 45fbab1..67556cc 100644 --- a/host/chez/natives-meta.ss +++ b/host/chez/natives-meta.ss @@ -40,7 +40,15 @@ ((jreify? x) (make-jreify (jreify-methods x) (jreify-protos x))) ;; () is a shared singleton — a fresh instance keeps meta off every other (). ((empty-list-t? x) (fresh-empty-list)) - (else x))) ; cseq / procedure + ;; a list/seq node gets a fresh identity too (Clojure's PersistentList is + ;; immutable — (with-meta a-list m) returns a NEW list). Keying meta on the + ;; original mutated it, so (with-meta xs {:k xs}) built a self-referential + ;; cycle that loops *print-meta* printing. + ((cseq? x) (make-cseq (cseq-head x) (cseq-tail x) (cseq-forced? x) + (cseq-list? x) (cseq-cvec x) (cseq-ci x))) + ((jolt-lazyseq? x) (make-jolt-lazyseq (jolt-lazyseq-thunk x) (jolt-lazyseq-val x) + (jolt-lazyseq-realized? x))) + (else x))) ; procedure (define (jolt-with-meta x m) (cond diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index ef06a57..f950a99 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -3308,4 +3308,8 @@ {:suite "reader / metadata" :label "an empty list in metadata reads as a value" :expected "true" :actual "(= () (:e (meta (read-string \"^{:e ()} [1]\"))))"} {:suite "edn / readers in collections" :label "a :default tag reader applies inside a set" :expected "true" :actual "(= #{[:t 1]} (clojure.edn/read-string {:default (fn [t v] [:t v])} \"#{#foo 1}\"))"} {:suite "edn / readers in collections" :label "a registered reader applies inside a set" :expected "true" :actual "(= #{6} (clojure.edn/read-string {:readers {(quote x) (fn [v] (* v 2))}} \"#{#x 3}\"))"} + {:suite "metadata / immutability" :label "with-meta on a list does not mutate the original" :expected "true" :actual "(let [ds (list 1 2)] (with-meta ds {:k 1}) (nil? (meta ds)))"} + {:suite "metadata / immutability" :label "with-meta on a list carries the metadata" :expected "true" :actual "(= {:k 1} (meta (with-meta (list 1) {:k 1})))"} + {:suite "metadata / immutability" :label "a meta-bearing list still equals the bare list" :expected "true" :actual "(let [ds (list 1)] (= ds (with-meta ds {:k 9})))"} + {:suite "metadata / immutability" :label "with-meta on a lazy seq carries metadata" :expected "true" :actual "(= {:k 5} (meta (with-meta (lazy-seq (list 1)) {:k 5})))"} ]