read-string constructs sets; format %x lowercase; extend/extends? on nil

read-string/read now return real sets for #{...} literals (top-level and
nested) instead of the reader's {:jolt/type :jolt/set} form — the data
seams convert set forms to sets (recursing, preserving metadata and source
map-key order); clojure.edn already did this. The compiler keeps reading
via the raw reader, so set literals in code stay forms the analyzer lowers.

format %x now emits lowercase hex (Chez number->string is uppercase); %X
unchanged.

extend and extends? handle a nil target type (host tag "nil"), matching
extend-type — protocols can be extended to nil via the function form, not
just the macro.

Found porting transit/data.json and shaking out aero.
This commit is contained in:
Yogthos 2026-06-24 14:03:47 -04:00
parent e74b940db5
commit c26fd175f2
8 changed files with 604 additions and 534 deletions

View file

@ -15,7 +15,10 @@
;; inference when the unit opted into direct-linking (jolt build --opt). Off that ;; inference when the unit opted into direct-linking (jolt build --opt). Off that
;; path it is a pure const-fold. Loaded from the compiler image (jolt.passes). ;; path it is a pure const-fold. Loaded from the compiler image (jolt.passes).
(define jolt-ce-run-passes (var-deref "jolt.passes" "run-passes")) (define jolt-ce-run-passes (var-deref "jolt.passes" "run-passes"))
(define jolt-ce-read (var-deref "clojure.core" "read-string")) ;; The compiler reads source as FORMS (set literals stay {:jolt/type :jolt/set},
;; which the analyzer lowers) — the raw reader, not clojure.core/read-string,
;; whose data conversion would turn those into real sets.
(define jolt-ce-read jolt-read-form-raw)
;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.* ;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.*
;; ref must lower to var-deref (resolved from the prelude), not trip the emitter's ;; ref must lower to var-deref (resolved from the prelude), not trip the emitter's

View file

