diff --git a/host/chez/reader.ss b/host/chez/reader.ss index 1ecb2f7..eea2003 100644 --- a/host/chez/reader.ss +++ b/host/chez/reader.ss @@ -739,3 +739,8 @@ (def-var! "clojure.core" "read-string" jolt-read-string) (def-var! "clojure.core" "__parse-next" jolt-parse-next) (def-var! "clojure.core" "__read-tagged" jolt-read-tagged) +;; __read-form-raw: the read form WITHOUT building values — set/tagged literals +;; stay FORMS. clojure.edn reads this so it applies a #tag through its :readers/ +;; :default (a #inst can be overridden to defer), rather than read-string building +;; the built-in #inst eagerly (which fails on a non-string like #inst ^:ref […]). +(def-var! "clojure.core" "__read-form-raw" jolt-read-form-raw) diff --git a/host/chez/seed/prelude.ss b/host/chez/seed/prelude.ss index 3b50cc5..ffdc2f2 100644 --- a/host/chez/seed/prelude.ss +++ b/host/chez/seed/prelude.ss @@ -1061,9 +1061,9 @@ (lambda (argv expr . _values) (let fnrec2128 ((argv argv) (expr expr) (_values (list->cseq _values))) (let* ((c (jolt-count argv))) (let* ((_a$2132 (var-deref "clojure.core" "__sqcat")) (_a$2133 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "do"))) (_a$2134 (let* ((_a$2130 (lambda (a) (let fnrec2129 ((a a)) (jolt-invoke (var-deref "clojure.template" "apply-template") argv expr a)))) (_a$2131 (jolt-invoke (var-deref "clojure.core" "partition") c _values))) (jolt-map _a$2130 _a$2131)))) (jolt-invoke _a$2132 _a$2133 _a$2134)))))) (mark-macro! "clojure.template" "do-template")) (guard (e (#t #f)) - (def-var! "clojure.edn" "edn->value" (letrec ((edn->value (lambda (opts x) (let fnrec2135 ((opts opts) (x x)) (if (jolt= (keyword "jolt" "set") (jolt-get x (keyword "jolt" "type"))) (let* ((_a$2139 (var-deref "clojure.core" "with-meta")) (_a$2140 (jolt-invoke (var-deref "clojure.core" "set") (let* ((_a$2137 (lambda (v) (let fnrec2136 ((v v)) (edn->value opts v)))) (_a$2138 (jolt-get x (keyword #f "value")))) (jolt-map _a$2137 _a$2138)))) (_a$2141 (jolt-invoke (var-deref "clojure.core" "meta") x))) (jolt-invoke _a$2139 _a$2140 _a$2141)) (if (jolt= (keyword "jolt" "tagged") (jolt-get x (keyword "jolt" "type"))) (let* ((tag (jolt-get x (keyword #f "tag"))) (v (edn->value opts (jolt-get x (keyword #f "form")))) (tag-sym (let* ((n (jolt-invoke (var-deref "clojure.core" "name") tag))) (jolt-invoke (var-deref "clojure.core" "symbol") (if (jolt= "#" (jolt-invoke (var-deref "clojure.core" "subs") n 0 1)) (jolt-invoke (var-deref "clojure.core" "subs") n 1) n)))) (custom (jolt-get (jolt-get opts (keyword #f "readers")) tag-sym))) (if (jolt-truthy? custom) (jolt-invoke custom v) (if (jolt-truthy? (jolt-get opts (keyword #f "default"))) (jolt-invoke (jolt-get opts (keyword #f "default")) tag-sym v) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "__read-tagged") tag v) jolt-nil)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") x)) (let* ((_a$2147 (var-deref "clojure.core" "with-meta")) (_a$2148 (let* ((_a$2145 (jolt-hash-map)) (_a$2146 (jolt-map (lambda (e) (let fnrec2142 ((e e)) (let* ((_o$2143 (edn->value opts (jolt-invoke (var-deref "clojure.core" "key") e))) (_o$2144 (edn->value opts (jolt-invoke (var-deref "clojure.core" "val") e)))) (jolt-vector _o$2143 _o$2144)))) x))) (jolt-into _a$2145 _a$2146))) (_a$2149 (jolt-invoke (var-deref "clojure.core" "meta") x))) (jolt-invoke _a$2147 _a$2148 _a$2149)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") x)) (let* ((_a$2151 (var-deref "clojure.core" "with-meta")) (_a$2152 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (v) (let fnrec2150 ((v v)) (edn->value opts v))) x)) (_a$2153 (jolt-invoke (var-deref "clojure.core" "meta") x))) (jolt-invoke _a$2151 _a$2152 _a$2153)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "set?") x)) (let* ((_a$2155 (var-deref "clojure.core" "with-meta")) (_a$2156 (jolt-invoke (var-deref "clojure.core" "set") (jolt-map (lambda (v) (let fnrec2154 ((v v)) (edn->value opts v))) x))) (_a$2157 (jolt-invoke (var-deref "clojure.core" "meta") x))) (jolt-invoke _a$2155 _a$2156 _a$2157)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") x)) (let* ((_a$2159 (var-deref "clojure.core" "with-meta")) (_a$2160 (jolt-map (lambda (v) (let fnrec2158 ((v v)) (edn->value opts v))) x)) (_a$2161 (jolt-invoke (var-deref "clojure.core" "meta") x))) (jolt-invoke _a$2159 _a$2160 _a$2161)) (if (jolt-truthy? (keyword #f "else")) x jolt-nil))))))))))) edn->value))) + (def-var! "clojure.edn" "edn->value" (letrec ((edn->value (lambda (opts x) (let fnrec2135 ((opts opts) (x x)) (if (jolt= (keyword "jolt" "set") (jolt-get x (keyword "jolt" "type"))) (let* ((_a$2139 (var-deref "clojure.core" "with-meta")) (_a$2140 (jolt-invoke (var-deref "clojure.core" "set") (let* ((_a$2137 (lambda (v) (let fnrec2136 ((v v)) (edn->value opts v)))) (_a$2138 (jolt-get x (keyword #f "value")))) (jolt-map _a$2137 _a$2138)))) (_a$2141 (edn->value opts (jolt-invoke (var-deref "clojure.core" "meta") x)))) (jolt-invoke _a$2139 _a$2140 _a$2141)) (if (jolt= (keyword "jolt" "tagged") (jolt-get x (keyword "jolt" "type"))) (let* ((tag (jolt-get x (keyword #f "tag"))) (v (edn->value opts (jolt-get x (keyword #f "form")))) (tag-sym (let* ((n (jolt-invoke (var-deref "clojure.core" "name") tag))) (jolt-invoke (var-deref "clojure.core" "symbol") (if (jolt= "#" (jolt-invoke (var-deref "clojure.core" "subs") n 0 1)) (jolt-invoke (var-deref "clojure.core" "subs") n 1) n)))) (custom (jolt-get (jolt-get opts (keyword #f "readers")) tag-sym))) (if (jolt-truthy? custom) (jolt-invoke custom v) (if (jolt-truthy? (jolt-get opts (keyword #f "default"))) (jolt-invoke (jolt-get opts (keyword #f "default")) tag-sym v) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "__read-tagged") tag v) jolt-nil)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") x)) (let* ((_a$2147 (var-deref "clojure.core" "with-meta")) (_a$2148 (let* ((_a$2145 (jolt-hash-map)) (_a$2146 (jolt-map (lambda (e) (let fnrec2142 ((e e)) (let* ((_o$2143 (edn->value opts (jolt-invoke (var-deref "clojure.core" "key") e))) (_o$2144 (edn->value opts (jolt-invoke (var-deref "clojure.core" "val") e)))) (jolt-vector _o$2143 _o$2144)))) x))) (jolt-into _a$2145 _a$2146))) (_a$2149 (edn->value opts (jolt-invoke (var-deref "clojure.core" "meta") x)))) (jolt-invoke _a$2147 _a$2148 _a$2149)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") x)) (let* ((_a$2151 (var-deref "clojure.core" "with-meta")) (_a$2152 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (v) (let fnrec2150 ((v v)) (edn->value opts v))) x)) (_a$2153 (edn->value opts (jolt-invoke (var-deref "clojure.core" "meta") x)))) (jolt-invoke _a$2151 _a$2152 _a$2153)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "set?") x)) (let* ((_a$2155 (var-deref "clojure.core" "with-meta")) (_a$2156 (jolt-invoke (var-deref "clojure.core" "set") (jolt-map (lambda (v) (let fnrec2154 ((v v)) (edn->value opts v))) x))) (_a$2157 (edn->value opts (jolt-invoke (var-deref "clojure.core" "meta") x)))) (jolt-invoke _a$2155 _a$2156 _a$2157)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") x)) (let* ((_a$2159 (var-deref "clojure.core" "with-meta")) (_a$2160 (jolt-map (lambda (v) (let fnrec2158 ((v v)) (edn->value opts v))) x)) (_a$2161 (edn->value opts (jolt-invoke (var-deref "clojure.core" "meta") x)))) (jolt-invoke _a$2159 _a$2160 _a$2161)) (if (jolt-truthy? (keyword #f "else")) x jolt-nil))))))))))) edn->value))) (guard (e (#t #f)) - (def-var! "clojure.edn" "read-edn" (letrec ((read-edn (lambda (opts s) (let fnrec2162 ((opts opts) (s s)) (if (jolt-truthy? (let* ((or__26__auto (jolt-nil? s))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt-invoke (var-deref "clojure.string" "blank?") s)))) (jolt-get opts (keyword #f "eof") jolt-nil) (jolt-invoke (var-deref "clojure.edn" "edn->value") opts (jolt-invoke (var-deref "clojure.core" "read-string") s))))))) read-edn))) + (def-var! "clojure.edn" "read-edn" (letrec ((read-edn (lambda (opts s) (let fnrec2162 ((opts opts) (s s)) (if (jolt-truthy? (let* ((or__26__auto (jolt-nil? s))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt-invoke (var-deref "clojure.string" "blank?") s)))) (jolt-get opts (keyword #f "eof") jolt-nil) (jolt-invoke (var-deref "clojure.edn" "edn->value") opts (jolt-invoke (var-deref "clojure.core" "__read-form-raw") s))))))) read-edn))) (guard (e (#t #f)) (def-var-with-meta! "clojure.edn" "read-string" (letrec ((read-string (case-lambda ((s) (let fnrec2163 ((s s)) (jolt-invoke (var-deref "clojure.edn" "read-edn") (jolt-hash-map) s))) ((opts s) (let fnrec2164 ((opts opts) (s s)) (jolt-invoke (var-deref "clojure.edn" "read-edn") opts s)))))) read-string) (let* ((_o$2165 (keyword #f "doc")) (_o$2166 "Reads one object from the string s. Returns the :eof option value (default\n nil) for nil or blank input. opts is an options map; :eof sets the value\n returned at end of input.")) (jolt-hash-map _o$2165 _o$2166)))) (guard (e (#t #f)) diff --git a/stdlib/clojure/edn.clj b/stdlib/clojure/edn.clj index 456ee6c..6015af8 100644 --- a/stdlib/clojure/edn.clj +++ b/stdlib/clojure/edn.clj @@ -16,7 +16,7 @@ ;; Reader FORMS are detected by :jolt/type tag, never by map? — strict map? ;; (correctly) excludes tagged structs, so the old (and (map? x) ...) guard ;; would skip them. - (= :jolt/set (get x :jolt/type)) (with-meta (set (map (fn [v] (edn->value opts v)) (get x :value))) (meta x)) + (= :jolt/set (get x :jolt/type)) (with-meta (set (map (fn [v] (edn->value opts v)) (get x :value))) (edn->value opts (meta x))) ;; Tagged elements: a reader from the :readers opt wins, then the built-in ;; data readers (#uuid/#inst + registered); an unknown tag falls to the ;; :default opt fn (called with tag and value, as in Clojure) or throws. @@ -34,12 +34,12 @@ (get opts :default) ((get opts :default) tag-sym v) :else (__read-tagged tag v))) (map? x) - (with-meta (into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x)) (meta x)) - (vector? x) (with-meta (mapv (fn [v] (edn->value opts v)) x) (meta x)) + (with-meta (into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x)) (edn->value opts (meta x))) + (vector? x) (with-meta (mapv (fn [v] (edn->value opts v)) x) (edn->value opts (meta x))) ;; a constructed set: recurse into its elements too, so a tagged literal ;; inside #{…} gets the :readers/:default treatment (aero's #ref in a set). - (set? x) (with-meta (set (map (fn [v] (edn->value opts v)) x)) (meta x)) - (seq? x) (with-meta (map (fn [v] (edn->value opts v)) x) (meta x)) + (set? x) (with-meta (set (map (fn [v] (edn->value opts v)) x)) (edn->value opts (meta x))) + (seq? x) (with-meta (map (fn [v] (edn->value opts v)) x) (edn->value opts (meta x))) :else x)) ;; Private helper, NOT named read-string: an unqualified (read-string …) call @@ -48,7 +48,10 @@ (defn- read-edn [opts s] (if (or (nil? s) (cstr/blank? s)) (get opts :eof nil) - (edn->value opts (clojure.core/read-string s)))) + ;; read the RAW form (tagged/set literals stay forms) so edn->value applies + ;; every #tag through :readers/:default — read-string would build the built-in + ;; #inst/#uuid eagerly, ignoring an override and failing on a non-string form. + (edn->value opts (__read-form-raw s)))) (defn read-string "Reads one object from the string s. Returns the :eof option value (default diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index f950a99..3276043 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -3312,4 +3312,6 @@ {: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})))"} + {:suite "edn / deferred tags" :label "a :readers override wins over the built-in #inst (not eagerly built)" :expected "true" :actual "(= [:I \"x\"] (clojure.edn/read-string {:readers {(quote inst) (fn [v] [:I v])}} \"#inst \\\"x\\\"\"))"} + {:suite "edn / deferred tags" :label "a normal #inst still constructs without an override" :expected "true" :actual "(= #inst \"2020-01-01T00:00:00.000-00:00\" (clojure.edn/read-string \"#inst \\\"2020-01-01T00:00:00.000-00:00\\\"\"))"} ]