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

Host hooks for library class shims: __register-class-methods! + __register-instance-check!

Browse source 
clj-http-lite drives java.net URL/HttpURLConnection and java.io byte streams
through .method interop. The Chez host had __register-class-ctor!/-statics! (what
router/reitit needs) but no way to register instance methods on a shim object or
to extend instance?. Add both, plus jolt.host/table?:

- tagged-table .method dispatch: an htable-arm on record-method-dispatch routes
  (.m obj a*) through a per-tag method registry keyed off the table's jolt/type;
  unregistered methods fall through (sorted colls are htables too).
- __register-instance-check! installs (fn [class-name val] -> true|false|nil),
  nil = fall through; chained ahead of the base instance-check.

Runtime .ss shims, no re-mint. Unit covers dispatch, args, instance? both ways.
This commit is contained in:
Yogthos 2026-06-22 13:06:12 -04:00
parent 21fbc50014
commit 8c6623503f
2 changed files with 60 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

6
test/chez/unit.edn
View file

@ -459,4 +459,10 @@
{:suite "deftype-mutable" :expr "(do (defprotocol IB (gv [_]) (sv [_ v])) (deftype B [^:unsynchronized-mutable val] IB (gv [_] val) (sv [_ v] (set! val v))) (let [b (->B 1)] (sv b 42) (gv b)))" :expected "42"}
{:suite "deftype-mutable" :expr "(do (defprotocol IC (bump [_]) (cur [_])) (deftype C [^:unsynchronized-mutable n] IC (bump [this] (set! n (inc n)) n) (cur [_] n)) (let [c (->C 5)] (bump c) (bump c) (bump c) (cur c)))" :expected "8"}
{:suite "deftype-mutable" :expr "(do (defprotocol IH (g [_]) (s [_ v])) (deftype H [^:volatile-mutable st] IH (g [_] st) (s [this v] (set! (.-st this) v))) (let [h (->H :old)] (s h :new) (g h)))" :expected ":new"}
{:suite "hostshim" :expr "(do (__register-class-ctor! \"Box1\" (fn [v] (let [t (jolt.host/tagged-table :my/box)] (jolt.host/ref-put! t :v v) t))) (__register-class-methods! :my/box {\"getV\" (fn [self] (jolt.host/ref-get self :v))}) (.getV (Box1. 42)))" :expected "42"}
{:suite "hostshim" :expr "(do (__register-class-ctor! \"Box2\" (fn [v] (let [t (jolt.host/tagged-table :my/box2)] (jolt.host/ref-put! t :v v) t))) (__register-class-methods! :my/box2 {\"add\" (fn [self n] (+ n (jolt.host/ref-get self :v)))}) (.add (Box2. 10) 5))" :expected "15"}
{:suite "hostshim" :expr "(do (__register-class-ctor! \"Box3\" (fn [] (jolt.host/tagged-table :my/box3))) (__register-instance-check! (fn [cn val] (if (= cn \"Box3\") (= :my/box3 (jolt.host/ref-get val :jolt/type)) nil))) (instance? Box3 (Box3.)))" :expected "true"}
{:suite "hostshim" :expr "(do (__register-class-ctor! \"Box4\" (fn [] (jolt.host/tagged-table :my/box4))) (__register-instance-check! (fn [cn val] (if (= cn \"Box4\") (= :my/box4 (jolt.host/ref-get val :jolt/type)) nil))) (instance? Box4 \"not-a-box\"))" :expected "false"}
{:suite "hostshim" :expr "(jolt.host/table? (jolt.host/tagged-table :t))" :expected "true"}
{:suite "hostshim" :expr "(jolt.host/table? \"x\")" :expected "false"}
]