reader: #:ns{...} namespaced map literals
jolt's reader had no case for #: , so #:event{:type :search} died as an unknown
tagged literal. Now #:ns{...} qualifies each bare keyword/symbol key with ns
(:_/x stays unqualified, an already-qualified key is left alone); #::{...} uses
the current ns and #::alias{...} resolves the alias — matching Clojure.
clojure.spec.alpha's multi-spec test (which builds #:event{...} event maps) now
passes.
make test green (+1 corpus row, 0 new divergences), shakesmoke byte-identical.
One re-mint (the reader is a seed source).
This commit is contained in:
parent
0becba7f93
commit
219d1e52c9
2 changed files with 40 additions and 0 deletions
|
|
@ -495,6 +495,43 @@
|
|||
(string-append "Unreadable constructor form: #" tok)
|
||||
(empty-pmap)))))))
|
||||
|
||||
;; #:ns{…} namespaced map literal: a bare keyword/symbol key gets `ns`, a `:_/x`
|
||||
;; key is un-namespaced, an already-qualified key stays. #::{…} uses the current
|
||||
;; ns; #::alias{…} resolves the alias.
|
||||
(define (rdr-nsmap-key mapns k)
|
||||
(cond
|
||||
((keyword? k)
|
||||
(let ((kns (keyword-t-ns k)) (kn (keyword-t-name k)))
|
||||
(cond ((and (string? kns) (string=? kns "_")) (keyword #f kn))
|
||||
(kns k)
|
||||
(else (keyword mapns kn)))))
|
||||
((symbol-t? k)
|
||||
(let ((kns (symbol-t-ns k)) (kn (symbol-t-name k)))
|
||||
(cond ((and (string? kns) (string=? kns "_")) (jolt-symbol #f kn))
|
||||
(kns k)
|
||||
(else (jolt-symbol mapns kn)))))
|
||||
(else k)))
|
||||
(define (rdr-nsmap-kvs mapns es)
|
||||
(cond ((null? es) '())
|
||||
((null? (cdr es)) es)
|
||||
(else (cons (rdr-nsmap-key mapns (car es))
|
||||
(cons (cadr es) (rdr-nsmap-kvs mapns (cddr es)))))))
|
||||
(define (rdr-read-ns-map s i end) ; i points just past "#:"
|
||||
(let* ((auto? (and (< i end) (char=? (string-ref s i) #\:)))
|
||||
(i2 (if auto? (+ i 1) i)))
|
||||
(let loop ((j i2))
|
||||
(cond
|
||||
((>= j end) (jolt-throw (jolt-ex-info "EOF in namespaced map literal" (empty-pmap))))
|
||||
((char=? (string-ref s j) #\{)
|
||||
(let* ((nstok (substring s i2 j))
|
||||
(mapns (if auto?
|
||||
(if (string=? nstok "") (chez-current-ns)
|
||||
(let ((a (chez-resolve-alias (chez-current-ns) nstok))) (if a a nstok)))
|
||||
nstok)))
|
||||
(let-values (((es k) (rdr-read-seq s (+ j 1) end #\})))
|
||||
(values (rdr-make-map (rdr-nsmap-kvs mapns es)) k))))
|
||||
(else (loop (+ j 1)))))))
|
||||
|
||||
(define (rdr-read-dispatch s i end) ; i points just past the '#'
|
||||
(when (>= i end) (jolt-throw (jolt-ex-info "EOF after #" (empty-pmap))))
|
||||
(let ((c (string-ref s i)))
|
||||
|
|
@ -533,6 +570,8 @@
|
|||
j)))
|
||||
((char=? c #\?) ; #?(...) / #?@(...) reader conditional
|
||||
(rdr-read-reader-cond s (+ i 1) end))
|
||||
((char=? c #\:) ; #:ns{...} namespaced map literal
|
||||
(rdr-read-ns-map s (+ i 1) end))
|
||||
(else ; #tag form -> tagged {:tag :#tag :form ...}
|
||||
(let-values (((tok j) (rdr-read-token s i end)))
|
||||
(let-values (((form k) (rdr-read-form s j end)))
|
||||
|
|
|
|||
|
|
@ -3389,4 +3389,5 @@
|
|||
{:suite "host-interop / Compiler/demunge" :label "demunge reverses name munging" :expected "\"a/b?\"" :actual "(clojure.lang.Compiler/demunge \"a$b_QMARK_\")"}
|
||||
{:suite "host-interop / a fn reports its munged class" :label "(class a-def'd-fn) is ns$munged-name, with the IFn hierarchy as ancestors" :expected "[\"clojure.core$odd_QMARK_\" true]" :actual "[(.getName (class odd?)) (boolean (some #{java.lang.Runnable} (ancestors (class odd?))))]"}
|
||||
{:suite "host-interop / MultiFn methods" :label ".getMethod / .dispatchFn on a multimethod" :expected "[true true true]" :actual "(do (defmulti mmc identity) (defmethod mmc :a [_] 1) [(some? (.getMethod mmc :a)) (nil? (.getMethod mmc :z)) (ifn? (.dispatchFn mmc))])"}
|
||||
{:suite "reader / namespaced map literal" :label "#:ns{...} qualifies bare keys; :_/x stays unqualified" :expected "[:search 2 nil]" :actual "[(:event/type #:event{:type :search :id 5}) (count #:x{:a 1 :b 2}) (:k #:_{:k 9})]"}
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue