Auto-resolve ::keywords; honor clojure.edn reader opts
The reader dropped the namespace on ::kw (read ::foo as :foo), so auto-resolved keywords never matched their qualified form — code that round-trips them (spec keys, aero's :aero.core/* expansion keys) silently broke. Resolve ::name against the current ns and ::alias/name through the alias table, as Clojure does. The runtime loader reads form-by-form with the ns set after the ns form; the cross-compile reads all forms up front, so ei-emit-ns*/ei-emit-ns-records set the ns before reading. clojure.edn/read over a reader discarded its opts map — :readers/:default/:eof were ignored, so a custom :default never saw the tag. Route the reader arity through read-string so opts apply, and pass the tag to :default as a symbol (not the internal :#name keyword), matching Clojure. Seed re-minted (the ::halt transducer key in clojure.core now reads as :clojure.core/halt). Corpus gains ::-keyword rows; the unit case that asserted the old ns-dropping behavior now asserts the qualified result.
This commit is contained in:
Yogthos
parent
53b1c79d99
commit
6d56982abe
7 changed files with 31 additions and 12 deletions
|
|
@ -59,6 +59,10 @@
|
|||
;; that fails to emit) and `jolt build` (bld-emit-ns: optimize? #t, guard? #f —
|
||||
;; strict, a failing form errors the build).
|
||||
(define (ei-emit-ns* ns-name src optimize? guard?)
|
||||
;; set the ns before reading so ::kw auto-resolves against this ns (the runtime
|
||||
;; loader reads form-by-form after the ns form sets it; the cross-compile reads
|
||||
;; all forms up front, so set it here).
|
||||
(set-chez-ns! ns-name)
|
||||
(let loop ((forms (ei-read-all src)) (acc '()))
|
||||
(if (null? forms)
|
||||
(reverse acc)
|
||||
|
|
@ -92,6 +96,7 @@
|
|||
;; record whose refs are roots. A macro is prunable — its expander isn't called at
|
||||
;; runtime in an AOT build.
|
||||
(define (ei-emit-ns-records ns-name src)
|
||||
(set-chez-ns! ns-name) ; ::kw resolves against this ns (see ei-emit-ns*)
|
||||
(let loop ((forms (ei-read-all src)) (acc '()))
|
||||
(if (null? forms)
|
||||
(reverse acc)
|
||||
|
|
|
|||
|
|
@ -64,12 +64,14 @@
|
|||
;; realized? reads :jolt/type and throws on a jolt-lazyseq record.
|
||||
((jolt-lazyseq? x) (jolt-lazyseq-realized? x))
|
||||
(else (jolt-invoke overlay-realized? x))))))
|
||||
;; clojure.edn/read over a reader: the overlay edn.clj drain-reader reads
|
||||
;; :jolt/type; the native version (io.ss) drains the jhost reader instead.
|
||||
;; clojure.edn/read over a reader: drain the jhost reader, then read through the
|
||||
;; overlay read-string so the opts map (:readers/:default/:eof) is honored.
|
||||
(def-var! "clojure.edn" "read"
|
||||
(case-lambda
|
||||
((reader) (chez-edn-read reader))
|
||||
((opts reader) (chez-edn-read reader))))
|
||||
((opts reader)
|
||||
(jolt-invoke (var-deref "clojure.edn" "read-string") opts
|
||||
(if (reader-jhost? reader) (drain-reader reader) (jolt-str-render-one reader))))))
|
||||
;; line-seq: a jhost reader (io/reader result) -> drain+split; a map-reader (the
|
||||
;; overlay's :read-line-fn model, e.g. with-in-str) -> the overlay version.
|
||||
(let ((overlay-line-seq (var-deref "clojure.core" "line-seq")))
|
||||
|
|
|
|||
|
|
@ -451,11 +451,19 @@
|
|||
|
||||
;; --- keyword ----------------------------------------------------------------
|
||||
(define (rdr-read-keyword s i end) ; i points just past the leading ':'
|
||||
;; ::kw auto-resolves; drop the ns, so skip a second ':'
|
||||
(let ((i (if (and (< i end) (char=? (string-ref s i) #\:)) (+ i 1) i)))
|
||||
(let-values (((tok j) (rdr-read-token s i end)))
|
||||
(let-values (((ns name) (rdr-sym-parts tok)))
|
||||
(values (keyword ns name) j)))))
|
||||
;; ::kw is auto-resolved against the current ns: ::name -> current-ns/name,
|
||||
;; ::alias/name -> the alias's target ns / name (Clojure's reader semantics).
|
||||
(let ((auto? (and (< i end) (char=? (string-ref s i) #\:))))
|
||||
(let ((i (if auto? (+ i 1) i)))
|
||||
(let-values (((tok j) (rdr-read-token s i end)))
|
||||
(let-values (((ns name) (rdr-sym-parts tok)))
|
||||
(if auto?
|
||||
(let* ((cur (chez-current-ns))
|
||||
(rns (if (string? ns)
|
||||
(let ((a (chez-resolve-alias cur ns))) (if a a ns))
|
||||
cur)))
|
||||
(values (keyword rns name) j))
|
||||
(values (keyword ns name) j)))))))
|
||||
|
||||
;; --- the main dispatch ------------------------------------------------------
|
||||
;; Returns (values form j). form is rdr-eof at end-of-input or at an unconsumed
|
||||
|
|
|
|||
|
|
@ -543,7 +543,7 @@
|
|||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "ensure-reduced" (letrec ((ensure-reduced (lambda (x) (let fnrec1989 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "reduced?") x)) x (jolt-invoke (var-deref "clojure.core" "reduced") x)))))) ensure-reduced)))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "halt-when" (letrec ((halt-when (case-lambda ((pred) (let fnrec1990 ((pred pred)) (jolt-invoke halt-when pred jolt-nil))) ((pred retf) (let fnrec1991 ((pred pred) (retf retf)) (lambda (rf) (let fnrec1992 ((rf rf)) (case-lambda (() (let fnrec1993 () (jolt-invoke rf))) ((result) (let fnrec1994 ((result result)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "map?") result))) (if (jolt-truthy? and__13__auto) (jolt-contains? result (keyword #f "halt")) and__13__auto))) (jolt-get result (keyword #f "halt")) (jolt-invoke rf result)))) ((result input) (let fnrec1995 ((result result) (input input)) (if (jolt-truthy? (jolt-invoke pred input)) (jolt-invoke (var-deref "clojure.core" "reduced") (jolt-hash-map (keyword #f "halt") (if (jolt-truthy? retf) (jolt-invoke retf (jolt-invoke rf result) input) input))) (jolt-invoke rf result input)))))))))))) halt-when)))
|
||||
(def-var! "clojure.core" "halt-when" (letrec ((halt-when (case-lambda ((pred) (let fnrec1990 ((pred pred)) (jolt-invoke halt-when pred jolt-nil))) ((pred retf) (let fnrec1991 ((pred pred) (retf retf)) (lambda (rf) (let fnrec1992 ((rf rf)) (case-lambda (() (let fnrec1993 () (jolt-invoke rf))) ((result) (let fnrec1994 ((result result)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "map?") result))) (if (jolt-truthy? and__13__auto) (jolt-contains? result (keyword "clojure.core" "halt")) and__13__auto))) (jolt-get result (keyword "clojure.core" "halt")) (jolt-invoke rf result)))) ((result input) (let fnrec1995 ((result result) (input input)) (if (jolt-truthy? (jolt-invoke pred input)) (jolt-invoke (var-deref "clojure.core" "reduced") (jolt-hash-map (keyword "clojure.core" "halt") (if (jolt-truthy? retf) (jolt-invoke retf (jolt-invoke rf result) input) input))) (jolt-invoke rf result input)))))))))))) halt-when)))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "clojure.core" "parse-boolean" (letrec ((parse-boolean (lambda (s) (let fnrec1996 ((s s)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") s)) (if (jolt= s "true") #t (if (jolt= s "false") #f (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "parse-boolean requires a string, got: " s))))))) parse-boolean)))
|
||||
(guard (e (#t #f))
|
||||
|
|
@ -1057,7 +1057,7 @@
|
|||
(lambda (argv expr . _values) (let fnrec74 ((argv argv) (expr expr) (_values (list->cseq _values))) (let* ((c (jolt-count argv))) (let* ((_a$78 (var-deref "clojure.core" "__sqcat")) (_a$79 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "do"))) (_a$80 (let* ((_a$76 (lambda (a) (let fnrec75 ((a a)) (jolt-invoke (var-deref "clojure.template" "apply-template") argv expr a)))) (_a$77 (jolt-invoke (var-deref "clojure.core" "partition") c _values))) (jolt-map _a$76 _a$77)))) (jolt-invoke _a$78 _a$79 _a$80))))))
|
||||
(mark-macro! "clojure.template" "do-template"))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "clojure.edn" "edn->value" (letrec ((edn->value (lambda (opts x) (let fnrec81 ((opts opts) (x x)) (if (jolt= (keyword "jolt" "set") (jolt-get x (keyword "jolt" "type"))) (jolt-invoke (var-deref "clojure.core" "set") (let* ((_a$83 (lambda (v) (let fnrec82 ((v v)) (jolt-invoke edn->value opts v)))) (_a$84 (jolt-get x (keyword #f "value")))) (jolt-map _a$83 _a$84))) (if (jolt= (keyword "jolt" "tagged") (jolt-get x (keyword "jolt" "type"))) (let* ((tag (jolt-get x (keyword #f "tag"))) (v (jolt-invoke 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 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$88 (jolt-hash-map)) (_a$89 (jolt-map (lambda (e) (let fnrec85 ((e e)) (let* ((_o$86 (jolt-invoke edn->value opts (jolt-invoke (var-deref "clojure.core" "key") e))) (_o$87 (jolt-invoke edn->value opts (jolt-invoke (var-deref "clojure.core" "val") e)))) (jolt-vector _o$86 _o$87)))) x))) (jolt-into _a$88 _a$89)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") x)) (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (v) (let fnrec90 ((v v)) (jolt-invoke edn->value opts v))) x) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") x)) (jolt-map (lambda (v) (let fnrec91 ((v v)) (jolt-invoke edn->value opts v))) x) (if (jolt-truthy? (keyword #f "else")) x jolt-nil)))))))))) edn->value)))
|
||||
(def-var! "clojure.edn" "edn->value" (letrec ((edn->value (lambda (opts x) (let fnrec81 ((opts opts) (x x)) (if (jolt= (keyword "jolt" "set") (jolt-get x (keyword "jolt" "type"))) (jolt-invoke (var-deref "clojure.core" "set") (let* ((_a$83 (lambda (v) (let fnrec82 ((v v)) (jolt-invoke edn->value opts v)))) (_a$84 (jolt-get x (keyword #f "value")))) (jolt-map _a$83 _a$84))) (if (jolt= (keyword "jolt" "tagged") (jolt-get x (keyword "jolt" "type"))) (let* ((tag (jolt-get x (keyword #f "tag"))) (v (jolt-invoke 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$88 (jolt-hash-map)) (_a$89 (jolt-map (lambda (e) (let fnrec85 ((e e)) (let* ((_o$86 (jolt-invoke edn->value opts (jolt-invoke (var-deref "clojure.core" "key") e))) (_o$87 (jolt-invoke edn->value opts (jolt-invoke (var-deref "clojure.core" "val") e)))) (jolt-vector _o$86 _o$87)))) x))) (jolt-into _a$88 _a$89)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") x)) (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (v) (let fnrec90 ((v v)) (jolt-invoke edn->value opts v))) x) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") x)) (jolt-map (lambda (v) (let fnrec91 ((v v)) (jolt-invoke edn->value opts v))) x) (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 fnrec92 ((opts opts) (s s)) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") s))) (if (jolt-truthy? or__14__auto) or__14__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)))
|
||||
(guard (e (#t #f))
|
||||
|
|
|
|||
|
|
@ -27,7 +27,8 @@
|
|||
custom (get (get opts :readers) tag-sym)]
|
||||
(cond
|
||||
custom (custom v)
|
||||
(get opts :default) ((get opts :default) tag v)
|
||||
;; Clojure calls :default with the tag as a SYMBOL and the value.
|
||||
(get opts :default) ((get opts :default) tag-sym v)
|
||||
:else (__read-tagged tag v)))
|
||||
(map? x)
|
||||
(into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x))
|
||||
|
|
|
|||
|
|
@ -2645,6 +2645,9 @@
|
|||
{:suite "clojure.walk / records keep their type" :label "instance? survives a walk" :expected "true" :actual "(do (require (quote [clojure.walk :as w])) (defrecord R [a]) (instance? R (w/postwalk identity (->R 1))))"}
|
||||
{:suite "clojure.walk / records keep their type" :label "a record nested in a map keeps its type" :expected "true" :actual "(do (require (quote [clojure.walk :as w])) (defrecord R [a]) (record? (:r (w/postwalk identity {:r (->R 1)}))))"}
|
||||
{:suite "clojure.walk / records keep their type" :label "prewalk preserves record type" :expected "true" :actual "(do (require (quote [clojure.walk :as w])) (defrecord R [a]) (record? (w/prewalk identity (->R 1))))"}
|
||||
{:suite "reader / auto-resolved keywords" :label "::kw is namespace-qualified" :expected "true" :actual "(some? (namespace ::foo))"}
|
||||
{:suite "reader / auto-resolved keywords" :label "::kw keeps its name" :expected "\"foo\"" :actual "(name ::foo)"}
|
||||
{:suite "reader / auto-resolved keywords" :label "::kw resolves to the current ns" :expected "true" :actual "(= ::a ::a)"}
|
||||
{:suite "conformance / CRITICAL: lazy sequences" :label "self-ref lazy-cat fib" :expected "[0 1 1 2 3 5 8 13 21 34]" :actual "(do (def fib-seq (lazy-cat [0 1] (map + (rest fib-seq) fib-seq))) (take 10 fib-seq))"}
|
||||
{:suite "conformance / CRITICAL: multi-collection map" :label "map two colls" :expected "[11 22 33]" :actual "(map + [1 2 3] [10 20 30])"}
|
||||
{:suite "conformance / CRITICAL: multi-collection map" :label "map three colls" :expected "[12 24 36]" :actual "(map + [1 2 3] [10 20 30] [1 2 3])"}
|
||||
|
|
|
|||
|
|
@ -303,7 +303,7 @@
|
|||
{:suite "reader" :expr "(integer? (read-string \"7\"))" :expected "true"}
|
||||
{:suite "reader" :expr "(= :foo (read-string \":foo\"))" :expected "true"}
|
||||
{:suite "reader" :expr "(= :a/b (read-string \":a/b\"))" :expected "true"}
|
||||
{:suite "reader" :expr "(= :foo (read-string \"::foo\"))" :expected "true"}
|
||||
{:suite "reader" :expr "(= [true \"foo\"] [(some? (namespace (read-string \"::foo\"))) (name (read-string \"::foo\"))])" :expected "true"}
|
||||
{:suite "reader" :expr "(= (quote sym) (read-string \"sym\"))" :expected "true"}
|
||||
{:suite "reader" :expr "(= (quote ns/sym) (read-string \"ns/sym\"))" :expected "true"}
|
||||
{:suite "reader" :expr "(nil? (read-string \"nil\"))" :expected "true"}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue