diff --git a/host/chez/host-class.ss b/host/chez/host-class.ss index 905d07d..70e668d 100644 --- a/host/chez/host-class.ss +++ b/host/chez/host-class.ss @@ -55,13 +55,11 @@ ;; fully-qualified canonical class names self-evaluate to their own name string, ;; so (= (class 1) java.lang.Long) and (instance? clojure.lang.Atom x) resolve the ;; class token (= what jolt-class / instance-check key on). +;; Value classes only — NOT the collection interfaces (ISeq/IPersistentMap/...), +;; which downstream code (e.g. SCI) references as protocols/interfaces. (for-each (lambda (nm) (def-var! "clojure.core" nm nm)) '("java.lang.Long" "java.lang.Integer" "java.lang.Double" "java.lang.Float" "java.lang.Number" "java.lang.String" "java.lang.Boolean" "java.lang.Character" - "java.lang.Object" "java.lang.CharSequence" "java.lang.Comparable" - "clojure.lang.Keyword" "clojure.lang.Symbol" "clojure.lang.Ratio" "clojure.lang.BigInt" - "clojure.lang.Atom" "clojure.lang.IFn" "clojure.lang.Fn" "clojure.lang.ISeq" - "clojure.lang.IPersistentMap" "clojure.lang.IPersistentVector" "clojure.lang.IPersistentCollection" - "clojure.lang.PersistentVector" "clojure.lang.Var" "clojure.lang.Namespace" - "clojure.lang.MapEntry")) + "java.lang.Object" + "clojure.lang.Keyword" "clojure.lang.Symbol" "clojure.lang.Ratio" "clojure.lang.Atom")) diff --git a/host/chez/multimethods.ss b/host/chez/multimethods.ss index 12c7a69..c5f99a6 100644 --- a/host/chez/multimethods.ss +++ b/host/chez/multimethods.ss @@ -58,22 +58,21 @@ (let* ((nm (symbol-t-name mm-sym)) (sns (symbol-t-ns mm-sym)) (qns (and sns (not (jolt-nil? sns)) (not (null? sns)) sns)) - ;; resolve the multifn's HOME ns like a var: a qualified name in its own ns - ;; (cross-ns defmethod); an unqualified name via current ns -> :refer -> - ;; clojure.core, so (defmethod print-method ...) finds clojure.core's multifn - ;; instead of auto-creating a stray one in the current ns. - (mns (cond - (qns (or (chez-resolve-alias (chez-current-ns) qns) qns)) - ((let ((c (var-cell-lookup (chez-current-ns) nm))) (and c (var-cell-defined? c))) - (chez-current-ns)) - ((chez-resolve-refer (chez-current-ns) nm)) - ((let ((c (var-cell-lookup "clojure.core" nm))) (and c (var-cell-defined? c))) - "clojure.core") - (else (chez-current-ns)))) + ;; 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))) (cur (var-deref mns nm)) (mf (if (jolt-multifn? cur) cur - (let ((m (make-jolt-multifn nm (var-deref "clojure.core" "identity") - (new-mm-table) kw-default #f (new-mm-table)))) + ;; auto-create: copy the dispatch fn + default from a same-named + ;; clojure.core multifn (e.g. print-method's 2-arg dispatch) so a + ;; (defmethod print-method ...) before naming clojure.core's still + ;; dispatches right — the old 1-arg identity fallback crashed. + (let* ((core (var-deref "clojure.core" nm)) + (disp (if (jolt-multifn? core) + (jolt-multifn-dispatch-fn core) + (var-deref "clojure.core" "identity"))) + (deft (if (jolt-multifn? core) (jolt-multifn-default core) kw-default)) + (m (make-jolt-multifn nm disp (new-mm-table) deft #f (new-mm-table)))) (def-var! mns nm m) m)))) (hashtable-set! (jolt-multifn-methods mf) dval impl) mf))