From 44b7f39562b6d0944be7ff67aa79c610c0f1c6a0 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 24 Jun 2026 09:13:28 -0400 Subject: [PATCH] defmethod on a referred multifn resolves to its home ns MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A (defmethod m …) where m is :refer'd from another ns passed the bare symbol to defmethod-setup, which resolved it in the current ns and created a shadow multifn — the method never reached the real one. Resolve an unqualified name through the refer table (then current ns) so it lands on the referred multifn. The AOT build strips the ns form, so the refer table is empty in a binary; emit chez-register-refer!/-refer-all! per app ns alongside the existing alias registrations. build-app's fixture gains a defmethod on a referred multifn. --- host/chez/build-smoke.sh | 3 ++- host/chez/build.ss | 24 ++++++++++++++++++++---- host/chez/multimethods.ss | 10 ++++++++-- test/chez/build-app/src/app/core.clj | 9 +++++++-- 4 files changed, 37 insertions(+), 9 deletions(-) diff --git a/host/chez/build-smoke.sh b/host/chez/build-smoke.sh index b2a61ea..95ae1f2 100755 --- a/host/chez/build-smoke.sh +++ b/host/chez/build-smoke.sh @@ -46,7 +46,8 @@ HELLO FROM A BUILT BINARY! args: [alpha bb ccc] sum: 10 greet-default: greet:default -greet-loud: greet:loud' +greet-loud: greet:loud +greet-soft: greet:soft' if [ "$got" != "$want" ]; then echo " FAIL: binary output mismatch" echo "--- want ---"; echo "$want" diff --git a/host/chez/build.ss b/host/chez/build.ss index 1dc401e..bb36752 100644 --- a/host/chez/build.ss +++ b/host/chez/build.ss @@ -185,10 +185,26 @@ (let loop ((xs (cdr items))) (when (and (pair? xs) (pair? (cdr xs))) (let ((k (car xs)) (v (cadr xs))) - (when (and (keyword? k) (string=? (keyword-t-name k) "as") (symbol-t? v)) - (emit! (string-append "(chez-register-alias! " (ei-str-lit ns-name) - " " (ei-str-lit (symbol-t-name v)) - " " (ei-str-lit target) ")")))) + (when (keyword? k) + (cond + ((and (string=? (keyword-t-name k) "as") (symbol-t? v)) + (emit! (string-append "(chez-register-alias! " (ei-str-lit ns-name) + " " (ei-str-lit (symbol-t-name v)) + " " (ei-str-lit target) ")"))) + ;; :refer [a b] / :refer :all — a defmethod on a referred multifn + ;; resolves the bare name through the refer table at runtime. + ((or (string=? (keyword-t-name k) "refer") (string=? (keyword-t-name k) "only")) + (cond + ((and (keyword? v) (string=? (keyword-t-name v) "all")) + (emit! (string-append "(chez-register-refer-all! " (ei-str-lit ns-name) + " " (ei-str-lit target) ")"))) + ((or (pvec? v) (and (cseq? v) (cseq-list? v))) + (for-each (lambda (n) + (when (symbol-t? n) + (emit! (string-append "(chez-register-refer! " (ei-str-lit ns-name) + " " (ei-str-lit (symbol-t-name n)) + " " (ei-str-lit target) ")")))) + (seq->list v)))))))) (loop (cddr xs)))))))) (define (bld-ns-prelude ns-name src) diff --git a/host/chez/multimethods.ss b/host/chez/multimethods.ss index 3233e26..f97c25d 100644 --- a/host/chez/multimethods.ss +++ b/host/chez/multimethods.ss @@ -73,8 +73,14 @@ (sns (symbol-t-ns mm-sym)) (qns (and sns (not (jolt-nil? sns)) (not (null? sns)) sns)) ;; qualified (cf.mm/ext) resolves in its own ns (cross-ns defmethod); - ;; unqualified stays in the current ns (a shadow, as before). - (mns (if qns (or (chez-resolve-alias (chez-current-ns) qns) qns) (chez-current-ns))) + ;; unqualified resolves in the current ns, else a :refer's home ns (so a + ;; defmethod on a referred multifn lands on the real one), else stays in + ;; the current ns (a shadow, as before). + (mns (cond + (qns (or (chez-resolve-alias (chez-current-ns) qns) qns)) + ((var-cell-lookup (chez-current-ns) nm) (chez-current-ns)) + ((chez-resolve-refer (chez-current-ns) nm) => values) + (else (chez-current-ns)))) (cur (var-deref mns nm)) (mf (if (jolt-multifn? cur) cur ;; auto-create: copy the dispatch fn + default from a same-named diff --git a/test/chez/build-app/src/app/core.clj b/test/chez/build-app/src/app/core.clj index c47c1fb..4914552 100644 --- a/test/chez/build-app/src/app/core.clj +++ b/test/chez/build-app/src/app/core.clj @@ -1,5 +1,5 @@ (ns app.core - (:require [app.util :as util] + (:require [app.util :as util :refer [greet]] [clojure.java.io :as io])) ;; An aliased cross-ns defmethod: 'util/greet is passed quoted to defmethod-setup, @@ -7,6 +7,10 @@ ;; ns "util" and never reaches app.util/greet (the dispatch falls to :default). (defmethod util/greet :loud [_] "greet:loud") +;; A defmethod on a REFERRED multifn (bare `greet`): the AOT build must register +;; the :refer so the bare name resolves to app.util/greet, not a shadow. +(defmethod greet :soft [_] "greet:soft") + (defn -main [& args] ;; the resource is baked into the binary (deps.edn :jolt/build :embed), so this ;; resolves with no resources/ dir on disk, run from any cwd. @@ -15,4 +19,5 @@ (println "args:" (vec args)) (println "sum:" (reduce + (map count args))) (println "greet-default:" (util/greet :unknown)) - (println "greet-loud:" (util/greet :loud))) + (println "greet-loud:" (util/greet :loud)) + (println "greet-soft:" (util/greet :soft)))