diff --git a/host/chez/emit-image.ss b/host/chez/emit-image.ss index 7bc6ea0..adb6329 100644 --- a/host/chez/emit-image.ss +++ b/host/chez/emit-image.ss @@ -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) diff --git a/host/chez/post-prelude.ss b/host/chez/post-prelude.ss index 7a47e03..9a6ee38 100644 --- a/host/chez/post-prelude.ss +++ b/host/chez/post-prelude.ss @@ -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"))) diff --git a/host/chez/reader.ss b/host/chez/reader.ss index 2e0966c..eadd4c9 100644 --- a/host/chez/reader.ss +++ b/host/chez/reader.ss @@ -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 diff --git a/host/chez/seed/prelude.ss b/host/chez/seed/prelude.ss index 8441f3d..50b3168 100644 --- a/host/chez/seed/prelude.ss +++ b/host/chez/seed/prelude.ss @@ -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)) diff --git a/stdlib/clojure/edn.clj b/stdlib/clojure/edn.clj index b67268e..66c4f9c 100644 --- a/stdlib/clojure/edn.clj +++ b/stdlib/clojure/edn.clj @@ -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)) diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index 672ca14..f67b72f 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -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])"} diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 53cb5bb..a8b49fa 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -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"}