@ -43,7 +43,7 @@
((#\d) (number->string (->long a))) ((#\d) (number->string (->long a)))
((#\s) (jolt-str-render-one a)) ((#\s) (jolt-str-render-one a))
((#\f) (fmt-float a (or prec 6))) ((#\f) (fmt-float a (or prec 6)))
((#\x) (number->string (->long a) 16)) ((#\x) (string-downcase (number->string (->long a) 16)))
((#\X) (string-upcase (number->string (->long a) 16))) ((#\X) (string-upcase (number->string (->long a) 16)))
((#\o) (number->string (->long a) 8)) ((#\o) (number->string (->long a) 8))
((#\b) (if (jolt-truthy? a) "true" "false")) ((#\b) (if (jolt-truthy? a) "true" "false"))

View file

@ -526,12 +526,62 @@
(jolt-throw (jolt-ex-info "EOF while reading reader macro" (empty-pmap)))) (jolt-throw (jolt-ex-info "EOF while reading reader macro" (empty-pmap))))
(values (jolt-list head form) j))) (values (jolt-list head form) j)))
;; --- form -> data -----------------------------------------------------------
;; read-string/read return DATA, so set literal FORMS ({:jolt/type :jolt/set
;; :value [...]}) become real sets, recursing through maps/vectors/lists. The
;; COMPILER reads via rdr-read-form and keeps the set FORM (the analyzer lowers
;; it), so this conversion runs only on the data seams. Structural sharing keeps
;; identity (and the rdr-map-order entry + metadata) for any branch with no set.
(define (rdr-set-form? x)
(and (pmap? x) (eq? (jolt-get x rdr-kw-jolt-type) rdr-kw-jolt-set)
(not (jolt-nil? (jolt-get x rdr-kw-value)))))
(define (rdr-conv-each xs) ; (values converted-list changed?)
(let loop ((xs xs) (acc '()) (changed #f))
(if (null? xs)
(values (reverse acc) changed)
(let ((c (rdr-form->data (car xs))))
(loop (cdr xs) (cons c acc) (or changed (not (eq? c (car xs)))))))))
(define (rdr-carry-meta src dst)
(let ((m (jolt-meta src))) (if (jolt-nil? m) dst (jolt-with-meta dst m))))
(define (rdr-form->data x)
(cond
((rdr-set-form? x)
(let ((items (jolt-get x rdr-kw-value)))
(rdr-carry-meta x
(let loop ((i 0) (s empty-pset))
(if (fx>=? i (pvec-count items)) s
(loop (fx+ i 1) (pset-conj s (rdr-form->data (pvec-nth-d items i jolt-nil)))))))))
((pvec? x)
(let-values (((items changed) (rdr-conv-each (vector->list (pvec-v x)))))
(if changed (rdr-carry-meta x (apply jolt-vector items)) x)))
((pmap? x)
(let ((order (hashtable-ref rdr-map-order x #f)))
(if order
(let-values (((kvs changed) (rdr-conv-each order)))
(if changed
(let ((m (rdr-make-map kvs))) (rdr-carry-meta x m))
x))
(let-values (((kvs changed)
(rdr-conv-each (pmap-fold x (lambda (k v a) (cons k (cons v a))) '()))))
(if changed (rdr-carry-meta x (apply jolt-hash-map kvs)) x)))))
((cseq? x)
(let-values (((items changed) (rdr-conv-each (seq->list x))))
(if changed (rdr-carry-meta x (apply jolt-list items)) x)))
(else x)))
;; --- the two host seams ----------------------------------------------------- ;; --- the two host seams -----------------------------------------------------
;; clojure.core/read-string: first form, or nil for blank / comment-only input ;; clojure.core/read-string: first form, or nil for blank / comment-only input
;; (parse-string wart, matched deliberately). ;; (parse-string wart, matched deliberately). jolt-read-form-raw keeps set FORMS
(define (jolt-read-string s) ;; for the compiler spine (compile-eval); the data seam converts them to sets.
(define (jolt-read-form-raw s)
(let-values (((form j) (rdr-read-form s 0 (string-length s)))) (let-values (((form j) (rdr-read-form s 0 (string-length s))))
(if (rdr-eof? form) jolt-nil form))) (if (rdr-eof? form) jolt-nil form)))
(define (jolt-read-string s)
(let ((form (jolt-read-form-raw s)))
(if (jolt-nil? form) form (rdr-form->data form))))
;; __parse-next: [form rest-of-string] or nil when only whitespace/comments left. ;; __parse-next: [form rest-of-string] or nil when only whitespace/comments left.
(define (jolt-parse-next s) (define (jolt-parse-next s)
@ -539,7 +589,7 @@
(let-values (((form j) (rdr-read-form s 0 end))) (let-values (((form j) (rdr-read-form s 0 end)))
(if (rdr-eof? form) (if (rdr-eof? form)
jolt-nil jolt-nil
(jolt-vector form (substring s j end)))))) (jolt-vector (rdr-form->data form) (substring s j end))))))
;; __read-tagged: apply a built-in data reader to an already-read form. The tag ;; __read-tagged: apply a built-in data reader to an already-read form. The tag
;; is the :#name keyword the reader produced; #uuid/#inst reuse the inst-time ctors. ;; is the :#name keyword the reader produced; #uuid/#inst reuse the inst-time ctors.

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View file

@ -383,7 +383,7 @@
;; extend-type). Tags are canonical host names or ns-qualified record names, ;; extend-type). Tags are canonical host names or ns-qualified record names,
;; so a bare record name also matches its "ns.Name" tag. ;; so a bare record name also matches its "ns.Name" tag.
(defn extends? [protocol atype] (defn extends? [protocol atype]
(let [want (name atype) (let [want (if (nil? atype) "nil" (name atype))
dotted (str "." want) dotted (str "." want)
dlen (count dotted)] dlen (count dotted)]
(boolean (some (fn [t] (boolean (some (fn [t]
@ -397,14 +397,16 @@
;; pairs, methods registered under the type's (canonicalized) name — so ;; pairs, methods registered under the type's (canonicalized) name — so
;; (extend 'String P {:m (fn [x] ...)}) dispatches exactly like extend-type. ;; (extend 'String P {:m (fn [x] ...)}) dispatches exactly like extend-type.
(defn extend [atype & proto+mmaps] (defn extend [atype & proto+mmaps]
;; nil extends on nil values; its host tag is the string "nil" (as extend-type).
(let [tname (if (nil? atype) "nil" (name atype))]
(loop [s (seq proto+mmaps)] (loop [s (seq proto+mmaps)]
(when s (when s
(let [proto (first s) (let [proto (first s)
mmap (second s) mmap (second s)
pname (name (get proto :name))] pname (name (get proto :name))]
(doseq [[k f] mmap] (doseq [[k f] mmap]
(register-method (name atype) pname (name k) f))) (register-method tname pname (name k) f)))
(recur (nnext s))))) (recur (nnext s))))))
(defmacro extend-type [tsym & body] (defmacro extend-type [tsym & body]
;; register-method is a fn (clojure.core); pass type/protocol/method NAMES as ;; register-method is a fn (clojure.core); pass type/protocol/method NAMES as

View file

@ -2953,4 +2953,19 @@
{:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "syntax-quote resolves alias" :expected "\"HI\"" :actual "(do (ns sq.lib (:require [clojure.string :as s])) (defmacro up [x] `(s/upper-case ~x)) (in-ns (quote user)) (sq.lib/up \"hi\"))"} {:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "syntax-quote resolves alias" :expected "\"HI\"" :actual "(do (ns sq.lib (:require [clojure.string :as s])) (defmacro up [x] `(s/upper-case ~x)) (in-ns (quote user)) (sq.lib/up \"hi\"))"}
{:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "ns name with ^{:map} meta" :expected "5" :actual "(do (ns ^{:author \"a\" :doc \"d\"} nm.meta) (def q 5) (in-ns (quote user)) nm.meta/q)"} {:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "ns name with ^{:map} meta" :expected "5" :actual "(do (ns ^{:author \"a\" :doc \"d\"} nm.meta) (def q 5) (in-ns (quote user)) nm.meta/q)"}
{:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "unquote *ns* in template" :expected "true" :actual "(do (defmacro cur-ns [] `(str ~*ns*)) (string? (cur-ns)))"} {:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "unquote *ns* in template" :expected "true" :actual "(do (defmacro cur-ns [] `(str ~*ns*)) (string? (cur-ns)))"}
{:suite "reader / read-string constructs sets" :label "top-level set" :expected "true" :actual "(set? (read-string \"#{:a :b}\"))"}
{:suite "reader / read-string constructs sets" :label "set value equals" :expected "true" :actual "(= #{1 2} (read-string \"#{1 2}\"))"}
{:suite "reader / read-string constructs sets" :label "set nested in map" :expected "true" :actual "(set? (:k (read-string \"{:k #{:a :b}}\")))"}
{:suite "reader / read-string constructs sets" :label "set nested in vector" :expected "true" :actual "(set? (first (read-string \"[#{:a}]\")))"}
{:suite "reader / read-string constructs sets" :label "set nested in list" :expected "true" :actual "(set? (first (read-string \"(#{:a})\")))"}
{:suite "reader / read-string constructs sets" :label "set keeps reader metadata" :expected "true" :actual "(:s (meta (read-string \"^:s #{1 2}\")))"}
{:suite "reader / read-string constructs sets" :label "set of sets" :expected "true" :actual "(every? set? (read-string \"#{#{1} #{2}}\"))"}
{:suite "io / str & format" :label "format %x lowercase" :expected "\"ff\"" :actual "(format \"%x\" 255)"}
{:suite "io / str & format" :label "format %04x zero-pad lower" :expected "\"00ff\"" :actual "(format \"%04x\" 255)"}
{:suite "io / str & format" :label "format %X uppercase" :expected "\"00FF\"" :actual "(format \"%04X\" 255)"}
{:suite "io / str & format" :label "format %x wide hex" :expected "\"deadbeef\"" :actual "(format \"%x\" 3735928559)"}
{:suite "protocols / extend & extends? on nil" :label "extend nil dispatches" :expected ":nil-via-extend" :actual "(do (defprotocol P2 (q [this])) (extend nil P2 {:q (fn [_] :nil-via-extend)}) (q nil))"}
{:suite "protocols / extend & extends? on nil" :label "extends? nil when extended" :expected "true" :actual "(do (defprotocol Pe (pe [this])) (extend nil Pe {:pe (fn [_] :x)}) (extends? Pe nil))"}
{:suite "protocols / extend & extends? on nil" :label "extends? nil when not extended" :expected "false" :actual "(do (defprotocol P3 (r [this])) (extends? P3 nil))"}
{:suite "protocols / extend & extends? on nil" :label "extend-type nil still works" :expected ":via-type" :actual "(do (defprotocol P4 (s [this])) (extend-type nil P4 (s [_] :via-type)) (s nil))"}
] ]

View file

@ -316,8 +316,8 @@
{:suite "reader" :expr "(= [1 2 3] (read-string \"[1 2 3]\"))" :expected "true"} {:suite "reader" :expr "(= [1 2 3] (read-string \"[1 2 3]\"))" :expected "true"}
{:suite "reader" :expr "(= (quote (+ 1 2)) (read-string \"(+ 1 2)\"))" :expected "true"} {:suite "reader" :expr "(= (quote (+ 1 2)) (read-string \"(+ 1 2)\"))" :expected "true"}
{:suite "reader" :expr "(= {:a 1 :b 2} (read-string \"{:a 1 :b 2}\"))" :expected "true"} {:suite "reader" :expr "(= {:a 1 :b 2} (read-string \"{:a 1 :b 2}\"))" :expected "true"}
{:suite "reader" :expr "(:value (read-string \"#{1 2 3}\"))" :expected "[1 2 3]"} {:suite "reader" :expr "(set? (read-string \"#{1 2 3}\"))" :expected "true"}
{:suite "reader" :expr "(= :jolt/set (:jolt/type (read-string \"#{1 2 3}\")))" :expected "true"} {:suite "reader" :expr "(= #{1 2 3} (read-string \"#{1 2 3}\"))" :expected "true"}
{:suite "reader" :expr "(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" :expected "true"} {:suite "reader" :expr "(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" :expected "true"}
{:suite "reader" :expr "(= (quote (quote x)) (read-string \"'x\"))" :expected "true"} {:suite "reader" :expr "(= (quote (quote x)) (read-string \"'x\"))" :expected "true"}
{:suite "reader" :expr "(= (quote (clojure.core/deref a)) (read-string \"@a\"))" :expected "true"} {:suite "reader" :expr "(= (quote (clojure.core/deref a)) (read-string \"@a\"))" :expected "true"}