embed a namespace value spliced into a form (~*ns*)
A macro like (defmacro cur-ns [] `(str ~*ns*)) splices the live *ns* value into its expansion, leaving an opaque jns object as a list element. The analyzer had no way to carry a runtime value and threw uncompilable — the last remaining corpus crash. Recognize a jns via the host contract (form-ns-value?) and emit a :the-ns leaf that reconstructs it by name (intern-ns!) at the call site, the same IR-leaf pattern as regex/inst/uuid. Closes unquote-*ns*-in- template; corpus crash count -> 0. A namespace fast path rather than a general constant pool: it's the only embedded-value case in the corpus and the common real-world one (libs splice ~*ns*). A general pool can come later if other value types appear.
This commit is contained in:
parent
ccc76fd69f
commit
8ce00d29fd
5 changed files with 17 additions and 4 deletions
|
|
@ -62,6 +62,11 @@
|
|||
(define (hc-regex? x) (hc-tagged-of x hc-kw-regex))
|
||||
(define (hc-inst? x) (hc-tagged-of x hc-kw-inst))
|
||||
(define (hc-uuid? x) (hc-tagged-of x hc-kw-uuid))
|
||||
;; A live namespace value spliced into a form (e.g. `(str ~*ns*) in a macro):
|
||||
;; the analyzer can't carry an opaque runtime value, so recognize a jns and
|
||||
;; reconstruct it by name at the call site (jolt-8sha).
|
||||
(define (hc-ns-value? x) (jns? x))
|
||||
(define (hc-ns-value-name x) (jns-name x))
|
||||
|
||||
;; --- form accessors ---------------------------------------------------------
|
||||
(define (hc-char-code x) (char->integer x)) ; native Chez char -> codepoint
|
||||
|
|
@ -292,6 +297,8 @@
|
|||
(def-var! "jolt.host" "form-regex?" hc-regex?)
|
||||
(def-var! "jolt.host" "form-inst?" hc-inst?)
|
||||
(def-var! "jolt.host" "form-uuid?" hc-uuid?)
|
||||
(def-var! "jolt.host" "form-ns-value?" hc-ns-value?)
|
||||
(def-var! "jolt.host" "form-ns-value-name" hc-ns-value-name)
|
||||
(def-var! "jolt.host" "form-elements" hc-elements)
|
||||
(def-var! "jolt.host" "form-vec-items" hc-vec-items)
|
||||
(def-var! "jolt.host" "form-set-items" hc-set-items)
|
||||
|
|
|
|||
|
|
@ -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 2722)
|
||||
;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2723)
|
||||
;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
|
||||
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
||||
(import (chezscheme))
|
||||
|
|
@ -192,7 +192,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) 2722)))
|
||||
(if s (string->number s) 2723)))
|
||||
(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"
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -23,6 +23,7 @@
|
|||
form-map-pairs form-set-items form-special? compile-ns
|
||||
form-regex? form-regex-source
|
||||
form-inst? form-inst-source form-uuid? form-uuid-source
|
||||
form-ns-value? form-ns-value-name
|
||||
form-macro? form-expand-1 resolve-global
|
||||
form-sym-meta host-intern! form-syntax-quote-lower
|
||||
record-type? record-ctor-key form-position late-bind?]]))
|
||||
|
|
@ -450,4 +451,7 @@
|
|||
;; end emits a runtime inst/uuid value (host/chez/inst-time.ss).
|
||||
(form-inst? form) {:op :inst :source (form-inst-source form)}
|
||||
(form-uuid? form) {:op :uuid :source (form-uuid-source form)}
|
||||
;; a live namespace value spliced into a form (~*ns* in a macro) -> a
|
||||
;; :the-ns leaf the back end reconstructs by name at the call site.
|
||||
(form-ns-value? form) {:op :the-ns :name (form-ns-value-name form)}
|
||||
:else (uncompilable "unsupported form"))))
|
||||
|
|
|
|||
|
|
@ -404,6 +404,8 @@
|
|||
;; #inst / #uuid literals -> runtime inst / uuid values.
|
||||
:inst (str "(jolt-inst-from-string " (chez-str-lit (:source node)) ")")
|
||||
:uuid (str "(jolt-uuid-from-string " (chez-str-lit (:source node)) ")")
|
||||
;; a namespace value spliced into a form (~*ns*) -> reconstruct by name.
|
||||
:the-ns (str "(intern-ns! " (chez-str-lit (:name node)) ")")
|
||||
;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else
|
||||
;; record-method-dispatch (a reify/record protocol method, jolt-jgoc).
|
||||
:host-call (let [m (:method node)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue