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

Conformance: reify falls back to a protocol's default extension (jolt-az9a)

Browse source 
A reify that doesn't implement a given protocol method now dispatches to that
protocol's extended impls over the reify's host tags (e.g. an Object/default
extension) instead of erroring 'No reified method'. This is malli's pattern: it
reifies some protocols and relies on RegexSchema's default for the rest. A method
with neither a reify impl nor a default still errors.
This commit is contained in:
Yogthos 2026-06-22 18:30:44 -04:00
parent 47864403e8
commit f30a517cf7
2 changed files with 12 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

11
host/chez/records.ss
View file

@ -240,7 +240,16 @@
((reified-methods obj)
=> (lambda (rm) (let ((f (hashtable-ref rm method-name #f)))
(if f (apply jolt-invoke f obj rest)
(error #f (string-append "No reified method " method-name))))))
;; not implemented on the reify — fall back to the
;; protocol's extended impls over the reify's host tags
;; (e.g. an Object/default extension). malli reifies some
;; protocols and relies on a protocol's default for the
;; rest (jolt-az9a).
(let loop ((tags (value-host-tags obj)))
(cond ((null? tags) (error #f (string-append "No reified method " method-name)))
((find-protocol-method (car tags) proto-name method-name)
=> (lambda (g) (apply jolt-invoke g obj rest)))
(else (loop (cdr tags)))))))))
(else
(let loop ((tags (value-host-tags obj)))
(cond ((null? tags) (error #f (string-append "No method " method-name " in " proto-name)))

2
test/chez/unit.edn
View file

@ -113,6 +113,8 @@
{:suite "hostctor" :expr "[(.getProtocol (java.net.URL. \"file:/tmp/x\")) (.getFile (java.net.URL. \"http://h/p\")) (.getProtocol (java.net.URL. \"http://h/p\"))]" :expected "[file http://h/p http]"}
{:suite "hostobj" :expr "(try (throw (ex-info \"x\" {})) (catch Throwable e [(.getNextException e) (vec (.getStackTrace e))]))" :expected "[nil []]"}
{:suite "hostobj" :expr "[(some? (ClassLoader/getSystemClassLoader)) (some? (.getContextClassLoader (Thread/currentThread)))]" :expected "[true true]"}
{:suite "reify" :expr "(do (defprotocol P (pm [_])) (defprotocol Q (qm [_])) (extend-protocol Q java.lang.Object (qm [_] :q-default)) (qm (reify P (pm [_] :p))))" :expected ":q-default"}
{:suite "reify" :expr "(do (defprotocol Q (qa [_]) (qb [_])) (extend-protocol Q java.lang.Object (qa [_] :da) (qb [_] :db)) (def r (reify Q (qa [_] :ra))) [(qa r) (qb r)])" :expected "[:ra :db]"}
{:suite "dotform" :expr "(.equals \"a\" \"a\")" :expected "true"}
{:suite "dotform" :expr "(.equals \"a\" \"b\")" :expected "false"}
{:suite "dotform" :expr "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" :expected "v=41"}