simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Recognize core clojure.lang interfaces in instance?

Browse source 
(instance? clojure.lang.IObj/IMapEntry/IRecord/IPersistentMap/... x) all returned
false, so libraries branching on these interfaces (e.g. a metadata-preserving
walk guarded by IObj) silently misbehaved. Register an instance-check arm mapping
the interface tokens to jolt predicates, matched by last dotted segment.
This commit is contained in:
Yogthos 2026-06-24 11:03:34 -04:00
parent 3412563a79
commit b2394325d4
1 changed files with 32 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

32
host/chez/host-static-classes.ss
View file

@ -506,5 +506,37 @@
(def-var! "clojure.core" "__register-instance-check!" (def-var! "clojure.core" "__register-instance-check!"
(lambda (f) (set! user-instance-checks (append user-instance-checks (list f))) jolt-nil)) (lambda (f) (set! user-instance-checks (append user-instance-checks (list f))) jolt-nil))
;; (instance? clojure.lang.IFoo x) for the core clojure.lang interfaces libraries
;; branch on — jolt's value model satisfies them, so report it. Matched by the
;; interface's last dotted segment, so "clojure.lang.IObj" and "IObj" both hit.
(define (hsc-last-segment s)
(let loop ((i (- (string-length s) 1)))
(cond ((< i 0) s)
((char=? (string-ref s i) #\.) (substring s (+ i 1) (string-length s)))
(else (loop (- i 1))))))
;; values that carry metadata (mirrors jolt-with-meta's set in natives-meta.ss).
(define (hsc-imeta? x)
(or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x)
(jolt-lazyseq? x) (jrec? x) (procedure? x) (symbol-t? x)))
(register-instance-check-arm!
(lambda (type-sym val)
(let ((iface (hsc-last-segment (symbol-t-name type-sym))))
(let ((hit (cond
((or (string=? iface "IObj") (string=? iface "IMeta")) (hsc-imeta? val))
((or (string=? iface "IMapEntry") (string=? iface "MapEntry")) (jolt-map-entry? val))
((string=? iface "IRecord") (jrec? val))
((string=? iface "IPersistentMap") (or (pmap? val) (htable-sorted-map? val)))
((string=? iface "IPersistentVector") (and (pvec? val) (not (jolt-map-entry? val))))
((string=? iface "IPersistentSet") (or (pset? val) (htable-sorted-set? val)))
((or (string=? iface "ISeq") (string=? iface "Seqable"))
(or (cseq? val) (empty-list-t? val) (jolt-lazyseq? val)))
((string=? iface "Sequential")
(or (pvec? val) (cseq? val) (empty-list-t? val) (jolt-lazyseq? val)))
((string=? iface "IFn")
(or (procedure? val) (keyword? val) (symbol-t? val)
(pmap? val) (pset? val) (pvec? val)))
(else 'none))))
(if (eq? hit 'none) 'pass (if hit #t #f))))))
;; (jolt.host/table? x) — is x a host tagged-table? ;; (jolt.host/table? x) — is x a host tagged-table?
(def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f))) (def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f)))