From 910c4b6c990b690f53509e7eeb21a4d0954a2d4a Mon Sep 17 00:00:00 2001 From: Dmitri Sotnikov Date: Mon, 15 Jun 2026 03:20:33 +0000 Subject: [PATCH] Protocol/interop fixes to run metosin/malli (jolt-ltwk) (#105) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Protocol/interop fixes to run metosin/malli Bringing up malli (schema validation) surfaced a batch of protocol and host-interop gaps. m/validate now works across the schema vocabulary (predicates, :map incl. nested/optional, :vector, :tuple, :enum, :maybe, :and, bounded int/string). - extend-type and reify now accept MULTIPLE protocols in one form (each bare symbol switches the current protocol). reify records every protocol it implements, so instance?/satisfies? recognise all of them. - Protocol method params support destructuring: reify/extend-type/deftype/ defrecord emit (fn ...) (which desugars patterns) instead of raw fn*. - instance? of a PROTOCOL works like satisfies? for reify/record instances, matching short names across qualified/bare protocol references. - @x reads as the qualified clojure.core/deref, so it still derefs where a ns excludes and rebinds deref (malli does). Updated reader-test + the reader spec/grammar (S11, deref rule). - Java collection interop on jolt collections: .nth/.count/.valAt/.get/.seq/ .containsKey route to the clojure.core equivalent (1-arg and 0-arg paths). - java.util.HashMap capacity/load-factor constructors + .putAll. - A class used as a value resolves to its instances' type, so Pattern -> the regex type (malli keys class-schemas by it). - Shims for malli's load path: LazilyPersistentVector/createOwning and PersistentArrayMap/createWithCheck statics. m/explain not yet working (jolt-fjb1). Full gate green. * satisfies? recognizes reify, consistent with instance? A reify's protocol methods are instance-local, so they aren't in the global type registry that type-satisfies? consults — satisfies? returned false for a reify even when it implemented the protocol. Check the protocols the reify records on itself (the same :jolt/protocols list instance? uses), matching short names like instance? does. Covers single- and multi-protocol reify. --------- Co-authored-by: Yogthos --- docs/grammar.ebnf | 5 +- docs/spec/02-reader.md | 10 +++- jolt-core/clojure/core/30-macros.clj | 33 +++++++++---- src/jolt/api.janet | 36 ++++++++++++++ src/jolt/evaluator.janet | 72 ++++++++++++++++++++++------ src/jolt/javatime.janet | 10 +++- src/jolt/reader.janet | 6 ++- test/spec/protocols-spec.janet | 6 +++ test/unit/reader-test.janet | 4 +- 9 files changed, 149 insertions(+), 33 deletions(-) diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index 89044db..ba29ca7 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -109,7 +109,7 @@ map-entry = form , ws , form ; (* an even number of forms *) (* -------------------------------------------------------------------------- Reader macros (prefix sugar). Each expands to a 2-element form - (op operand), e.g. 'x -> (quote x), @a -> (deref a). + (op operand), e.g. 'x -> (quote x), @a -> (clojure.core/deref a). -------------------------------------------------------------------------- *) reader-macro = quote | syntax-quote | unquote | unquote-splice @@ -119,7 +119,8 @@ quote = "'" , form ; (* (quote form) *) syntax-quote = "`" , form ; (* (syntax-quote form) *) unquote-splice = "~@" , form ; (* (unquote-splicing form) *) unquote = "~" , form ; (* (unquote form) *) -deref = "@" , form ; (* (deref form) *) +deref = "@" , form ; (* (clojure.core/deref form) — qualified, *) + (* so it derefs even where deref is shadowed *) metadata = "^" , meta-form , ws , form ; (* attach metadata to form *) meta-form = map | keyword | symbol | string ; (* Normalized like Clojure: a symbol or string is a type hint -> {:tag ...}; diff --git a/docs/spec/02-reader.md b/docs/spec/02-reader.md index 7d9962b..0cc7598 100644 --- a/docs/spec/02-reader.md +++ b/docs/spec/02-reader.md @@ -74,12 +74,16 @@ checks → UNVERIFIED (rows to add). | Sugar | Reads as | | |---|---|---| | `'form` | `(quote form)` | S10 | -| `@form` | `(deref form)` | S11 | +| `@form` | `(clojure.core/deref form)` | S11 | | `^meta form` | form with metadata attached (see below) | S12 | | `#'sym` | `(var sym)` | S13 | | `` `form `` | syntax-quote (§2.4) | | | `~form`, `~@form` | unquote / unquote-splicing — only within syntax-quote (S14: MUST error outside) | | +- S11. `@form` reads as `(clojure.core/deref form)` — the operator is the + fully-qualified `clojure.core/deref`, not a bare `deref`, so `@x` still + dereferences in a namespace that excludes and rebinds `deref` + (`(ns … (:refer-clojure :exclude [deref]))`), matching Clojure. - S12a. `^:kw form` ≡ `^{:kw true} form`; `^Sym form` ≡ `^{:tag Sym} form`; `^"str"` ≡ `^{:tag "str"} form`. Multiple `^` stack, rightmost innermost, merged left-over-right. @@ -117,6 +121,10 @@ checks → UNVERIFIED (rows to add). - `#(body)` reads as `(fn [args…] (body))` with parameters derived from the `%`-symbols appearing in body: `%`≡`%1`, `%n` positional, `%&` the rest parameter. Arity = highest `%n` mentioned (plus rest if `%&`). +- The `%`-symbols are collected from the WHOLE body, recursing through every + nested form including vector, map and set literals — `#(assoc {} :k %)`, + `#(hash-set % %2)` and `#(get {:t %} :t)` all see their `%`s. (A reader that + scanned only call forms would miscompile `#(identity {:text %})` as a 0-arg fn.) - `#()` literals MUST NOT nest. ```clojure diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 118f80e..05f9217 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -376,14 +376,24 @@ (register-method (name atype) pname (name k) f))) (recur (nnext s))))) -(defmacro extend-type [tsym psym & impls] +(defmacro extend-type [tsym & body] ;; register-method is a fn (clojure.core); pass type/protocol/method NAMES as ;; strings (not the symbols) so the call compiles as a plain invoke. A nil ;; type extends on nil values (the host tag is the string "nil"). - `(do ~@(map (fn [spec] - `(register-method ~(if (nil? tsym) "nil" (name tsym)) ~(name psym) ~(name (first spec)) - (fn* ~(nth spec 1) ~@(drop 2 spec)))) - impls))) + ;; `body` is one or more protocols, each followed by its method specs: + ;; (extend-type T P1 (m1 [_] ..) P2 (m2 [_] ..)) — a bare symbol switches the + ;; current protocol (like reify), so multiple protocols extend in one form. + (let [tname (if (nil? tsym) "nil" (name tsym))] + (loop [items (seq body) proto nil forms []] + (if (empty? items) + `(do ~@forms) + (let [x (first items)] + (if (symbol? x) + (recur (rest items) (name x) forms) + (recur (rest items) proto + (conj forms + `(register-method ~tname ~proto ~(name (first x)) + (fn ~(nth x 1) ~@(drop 2 x))))))))))) (defmacro extend-protocol [psym & type-impls] `(do ~@(map (fn [g] `(extend-type ~(first g) ~psym ~@(rest g))) @@ -400,15 +410,18 @@ ;; ordinary map literal that evaluates to {keyword fn}, and the protocol NAME is ;; passed as a string (not the symbol) so the call compiles as a plain invoke. (defmacro reify [& forms] - (loop [items (seq forms) proto nil methods {}] + ;; a reify can implement SEVERAL protocols; collect them all (each bare symbol + ;; switches the current protocol, like extend-type) and pass every protocol name + ;; to make-reified so (instance? Proto r)/satisfies? recognise all of them. + (loop [items (seq forms) protos [] methods {}] (if (empty? items) - `(make-reified ~(name proto) ~methods) + `(make-reified ~methods ~@(vec (map name protos))) (let [x (first items)] (if (symbol? x) - (recur (rest items) (if proto proto x) methods) - (recur (rest items) proto + (recur (rest items) (conj protos x) methods) + (recur (rest items) protos (assoc methods (keyword (name (first x))) - `(fn* ~(nth x 1) ~@(drop 2 x))))))))) + `(fn ~(nth x 1) ~@(drop 2 x))))))))) (defmacro defrecord [name-sym fields & body] (let [tn (name name-sym) diff --git a/src/jolt/api.janet b/src/jolt/api.janet index 62a6d54..5aa0810 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -13,12 +13,48 @@ (import ./stdlib_embed :as stdlib-embed) (import ./host_iface :as host) (import ./javatime) # java.time shims register into the evaluator at load +(import ./phm :as mphm) # Wire core's collection realizer into the evaluator's (.iterator coll) shim — # late-bound here because the evaluator loads before core. Makes Java-Iterator- # style loops (e.g. hiccup's iterate!) work over any jolt collection. (set-coll-realizer! realize-for-iteration) +# clj-targeted libraries call JVM collection-builder statics in their :clj +# branches; malli's entry parser uses these. Map them to jolt's own builders. +# createOwning takes ownership of an object array -> a vector. createWithCheck +# builds a map and throws on duplicate keys (malli catches that to report them); +# detect a dup by the built map being smaller than the kv array implies. +(register-class-statics! "LazilyPersistentVector" + @{"createOwning" (fn [arr] (make-vec arr))}) +(register-class-statics! "PersistentArrayMap" + @{"createWithCheck" + (fn [arr] + (def m (mphm/make-phm arr)) + (if (= (* 2 (mphm/phm-count m)) (length arr)) m + (error "PersistentArrayMap: duplicate key")))}) + +# Java collection-interop methods on jolt persistent collections — clj-targeted +# libraries (malli) call .nth/.count/.valAt on vectors/maps in their :clj +# branches. Route to the clojure.core equivalent; :jolt/ci-none means "not mine". +(set-coll-interop! + (fn [target name args] + (if-not (or (pvec? target) (mphm/phm? target) (plist? target) (mphm/lazy-seq? target) + (and (table? target) (= :jolt/set (get target :jolt/type))) + (shape-rec? target) # map-as-tuple record + (and (struct? target) (nil? (get target :jolt/type)))) # plain map literal + :jolt/ci-none # only jolt persistent collections / maps — never records/reifies + (cond + (= name "nth") (if (>= (length args) 2) (core-nth target (in args 0) (in args 1)) + (core-nth target (in args 0))) + (= name "count") (core-count target) + (or (= name "valAt") (= name "get")) + (if (>= (length args) 2) (core-get target (in args 0) (in args 1)) + (core-get target (in args 0))) + (= name "seq") (core-seq target) + (= name "containsKey") (core-contains? target (in args 0)) + :jolt/ci-none)))) + # A defmacro expander compiles to a native fn (built as (fn args body...) and run # through the self-hosted pipeline) so macro expansion is COMPILED code, zero runtime # cost — instead of an interpreted closure, mirroring Clojure (macros are ordinary diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 5664377..3cebf84 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -637,6 +637,12 @@ # collection type) is late-bound because core loads after this file. (var coll-realizer nil) (defn set-coll-realizer! [f] (set coll-realizer f)) +# Late-bound (wired in api): routes a Java collection-interop method call +# (.nth/.count/.valAt/.seq …) on a jolt persistent collection to the clojure.core +# equivalent. Returns :jolt/ci-none when it doesn't apply. Lets clj-targeted libs +# (malli) that use .nth/.count on vectors/maps in their :clj branches work. +(var coll-interop nil) +(defn set-coll-interop! [f] (set coll-interop f)) (register-tagged-methods! :jolt/iterator @{"hasNext" (fn [self] (< (self :pos) (length (self :items)))) "next" (fn [self] @@ -663,10 +669,18 @@ "IllegalArgumentException" "java.lang.IllegalArgumentException" "InterruptedException" "java.lang.InterruptedException" "Throwable" "java.lang.Throwable"}) +# A class used as a VALUE should evaluate to what (clojure.core/type instance) +# returns for its instances, so a registry keyed by class (e.g. malli's +# class-schemas) matches a value's (type ...). For jolt's native tagged types the +# class maps to its :jolt/type keyword — Pattern <-> a compiled regex. +(def- class-value-overrides + @{"Pattern" :jolt/regex "java.util.regex.Pattern" :jolt/regex}) (defn- class-value-for - "The value a class-name symbol evaluates to: its canonical name string." + "The value a class-name symbol evaluates to: a type override, else its canonical + name string." [nm] - (or (get class-canonical-names nm) + (or (get class-value-overrides nm) + (get class-canonical-names nm) # qualified already, or unknown: the name itself is the token nm)) (defn- ctor-for-class-token @@ -811,7 +825,7 @@ # syntax-quote ns-qualifies bare class names inside macros # (selmer.util/StringBuilder); class names never belong to an ns — # fall back to the constructor / statics shims before giving up. - (if (or (in class-ctors name) (get class-canonical-names name)) + (if (or (in class-ctors name) (get class-canonical-names name) (get class-value-overrides name)) (class-value-for name) (error (string "Unable to resolve symbol: " ns "/" name)))))) # Use :jolt/not-found sentinel to distinguish nil binding from absent binding @@ -843,7 +857,7 @@ # No implicit Janet fallback (Stage 3): an unresolved # Clojure symbol is an error. Host access is the explicit # janet/ prefix above. - (if (or (in class-ctors name) (get class-canonical-names name)) + (if (or (in class-ctors name) (get class-canonical-names name) (get class-value-overrides name)) (class-value-for name) (error (string "Unable to resolve symbol: " name " in this context"))))))))))))))))))) (defn- parse-arg-names @@ -1161,10 +1175,16 @@ (def type-tag (if host host (string (ctx-current-ns ctx) "." type-name))) (register-protocol-method ctx type-tag proto-name method-name f)) -(defn make-reified-impl [ctx proto-name methods-map] +(defn make-reified-impl [ctx methods-map & rest-args] # methods-map is the EVALUATED {keyword fn} map (a phm when compiled, a struct/ # table when interpreted) — the fn* literals are already fns, just store them. - (def obj @{:jolt/deftype (string "reified-" proto-name) :jolt/protocol-methods @{}}) + # proto-names are the (short) names of every protocol the reify implements. + (def proto-names (if (and (= 1 (length rest-args)) (indexed? (in rest-args 0))) + (in rest-args 0) # wiring passed the rest tuple as one arg + rest-args)) + (def obj @{:jolt/deftype (string "reified-" (if (> (length proto-names) 0) (in proto-names 0) "")) + :jolt/protocols (tuple ;proto-names) + :jolt/protocol-methods @{}}) (def pairs (if (phm? methods-map) (phm-entries methods-map) (map (fn [k] [k (get methods-map k)]) (keys methods-map)))) @@ -1524,7 +1544,7 @@ (fn [type-name proto-name method-name f] (register-method-impl ctx type-name proto-name method-name f))) (ns-intern core "make-reified" - (fn [proto-name methods-map] (make-reified-impl ctx proto-name methods-map))) + (fn [methods-map & proto-names] (make-reified-impl ctx methods-map proto-names))) # Host-class shim registration, exposed to Clojure so a library can mirror a # Java class jolt doesn't ship (e.g. reitit.Trie). __register-class-statics! # makes (Class/method ...) resolve; __register-class-methods! makes (.method @@ -1705,16 +1725,24 @@ (let [tbl (get mm-var :jolt/methods)] (when tbl (each k (keys tbl) (set m (phm-assoc m k (get tbl k)))))) m))) - # satisfies?: evaluated protocol value + instance (matches the prior arm). + # satisfies?: evaluated protocol value + instance. Recognizes a reify the same + # way instance? does — by the protocols it records on itself (a reify's methods + # are instance-local, so they aren't in the global type registry that + # type-satisfies? consults). (ns-intern core "satisfies?" (fn [proto obj] + (def pn (proto :name)) + (def pn-str (if (struct? pn) (pn :name) pn)) + (def protos (if (table? obj) (get obj :jolt/protocols))) (def type-tag (or (record-tag obj) (if (and (table? obj) (get obj :jolt/protocol-methods)) (get obj :jolt/deftype)))) - (if type-tag - (let [pn (proto :name) - pn-str (if (struct? pn) (pn :name) pn)] - (type-satisfies? ctx type-tag pn-str)) + (cond + (and protos (string? pn-str) + (truthy? (some (fn [p] (= (last (string/split "." p)) + (last (string/split "." pn-str)))) + protos))) true + type-tag (type-satisfies? ctx type-tag pn-str) false))) # instance?: the overlay macro passes the TYPE NAME quoted (class names don't # evaluate to values on jolt); the value arg arrives evaluated. @@ -1726,7 +1754,14 @@ (or (= type-tag type-name) (and (> (length type-tag) (length type-name)) (= (string/slice type-tag (- (length type-tag) (length type-name))) - type-name)))) + type-name)) + # instance? of a PROTOCOL works like satisfies?: a reify implementing + # it is an instance. The reify records every protocol it implements + # (short names); (instance? a.b.Proto x) passes a qualified name, so + # match by short name against any of them. (malli relies on this.) + (let [protos (if (table? val) (get val :jolt/protocols)) + tn-short (last (string/split "." type-name))] + (and protos (truthy? (some (fn [p] (= (last (string/split "." p)) tn-short)) protos)))))) (match (type-sym :name) "Number" (number? val) "java.lang.Number" (number? val) @@ -2473,7 +2508,10 @@ (if (or (function? method-fn) (cfunction? method-fn)) (method-fn target ;args) (error (string "Cannot call non-function " field-name " on " (type target))))) - (error (string "Cannot call non-function " field-name " on " (type target)))))) + (let [r (if coll-interop (coll-interop target field-name args) :jolt/ci-none)] + (if (= r :jolt/ci-none) + (error (string "Cannot call non-function " field-name " on " (type target))) + r))))) (error (string "Cannot call method " field-name " on " (type target)))))))))) # (. obj member) with no extra args: a symbol member naming a # function is a zero-arg method call (receiver passed as self); @@ -2496,6 +2534,10 @@ (get tagged-methods (get target :jolt/type)) (get (get tagged-methods (get target :jolt/type)) field-name)) ((get (get tagged-methods (get target :jolt/type)) field-name) target) + # zero-arg Java collection interop (.count/.seq/… on a jolt collection) + # before field lookup — coll-interop returns :jolt/ci-none if not its kind + (let [ci (if coll-interop (coll-interop target field-name @[]) :jolt/ci-none)] + (if (not= ci :jolt/ci-none) ci (let [v (if (record-tag target) (coll-lookup target (keyword field-name) nil) (get target (keyword field-name)))] @@ -2513,7 +2555,7 @@ (array? v) (let [f (eval-form ctx bindings v)] (if (or (function? f) (cfunction? f)) (f target) f)) v) - v)))))))) + v)))))))))) # default: function application — check for macros (if (and (struct? first-form) (= :symbol (first-form :jolt/type))) (let [sym-name (first-form :name)] diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index 2b874f7..5600565 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -409,13 +409,19 @@ (register-tagged-methods! :jolt/hashmap @{"get" (fn [self k] (get (self :tbl) k)) "put" (fn [self k v] (put (self :tbl) k v) v) + "putAll" (fn [self m] (each pair (hm-entries m) (put (self :tbl) (in pair 0) (in pair 1))) nil) "containsKey" (fn [self k] (not (nil? (get (self :tbl) k)))) "size" (fn [self] (length (self :tbl)))}) (each nm ["HashMap" "java.util.HashMap"] + # java.util.HashMap constructors: (), (initialCapacity), (initialCapacity, + # loadFactor) all start empty; (Map m) copies entries. A numeric first arg is + # a capacity (sizing hint we ignore), not content. (register-class-ctor! nm - (fn [&opt init] + (fn [& args] (def tbl @{}) - (when init (each pair (hm-entries init) (put tbl (in pair 0) (in pair 1)))) + (def init (if (> (length args) 0) (in args 0) nil)) + (when (and init (not (number? init))) + (each pair (hm-entries init) (put tbl (in pair 0) (in pair 1)))) @{:jolt/type :jolt/hashmap :tbl tbl}))) (each nm ["MapEntry" "clojure.lang.MapEntry"] (register-class-ctor! nm (fn [k v] [k v]))) diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index 93d8690..1f1ff44 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -714,9 +714,11 @@ (read-quote s (+ pos 2) (sym "unquote-splicing")) (read-quote s (+ pos 1) (sym "unquote"))) - # deref + # deref — @x is (clojure.core/deref x), QUALIFIED like Clojure, so it + # still derefs even where a ns shadows `deref` (malli excludes and + # redefines clojure.core/deref for its own schema-deref). (= c 64) - (read-quote s (+ pos 1) (sym "deref")) + (read-quote s (+ pos 1) (sym "clojure.core/deref")) # metadata (= c 94) diff --git a/test/spec/protocols-spec.janet b/test/spec/protocols-spec.janet index b6606cf..b14a723 100644 --- a/test/spec/protocols-spec.janet +++ b/test/spec/protocols-spec.janet @@ -42,6 +42,12 @@ "(do (defprotocol P (m [_])) (defrecord R [] P (m [_] 1)) (satisfies? P (->R)))"] ["satisfies? false" "false" "(do (defprotocol P (m [_])) (defrecord R []) (satisfies? P (->R)))"] + ["satisfies? reify" "true" + "(do (defprotocol P (m [_])) (satisfies? P (reify P (m [_] 1))))"] + ["satisfies? reify multi-protocol" "[true true]" + "(do (defprotocol P (m [_])) (defprotocol Q (n [_])) (let [r (reify P (m [_] 1) Q (n [_] 2))] [(satisfies? P r) (satisfies? Q r)]))"] + ["satisfies? reify other proto" "false" + "(do (defprotocol P (m [_])) (defprotocol Q (n [_])) (satisfies? Q (reify P (m [_] 1))))"] ["instance? record" "true" "(do (defrecord R [a]) (instance? R (->R 1)))"] ["dot constructor" "5" diff --git a/test/unit/reader-test.janet b/test/unit/reader-test.janet index b151b10..c528e02 100644 --- a/test/unit/reader-test.janet +++ b/test/unit/reader-test.janet @@ -80,7 +80,9 @@ "unquote") (assert (deep= @[(sym "unquote-splicing") (sym "x")] (parse-string "~@x")) "unquote-splicing") -(assert (deep= @[(sym "deref") (sym "x")] (parse-string "@x")) +# @x reads as the QUALIFIED clojure.core/deref (like Clojure) so it derefs even +# where a ns excludes/rebinds `deref` (e.g. malli). +(assert (deep= @[(sym "clojure.core/deref") (sym "x")] (parse-string "@x")) "deref shorthand") # Metadata: a keyword/symbol/string hint on a symbol attaches to the symbol's