Chez inc7: :refer support — Chez analyzer reaches parity with the oracle

(require '[clojure.string :refer [blank?]]) then an unqualified blank? now
resolves. chez-register-spec! registers :refer names (in addition to :as) into a
refer table; hc-resolve-cell's unqualified branch consults it before clojure.core.

Zero-Janet corpus parity 2293 -> 2295 = the Janet-hosted oracle's exact pass
count. The self-hosted Chez compiler (read -> analyze -> emit -> eval, no Janet)
now compiles every corpus case the Janet-hosted compiler does, with 0
divergences. Remaining failures are shared runtime breadth (host interop,
futures, runtime eval) deferred to Phase 4 / jolt-r8ku. Floor 2295.

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"

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

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).

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)))