Class-name symbols self-evaluate; extends? matches host classes; ISO_INSTANT

A slash-free dotted symbol with a Capitalized final segment (java.util.Map,
clojure.lang.Named, java.time.Instant) now self-evaluates to its name string
instead of resolving to nil — jolt models a class as its name, so a library
can extend a protocol to, or instance?-check, a host class jolt has no shim
for. hc-resolve-global classifies these as :class; the analyzer emits a const.

extends? now matches when either the query or the registered tag is a dotted
suffix of the other, so (extends? P java.util.Collection) finds the impl
extend registered under the canonical short tag.

Add DateTimeFormatter/ISO_INSTANT (UTC, trailing Z).

These unblock loading clojure.data.json, which dispatches JSONWriter on
java.util.Map/Collection/CharSequence/Instant and defaults a formatter to
ISO_INSTANT.
This commit is contained in:
Yogthos 2026-06-24 14:17:34 -04:00
parent c26fd175f2
commit 21895cb932
7 changed files with 552 additions and 526 deletions

View file

@ -32,6 +32,7 @@
(define hc-kw-name (keyword #f "name"))
(define hc-kw-var (keyword #f "var"))
(define hc-kw-unresolved (keyword #f "unresolved"))
(define hc-kw-class (keyword #f "class"))
(define hc-kw-num-ret (keyword #f "num-ret"))
(define hc-kw-double (keyword #f "double"))
(define hc-kw-long (keyword #f "long"))
@ -192,6 +193,19 @@
((equal? t "long") hc-kw-long)
(else #f))))))
;; A slash-free dotted symbol whose final segment is Capitalized is a class
;; reference (java.util.Map, clojure.lang.Named) — Clojure has no such vars. With
;; no JVM classes, jolt models a class as its name string, so the symbol
;; self-evaluates to that string (the analyzer emits a :const). This lets a lib
;; extend a protocol to / instance?-check a host class jolt has no shim for.
(define (hc-fq-class-name? nm)
(let ((n (string-length nm)))
(let loop ((i (fx- n 1)))
(cond ((fx<? i 0) #f)
((char=? (string-ref nm i) #\.)
(and (fx<? (fx+ i 1) n) (char-upper-case? (string-ref nm (fx+ i 1)))))
(else (loop (fx- i 1)))))))
(define (hc-resolve-global ctx sym)
(let* ((nm (symbol-t-name sym))
(cell (hc-resolve-cell ctx sym)))
@ -201,7 +215,9 @@
hc-kw-name (var-cell-name cell)))
(nr (hc-cell-num-ret cell)))
(if nr (jolt-assoc base hc-kw-num-ret nr) base))
(jolt-hash-map hc-kw-kind hc-kw-unresolved hc-kw-name nm))))
(if (hc-fq-class-name? nm)
(jolt-hash-map hc-kw-kind hc-kw-class hc-kw-name nm)
(jolt-hash-map hc-kw-kind hc-kw-unresolved hc-kw-name nm)))))
(define (hc-intern! ctx ns-name nm) (declare-var! ns-name nm) jolt-nil)

View file

@ -320,6 +320,8 @@
(list (cons "ofPattern" (lambda (p . _) (mk-formatter p)))
(cons "ISO_LOCAL_DATE" (mk-formatter "yyyy-MM-dd"))
(cons "ISO_LOCAL_DATE_TIME" (mk-formatter "yyyy-MM-dd'T'HH:mm:ss"))
;; ISO_INSTANT always renders in UTC with a trailing Z (format-ms is UTC; X -> "Z").
(cons "ISO_INSTANT" (mk-formatter "yyyy-MM-dd'T'HH:mm:ssX"))
(cons "ofLocalizedDate" (lambda (fs) (style-fmt 'date fs)))
(cons "ofLocalizedTime" (lambda (fs) (style-fmt 'time fs)))
(cons "ofLocalizedDateTime" (lambda (fs) (style-fmt 'datetime fs)))))

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View file

@ -380,17 +380,19 @@
step)))
;; True when atype's methods were registered for this protocol (via extend /
;; extend-type). Tags are canonical host names or ns-qualified record names,
;; so a bare record name also matches its "ns.Name" tag.
;; extend-type). Tags are canonical host names or ns-qualified record names, so a
;; name matches its tag when either is a dotted suffix of the other — a bare
;; record name matches its "ns.Name" tag, and a query for a qualified host class
;; (java.util.Map) matches the canonical short tag (Map) extend registered it as.
(defn extends? [protocol atype]
(let [want (if (nil? atype) "nil" (name atype))
dotted (str "." want)
dlen (count dotted)]
suffix? (fn [long short]
(let [d (str "." short)]
(and (> (count long) (count d))
(= (subs long (- (count long) (count d))) d))))]
(boolean (some (fn [t]
(let [tn (name t)]
(or (= tn want)
(and (> (count tn) dlen)
(= (subs tn (- (count tn) dlen)) dotted)))))
(or (= tn want) (suffix? tn want) (suffix? want tn))))
(extenders protocol)))))
;; extend, the FUNCTION (extend-type's runtime sibling): protocol + method-map

View file

@ -516,6 +516,9 @@
;; jolt.passes.numeric types a call to it (an accumulator over the result).
:var (cond-> (var-ref (:ns r) (:name r)) (:num-ret r) (assoc :num-ret (:num-ret r)))
:host (host-ref (:name r))
;; a class-name symbol (java.util.Map) self-evaluates to its name
;; string — jolt models a class as its name, with no JVM classes.
:class (const (:name r))
;; :unresolved — emitting a var-ref here would auto-intern an
;; UNBOUND var, so a typo'd symbol would die later as 'Cannot call
;; nil as a function' with no hint which symbol.

View file

@ -2968,4 +2968,7 @@
{: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))"}
{:suite "protocols / extend on host classes" :label "dispatch by java.util.Map/Collection/CharSequence" :expected "[:map :coll :str :obj]" :actual "(do (defprotocol W (-w [x])) (extend java.util.Map W {:-w (fn [_] :map)}) (extend java.util.Collection W {:-w (fn [_] :coll)}) (extend java.lang.CharSequence W {:-w (fn [_] :str)}) (extend java.lang.Object W {:-w (fn [_] :obj)}) [(-w {:a 1}) (-w [1 2]) (-w \"s\") (-w 42)])"}
{:suite "protocols / extend on host classes" :label "satisfies? via java.util.Map" :expected "true" :actual "(do (defprotocol Q (qq [x])) (extend java.util.Map Q {:qq (fn [_] :m)}) (satisfies? Q {}))"}
{:suite "protocols / extend on host classes" :label "extends? on a qualified host class" :expected "true" :actual "(do (defprotocol Qe (qe [x])) (extend java.util.Collection Qe {:qe (fn [_] :c)}) (extends? Qe java.util.Collection))"}
]