From 75f6bc79d1597f4a69084ce4455b91d2bb9d2c8d Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sat, 27 Jun 2026 16:48:14 -0400 Subject: [PATCH] data.priority-map: deftype interop fixes (rseq, arity-overload, empty, Sorted) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit data.priority-map's whole suite passes (4/4). It leans on deftype/collection interop jolt got wrong; four general fixes: - rseq dispatches to a deftype's clojure.lang.Reversible.rseq method instead of always demanding a vector/sorted-coll (natives-seq.ss). - a deftype method declared at two arities from two interfaces now dispatches by arity: the priority-map has seq[this] (Seqable) and seq[this ascending] (Sorted), so (.seq pm false) must reach the 2-arg one. find-method-any-protocol now matches the call's arg count via procedure-arity-mask, and a deftype's own declared method wins over the generic collection interop in dot-forms. - (empty x) on a deftype/record with its own empty method uses it rather than returning {} (jolt.host/jrec-method? gate in clojure.core/empty). - clojure.lang.Sorted (comparator / entryKey / seqFrom) works on jolt's sorted-map/set, so subseq/rsubseq run — including the priority-map delegating .comparator to its backing sorted-map (dot-forms.ss + host-static.ss). Listed in docs/libraries.md + the site. One re-mint (clojure.core/empty); everything else runtime. make test green (0 new divergences), shakesmoke byte-identical. --- docs/libraries.md | 2 ++ host/chez/java/dot-forms.ss | 12 +++++++++++ host/chez/java/host-static.ss | 34 ++++++++++++++++++++++++++++++ host/chez/natives-seq.ss | 11 +++++++--- host/chez/records.ss | 21 +++++++++++++++++- host/chez/seed/prelude.ss | 2 +- jolt-core/clojure/core/22-coll.clj | 3 +++ 7 files changed, 80 insertions(+), 5 deletions(-) diff --git a/docs/libraries.md b/docs/libraries.md index 2264697..d891859 100644 --- a/docs/libraries.md +++ b/docs/libraries.md @@ -63,6 +63,8 @@ e.g. the [ring-app example](https://github.com/jolt-lang/examples/tree/main/ring * [data.csv](https://github.com/clojure/data.csv) — reading and writing CSV. * [data.codec](https://github.com/clojure/data.codec) — base64 encode/decode over byte arrays. +* [data.priority-map](https://github.com/clojure/data.priority-map) — priority + maps (incl. keyfn / custom comparator), with `subseq`/`rsubseq`. * [test.check](https://github.com/clojure/test.check) — property-based testing (generators, `quick-check`, shrinking). * [tick](https://github.com/juxt/tick) — date/time over Jolt's `java.time`; diff --git a/host/chez/java/dot-forms.ss b/host/chez/java/dot-forms.ss index dcb4760..fd61301 100644 --- a/host/chez/java/dot-forms.ss +++ b/host/chez/java/dot-forms.ss @@ -96,9 +96,21 @@ ;; (.getClass x) universal — the class token for any value, before the ;; collection/map field-lookup arms below would read it as a missing key. ((string=? method-name "getClass") (jolt-class obj)) + ;; a deftype/record's OWN declared method (matched by name AND arity) wins + ;; over the generic collection interop below — e.g. data.priority-map + ;; declares both seq[this] (Seqable) and seq[this ascending] (Sorted), and + ;; (.seq pm false) must reach the 2-arg one, not dot-coll's plain seq. + ((and (not field?) (jrec? obj) + (find-method-any-protocol-arity (jrec-tag obj) mname (+ 1 (length rest)))) + => (lambda (f) (apply jolt-invoke f obj rest))) ;; collection interop first (entry count / seq / nth / get / containsKey). ((and (dot-coll? obj) (dot-coll-method obj mname rest)) => (lambda (box) (car box))) + ;; clojure.lang.Sorted (comparator / entryKey / seqFrom) on a sorted + ;; map/set, before the map arm below reads the method name as a key. + ;; data.priority-map's subseq/rsubseq reach for these. + ((and (not field?) (htable-sorted? obj) (sorted-iface-method? mname)) + (sorted-iface-dispatch obj mname rest)) ;; (.-field obj) / (. obj -field): field read on a record or map. (field? (jolt-get obj (keyword #f mname) jolt-nil)) ;; non-record map: a universal object-method (getMessage/...) wins first, diff --git a/host/chez/java/host-static.ss b/host/chez/java/host-static.ss index 2c14f0c..5b646b7 100644 --- a/host/chez/java/host-static.ss +++ b/host/chez/java/host-static.ss @@ -56,6 +56,40 @@ ;; record-method-dispatch (records.ss) gets a jhost arm: dispatch (.method obj a*) ;; through the tag's method table. +;; clojure.lang.Sorted on jolt's sorted-map / sorted-set: comparator / entryKey / +;; seqFrom / seq. data.priority-map's subseq/rsubseq reach for these (its +;; PersistentPriorityMap delegates .comparator to the backing sorted-map). The +;; comparator is returned as a small Comparator object whose .compare runs the +;; map's 3-way fn, since (.. sc comparator (compare a b)) is the calling form. +(define sorted-cmp-kw (keyword #f "cmp")) +(register-host-methods! "jolt-comparator" + (list (cons "compare" (lambda (self a b) (jolt-invoke (jhost-state self) a b))))) +(define (sorted-comparator-of sc) + (let ((c (jolt-ref-get sc sorted-cmp-kw))) + (make-jhost "jolt-comparator" (if (jolt-nil? c) jolt-compare c)))) +(define (sorted-iface-method? m) + (or (string=? m "comparator") (string=? m "entryKey") + (string=? m "seqFrom") (string=? m "seq"))) +(define (sorted-iface-dispatch obj method rest) + (cond + ((string=? method "comparator") (sorted-comparator-of obj)) + ((string=? method "entryKey") (jolt-first (car rest))) ; map entry -> its key + ((string=? method "seq") ; (.seq sc) or (.seq sc ascending?) + (if (or (null? rest) (jolt-truthy? (car rest))) (jolt-seq obj) (jolt-rseq obj))) + ;; (.seqFrom sc k ascending?) — the entries from k onward, in order. Done with a + ;; comparator filter over the seq (jolt has no tree cursor), like subseq. + ((string=? method "seqFrom") + (let* ((k (car rest)) (asc (jolt-truthy? (cadr rest))) + (cmp (jolt-ref-get obj sorted-cmp-kw)) + (cmpf (if (jolt-nil? cmp) jolt-compare cmp)) + (es (seq->list (jolt-seq obj))) + (keep (filter (lambda (e) + (let ((c (jnum->exact (jolt-invoke cmpf (jolt-first e) k)))) + (if asc (>= c 0) (<= c 0)))) + es))) + (list->cseq (if asc keep (reverse keep))))) + (else (error #f (string-append "No method " method " on sorted collection"))))) + (define %hs-record-method-dispatch record-method-dispatch) (set! record-method-dispatch (lambda (obj method-name rest-args) diff --git a/host/chez/natives-seq.ss b/host/chez/natives-seq.ss index 003550d..6d3c9f7 100644 --- a/host/chez/natives-seq.ss +++ b/host/chez/natives-seq.ss @@ -224,9 +224,14 @@ ;; rseq: vectors + sorted colls only (Clojure), the reverse of the ascending seq. (define (jolt-rseq coll) - (if (or (pvec? coll) (htable-sorted? coll)) - (list->cseq (reverse (seq->list (jolt-seq coll)))) - (jolt-throw (jolt-ex-info "rseq requires a vector or sorted collection" (jolt-hash-map))))) + (cond + ((or (pvec? coll) (htable-sorted? coll)) + (list->cseq (reverse (seq->list (jolt-seq coll))))) + ;; a deftype/record implementing clojure.lang.Reversible (rseq) — e.g. + ;; data.priority-map — drives rseq through its own method. + ((and (jrec? coll) (find-method-any-protocol (jrec-tag coll) "rseq")) + => (lambda (f) (jolt-invoke f coll))) + (else (jolt-throw (jolt-ex-info "rseq requires a vector or sorted collection" (jolt-hash-map)))))) (def-var! "clojure.core" "rseq" jolt-rseq) ;; clojure.core/unchecked-* — host-defined wrapping (Java long) arithmetic from diff --git a/host/chez/records.ss b/host/chez/records.ss index cab46a2..5bebf0b 100644 --- a/host/chez/records.ss +++ b/host/chez/records.ss @@ -441,9 +441,28 @@ (and (pair? protos) (let ((f (hashtable-ref (hashtable-ref ti (car protos) #f) method #f))) (or f (loop (cdr protos))))))))) +;; A deftype can implement a method NAME at two arities from two interfaces (e.g. +;; data.priority-map's seq: Seqable.seq[this] and Sorted.seq[this ascending]), +;; registered under different protocols. Pick the impl whose procedure accepts +;; the call's arg count (this + args); fall back to any same-named impl. +(define (proc-accepts? f n) + (and (procedure? f) (bitwise-bit-set? (procedure-arity-mask f) n))) +(define (find-method-any-protocol-arity type-tag method nargs) + (let ((ti (hashtable-ref type-registry type-tag #f))) + (and ti (let loop ((protos (vector->list (hashtable-keys ti))) (fallback #f)) + (if (null? protos) + fallback + (let ((f (hashtable-ref (hashtable-ref ti (car protos) #f) method #f))) + (cond ((and f (proc-accepts? f nargs)) f) + (else (loop (cdr protos) (or fallback f)))))))))) (define (type-satisfies? type-tag proto) (let ((ti (hashtable-ref type-registry type-tag #f))) (and ti (hashtable-ref ti proto #f) #t))) +;; True when a deftype/record instance DECLARES a method by this name (an inline +;; protocol impl), so clojure.core can prefer it over generic collection behavior +;; — e.g. (empty priority-map) must use the type's own empty, not return {}. +(def-var! "jolt.host" "jrec-method?" + (lambda (v name) (if (and (jrec? v) (find-method-any-protocol (jrec-tag v) name)) #t #f))) ;; host type-tag candidates for a non-record value (extend-protocol on builtins). (define (value-host-tags obj) @@ -768,7 +787,7 @@ ;; which .getName/.getSimpleName work via the String method shim). ((and (string=? method-name "getClass") (not (jrec? obj)) (not (jreify? obj))) (jolt-class obj)) - ((and (jrec? obj) (find-method-any-protocol (jrec-tag obj) method-name)) + ((and (jrec? obj) (find-method-any-protocol-arity (jrec-tag obj) method-name (+ 1 (length rest)))) => (lambda (f) (apply jolt-invoke f obj rest))) ;; (.field inst): a deftype/record field read with no matching method. ;; Clojure reads the field for (.q x) just like (.-q x); a declared method diff --git a/host/chez/seed/prelude.ss b/host/chez/seed/prelude.ss index bedbe42..3df489d 100644 --- a/host/chez/seed/prelude.ss +++ b/host/chez/seed/prelude.ss @@ -487,7 +487,7 @@ (guard (e (#t #f)) (def-var! "clojure.core" "reverse" (letrec ((reverse (lambda (coll) (let fnrec4586 ((coll coll)) (jolt-reduce jolt-conj (jolt-list ) coll))))) reverse))) (guard (e (#t #f)) - (def-var! "clojure.core" "empty" (letrec ((empty (lambda (coll) (let fnrec4587 ((coll coll)) (if (jolt-nil? coll) jolt-nil (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "sorted?") coll)) (jolt-invoke (jolt-get (jolt-invoke (var-deref "jolt.host" "ref-get") coll (keyword #f "ops")) (keyword #f "empty")) coll) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") coll)) (let* ((_a$4588 (var-deref "clojure.core" "with-meta")) (_a$4589 (jolt-hash-map)) (_a$4590 (jolt-invoke (var-deref "clojure.core" "meta") coll))) (jolt-invoke _a$4588 _a$4589 _a$4590)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "set?") coll)) (let* ((_a$4591 (var-deref "clojure.core" "with-meta")) (_a$4592 (jolt-hash-set)) (_a$4593 (jolt-invoke (var-deref "clojure.core" "meta") coll))) (jolt-invoke _a$4591 _a$4592 _a$4593)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") coll)) (let* ((_a$4594 (var-deref "clojure.core" "with-meta")) (_a$4595 (jolt-vector)) (_a$4596 (jolt-invoke (var-deref "clojure.core" "meta") coll))) (jolt-invoke _a$4594 _a$4595 _a$4596)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "coll?") coll)) (jolt-invoke (var-deref "clojure.core" "with-meta") (jolt-list ) (jolt-invoke (var-deref "clojure.core" "meta") coll)) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))))))))))) empty))) + (def-var! "clojure.core" "empty" (letrec ((empty (lambda (coll) (let fnrec4587 ((coll coll)) (if (jolt-nil? coll) jolt-nil (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "jrec-method?") coll "empty")) (record-method-dispatch coll "empty" (jolt-vector)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "sorted?") coll)) (jolt-invoke (jolt-get (jolt-invoke (var-deref "jolt.host" "ref-get") coll (keyword #f "ops")) (keyword #f "empty")) coll) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") coll)) (let* ((_a$4588 (var-deref "clojure.core" "with-meta")) (_a$4589 (jolt-hash-map)) (_a$4590 (jolt-invoke (var-deref "clojure.core" "meta") coll))) (jolt-invoke _a$4588 _a$4589 _a$4590)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "set?") coll)) (let* ((_a$4591 (var-deref "clojure.core" "with-meta")) (_a$4592 (jolt-hash-set)) (_a$4593 (jolt-invoke (var-deref "clojure.core" "meta") coll))) (jolt-invoke _a$4591 _a$4592 _a$4593)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") coll)) (let* ((_a$4594 (var-deref "clojure.core" "with-meta")) (_a$4595 (jolt-vector)) (_a$4596 (jolt-invoke (var-deref "clojure.core" "meta") coll))) (jolt-invoke _a$4594 _a$4595 _a$4596)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "coll?") coll)) (jolt-invoke (var-deref "clojure.core" "with-meta") (jolt-list ) (jolt-invoke (var-deref "clojure.core" "meta") coll)) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil)))))))))))) empty))) (guard (e (#t #f)) (def-var! "clojure.core" "assoc-in" (letrec ((assoc-in (lambda (m G__130 v) (let fnrec4597 ((m m) (G__130 G__130) (v v)) (let* ((G__131 G__130) (k (jolt-nth G__131 0 jolt-nil)) (ks (jolt-invoke (var-deref "clojure.core" "nthnext") G__131 1))) (if (jolt-truthy? ks) (jolt-assoc m k (assoc-in (jolt-get m k) ks v)) (jolt-assoc m k v))))))) assoc-in))) (guard (e (#t #f)) diff --git a/jolt-core/clojure/core/22-coll.clj b/jolt-core/clojure/core/22-coll.clj index e00ce1d..297cccc 100644 --- a/jolt-core/clojure/core/22-coll.clj +++ b/jolt-core/clojure/core/22-coll.clj @@ -133,6 +133,9 @@ (defn empty [coll] (cond (nil? coll) nil + ;; a deftype/record with its own empty (IPersistentCollection) — e.g. + ;; data.priority-map — uses it, before the generic map/set/vector arms. + (jolt.host/jrec-method? coll "empty") (.empty coll) (sorted? coll) ((get (jolt.host/ref-get coll :ops) :empty) coll) (map? coll) (with-meta {} (meta coll)) (set? coll) (with-meta #{} (meta coll))