diff --git a/host/chez/compile-eval.ss b/host/chez/compile-eval.ss index 1b4f3d1..720b944 100644 --- a/host/chez/compile-eval.ss +++ b/host/chez/compile-eval.ss @@ -108,11 +108,15 @@ ;; visible (macro flag set, var interned) before a later subform is analyzed. (define (jolt-compile-eval-form form ns) (cond + ;; thread the current ns: an earlier subform may switch it (ns/in-ns call + ;; set-chez-ns!), and the next subform must be ANALYZED in that ns so its defs + ;; land there and its refs resolve (cross-ns def/require in one program). ((ce-top-do? form) - (let loop ((fs (cdr (seq->list form))) (result jolt-nil)) + (let loop ((fs (cdr (seq->list form))) (result jolt-nil) (cur ns)) (if (null? fs) result - (loop (cdr fs) (jolt-compile-eval-form (car fs) ns))))) + (let ((r (jolt-compile-eval-form (car fs) cur))) + (loop (cdr fs) r (chez-current-ns)))))) ;; runtime defmacro: def the expander fn + mark the var a macro so subsequent ;; forms expand it (hc-macro? reads var-macro-table). Mirrors emit-image.ss ;; ei-emit-ns. diff --git a/host/chez/multimethods.ss b/host/chez/multimethods.ss index 2aa5660..4af26e3 100644 --- a/host/chez/multimethods.ss +++ b/host/chez/multimethods.ss @@ -56,11 +56,16 @@ ;; if absent (defmethod before defmulti — rare; identity dispatch as a fallback). (define (jolt-defmethod-setup mm-sym dval impl) (let* ((nm (symbol-t-name mm-sym)) - (cur (var-deref (chez-current-ns) nm)) + ;; a QUALIFIED multifn (cf.mm/ext) resolves in its own ns (cross-ns + ;; defmethod), not the current one — else we'd auto-create a stray multifn. + (sns (symbol-t-ns mm-sym)) + (qns (and sns (not (jolt-nil? sns)) (not (null? sns)) sns)) + (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)))) - (def-var! (chez-current-ns) nm m) m)))) + (def-var! mns nm m) m)))) (hashtable-set! (jolt-multifn-methods mf) dval impl) mf)) diff --git a/host/chez/natives-str.ss b/host/chez/natives-str.ss index a108e12..d359010 100644 --- a/host/chez/natives-str.ss +++ b/host/chez/natives-str.ss @@ -286,4 +286,24 @@ (for-each (lambda (s) (chez-register-spec! (chez-current-ns) s)) specs) jolt-nil) (def-var! "clojure.core" "require" chez-runtime-require) -(def-var! "clojure.core" "use" chez-runtime-require) +;; use = require + refer ALL of the target's public vars (unless an explicit +;; :only/:refer filter is given, which chez-register-spec! handles per-name). +(define (chez-runtime-use . specs) + (for-each + (lambda (spec) + (chez-register-spec! (chez-current-ns) spec) + (let* ((items (cond ((pvec? spec) (seq->list spec)) + ((or (cseq? spec) (empty-list-t? spec)) (seq->list spec)) + ((symbol-t? spec) (list spec)) + (else '()))) + (target (and (pair? items) (symbol-t? (car items)) (symbol-t-name (car items)))) + (filtered (let scan ((xs (if (pair? items) (cdr items) '()))) + (cond ((null? xs) #f) + ((and (keyword? (car xs)) + (member (keyword-t-name (car xs)) '("only" "refer"))) #t) + (else (scan (cdr xs))))))) + (when (and target (not filtered)) + (chez-register-refer-all! (chez-current-ns) target)))) + specs) + jolt-nil) +(def-var! "clojure.core" "use" chez-runtime-use) diff --git a/host/chez/ns.ss b/host/chez/ns.ss index f0751b0..40dd2b3 100644 --- a/host/chez/ns.ss +++ b/host/chez/ns.ss @@ -38,8 +38,19 @@ (define ns-refer-table (make-hashtable equal-hash equal?)) (define (chez-register-refer! cns name target) (hashtable-set! ns-refer-table (cons cns name) target)) +;; refer-all (a bare `use`): cns -> list of fully-referred target ns names. A name +;; not found per-name resolves to the first refer-all target that defines it. +(define ns-refer-all-table (make-hashtable equal-hash equal?)) +(define (chez-register-refer-all! cns target) + (let ((cur (hashtable-ref ns-refer-all-table cns '()))) + (unless (member target cur) + (hashtable-set! ns-refer-all-table cns (cons target cur))))) (define (chez-resolve-refer cns name) - (hashtable-ref ns-refer-table (cons cns name) #f)) + (or (hashtable-ref ns-refer-table (cons cns name) #f) + (let loop ((ts (hashtable-ref ns-refer-all-table cns '()))) + (cond ((null? ts) #f) + ((let ((c (var-cell-lookup (car ts) name))) (and c (var-cell-defined? c))) (car ts)) + (else (loop (cdr ts))))))) ;; parse a require/use spec FORM and register its :as alias + :refer names under ;; `cns`. spec: [ns :as a :refer [x y] ...] / (ns ...) / bare ns. opts are ;; keyword/value pairs after the ns symbol. diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index c51ddb7..0c97938 100644 --- a/host/chez/run-corpus.ss +++ b/host/chez/run-corpus.ss @@ -11,7 +11,7 @@ ;; reset between cases so there is no leakage — same isolation a fresh process gives. ;; ;; chez --script host/chez/run-corpus.ss -;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2684) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2688) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -65,6 +65,7 @@ (zj-prune! type-registry zj-type-base) (hashtable-clear! ns-alias-table) (hashtable-clear! ns-refer-table) + (hashtable-clear! ns-refer-all-table) (when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!") (var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy")))) (set-chez-ns! "user")) @@ -202,7 +203,7 @@ ;; Regression floor: fail on any NEW divergence or if pass drops below the floor. (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR"))) - (if s (string->number s) 2684))) + (if s (string->number s) 2688))) (define floor (if limit 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n" diff --git a/host/chez/run-unit.ss b/host/chez/run-unit.ss index b87b668..d57b831 100644 --- a/host/chez/run-unit.ss +++ b/host/chez/run-unit.ss @@ -55,6 +55,7 @@ (zj-prune! type-registry zj-type-base) (hashtable-clear! ns-alias-table) (hashtable-clear! ns-refer-table) + (hashtable-clear! ns-refer-all-table) (when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!") (var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy")))) (set-chez-ns! "user"))