Chez inc 3k: converter + string-op RT shims
str/subs/vec/keyword/symbol/compare/int/double/gensym — host-coupled seed natives the overlay assumes, now def-var!'d into clojure.core via host/chez/converters.ss (loaded last, str reuses jolt-pr-str). Semantics match the seed: str-render-one for str (nil->"", bare chars, regex source), the 3-way core-compare port, int truncates. The symbol no-ns sentinel is #f to match emit's quoted-symbol lowering (jolt-symbol #f "x"), so (= 'x (symbol "x")) holds — jolt= compares ns with strict equal?, and jolt-nil vs #f would otherwise diverge. Prelude parity 1220 -> 1326/2497, 0 new divergences. Floor raised to 1326; three newly-reached *ns*/var-rendering cases added to the allowlist (Phase 2). run-prelude and the per-case program file are now PID-unique so concurrent chez runs don't read each other's half-written files.
This commit is contained in:
parent
0c9c7931fe
commit
bb8b2d201c
5 changed files with 175 additions and 12 deletions
120
host/chez/converters.ss
Normal file
120
host/chez/converters.ss
Normal file
|
|
@ -0,0 +1,120 @@
|
||||||
|
;; converters + string ops (jolt-t6cr) — host-coupled seed natives the Chez host
|
||||||
|
;; must provide; def-var!'d into clojure.core, resolved in prelude mode. Loaded
|
||||||
|
;; last (after jolt-pr-str), since `str` reuses the printer. Semantics match the
|
||||||
|
;; Janet seed (core_print.janet str-render-one, core_io.janet core-compare,
|
||||||
|
;; core_refs.janet int/double). jolt is all-flonum, so numeric results are
|
||||||
|
;; flonums (int truncates toward zero, compare returns -1.0/0.0/1.0).
|
||||||
|
|
||||||
|
;; str: nil -> "", string raw, char bare (not \c), regex -> raw source, else the
|
||||||
|
;; printer (which renders collections with readable elements).
|
||||||
|
(define (jolt-str-render-one v)
|
||||||
|
(cond
|
||||||
|
((jolt-nil? v) "")
|
||||||
|
((string? v) v)
|
||||||
|
((char? v) (string v))
|
||||||
|
((regex-t? v) (regex-t-source v))
|
||||||
|
(else (jolt-pr-str v))))
|
||||||
|
(define (jolt-str . xs)
|
||||||
|
(let loop ((xs xs) (acc '()))
|
||||||
|
(if (null? xs)
|
||||||
|
(apply string-append (reverse acc))
|
||||||
|
(loop (cdr xs) (cons (jolt-str-render-one (car xs)) acc)))))
|
||||||
|
|
||||||
|
;; jolt indices are flonums; substring etc. need exact ints.
|
||||||
|
(define (jolt->idx n) (exact (truncate n)))
|
||||||
|
|
||||||
|
(define (jolt-subs s start . end)
|
||||||
|
(substring s (jolt->idx start)
|
||||||
|
(if (null? end) (string-length s) (jolt->idx (car end)))))
|
||||||
|
|
||||||
|
;; vec: a pvec from any seqable (already-pvec returns itself).
|
||||||
|
(define (jolt-vec coll)
|
||||||
|
(cond
|
||||||
|
((jolt-nil? coll) (jolt-vector))
|
||||||
|
((pvec? coll) coll)
|
||||||
|
((string? coll) (apply jolt-vector (string->list coll)))
|
||||||
|
(else (apply jolt-vector (seq->list coll)))))
|
||||||
|
|
||||||
|
(define (jolt-keyword . args)
|
||||||
|
(cond
|
||||||
|
((= (length args) 1)
|
||||||
|
(let ((a (car args)))
|
||||||
|
(cond
|
||||||
|
((jolt-nil? a) jolt-nil)
|
||||||
|
((keyword? a) a)
|
||||||
|
((string? a) (keyword #f a))
|
||||||
|
((jolt-symbol? a)
|
||||||
|
(let ((ns (symbol-t-ns a)))
|
||||||
|
(keyword (if (or (jolt-nil? ns) (not ns) (eq? ns '())) #f ns) (symbol-t-name a))))
|
||||||
|
(else (error #f "keyword: requires string/symbol/keyword" a)))))
|
||||||
|
((= (length args) 2)
|
||||||
|
(keyword (let ((ns (car args))) (if (jolt-nil? ns) #f ns)) (cadr args)))
|
||||||
|
(else (error #f "keyword: wrong arity"))))
|
||||||
|
|
||||||
|
(define (jolt-symbol-new . args)
|
||||||
|
(cond
|
||||||
|
((= (length args) 1)
|
||||||
|
(let ((a (car args)))
|
||||||
|
(cond
|
||||||
|
((jolt-symbol? a) a)
|
||||||
|
;; no-ns sentinel is #f — matches emit's quoted-symbol lowering
|
||||||
|
;; (jolt-symbol #f "x"), so (= 'x (symbol "x")) holds (jolt= compares ns
|
||||||
|
;; with strict equal?; jolt-nil vs #f would otherwise differ).
|
||||||
|
((string? a) (jolt-symbol #f a))
|
||||||
|
((keyword? a) (jolt-symbol (keyword-t-ns a) (keyword-t-name a)))
|
||||||
|
(else (error #f "symbol: requires string/symbol" a)))))
|
||||||
|
((= (length args) 2) (jolt-symbol (car args) (cadr args)))
|
||||||
|
(else (error #f "symbol: wrong arity"))))
|
||||||
|
|
||||||
|
;; gensym: per-process counter, like the seed's gensym_counter.
|
||||||
|
(define jolt-gensym-counter 0)
|
||||||
|
(define (jolt-gensym . prefix)
|
||||||
|
(let ((p (if (null? prefix) "G__" (car prefix))))
|
||||||
|
(set! jolt-gensym-counter (+ jolt-gensym-counter 1))
|
||||||
|
(jolt-symbol #f
|
||||||
|
(string-append (if (string? p) p (jolt-str-render-one p))
|
||||||
|
(number->string jolt-gensym-counter)))))
|
||||||
|
|
||||||
|
(define (jolt-int x) (if (char? x) (exact->inexact (char->integer x)) (truncate x)))
|
||||||
|
(define (jolt-double x) (if (char? x) (exact->inexact (char->integer x)) (exact->inexact x)))
|
||||||
|
|
||||||
|
;; compare: 3-way, ported from core_io.janet core-compare.
|
||||||
|
(define (jolt-cmp3 x y) (cond ((< x y) -1.0) ((> x y) 1.0) (else 0.0)))
|
||||||
|
(define (jolt-strcmp a b) (cond ((string<? a b) -1.0) ((string>? a b) 1.0) (else 0.0)))
|
||||||
|
(define (jolt-kw->string k)
|
||||||
|
(let ((ns (keyword-t-ns k))) (if ns (string-append ns "/" (keyword-t-name k)) (keyword-t-name k))))
|
||||||
|
(define (jolt-sym-ns-string s)
|
||||||
|
(let ((n (symbol-t-ns s))) (if (or (jolt-nil? n) (not n) (eq? n '())) "" n)))
|
||||||
|
(define (jolt-compare a b)
|
||||||
|
(cond
|
||||||
|
((and (jolt-nil? a) (jolt-nil? b)) 0.0)
|
||||||
|
((jolt-nil? a) -1.0)
|
||||||
|
((jolt-nil? b) 1.0)
|
||||||
|
((and (number? a) (number? b)) (jolt-cmp3 a b))
|
||||||
|
((and (string? a) (string? b)) (jolt-strcmp a b))
|
||||||
|
((and (keyword? a) (keyword? b)) (jolt-strcmp (jolt-kw->string a) (jolt-kw->string b)))
|
||||||
|
((and (jolt-symbol? a) (jolt-symbol? b))
|
||||||
|
(let ((r (jolt-strcmp (jolt-sym-ns-string a) (jolt-sym-ns-string b))))
|
||||||
|
(if (= r 0.0) (jolt-strcmp (symbol-t-name a) (symbol-t-name b)) r)))
|
||||||
|
((and (boolean? a) (boolean? b)) (cond ((eq? a b) 0.0) ((eq? a #f) -1.0) (else 1.0)))
|
||||||
|
((and (char? a) (char? b)) (jolt-cmp3 (char->integer a) (char->integer b)))
|
||||||
|
((and (pvec? a) (pvec? b))
|
||||||
|
(let ((la (pvec-count a)) (lb (pvec-count b)))
|
||||||
|
(if (not (= la lb))
|
||||||
|
(jolt-cmp3 la lb)
|
||||||
|
(let loop ((i 0))
|
||||||
|
(if (>= i la)
|
||||||
|
0.0
|
||||||
|
(let ((r (jolt-compare (pvec-nth-d a i jolt-nil) (pvec-nth-d b i jolt-nil))))
|
||||||
|
(if (= r 0.0) (loop (+ i 1)) r)))))))
|
||||||
|
(else (error #f "compare: cannot compare these types" a b))))
|
||||||
|
|
||||||
|
(def-var! "clojure.core" "str" jolt-str)
|
||||||
|
(def-var! "clojure.core" "subs" jolt-subs)
|
||||||
|
(def-var! "clojure.core" "vec" jolt-vec)
|
||||||
|
(def-var! "clojure.core" "keyword" jolt-keyword)
|
||||||
|
(def-var! "clojure.core" "symbol" jolt-symbol-new)
|
||||||
|
(def-var! "clojure.core" "gensym" jolt-gensym)
|
||||||
|
(def-var! "clojure.core" "int" jolt-int)
|
||||||
|
(def-var! "clojure.core" "double" jolt-double)
|
||||||
|
(def-var! "clojure.core" "compare" jolt-compare)
|
||||||
|
|
@ -144,3 +144,8 @@
|
||||||
(if (jolt-nil? s) (reverse acc)
|
(if (jolt-nil? s) (reverse acc)
|
||||||
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
|
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
|
||||||
(else (format "~a" x))))
|
(else (format "~a" x))))
|
||||||
|
|
||||||
|
;; converters + string ops (jolt-t6cr): str/subs/vec/keyword/symbol/compare/int/
|
||||||
|
;; double/gensym — host-coupled seed natives def-var!'d into clojure.core. Loaded
|
||||||
|
;; LAST because `str` reuses jolt-pr-str (defined just above).
|
||||||
|
(load "host/chez/converters.ss")
|
||||||
|
|
|
||||||
|
|
@ -104,16 +104,21 @@ corpus case with all of core present, bucketing the result —
|
||||||
JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet
|
JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet
|
||||||
JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast)
|
JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast)
|
||||||
|
|
||||||
First parity baseline (inc 3j): **1220/2497** evaluated cases pass, 0 NEW
|
Parity baseline: inc 3j **1220/2497**; inc 3k (converters, jolt-t6cr) **1326/2497**,
|
||||||
divergences (10 allowlisted: dynamic vars `*ns*`/`*clojure-version*`/`*unchecked-math*`,
|
0 NEW divergences (13 allowlisted: dynamic vars `*ns*`/`*clojure-version*`/
|
||||||
class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps).
|
`*unchecked-math*`, var/`*ns*` rendering, class names, eval-order, with-open — all
|
||||||
|
deferred Phase-2 / dynamic-var gaps). inc 3k added `host/chez/converters.ss`:
|
||||||
|
`str`/`subs`/`vec`/`keyword`/`symbol`/`compare`/`int`/`double`/`gensym` (seed natives,
|
||||||
|
matching `core_print.janet`/`core_io.janet` semantics — `str` reuses the printer,
|
||||||
|
`compare` is the 3-way port, the symbol no-ns sentinel is `#f` to match emit's
|
||||||
|
quoted-symbol lowering so `(= 'x (symbol "x"))` holds).
|
||||||
|
|
||||||
The remaining buckets are the punch-list the next increments chase: ~360 emit-fail
|
The remaining buckets are the punch-list the next increments chase: ~360 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
|
||||||
the analyzer's subset) and ~900 runtime crashes, dominated by core fns calling
|
the analyzer's subset) and ~800 runtime crashes, dominated by core fns calling
|
||||||
host-coupled seed natives with no Chez shim yet (`str`/`format`/`vec`/transients —
|
host-coupled seed natives with no Chez shim yet (transients — inc 3l jolt-kl2l),
|
||||||
inc 3k/3l, jolt-t6cr/jolt-kl2l), plus smaller buckets (`##Inf`/`##NaN` literals →
|
plus smaller buckets (`##Inf`/`##NaN` literals → unbound `inf`/`nan`, seq-prim
|
||||||
unbound `inf`/`nan`, seq-prim transducer arities — inc 3m jolt-q3w8; multimethod
|
transducer arities — inc 3m jolt-q3w8; multimethod dispatch — Phase 2 jolt-9ls5).
|
||||||
dispatch — Phase 2 jolt-9ls5).
|
|
||||||
|
|
||||||
Two host shims landed with the prelude. `host/chez/atoms.ss`: atom/deref/swap!/
|
Two host shims landed with the prelude. `host/chez/atoms.ss`: atom/deref/swap!/
|
||||||
reset! (+ compare-and-set!/swap-vals!/reset-vals!) — host-coupled mutable cells the
|
reset! (+ compare-and-set!/swap-vals!/reset-vals!) — host-coupled mutable cells the
|
||||||
|
|
|
||||||
|
|
@ -312,8 +312,11 @@
|
||||||
(emit/set-prelude-mode! false)
|
(emit/set-prelude-mode! false)
|
||||||
(if (not (r 0)) [:emit-err (r 1) ""]
|
(if (not (r 0)) [:emit-err (r 1) ""]
|
||||||
(do
|
(do
|
||||||
(spit "/tmp/chez-regex-prelude.ss" (emit/program @[] (r 1)))
|
# PID-unique path: two emit-test processes (or a foreground -e) must not
|
||||||
(def proc (os/spawn ["chez" "--script" "/tmp/chez-regex-prelude.ss"] :p {:out :pipe :err :pipe}))
|
# read each other's half-written program file.
|
||||||
|
(def path (string "/tmp/chez-prelude-" (os/getpid) ".ss"))
|
||||||
|
(spit path (emit/program @[] (r 1)))
|
||||||
|
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))
|
||||||
(def out (ev/read (proc :out) 0x100000))
|
(def out (ev/read (proc :out) 0x100000))
|
||||||
(def err (ev/read (proc :err) 0x100000))
|
(def err (ev/read (proc :err) 0x100000))
|
||||||
[(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])))
|
[(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])))
|
||||||
|
|
@ -398,6 +401,32 @@
|
||||||
(ok (string "pred: " src) (and (= code 0) (= out want))
|
(ok (string "pred: " src) (and (= code 0) (= out want))
|
||||||
(string "chez=" out " janet=" want " | " err))))
|
(string "chez=" out " janet=" want " | " err))))
|
||||||
|
|
||||||
|
# 3p) converters + string ops (jolt-t6cr): str/subs/vec/keyword/symbol/compare/
|
||||||
|
# int/double/gensym are host-coupled seed natives (host/chez/converters.ss),
|
||||||
|
# def-var!'d into clojure.core, resolved in prelude mode. Semantics match the
|
||||||
|
# seed (str-render-one for str, the 3-way core-compare, truncating int). Parity
|
||||||
|
# vs the CLI oracle.
|
||||||
|
(each src ["(str)" "(str \"a\")" "(str \"a\" \"b\" \"c\")" "(str 1 2)"
|
||||||
|
"(str :k)" "(str nil)" "(str \"x\" nil \"y\")" "(str \\a)"
|
||||||
|
"(str 'sym)" "(str [1 2])" "(str (* 1.0 5))"
|
||||||
|
"(subs \"hello\" 1)" "(subs \"hello\" 1 3)"
|
||||||
|
"(vec (list 1 2 3))" "(vec (range 3))" "(vec \"ab\")" "(count (vec (range 4)))"
|
||||||
|
"(keyword \"foo\")" "(keyword \"ns\" \"bar\")" "(keyword 'sym)"
|
||||||
|
"(name (keyword \"a\" \"b\"))" "(namespace (keyword \"a\" \"b\"))"
|
||||||
|
"(symbol \"x\")" "(str (symbol \"ns\" \"y\"))" "(name (symbol \"z\"))"
|
||||||
|
"(compare 1 2)" "(compare 2 1)" "(compare 1 1)" "(compare \"a\" \"b\")"
|
||||||
|
"(compare :a :b)" "(compare [1 2] [1 3])" "(compare nil nil)" "(compare nil 1)"
|
||||||
|
"(int 3.7)" "(int \\A)" "(double 5)" "(double \\A)"]
|
||||||
|
(let [[code out err] (run-prelude src) want (cli-oracle src)]
|
||||||
|
(ok (string "conv: " src) (and (= code 0) (= out want))
|
||||||
|
(string "chez=" out " janet=" want " | " err))))
|
||||||
|
# gensym uses a per-process counter, so only the PREFIX is stable across the
|
||||||
|
# Chez run vs the Janet oracle; the numeric suffix legitimately differs.
|
||||||
|
(each src ["(symbol? (gensym))" "(subs (name (gensym \"foo_\")) 0 4)" "(string? (name (gensym)))"]
|
||||||
|
(let [[code out err] (run-prelude src) want (cli-oracle src)]
|
||||||
|
(ok (string "conv: " 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.
|
||||||
|
|
|
||||||
|
|
@ -50,6 +50,9 @@
|
||||||
"source order with a nil value (phm form)" true
|
"source order with a nil value (phm form)" true
|
||||||
"close on throw" true
|
"close on throw" true
|
||||||
"ns-name of *ns*" true
|
"ns-name of *ns*" true
|
||||||
|
"str of *ns*" true
|
||||||
|
"*ns* user" true
|
||||||
|
"str of a var" true
|
||||||
"*clojure-version* major" true
|
"*clojure-version* major" true
|
||||||
"*unchecked-math*" true})
|
"*unchecked-math*" true})
|
||||||
|
|
||||||
|
|
@ -126,8 +129,9 @@
|
||||||
# Regression floor (inc 3j baseline): raise as runtime gaps close, like the probe
|
# Regression floor (inc 3j baseline): raise as runtime gaps close, like the probe
|
||||||
# reach-floor and the suite baseline. The gate fails if parity drops below it, or
|
# reach-floor and the suite baseline. The gate fails if parity drops below it, or
|
||||||
# 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 at inc 3j: 1220/2497. Strided runs scale the floor down.
|
# Full-corpus baseline: inc 3j 1220/2497; inc 3k (converters) 1326. Strided runs
|
||||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1220")))
|
# scale the floor down.
|
||||||
|
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1326")))
|
||||||
(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)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue