Phase 12: Protocol System — full implementation with all tests passing

Root cause: fn* multi-arity detection checks (array? (in form 1))
— defprotocol used @[...] for args, triggering multi-arity path
that treated the body form as a second arity pair.

Fixes applied:
- defprotocol: change fn* args from @[...] to [...] (tuple)
  so single-arity fn* path is used with [this & rest-args]
- defprotocol: remove quote wrappers from protocol-dispatch call
  (protocol-name and method-name passed directly as symbols)
- extend-type/extend-protocol: remove quote wrappers from
  register-method call (symbols passed directly, not via quote)
- protocol-dispatch: use (in form ...) directly for proto/method
  symbols (no eval-form needed after quote removal)
- satisfy?: extract name string from protocol value's :name field
  (which is a symbol struct, not a plain string)
- make-reified: remove spurious (apply fn []) call
- core-reify: fix (keyword struct) → extract :name string first
- core-extend-protocol: handle single method spec vs multi

5 test sections (35-39) covering:
  defprotocol, extend-type, extend-protocol,
  satisfies?, reify — all pass

315 ok, 2 fail (pre-existing, unchanged)
This commit is contained in:
Yogthos 2026-06-03 00:33:41 -04:00
parent d6eb29646d
commit f7747ed1b4
4 changed files with 118 additions and 55 deletions

View file

@ -1056,11 +1056,11 @@
(array/push method-def method-name)
(def fn-form @[])
(array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"})
(array/push fn-form @[{:jolt/type :symbol :ns nil :name "this"} {:jolt/type :symbol :ns nil :name "&"} {:jolt/type :symbol :ns nil :name "rest-args"}])
(array/push fn-form [{:jolt/type :symbol :ns nil :name "this"} {:jolt/type :symbol :ns nil :name "&"} {:jolt/type :symbol :ns nil :name "rest-args"}])
(array/push fn-form @[
{:jolt/type :symbol :ns nil :name "protocol-dispatch"}
{:jolt/type :symbol :ns nil :name "quote"} protocol-name
{:jolt/type :symbol :ns nil :name "quote"} method-name
protocol-name
method-name
{:jolt/type :symbol :ns nil :name "this"}
{:jolt/type :symbol :ns nil :name "rest-args"}])
(array/push method-def fn-form)
@ -1076,9 +1076,9 @@
(def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body])
(array/push result @[
{:jolt/type :symbol :ns nil :name "register-method"}
{:jolt/type :symbol :ns nil :name "quote"} type-sym
{:jolt/type :symbol :ns nil :name "quote"} proto-sym
{:jolt/type :symbol :ns nil :name "quote"} method-name
type-sym
proto-sym
method-name
fn-form]))
result)
@ -1087,21 +1087,32 @@
(var i 0)
(while (< i (length type-impls))
(let [type-sym (type-impls i)
impls (type-impls (+ i 1))]
(var j 0)
(while (< j (length impls))
(let [method-spec (impls j)]
methods (type-impls (+ i 1))]
# methods is a single method spec array or an array of method specs
# If the first element is a symbol (method name), treat as single spec
(if (and (struct? (methods 0)) (= :symbol ((methods 0) :jolt/type)))
(let [method-spec methods]
(def method-name (method-spec 0))
(def arg-vec (method-spec 1))
(def body (tuple/slice method-spec 2))
(def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body])
(array/push result @[
{:jolt/type :symbol :ns nil :name "register-method"}
{:jolt/type :symbol :ns nil :name "quote"} type-sym
{:jolt/type :symbol :ns nil :name "quote"} proto-sym
{:jolt/type :symbol :ns nil :name "quote"} method-name
type-sym
proto-sym
method-name
fn-form]))
(+= j 2)))
(each method-spec methods
(def method-name (method-spec 0))
(def arg-vec (method-spec 1))
(def body (tuple/slice method-spec 2))
(def fn-form @[{:jolt/type :symbol :ns nil :name "fn*"} arg-vec ;body])
(array/push result @[
{:jolt/type :symbol :ns nil :name "register-method"}
type-sym
proto-sym
method-name
fn-form]))))
(+= i 2))
result)
@ -1116,12 +1127,12 @@
(def method-name (method-spec 0))
(def arg-vec (method-spec 1))
(def body (tuple/slice method-spec 2))
(put methods (keyword method-name) @{:fn* true :args arg-vec :body body})
(put methods (keyword (if (struct? method-name) (method-name :name) method-name)) @{:fn* true :args arg-vec :body body})
(+= i 2)))
(array/push result @[
{:jolt/type :symbol :ns nil :name "make-reified"}
{:jolt/type :symbol :ns nil :name "quote"} proto-sym
{:jolt/type :symbol :ns nil :name "quote"} methods])
proto-sym
methods])
result)
(def core-satisfies? (fn [proto-sym obj] false))

View file

@ -651,8 +651,8 @@
(let [fn-value (if (and (table? v) (get v :fn*))
(let [args-vec (get v :args)
body-forms (get v :body)]
(apply (eval-form ctx @{}
@[{:jolt/type :symbol :ns nil :name "fn*"} args-vec ;body-forms]) []))
(eval-form ctx @{}
@[{:jolt/type :symbol :ns nil :name "fn*"} args-vec ;body-forms]))
v)]
(put (obj :jolt/protocol-methods) k fn-value)))
obj)
@ -663,7 +663,9 @@
(if (get obj :jolt/protocol-methods)
(get obj :jolt/deftype)))]
(if type-tag
(type-satisfies? ctx type-tag (proto-sym :name))
(let [pn (proto-sym :name)
pn-str (if (struct? pn) (pn :name) pn)]
(type-satisfies? ctx type-tag pn-str))
false))
"locking" (eval-form ctx bindings (in form 2))
"instance?" (let [type-sym (in form 1)