diff --git a/host/chez/driver.janet b/host/chez/driver.janet index 9a6772b..682db73 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -417,6 +417,7 @@ " (zj-prune! ns-registry zj-ns-base)\n" " (zj-prune! type-registry zj-type-base)\n" " (hashtable-clear! ns-alias-table)\n" + " (hashtable-clear! ns-refer-table)\n" " (when zj-ghier (jolt-invoke (var-deref \"clojure.core\" \"reset!\")\n" " (var-cell-root zj-ghier) (jolt-invoke (var-deref \"clojure.core\" \"make-hierarchy\"))))\n" " (set-chez-ns! \"user\"))\n" diff --git a/host/chez/host-contract.ss b/host/chez/host-contract.ss index 3aae8b6..f5c9608 100644 --- a/host/chez/host-contract.ss +++ b/host/chez/host-contract.ss @@ -134,6 +134,9 @@ (let ((target (or (chez-resolve-alias (chez-actx-cns ctx) qualified) qualified))) (var-cell-lookup target nm)) (or (var-cell-lookup (chez-actx-cns ctx) nm) + ;; a :refer'd name resolves to its source ns + (let ((ref (chez-resolve-refer (chez-actx-cns ctx) nm))) + (and ref (var-cell-lookup ref nm))) (var-cell-lookup "clojure.core" nm))))) ;; Runtime macros (jolt-r9lm, inc6b): a defmacro is emitted into the prelude as a diff --git a/host/chez/ns.ss b/host/chez/ns.ss index 23ac14e..470e461 100644 --- a/host/chez/ns.ss +++ b/host/chez/ns.ss @@ -34,8 +34,15 @@ (hashtable-set! ns-alias-table (cons cns alias) target)) (define (chez-resolve-alias cns alias) (hashtable-ref ns-alias-table (cons cns alias) #f)) -;; parse a require/use spec FORM and register its :as alias under `cns`. -;; spec: [ns :as a ...] / (ns :as a ...) / bare ns (no alias). +;; :refer brings an UNQUALIFIED name into cns, resolving to target-ns/name. +(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)) +(define (chez-resolve-refer cns name) + (hashtable-ref ns-refer-table (cons cns name) #f)) +;; 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. (define (chez-register-spec! cns spec) (let ((items (cond ((pvec? spec) (seq->list spec)) ((or (cseq? spec) (empty-list-t? spec)) (seq->list spec)) @@ -43,11 +50,18 @@ (when (and (pair? items) (symbol-t? (car items))) (let ((target (symbol-t-name (car items)))) (let loop ((xs (cdr items))) - (cond ((or (null? xs) (null? (cdr xs))) #f) - ((and (keyword? (car xs)) (string=? (keyword-t-name (car xs)) "as") - (symbol-t? (cadr xs))) - (chez-register-alias! cns (symbol-t-name (cadr xs)) target)) - (else (loop (cdr xs))))))))) + (when (and (pair? xs) (pair? (cdr xs))) + (let ((k (car xs)) (v (cadr xs))) + (when (keyword? k) + (cond + ((string=? (keyword-t-name k) "as") + (when (symbol-t? v) (chez-register-alias! cns (symbol-t-name v) target))) + ((string=? (keyword-t-name k) "refer") + (when (pvec? v) + (for-each (lambda (n) + (when (symbol-t? n) (chez-register-refer! cns (symbol-t-name n) target))) + (seq->list v))))))) + (loop (cddr xs)))))))) ;; a namespace designator -> its name string (a jns or a symbol; the corpus never ;; passes a bare string). diff --git a/test/chez/run-corpus-zero-janet.janet b/test/chez/run-corpus-zero-janet.janet index d2fb7c4..51ae912 100644 --- a/test/chez/run-corpus-zero-janet.janet +++ b/test/chez/run-corpus-zero-janet.janet @@ -163,7 +163,7 @@ # Regression floor: raise as the Chez-hosted compiler closes gaps. The gate fails # on any NEW divergence or if pass drops below the floor. Strided runs scale to 0. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2293"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2295"))) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))