Fixed-arity protocol dispatch shims (#223)

defprotocol emitted one variadic (fn [this & rest] (protocol-dispatch P m this
(list->cseq rest))) per method, so every protocol call — even a no-extra-arg one
like (area s) — consed a rest list, wrapped it in a cseq, var-deref'd
protocol-dispatch, and jolt-invoke'd it (consing again). On mono-dispatch that was
2.07GB of allocation, ~65% of the benchmark.

Emit one fixed-arity clause per declared arglist instead. The 1/2/3-param arities
call positional protocol-dispatch{1,2,3}, which resolve the impl (by record tag,
reify method, or host-tag extension — factored into protocol-resolve) and apply it
directly; no rest-list, no seq round-trip. The dispatchN entry points are in the
native-op table so the shim calls bind straight to the records.ss procedures
rather than var-deref. 4+ params fall back to the variadic protocol-dispatch.

mono-dispatch 1.5s/2.07GB -> 0.69s/280MB; dispatch 26x -> 12.2x, mono-dispatch
111x -> 51x vs JVM. 5 new corpus rows pin multi-arity methods, host-type args,
and protocol-method-as-value against JVM Clojure.

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-26 05:57:42 +00:00 committed by GitHub
parent 8bea1abe12
commit 0a7e818700
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
6 changed files with 663 additions and 625 deletions

View file

@ -432,13 +432,28 @@
;; register method var-keys for devirtualization; the inference
;; reads this (via infer-unit!) to resolve a protocol call on a known record
(register-protocol-methods! ~(name pname) [~@(map (fn [s] (name (first s))) sigs)])
;; one fn clause per declared arity. The protocol/method NAMES pass as
;; strings so the body compiles as a plain invoke (not symbol-as-var). The
;; common 1/2/3-param arities call positional protocol-dispatchN, which
;; applies the impl directly — no rest-list cons; 4+ params fall back to the
;; variadic protocol-dispatch with a vector of the extra args.
~@(map (fn [sig]
`(def ~(first sig)
;; protocol-dispatch is a fn (clojure.core); pass the protocol /
;; method NAMES as strings (not the symbols) so it compiles as a
;; plain invoke rather than evaluating the symbols as vars.
(fn* [this# & rest#]
(protocol-dispatch ~(name pname) ~(name (first sig)) this# rest#))))
(let [pn (name pname)
mn (name (first sig))
arglists (filter vector? (rest sig))
clause (fn [argv]
(let [ps (mapv (fn [_] (fresh-sym)) argv)
n (count ps)
obj (first ps)]
(cond
(= n 1) (list ps (list 'protocol-dispatch1 pn mn obj))
(= n 2) (list ps (list 'protocol-dispatch2 pn mn obj (nth ps 1)))
(= n 3) (list ps (list 'protocol-dispatch3 pn mn obj (nth ps 1) (nth ps 2)))
:else (list ps (list 'protocol-dispatch pn mn obj (vec (rest ps)))))))]
(if (seq arglists)
`(def ~(first sig) (fn* ~@(map clause arglists)))
`(def ~(first sig)
(fn* [this# & rest#] (protocol-dispatch ~pn ~mn this# rest#))))))
sigs))))
;; Member threading: (.. x f g) => (. (. x f) g); a parenthesized member