From 011e5d6337c60e3eadb78e449b3a16cb34b5b8c2 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sat, 20 Jun 2026 01:25:01 -0400 Subject: [PATCH] Chez inc7: namespace :as aliases on the Chez-hosted analyzer (require '[clojure.string :as s]) then s/foo crashed "Unknown class s": the Chez analyzer resolved a qualified symbol's ns literally, and there was no alias table (ns.ss jolt-ns-aliases was a stub, require a no-op). Add an alias table + chez-register-spec! (parses [ns :as a]) in ns.ss; hc-resolve-cell now resolves a qualified ns through it; compile-eval pre-registers a form's require/use :as aliases before analysis (analysis precedes the runtime require, so the runtime require staying a no-op is fine). The batched gate runner clears the alias table between cases. Zero-Janet corpus parity 2159 -> 2240, 0 divergences. spine-test 35/35. --- host/chez/compile-eval.ss | 31 +++++++++++++++++++++++---- host/chez/driver.janet | 1 + host/chez/host-contract.ss | 4 +++- host/chez/ns.ss | 25 +++++++++++++++++++++ test/chez/run-corpus-zero-janet.janet | 2 +- 5 files changed, 57 insertions(+), 6 deletions(-) diff --git a/host/chez/compile-eval.ss b/host/chez/compile-eval.ss index 0c67bb9..193cb2f 100644 --- a/host/chez/compile-eval.ss +++ b/host/chez/compile-eval.ss @@ -20,13 +20,36 @@ ;; once, here, so every analyze->emit on this spine sees the full core (jolt-qjr0). ((var-deref "jolt.backend-scheme" "set-prelude-mode!") #t) +;; (quote X) -> X, else x — unwraps a quoted require spec. +(define (ce-unquote x) + (if (and (cseq? x) (cseq-list? x)) + (let ((items (seq->list x))) + (if (and (pair? items) (symbol-t? (car items)) + (string=? (symbol-t-name (car items)) "quote") (pair? (cdr items))) + (cadr items) x)) + x)) + +;; Pre-register any (require ...)/(use ...) :as aliases under `ns` BEFORE analysis, +;; so a qualified s/foo resolves while compiling (analysis precedes the runtime +;; require). Walks the whole form (a require may be nested in a do/let). jolt-qjr0. +(define (ce-scan-requires! form ns) + (when (and (cseq? form) (cseq-list? form)) + (let ((items (seq->list form))) + (when (pair? items) + (let ((h (car items))) + (if (and (symbol-t? h) + (let ((n (symbol-t-name h))) (or (string=? n "require") (string=? n "use")))) + (for-each (lambda (a) (chez-register-spec! ns (ce-unquote a))) (cdr items)) + (for-each (lambda (x) (ce-scan-requires! x ns)) items))))))) + ;; Source string -> Scheme source string (read -> analyze -> emit, all on Chez). ;; `ns` is the compile namespace unqualified symbols resolve against. (define (jolt-analyze-emit src ns) - (let* ((form (jolt-ce-read src)) - (ctx (make-analyze-ctx ns)) - (ir (jolt-ce-analyze ctx form))) - (jolt-ce-emit ir))) + (let* ((form (jolt-ce-read src))) + (ce-scan-requires! form ns) + (let* ((ctx (make-analyze-ctx ns)) + (ir (jolt-ce-analyze ctx form))) + (jolt-ce-emit ir)))) ;; Source string -> value (compile on Chez, then eval the emitted Scheme in the ;; top-level environment where rt.ss's runtime procedures live). diff --git a/host/chez/driver.janet b/host/chez/driver.janet index 49b67f9..2adf56e 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -416,6 +416,7 @@ " (var-cell-root-set! (car cr) (cdr cr)))) zj-roots)\n" " (zj-prune! ns-registry zj-ns-base)\n" " (zj-prune! type-registry zj-type-base)\n" + " (hashtable-clear! ns-alias-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 ae68a3b..3aae8b6 100644 --- a/host/chez/host-contract.ss +++ b/host/chez/host-contract.ss @@ -130,7 +130,9 @@ (sns (symbol-t-ns sym)) (qualified (and sns (not (jolt-nil? sns)) (not (null? sns)) sns))) (if qualified - (var-cell-lookup qualified nm) + ;; a qualified ns may be a require :as alias (s/split -> clojure.string/split) + (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) (var-cell-lookup "clojure.core" nm))))) diff --git a/host/chez/ns.ss b/host/chez/ns.ss index ba8401d..23ac14e 100644 --- a/host/chez/ns.ss +++ b/host/chez/ns.ss @@ -24,6 +24,31 @@ (intern-ns! "user") (intern-ns! "clojure.core") +;; --- namespace aliases (jolt-qjr0) ----------------------------------------- +;; (require '[ns :as a]) registers a -> ns so the analyzer can resolve a/foo to +;; ns/foo. Keyed by (compile-ns . alias). On the zero-Janet spine the requires are +;; pre-registered at analyze time (compile-eval.ss) — analysis precedes eval, so a +;; runtime require no-op is fine. Also drives jolt-ns-aliases below. +(define ns-alias-table (make-hashtable equal-hash equal?)) +(define (chez-register-alias! cns alias target) + (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). +(define (chez-register-spec! cns spec) + (let ((items (cond ((pvec? spec) (seq->list spec)) + ((or (cseq? spec) (empty-list-t? spec)) (seq->list spec)) + (else '())))) + (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))))))))) + ;; a namespace designator -> its name string (a jns or a symbol; the corpus never ;; passes a bare string). (define (ns-desig->name d) diff --git a/test/chez/run-corpus-zero-janet.janet b/test/chez/run-corpus-zero-janet.janet index 012401e..4c9e672 100644 --- a/test/chez/run-corpus-zero-janet.janet +++ b/test/chez/run-corpus-zero-janet.janet @@ -157,7 +157,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") "2159"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2240"))) (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)))