fa02c8f93d
A protocol method call compiles to (protocol-dispatch proto method this rest) — a
runtime registry walk (type-tag -> proto -> method) on every call, ~19x a direct
call. When the inference proves the receiver (arg 0) is a known record type, the
call now resolves to a DIRECT method call at compile time, skipping the registry.
- defprotocol registers each method's var-key 'ns/method' -> [proto method] (a
ctx-capturing register-protocol-methods! emitted into the do-block); infer-unit!
feeds it to the inference via a box (like record-shapes).
- the record-ctor return type carries :type (the record tag) so the inference
knows the receiver type; the :else invoke case annotates a protocol call whose
arg0 has a known :type with :devirt-{type,proto,method}.
- emit-invoke resolves the impl via find-protocol-method at emit time and emits a
direct call to the embedded impl fn value. Unknown/polymorphic receivers (no
proven :type) fall back to the dispatch path unchanged.
Measured: removes the dispatch overhead (14.7s -> 9.3s on a 10M-call loop); the
remaining cost is the method body itself (non-inlined, unproven reads) — inlining
the resolved method is the follow-up (jolt-t6r) toward direct-call speed.
Sound under the closed-world assumption direct-linking already makes (the impl is
resolved + embedded at compile time). Adds devirt-test (subprocess: dispatched ==
devirtualized across polymorphic dispatch, unknown-receiver fallback, and
heterogeneous collections). Stalin's compile-call/callee-environment is the model.
41 lines
2.2 KiB
Text
41 lines
2.2 KiB
Text
# Protocol-dispatch devirtualization (jolt-41m): when the inference proves a
|
|
# protocol call's receiver is a known record type, the call is compiled to a
|
|
# DIRECT method call, skipping the runtime dispatch registry. This must stay
|
|
# SOUND — same results as the dispatched path — including polymorphic dispatch
|
|
# (the right method per type), fallback when the receiver type is unknown, and
|
|
# heterogeneous collections. Runs a protocol+record program through the built
|
|
# binary (devirt needs infer-unit!, which runs on ns load, not eval-string) and
|
|
# checks the output. Skips cleanly if build/jolt is absent.
|
|
(def jolt "build/jolt")
|
|
|
|
(defn- run [whole?]
|
|
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dv-test"))
|
|
(os/mkdir dir)
|
|
(spit (string dir "/dv.clj")
|
|
(string
|
|
"(ns dv)\n"
|
|
"(defprotocol Shape (area [s]) (kind [s]))\n"
|
|
"(defrecord Rect [w h] Shape (area [r] (* (:w r) (:h r))) (kind [_] :rect))\n"
|
|
"(defrecord Circ [r] Shape (area [c] (* 3 (:r c) (:r c))) (kind [_] :circ))\n"
|
|
"(defn poly [s] (area s))\n" # receiver unknown -> must fall back
|
|
"(defn -main []\n"
|
|
" (println (area (->Rect 3 4)) (area (->Circ 5))\n" # devirt: 12 75
|
|
" (kind (->Rect 1 1)) (kind (->Circ 1))\n" # devirt: :rect :circ
|
|
" (poly (->Rect 3 4)) (poly (->Circ 5))\n" # fallback: 12 75
|
|
" (mapv area [(->Rect 2 3) (->Circ 2)])))\n")) # heterogeneous: [6 12]
|
|
(def out (string dir "/out.txt"))
|
|
(def jbin (string (os/cwd) "/" jolt))
|
|
(def cmd (string (if whole? "JOLT_WHOLE_PROGRAM=1 " "")
|
|
"JOLT_DIRECT_LINK=1 JOLT_PATH=" dir " " jbin " -m dv > " out " 2>&1"))
|
|
(os/execute ["sh" "-c" cmd] :p)
|
|
(string/trimr (slurp out)))
|
|
|
|
(def expected "12 75 :rect :circ 12 75 [6 12]")
|
|
(if (not (os/stat jolt))
|
|
(print "devirt: SKIP (no build/jolt — run from source)")
|
|
(let [per-ns (run false) whole (run true)]
|
|
(printf " per-ns: %s" per-ns)
|
|
(printf " whole-program: %s" whole)
|
|
(if (and (= per-ns expected) (= whole expected))
|
|
(print "devirt: correct (dispatched == devirtualized)")
|
|
(do (printf "devirt: WRONG — expected %q" expected) (os/exit 1)))))
|