Cross-ns def/require/use/defmethod through the spine (jolt-c2l1)
The per-form eval passed a FIXED compile-ns to every subform of a top-level do,
so a runtime (ns ...)/(in-ns ...) didn't redirect later defs/refs — defs landed
in the wrong ns and qualified refs hit host-static ("Unknown class"). Thread
the current ns: each subform analyzes in (chez-current-ns), which ns/in-ns move.
That exposed two more gaps, now fixed:
- use refers ALL of a target's public vars (a refer-all table consulted by
chez-resolve-refer) — was bound to plain require (explicit :refer only).
- defmethod on a QUALIFIED multifn (cf.mm/ext from another ns) resolves in the
symbol's ns, not the current one (was auto-creating a stray multifn).
Corpus 2684->2688, 0 new divergences; floor raised. No re-mint (runtime shims).
This commit is contained in:
parent
76f8274603
commit
c788e86f1a
6 changed files with 50 additions and 8 deletions
|
|
@ -108,11 +108,15 @@
|
||||||
;; visible (macro flag set, var interned) before a later subform is analyzed.
|
;; visible (macro flag set, var interned) before a later subform is analyzed.
|
||||||
(define (jolt-compile-eval-form form ns)
|
(define (jolt-compile-eval-form form ns)
|
||||||
(cond
|
(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)
|
((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)
|
(if (null? fs)
|
||||||
result
|
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
|
;; 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
|
;; forms expand it (hc-macro? reads var-macro-table). Mirrors emit-image.ss
|
||||||
;; ei-emit-ns.
|
;; ei-emit-ns.
|
||||||
|
|
|
||||||
|
|
@ -56,11 +56,16 @@
|
||||||
;; if absent (defmethod before defmulti — rare; identity dispatch as a fallback).
|
;; if absent (defmethod before defmulti — rare; identity dispatch as a fallback).
|
||||||
(define (jolt-defmethod-setup mm-sym dval impl)
|
(define (jolt-defmethod-setup mm-sym dval impl)
|
||||||
(let* ((nm (symbol-t-name mm-sym))
|
(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
|
(mf (if (jolt-multifn? cur) cur
|
||||||
(let ((m (make-jolt-multifn nm (var-deref "clojure.core" "identity")
|
(let ((m (make-jolt-multifn nm (var-deref "clojure.core" "identity")
|
||||||
(new-mm-table) kw-default #f (new-mm-table))))
|
(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)
|
(hashtable-set! (jolt-multifn-methods mf) dval impl)
|
||||||
mf))
|
mf))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -286,4 +286,24 @@
|
||||||
(for-each (lambda (s) (chez-register-spec! (chez-current-ns) s)) specs)
|
(for-each (lambda (s) (chez-register-spec! (chez-current-ns) s)) specs)
|
||||||
jolt-nil)
|
jolt-nil)
|
||||||
(def-var! "clojure.core" "require" chez-runtime-require)
|
(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)
|
||||||
|
|
|
||||||
|
|
@ -38,8 +38,19 @@
|
||||||
(define ns-refer-table (make-hashtable equal-hash equal?))
|
(define ns-refer-table (make-hashtable equal-hash equal?))
|
||||||
(define (chez-register-refer! cns name target)
|
(define (chez-register-refer! cns name target)
|
||||||
(hashtable-set! ns-refer-table (cons 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)
|
(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
|
;; 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
|
;; `cns`. spec: [ns :as a :refer [x y] ...] / (ns ...) / bare ns. opts are
|
||||||
;; keyword/value pairs after the ns symbol.
|
;; keyword/value pairs after the ns symbol.
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,7 @@
|
||||||
;; reset between cases so there is no leakage — same isolation a fresh process gives.
|
;; reset between cases so there is no leakage — same isolation a fresh process gives.
|
||||||
;;
|
;;
|
||||||
;; chez --script host/chez/run-corpus.ss
|
;; 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_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
|
||||||
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
||||||
(import (chezscheme))
|
(import (chezscheme))
|
||||||
|
|
@ -65,6 +65,7 @@
|
||||||
(zj-prune! type-registry zj-type-base)
|
(zj-prune! type-registry zj-type-base)
|
||||||
(hashtable-clear! ns-alias-table)
|
(hashtable-clear! ns-alias-table)
|
||||||
(hashtable-clear! ns-refer-table)
|
(hashtable-clear! ns-refer-table)
|
||||||
|
(hashtable-clear! ns-refer-all-table)
|
||||||
(when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
|
(when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
|
||||||
(var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
|
(var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
|
||||||
(set-chez-ns! "user"))
|
(set-chez-ns! "user"))
|
||||||
|
|
@ -202,7 +203,7 @@
|
||||||
|
|
||||||
;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
|
;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
|
||||||
(define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_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))
|
(define floor (if limit 0 base-floor))
|
||||||
(when (or (> (length diverged) 0) (< pass floor))
|
(when (or (> (length diverged) 0) (< pass floor))
|
||||||
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"
|
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"
|
||||||
|
|
|
||||||
|
|
@ -55,6 +55,7 @@
|
||||||
(zj-prune! type-registry zj-type-base)
|
(zj-prune! type-registry zj-type-base)
|
||||||
(hashtable-clear! ns-alias-table)
|
(hashtable-clear! ns-alias-table)
|
||||||
(hashtable-clear! ns-refer-table)
|
(hashtable-clear! ns-refer-table)
|
||||||
|
(hashtable-clear! ns-refer-all-table)
|
||||||
(when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
|
(when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
|
||||||
(var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
|
(var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
|
||||||
(set-chez-ns! "user"))
|
(set-chez-ns! "user"))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue