perf: generation-guarded inline cache for host-value protocol dispatch

Host-value protocol dispatch (a protocol extended to Number/String/… called on a
host value) recomputed the candidate type-tag list and walked the registry — up
to ~15 map lookups plus an array alloc — on every call. It now caches
(most-specific-host-tag, protocol, method) -> fn, guarded by a registry
generation that bumps in register-protocol-method; re-extending a protocol
invalidates the cache. The single-lookup fast paths (deftype protocol dispatch,
direct multimethod dispatch) are untouched — they're already cheap, so no cache
overhead there. The multimethod hierarchy-fallback cache (narrower: only
derive-based dispatch) is deferred.

Test in test/integration/dispatch-cache-test.janet covers correctness under
re-extension in all three modes. Conformance 218/218; battery 3916.

src/jolt/evaluator.janet

@@ -1069,12 +1069,30 @@
                               (let [fn (find-protocol-method ctx type-tag proto-name method-name)]
                                 (if fn (apply fn obj rest-args)
                                   (error (string "No method " method-name " in " proto-name " for " type-tag))))
-                              # host value: try candidate host type-tags (Long/String/Object/...)
+                              # host value: try candidate host type-tags (Long/String/Object/...).
-                              (let [cands (value-host-tags obj)]
+                              # Generation-guarded inline cache: the candidate
-                                (var found nil)
+                              # walk (array alloc + up to ~15 registry lookups) is
-                                (each tag cands
+                              # the same for every value of a given host class, so
-                                  (when (nil? found)
+                              # cache (most-specific-tag, proto, method) -> fn,
-                                    (set found (find-protocol-method ctx tag proto-name method-name))))
+                              # invalidated when the registry generation bumps.
+                              (let [env (ctx :env)
+                                    reg-gen (or (get env :type-registry-gen) 0)
+                                    pc (let [c (get env :proto-dispatch-cache)]
+                                         (if (and c (= (c :gen) reg-gen)) c
+                                           (let [n @{:gen reg-gen :map @{}}]
+                                             (put env :proto-dispatch-cache n) n)))
+                                    cands (value-host-tags obj)
+                                    ckey [(first cands) proto-name method-name]
+                                    cached (get (pc :map) ckey)
+                                    found (if (nil? cached)
+                                            (let [f (do (var r nil)
+                                                      (each tag cands
+                                                        (when (nil? r)
+                                                          (set r (find-protocol-method ctx tag proto-name method-name))))
+                                                      r)]
+                                              (put (pc :map) ckey (if f f :jolt/none))
+                                              f)
+                                            (if (= cached :jolt/none) nil cached))]
                                 (if found (apply found obj rest-args)
                                   (error (string "No dispatch for " method-name " on " (type obj))))))))
     "register-method" (let [type-sym (in form 1)

src/jolt/types.janet

@@ -500,12 +500,15 @@
 (defn register-protocol-method
   "Register a protocol method implementation for a type."
   [ctx type-tag protocol-name method-name fn]
-  (let [registry (get (ctx :env) :type-registry)
+  (let [env (ctx :env)
+        registry (get env :type-registry)
         type-impls (or (get registry type-tag)
                       (do (put registry type-tag @{}) (get registry type-tag)))
         proto-impls (or (get type-impls protocol-name)
                        (do (put type-impls protocol-name @{}) (get type-impls protocol-name)))]
-    (put proto-impls method-name fn)))
+    (put proto-impls method-name fn)
+    # Bump the registry generation so any dispatch cache keyed on it invalidates.
+    (put env :type-registry-gen (+ 1 (or (get env :type-registry-gen) 0)))))
 
 (defn find-protocol-method
   "Find a protocol method implementation for a type."

test/integration/dispatch-cache-test.janet

@@ -0,0 +1,33 @@
+# Protocol host-value dispatch cache (jolt-4ay).
+#
+# Host-value protocol dispatch used to recompute the candidate type-tag list and
+# walk the registry on every call. It's now a generation-guarded cache keyed by
+# (most-specific-host-tag, protocol, method); registering a protocol impl bumps
+# the registry generation and invalidates it. This pins correctness: the cache
+# must never hide a re-extension.
+
+(use ../../src/jolt/api)
+
+(var failures 0)
+(defn- check [label got want]
+  (unless (= got want)
+    (++ failures)
+    (printf "FAIL [%s] got %q want %q" label got want)))
+
+(each mode [{:compile? true} {} {:aot-core? false}]
+  (def ctx (init mode))
+  (eval-string ctx "(defprotocol P (m [x]))")
+  (eval-string ctx "(extend-protocol P Number (m [x] (* x 2)))")
+  (check (string mode " host dispatch") (eval-string ctx "(m 5)") 10)
+  (check (string mode " cache hit (same class)") (eval-string ctx "(m 7)") 14)
+  # Re-extend: registry generation bumps, cache must invalidate.
+  (eval-string ctx "(extend-protocol P Number (m [x] (+ x 100)))")
+  (check (string mode " sees re-extension") (eval-string ctx "(m 5)") 105)
+  # Extending a different host class bumps gen too; number impl re-resolves.
+  (eval-string ctx "(extend-protocol P String (m [x] (str \"s:\" x)))")
+  (check (string mode " other class") (eval-string ctx "(m \"hi\")") "s:hi")
+  (check (string mode " number after other-class extend") (eval-string ctx "(m 3)") 103))
+
+(if (pos? failures)
+  (do (printf "dispatch-cache: %d failure(s)" failures) (os/exit 1))
+  (print "dispatch-cache: all cases passed (compile, interpret, aot-core off)"))