Chez Phase 1 (increment 3p): misc seq/regex gaps + bug tracking

jolt-y1zq tail:
- 0-arg (conj) -> [] and 0-arg (conj!) -> a fresh transient vector
- nth sees through a transient (like get/count/contains?)
- irregex \p{...}/\P{...} property classes translate to the seed's ASCII char
  classes (regex.ss): \p{L} -> [a-zA-Z] + non-ASCII codepoints (the seed counts
  UTF-8 high bytes as letters), \p{N} -> [0-9], \p{Ps} -> [([{], etc. The
  translator tracks [...] nesting so a \p{} inside a class emits its content, not
  a nested class.

Two pre-existing bugs found and filed (tracked, not replicated):
- jolt-x0os: the Chez emitter mangles non-ASCII string literals into invalid Chez
  hex escapes (so p{L} utf-8 crashes on the input string, not the regex).
- jolt-ea9k: the seed's transient assoc! accepts odd args and assigns nil to the
  trailing key (non-Clojure; plain assoc throws). The Chez host throws
  (Clojure-correct); the 4 spec rows encoding the leniency are flagged in
  transients-spec.janet pending the seed fix.

Parity 1493 -> 1506/2497, 0 new divergences. emit-test 291/291.
This commit is contained in:
Yogthos 2026-06-18 00:44:21 -04:00
parent cbb0f2ab4a
commit e51cc2e47e
7 changed files with 131 additions and 12 deletions

View file

@ -202,11 +202,14 @@
(pmap-assoc coll (pvec-nth-d x 0 jolt-nil) (pvec-nth-d x 1 jolt-nil))) (pmap-assoc coll (pvec-nth-d x 0 jolt-nil) (pvec-nth-d x 1 jolt-nil)))
(else (error 'conj "conj on a map expects a [k v] pair or a map")))) (else (error 'conj "conj on a map expects a [k v] pair or a map"))))
(else (error 'conj "unsupported collection")))) (else (error 'conj "unsupported collection"))))
;; (conj nil a b ...) builds a list in Clojure, conj prepending -> (b a). ;; (conj) -> []; (conj nil a b ...) builds a list (conj prepending -> (b a)).
(define (jolt-conj coll . xs) (define (jolt-conj . args)
(if (jolt-nil? coll) (if (null? args)
(fold-left jolt-conj1 jolt-empty-list xs) (jolt-vector)
(fold-left jolt-conj1 coll xs))) (let ((coll (car args)) (xs (cdr args)))
(if (jolt-nil? coll)
(fold-left jolt-conj1 jolt-empty-list xs)
(fold-left jolt-conj1 coll xs)))))
(define jolt-get (define jolt-get
(case-lambda (case-lambda

View file

@ -34,10 +34,67 @@
(apply %chez-error args))) (apply %chez-error args)))
(load "vendor/irregex/irregex.scm") (load "vendor/irregex/irregex.scm")
;; Unicode property classes \p{...} (jolt-y1zq): irregex's string syntax has no
;; \p{...}, so translate the ones the seed's byte-PEG maps (src/jolt/regex.janet
;; prop-frag) to ASCII char classes before compiling. ASCII-only — the seed counts
;; UTF-8 high bytes as letters for \p{L}, which a Unicode-char Scheme string can't
;; reproduce byte-for-byte; the corpus tests ASCII inputs, where they agree. An
;; unmapped name is left as-is (irregex errors, as before — no new behavior). The
;; ORIGINAL source is kept for printing; only the compiled pattern is translated.
(define (prop-class name)
(cond
;; L/Alpha: ASCII letters + any non-ASCII codepoint (the seed counts UTF-8 high
;; bytes as letters, so ^\p{L}+$ accepts accented words). N/Z stay ASCII-only,
;; matching the seed's byte-PEG.
((or (string=? name "L") (string=? name "Alpha")) "a-zA-Z\\x80-\\x{10FFFF}")
((string=? name "Lu") "A-Z")
((string=? name "Ll") "a-z")
((or (string=? name "N") (string=? name "Nd") (string=? name "Digit")) "0-9")
((or (string=? name "Z") (string=? name "Zs")) " ")
((string=? name "Ps") "([{")
((string=? name "Pe") ")\\]}")
(else #f)))
;; Tracks whether the cursor is inside a [...] char class: a \p{X} there emits the
;; class CONTENT (the seed inlines it), standalone it emits a wrapping [X]. Escapes
;; (\[, \]) don't toggle the class. \P (negation) only wraps when standalone.
(define (translate-prop-classes src)
(let ((len (string-length src)) (out (open-output-string)))
(let loop ((i 0) (in-class #f))
(if (fx>=? i len)
(get-output-string out)
(let ((c (string-ref src i)))
(cond
;; \p{Name} / \P{Name}
((and (char=? c #\\) (fx<? (fx+ i 2) len)
(let ((p (string-ref src (fx+ i 1)))) (or (char=? p #\p) (char=? p #\P)))
(char=? (string-ref src (fx+ i 2)) #\{))
(let* ((close (let scan ((j (fx+ i 3)))
(cond ((fx>=? j len) #f)
((char=? (string-ref src j) #\}) j)
(else (scan (fx+ j 1))))))
(cls (and close (prop-class (substring src (fx+ i 3) close)))))
(cond
((not cls) (write-char c out) (loop (fx+ i 1) in-class))
(in-class (display cls out) (loop (fx+ close 1) in-class))
(else
(display "[" out)
(when (char=? (string-ref src (fx+ i 1)) #\P) (display "^" out))
(display cls out) (display "]" out)
(loop (fx+ close 1) in-class)))))
;; any other escape: copy the pair verbatim, don't toggle class state
((and (char=? c #\\) (fx<? (fx+ i 1) len))
(write-char c out) (write-char (string-ref src (fx+ i 1)) out)
(loop (fx+ i 2) in-class))
((and (not in-class) (char=? c #\[))
(write-char c out) (loop (fx+ i 1) #t))
((and in-class (char=? c #\]))
(write-char c out) (loop (fx+ i 1) #f))
(else (write-char c out) (loop (fx+ i 1) in-class))))))))
;; A jolt regex value: the source string (for printing / str) + the compiled ;; A jolt regex value: the source string (for printing / str) + the compiled
;; irregex. regex? recognizes it; the printer renders #"source". ;; irregex. regex? recognizes it; the printer renders #"source".
(define-record-type regex-t (fields source irx) (nongenerative jolt-regex-v1)) (define-record-type regex-t (fields source irx) (nongenerative jolt-regex-v1))
(define (jolt-regex source) (make-regex-t source (irregex source))) (define (jolt-regex source) (make-regex-t source (irregex (translate-prop-classes source))))
(define (jolt-regex? x) (regex-t? x)) (define (jolt-regex? x) (regex-t? x))
(define (jolt-re-pattern x) (if (regex-t? x) x (jolt-regex x))) (define (jolt-re-pattern x) (if (regex-t? x) x (jolt-regex x)))

View file

@ -23,10 +23,14 @@
(jolt-transient-active-set! t #f) (jolt-transient-active-set! t #f)
(jolt-transient-coll t)) (jolt-transient-coll t))
(define (jolt-conj! t . xs) ;; (conj!) with no args -> a fresh transient vector (Clojure); otherwise mutate t.
(jolt-trans-check t "conj!") (define (jolt-conj! . args)
(jolt-transient-coll-set! t (apply jolt-conj (jolt-transient-coll t) xs)) (if (null? args)
t) (jolt-transient-new (jolt-vector))
(let ((t (car args)) (xs (cdr args)))
(jolt-trans-check t "conj!")
(jolt-transient-coll-set! t (apply jolt-conj (jolt-transient-coll t) xs))
t)))
;; (assoc! t k v & kvs): variadic like Clojure (jolt-assoc already folds pairs). ;; (assoc! t k v & kvs): variadic like Clojure (jolt-assoc already folds pairs).
(define (jolt-assoc! t . kvs) (define (jolt-assoc! t . kvs)
(jolt-trans-check t "assoc!") (jolt-trans-check t "assoc!")
@ -63,6 +67,11 @@
(set! jolt-count (lambda (coll) (%prev-jolt-count (jolt-deref-transient coll)))) (set! jolt-count (lambda (coll) (%prev-jolt-count (jolt-deref-transient coll))))
(define %prev-jolt-contains? jolt-contains?) (define %prev-jolt-contains? jolt-contains?)
(set! jolt-contains? (lambda (coll k) (%prev-jolt-contains? (jolt-deref-transient coll) k))) (set! jolt-contains? (lambda (coll k) (%prev-jolt-contains? (jolt-deref-transient coll) k)))
(define %prev-jolt-nth jolt-nth)
(set! jolt-nth
(case-lambda
((coll i) (%prev-jolt-nth (jolt-deref-transient coll) i))
((coll i d) (%prev-jolt-nth (jolt-deref-transient coll) i d))))
(def-var! "clojure.core" "transient" jolt-transient-new) (def-var! "clojure.core" "transient" jolt-transient-new)
(def-var! "clojure.core" "persistent!" jolt-persistent!) (def-var! "clojure.core" "persistent!" jolt-persistent!)

View file

@ -145,6 +145,24 @@ class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps).
`jolt-into`. The `td-*` factories are ported from the seed (core_coll.janet); a `jolt-into`. The `td-*` factories are ported from the seed (core_coll.janet); a
`reduced` step stops the fold via reduce-seq's short-circuit. `transduce`/`comp`/ `reduced` step stops the fold via reduce-seq's short-circuit. `transduce`/`comp`/
`completing` are overlay and compose over these for free. `completing` are overlay and compose over these for free.
- inc 3p misc seq/regex gaps (jolt-y1zq): 0-arg `(conj)` -> `[]`, 0-arg `(conj!)` ->
a fresh transient vector, `nth` sees through a transient (like get/count/contains?),
and irregex `\p{...}`/`\P{...}` property classes translate to the seed's ASCII char
classes (regex.ss; `\p{L}`->`[a-zA-Z]`, `\p{N}`->`[0-9]`, `\p{Ps}`->`[([{]`, …) —
ASCII-only (the seed counts UTF-8 high bytes as letters, which a Unicode-char Scheme
string can't reproduce; the corpus tests ASCII, where they agree) and
`clojure.math/PI` (missing ns).
Two pre-existing bugs surfaced here and are tracked (not replicated):
- **jolt-x0os** (Chez emit) — a non-ASCII string literal emits an invalid Chez hex
escape (`(str "héllo")` -> "read: invalid character \\ in string hex escape"). This
is why `p{L} utf-8` still crashes (the `\p{L}` translation is correct and matches
non-ASCII, but the input string can't be emitted). A crash, not a divergence.
- **jolt-ea9k** (seed) — `assoc!` on a transient accepts ODD args and assigns nil to
the trailing key (plain `assoc` correctly throws; Clojure's `assoc!` throws too).
The Chez host throws (Clojure-correct), so the 4 `odd arg …` corpus rows — which
encode the seed's lenient behavior — sit in the crash bucket until the seed is
fixed and those spec rows are updated to `:throws`.
The remaining buckets are the punch-list the next increments chase: ~361 emit-fail The remaining buckets are the punch-list the next increments chase: ~361 emit-fail
(genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of (genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of

View file

@ -556,6 +556,33 @@
(ok (string "transducer -e: " src) (and (= code 0) (= out want)) (ok (string "transducer -e: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))) (string "chez=" out " janet=" want " | " err)))))
# 3u) misc seq/regex gaps (jolt-y1zq): 0-arg (conj) -> []; 0-arg (conj!) -> a
# fresh transient vector; nth sees through a transient; and irregex \p{...} /
# \P{...} unicode property classes translate to the seed's ASCII char classes
# (regex.ss). Deferred: the assoc!-odd-args seed quirk (non-Clojure, trailing key
# gets nil) and clojure.math/PI (missing ns). \p/conj!/nth run in run-prelude;
# halt-when (overlay, exercises conj 0-arg as the transduce init) via the binary.
(each src ["(= [] (conj))" "(= [1] (conj nil 1))"
"(= [] (persistent! (conj!)))"
"(= 2 (nth (transient [1 2 3]) 1))"
"(re-matches #\"^\\p{L}+$\" \"hello\")"
"(boolean (re-matches #\"^\\p{L}+$\" \"ab1\"))"
"(re-seq #\"\\p{N}+\" \"a12b345\")"
"(re-matches #\"^\\P{N}+$\" \"abc\")"
"(re-matches #\"^\\p{Ll}\\p{Lu}$\" \"aB\")"
"(re-matches #\"^\\p{Ps}x\\p{Pe}$\" \"(x)\")"
# \p{} INSIDE a [...] class emits the class content, not a nested [...]
"(= \" \" (re-matches #\"(?u)^[\\s\\p{Z}]+$\" \" \"))"]
(let [[code out err] (run-prelude src) want (cli-oracle src)]
(ok (string "y1zq: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err))))
(when (os/stat "bin/jolt-chez")
(each src ["(= 7 (transduce (halt-when (fn [x] (> x 5))) conj [1 2 7 3]))"
"(= [1 2 3] (transduce (halt-when (fn [x] (> x 5))) conj [1 2 3]))"]
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
(ok (string "y1zq -e: " src) (and (= code 0) (= out want))
(string "chez=" out " janet=" want " | " err)))))
# 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to # 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to
# track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the # track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the
# jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers. # jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers.

View file

@ -136,8 +136,9 @@
# on any NEW (un-allowlisted) divergence — a real Chez correctness regression. # on any NEW (un-allowlisted) divergence — a real Chez correctness regression.
# Full-corpus baseline: inc 3j 1220/2497; 3k (converters) 1326; 3l (transients) # Full-corpus baseline: inc 3j 1220/2497; 3k (converters) 1326; 3l (transients)
# 1382; 3m (numeric-edge emit + variadic assoc!) 1407; 3n (seq-native shims + # 1382; 3m (numeric-edge emit + variadic assoc!) 1407; 3n (seq-native shims +
# reduced) 1467; 3o (transducer arities) 1493. Strided runs scale down. # reduced) 1467; 3o (transducer arities) 1493; 3p (misc seq/regex gaps) 1506.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1493"))) # Strided runs scale down.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1506")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor)) (when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged))) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))

View file

@ -57,6 +57,10 @@
# assoc! (unlike assoc) accepts an odd arg count — a missing final value is nil. # assoc! (unlike assoc) accepts an odd arg count — a missing final value is nil.
# (A struct literal can't express an explicit nil value, so assert via contains?.) # (A struct literal can't express an explicit nil value, so assert via contains?.)
# KNOWN BUG (jolt-ea9k): this leniency is non-Clojure — Clojure's assoc! throws on
# odd args, as does jolt's own plain assoc. These rows encode the buggy behavior;
# when the seed is fixed to throw, update them to :throws. The Chez host already
# throws (Clojure-correct), so these sit in its crash bucket until then.
(defspec "transient / assoc! odd args" (defspec "transient / assoc! odd args"
["odd arg key present" "true" ["odd arg key present" "true"
"(contains? (persistent! (assoc! (transient {}) :a 1 :b)) :b)"] "(contains? (persistent! (assoc! (transient {}) :a 1 :b)) :b)"]