Reader attaches collection metadata to data, not a with-meta form
The reader lowered ^meta on a vector/map/set literal to a runtime (with-meta form meta) list, so read-string/edn of data with metadata returned the form and lost the metadata. Attach it to the value instead, as Clojure does; the analyzer re-emits (with-meta coll meta) for a meta-carrying collection literal in code, so a literal still carries its metadata at runtime and ^Type/^long arglist hints (consumed by analyze-arity directly) are unaffected. Also: pr honors *print-meta*, and clojure.walk/clojure.edn re-attach metadata to the collections they rebuild (matches Clojure; a metadata-driven config lib like aero relies on it).
This commit is contained in:
parent
091d2c4b62
commit
473d1002b7
8 changed files with 763 additions and 716 deletions
|
|
@ -86,6 +86,10 @@
|
||||||
(define (hc-sym-meta x)
|
(define (hc-sym-meta x)
|
||||||
(let ((m (symbol-t-meta x)))
|
(let ((m (symbol-t-meta x)))
|
||||||
(if (and m (not (jolt-nil? m)) (not (null? m))) m jolt-nil)))
|
(if (and m (not (jolt-nil? m)) (not (null? m))) m jolt-nil)))
|
||||||
|
;; Metadata the reader attached to a collection literal (vec/map/set/list), or
|
||||||
|
;; jolt-nil. The analyzer re-emits a runtime (with-meta ..) for a meta-carrying
|
||||||
|
;; vector/map/set so the value keeps its metadata.
|
||||||
|
(define (hc-coll-meta x) (jolt-meta x))
|
||||||
|
|
||||||
;; list items -> jolt vector (pvec); the analyzer mapv's over the result.
|
;; list items -> jolt vector (pvec); the analyzer mapv's over the result.
|
||||||
(define (hc-elements x)
|
(define (hc-elements x)
|
||||||
|
|
@ -327,6 +331,7 @@
|
||||||
(def-var! "jolt.host" "form-sym-name" hc-sym-name)
|
(def-var! "jolt.host" "form-sym-name" hc-sym-name)
|
||||||
(def-var! "jolt.host" "form-sym-ns" hc-sym-ns)
|
(def-var! "jolt.host" "form-sym-ns" hc-sym-ns)
|
||||||
(def-var! "jolt.host" "form-sym-meta" hc-sym-meta)
|
(def-var! "jolt.host" "form-sym-meta" hc-sym-meta)
|
||||||
|
(def-var! "jolt.host" "form-coll-meta" hc-coll-meta)
|
||||||
(def-var! "jolt.host" "form-list?" hc-list?)
|
(def-var! "jolt.host" "form-list?" hc-list?)
|
||||||
(def-var! "jolt.host" "form-vec?" hc-vec?)
|
(def-var! "jolt.host" "form-vec?" hc-vec?)
|
||||||
(def-var! "jolt.host" "form-map?" hc-map?)
|
(def-var! "jolt.host" "form-map?" hc-map?)
|
||||||
|
|
|
||||||
|
|
@ -67,12 +67,31 @@
|
||||||
(if (jolt-nil? s) (reverse acc)
|
(if (jolt-nil? s) (reverse acc)
|
||||||
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-readable (seq-first s)) acc))))) ")"))
|
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-readable (seq-first s)) acc))))) ")"))
|
||||||
(else (jolt-pr-str x))))
|
(else (jolt-pr-str x))))
|
||||||
(define (jolt-pr-readable x)
|
(define (jolt-pr-readable-dispatch x)
|
||||||
(let loop ((as jolt-pr-readable-arms))
|
(let loop ((as jolt-pr-readable-arms))
|
||||||
(cond ((null? as) (jolt-pr-readable-base x))
|
(cond ((null? as) (jolt-pr-readable-base x))
|
||||||
(((caar as) x) ((cdar as) x))
|
(((caar as) x) ((cdar as) x))
|
||||||
(else (loop (cdr as))))))
|
(else (loop (cdr as))))))
|
||||||
|
|
||||||
|
;; *print-meta* support. The var is def'd after this file loads, so capture its
|
||||||
|
;; cell lazily; jolt-var-get (patched by dyn-binding.ss) honors a `binding`.
|
||||||
|
(define pr-meta-cell #f)
|
||||||
|
(define (pr-print-meta?)
|
||||||
|
(unless pr-meta-cell (set! pr-meta-cell (jolt-var "clojure.core" "*print-meta*")))
|
||||||
|
(jolt-truthy? (jolt-var-get pr-meta-cell)))
|
||||||
|
;; The metadata to print before x, or jolt-nil. A var prints as #'ns/name (its
|
||||||
|
;; {:ns :name} is derived, not user metadata) and a procedure is opaque — skip both.
|
||||||
|
(define (pr-user-meta x)
|
||||||
|
(if (or (var-cell? x) (procedure? x)) jolt-nil (jolt-meta x)))
|
||||||
|
|
||||||
|
(define (jolt-pr-readable x)
|
||||||
|
(if (pr-print-meta?)
|
||||||
|
(let ((m (pr-user-meta x)))
|
||||||
|
(if (jolt-nil? m)
|
||||||
|
(jolt-pr-readable-dispatch x)
|
||||||
|
(string-append "^" (jolt-pr-readable-dispatch m) " " (jolt-pr-readable-dispatch x))))
|
||||||
|
(jolt-pr-readable-dispatch x)))
|
||||||
|
|
||||||
;; __pr-str1: render ONE value readably (the overlay's pr-str joins these).
|
;; __pr-str1: render ONE value readably (the overlay's pr-str joins these).
|
||||||
(define (jolt-pr-str1 x) (jolt-pr-readable x))
|
(define (jolt-pr-str1 x) (jolt-pr-readable x))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -290,20 +290,22 @@
|
||||||
((symbol-t? target)
|
((symbol-t? target)
|
||||||
(make-symbol-t (symbol-t-ns target) (symbol-t-name target)
|
(make-symbol-t (symbol-t-ns target) (symbol-t-name target)
|
||||||
(rdr-merge-meta (symbol-t-meta target) meta)))
|
(rdr-merge-meta (symbol-t-meta target) meta)))
|
||||||
;; A LIST form is code: ^Type (expr) is a compile-time hint on the FORM, not a
|
|
||||||
;; runtime operation. Attach the metadata to the form itself (so a quoted list
|
|
||||||
;; keeps it and the analyzer can read :tag) — never lower to a runtime
|
|
||||||
;; (with-meta (expr) meta), which would mis-apply the hint to the call's RESULT
|
|
||||||
;; and throw when that result is a string/number (e.g. ^String (to-str x)).
|
|
||||||
;; Matches Clojure: a tag hint on an evaluated form is discarded at runtime.
|
|
||||||
((cseq? target) (jolt-with-meta target meta))
|
|
||||||
((empty-list-t? target) target)
|
((empty-list-t? target) target)
|
||||||
;; A vector/map/set LITERAL: Clojure attaches the metadata to the runtime value
|
;; Lists/vectors/maps/sets attach metadata to the value itself, as Clojure's
|
||||||
;; ((meta ^{:tag :int} [1 2]) / ^:foo {}), so lower to a runtime (with-meta form
|
;; reader does. Reading DATA (read-string, edn) then preserves it. A list form
|
||||||
;; meta). Use the BARE `with-meta` symbol (ns #f) — the fn/defn macros unwrap a
|
;; is code: ^Type (expr) is a compile-time hint on the FORM, read off the form
|
||||||
;; (with-meta <arglist-vec> _) return-hint by matching the unqualified head, so a
|
;; for :tag and discarded at runtime (a hint on an evaluated form is dropped).
|
||||||
;; qualified clojure.core/with-meta would slip past them (^bytes [b]).
|
;; A vector/map/set LITERAL keeps it as a runtime value: the analyzer re-emits a
|
||||||
(else (jolt-list (jolt-symbol #f "with-meta") target meta))))
|
;; (with-meta form meta) for a meta-carrying collection literal in code, so
|
||||||
|
;; (meta ^{:tag :int} [1 2]) / ^:foo {} still works.
|
||||||
|
(else
|
||||||
|
(let ((c (jolt-with-meta target meta)))
|
||||||
|
;; jolt-with-meta copies a pmap, giving it a fresh identity the rdr-map-order
|
||||||
|
;; side-table (source key order for left-to-right map-literal eval) loses —
|
||||||
|
;; carry the order entry over to the copy.
|
||||||
|
(let ((order (and (pmap? target) (hashtable-ref rdr-map-order target #f))))
|
||||||
|
(when order (hashtable-set! rdr-map-order c order)))
|
||||||
|
c))))
|
||||||
|
|
||||||
;; --- # dispatch -------------------------------------------------------------
|
;; --- # dispatch -------------------------------------------------------------
|
||||||
;; #(...) anonymous fn shorthand: % -> p1, %N -> pN, %& -> rest. The
|
;; #(...) anonymous fn shorthand: % -> p1, %N -> pN, %& -> rest. The
|
||||||
|
|
|
||||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
|
@ -26,7 +26,7 @@
|
||||||
form-bigdec? form-bigdec-source
|
form-bigdec? form-bigdec-source
|
||||||
form-ns-value? form-ns-value-name
|
form-ns-value? form-ns-value-name
|
||||||
form-macro? form-expand-1 resolve-global
|
form-macro? form-expand-1 resolve-global
|
||||||
form-sym-meta host-intern! form-syntax-quote-lower
|
form-sym-meta form-coll-meta host-intern! form-syntax-quote-lower
|
||||||
record-type? record-ctor-key form-position late-bind?
|
record-type? record-ctor-key form-position late-bind?
|
||||||
resolve-class-hint]]))
|
resolve-class-hint]]))
|
||||||
|
|
||||||
|
|
@ -590,17 +590,31 @@
|
||||||
p (form-position form)]
|
p (form-position form)]
|
||||||
(if p (assoc n :pos p) n)))))))
|
(if p (assoc n :pos p) n)))))))
|
||||||
|
|
||||||
|
;; A vector/map/set literal carrying reader metadata (^:foo {…}, ^{:tag :int} [1])
|
||||||
|
;; keeps it as a runtime value: wrap the collection node in (with-meta coll meta).
|
||||||
|
;; The metadata is itself a form (its values may be expressions, ^{:a (f)}), so
|
||||||
|
;; analyze it. nil meta passes the node through. Arglist vectors never reach here —
|
||||||
|
;; analyze-arity reads their items directly — so a ^Type [args] hint is not wrapped.
|
||||||
|
(defn- with-coll-meta [ctx form env node]
|
||||||
|
(let [m (form-coll-meta form)]
|
||||||
|
(if (nil? m)
|
||||||
|
node
|
||||||
|
(invoke (var-ref "clojure.core" "with-meta") [node (analyze ctx m env)]))))
|
||||||
|
|
||||||
(defn analyze
|
(defn analyze
|
||||||
([ctx form] (analyze ctx form (empty-env)))
|
([ctx form] (analyze ctx form (empty-env)))
|
||||||
([ctx form env]
|
([ctx form env]
|
||||||
(cond
|
(cond
|
||||||
(form-literal? form) (const form)
|
(form-literal? form) (const form)
|
||||||
(form-sym? form) (analyze-symbol ctx form env)
|
(form-sym? form) (analyze-symbol ctx form env)
|
||||||
(form-vec? form) (vector-node (mapv #(analyze ctx % env) (form-vec-items form)))
|
(form-vec? form) (with-coll-meta ctx form env
|
||||||
(form-map? form) (map-node (mapv (fn [p] [(analyze ctx (first p) env)
|
(vector-node (mapv #(analyze ctx % env) (form-vec-items form))))
|
||||||
|
(form-map? form) (with-coll-meta ctx form env
|
||||||
|
(map-node (mapv (fn [p] [(analyze ctx (first p) env)
|
||||||
(analyze ctx (second p) env)])
|
(analyze ctx (second p) env)])
|
||||||
(form-map-pairs form)))
|
(form-map-pairs form))))
|
||||||
(form-set? form) (set-node (mapv #(analyze ctx % env) (form-set-items form)))
|
(form-set? form) (with-coll-meta ctx form env
|
||||||
|
(set-node (mapv #(analyze ctx % env) (form-set-items form))))
|
||||||
(form-list? form) (analyze-list ctx form env)
|
(form-list? form) (analyze-list ctx form env)
|
||||||
;; regex literal #"…" -> a :regex IR node (leaf). The Chez back end emits a
|
;; regex literal #"…" -> a :regex IR node (leaf). The Chez back end emits a
|
||||||
;; jolt-regex value over the vendored irregex.
|
;; jolt-regex value over the vendored irregex.
|
||||||
|
|
|
||||||
|
|
@ -8,12 +8,15 @@
|
||||||
;; The reader yields set literals as a FORM ({:jolt/type :jolt/set :value [...]})
|
;; The reader yields set literals as a FORM ({:jolt/type :jolt/set :value [...]})
|
||||||
;; rather than a constructed set, so build the actual values, recursing into
|
;; rather than a constructed set, so build the actual values, recursing into
|
||||||
;; maps/vectors/lists. (Lists stay lists — EDN never evaluates them as code.)
|
;; maps/vectors/lists. (Lists stay lists — EDN never evaluates them as code.)
|
||||||
|
;; Re-attach the source value's metadata to each rebuilt collection — read-string
|
||||||
|
;; preserves reader metadata (^:ref […]) but this rebuild would otherwise drop it,
|
||||||
|
;; which a metadata-driven config lib (aero/integrant) relies on.
|
||||||
(defn- edn->value [opts x]
|
(defn- edn->value [opts x]
|
||||||
(cond
|
(cond
|
||||||
;; Reader FORMS are detected by :jolt/type tag, never by map? — strict map?
|
;; Reader FORMS are detected by :jolt/type tag, never by map? — strict map?
|
||||||
;; (correctly) excludes tagged structs, so the old (and (map? x) ...) guard
|
;; (correctly) excludes tagged structs, so the old (and (map? x) ...) guard
|
||||||
;; would skip them.
|
;; would skip them.
|
||||||
(= :jolt/set (get x :jolt/type)) (set (map (fn [v] (edn->value opts v)) (get x :value)))
|
(= :jolt/set (get x :jolt/type)) (with-meta (set (map (fn [v] (edn->value opts v)) (get x :value))) (meta x))
|
||||||
;; Tagged elements: a reader from the :readers opt wins, then the built-in
|
;; Tagged elements: a reader from the :readers opt wins, then the built-in
|
||||||
;; data readers (#uuid/#inst + registered); an unknown tag falls to the
|
;; data readers (#uuid/#inst + registered); an unknown tag falls to the
|
||||||
;; :default opt fn (called with tag and value, as in Clojure) or throws.
|
;; :default opt fn (called with tag and value, as in Clojure) or throws.
|
||||||
|
|
@ -31,9 +34,9 @@
|
||||||
(get opts :default) ((get opts :default) tag-sym v)
|
(get opts :default) ((get opts :default) tag-sym v)
|
||||||
:else (__read-tagged tag v)))
|
:else (__read-tagged tag v)))
|
||||||
(map? x)
|
(map? x)
|
||||||
(into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x))
|
(with-meta (into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x)) (meta x))
|
||||||
(vector? x) (mapv (fn [v] (edn->value opts v)) x)
|
(vector? x) (with-meta (mapv (fn [v] (edn->value opts v)) x) (meta x))
|
||||||
(seq? x) (map (fn [v] (edn->value opts v)) x)
|
(seq? x) (with-meta (map (fn [v] (edn->value opts v)) x) (meta x))
|
||||||
:else x))
|
:else x))
|
||||||
|
|
||||||
;; Private helper, NOT named read-string: an unqualified (read-string …) call
|
;; Private helper, NOT named read-string: an unqualified (read-string …) call
|
||||||
|
|
|
||||||
|
|
@ -5,19 +5,21 @@
|
||||||
[inner outer form]
|
[inner outer form]
|
||||||
(cond
|
(cond
|
||||||
; vectors/maps first so seq? can't swallow them (a vector is not seq? on
|
; vectors/maps first so seq? can't swallow them (a vector is not seq? on
|
||||||
; jolt, but keep the concrete branches authoritative)
|
; jolt, but keep the concrete branches authoritative). Re-attach the form's
|
||||||
(vector? form) (outer (vec (map inner form)))
|
; metadata to the rebuilt collection, as Clojure does — a metadata-driven walk
|
||||||
|
; (aero/spec) needs ^:ref and friends to survive the rebuild.
|
||||||
|
(vector? form) (outer (with-meta (vec (map inner form)) (meta form)))
|
||||||
; a record is also map?, but (empty record) yields a plain map — rebuild by
|
; a record is also map?, but (empty record) yields a plain map — rebuild by
|
||||||
; conj-ing the walked entries back onto the original so the record TYPE
|
; conj-ing the walked entries back onto the original so the record TYPE
|
||||||
; survives. Type-dispatched walks depend on it (e.g. integrant resolves
|
; survives. Type-dispatched walks depend on it (e.g. integrant resolves
|
||||||
; #ig/ref by detecting its Ref record while postwalking the config).
|
; #ig/ref by detecting its Ref record while postwalking the config).
|
||||||
(record? form) (outer (reduce (fn [r x] (conj r (inner x))) form form))
|
(record? form) (outer (reduce (fn [r x] (conj r (inner x))) form form))
|
||||||
(map? form) (outer (into (empty form) (map inner form)))
|
(map? form) (outer (with-meta (into (empty form) (map inner form)) (meta form)))
|
||||||
; lists rebuild as lists, other seqs (incl. macro/template output: cons/
|
; lists rebuild as lists, other seqs (incl. macro/template output: cons/
|
||||||
; concat/lazy-seq) walk too — without this, postwalk-replace silently no-op'd
|
; concat/lazy-seq) walk too — without this, postwalk-replace silently no-op'd
|
||||||
; a quoted list, breaking clojure.template/apply-template
|
; a quoted list, breaking clojure.template/apply-template
|
||||||
(list? form) (outer (apply list (map inner form)))
|
(list? form) (outer (with-meta (apply list (map inner form)) (meta form)))
|
||||||
(seq? form) (outer (map inner form))
|
(seq? form) (outer (with-meta (map inner form) (meta form)))
|
||||||
:else (outer form)))
|
:else (outer form)))
|
||||||
|
|
||||||
(defn postwalk
|
(defn postwalk
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue