Protocol/interop fixes to run metosin/malli (jolt-ltwk) (#105)

* 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 <yogthos@gmail.com>

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 ...};

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

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]
+  ;; `body` is one or more protocols, each followed by its method specs:
-                `(register-method ~(if (nil? tsym) "nil" (name tsym)) ~(name psym) ~(name (first spec))
+  ;; (extend-type T P1 (m1 [_] ..) P2 (m2 [_] ..)) — a bare symbol switches the
-                                  (fn* ~(nth spec 1) ~@(drop 2 spec))))
+  ;; current protocol (like reify), so multiple protocols extend in one form.
-              impls)))
+  (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) (conj protos x) methods)
-          (recur (rest items) proto
+          (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)

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

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
+      (cond
-        (let [pn (proto :name)
+        (and protos (string? pn-str)
-              pn-str (if (struct? pn) (pn :name) pn)]
+             (truthy? (some (fn [p] (= (last (string/split "." p))
-          (type-satisfies? ctx type-tag pn-str))
+                                       (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)]

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])))

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)

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"

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