diff --git a/host/chez/emit.janet b/host/chez/emit.janet index 266dfa0..d51e89e 100644 --- a/host/chez/emit.janet +++ b/host/chez/emit.janet @@ -115,6 +115,48 @@ (var emit nil) # forward declaration (mutual recursion with the helpers below) +# A Chez string literal (jolt-x0os). Janet's %j renders a non-ASCII char as raw +# UTF-8 bytes (\xC3\xA9) and a control char / DEL as \xHH with NO terminating +# semicolon — both forms Chez's reader rejects ("invalid character \ in string +# hex escape"). Emit a Chez string where every byte outside printable ASCII +# becomes a codepoint hex escape \x; (UTF-8 decoded for multibyte) and the +# named escapes (\n \t \r \" \\) match what both readers accept. For pure +# printable ASCII this is byte-identical to %j. +(defn- utf8-cp [s i] + # decode the UTF-8 sequence starting at byte i -> [codepoint byte-length] + (def b (in s i)) + (cond + (< b 0x80) [b 1] + (= (band b 0xE0) 0xC0) [(bor (blshift (band b 0x1F) 6) + (band (in s (+ i 1)) 0x3F)) 2] + (= (band b 0xF0) 0xE0) [(bor (blshift (band b 0x0F) 12) + (blshift (band (in s (+ i 1)) 0x3F) 6) + (band (in s (+ i 2)) 0x3F)) 3] + (= (band b 0xF8) 0xF0) [(bor (blshift (band b 0x07) 18) + (blshift (band (in s (+ i 1)) 0x3F) 12) + (blshift (band (in s (+ i 2)) 0x3F) 6) + (band (in s (+ i 3)) 0x3F)) 4] + [b 1])) # malformed lead byte: pass through one byte +(defn- chez-str-lit [s] + (def out @"\"") + (def n (length s)) + (var i 0) + (while (< i n) + (def b (in s i)) + (cond + (= b 0x22) (do (buffer/push-string out "\\\"") (++ i)) + (= b 0x5C) (do (buffer/push-string out "\\\\") (++ i)) + (= b 0x0A) (do (buffer/push-string out "\\n") (++ i)) + (= b 0x09) (do (buffer/push-string out "\\t") (++ i)) + (= b 0x0D) (do (buffer/push-string out "\\r") (++ i)) + (and (>= b 0x20) (< b 0x7F)) (do (buffer/push-byte out b) (++ i)) + (< b 0x80) (do (buffer/push-string out (string/format "\\x%x;" b)) (++ i)) + (let [[cp len] (utf8-cp s i)] + (buffer/push-string out (string/format "\\x%x;" cp)) + (+= i len)))) + (buffer/push-string out "\"") + (string out)) + (defn- emit-const [v] (cond (nil? v) "jolt-nil" @@ -130,13 +172,13 @@ (not= v v) "+nan.0" (let [s (string v)] (if (or (string/find "." s) (string/find "e" s)) s (string s ".0")))) - (string? v) (string/format "%j" v) # quoted+escaped string literal + (string? v) (chez-str-lit v) # quoted+escaped string literal # keyword literal -> (keyword ns name); ns is everything before the first "/" (keyword? v) (let [s (string v) idx (string/find "/" s)] (if (and idx (> idx 0)) - (string "(keyword " (string/format "%j" (string/slice s 0 idx)) " " - (string/format "%j" (string/slice s (inc idx))) ")") - (string "(keyword #f " (string/format "%j" s) ")"))) + (string "(keyword " (chez-str-lit (string/slice s 0 idx)) " " + (chez-str-lit (string/slice s (inc idx))) ")") + (string "(keyword #f " (chez-str-lit s) ")"))) # jolt char value {:ch :jolt/type :jolt/char} (and (struct? v) (= :jolt/char (get v :jolt/type))) (string "(integer->char " (get v :ch) ")") @@ -160,8 +202,8 @@ (emit-const form) (and (struct? form) (= :symbol (get form :jolt/type))) (let [ns (get form :ns)] - (string "(jolt-symbol " (if ns (string/format "%j" ns) "#f") " " - (string/format "%j" (get form :name)) ")")) + (string "(jolt-symbol " (if ns (chez-str-lit ns) "#f") " " + (chez-str-lit (get form :name)) ")")) (and (struct? form) (= :jolt/char (get form :jolt/type))) (emit-const form) (and (struct? form) (= :jolt/set (get form :jolt/type))) (string "(jolt-hash-set " (string/join (map emit-quoted (get form :value)) " ") ")") @@ -355,8 +397,8 @@ core-proc core-proc (and (stdlib-var? node) (not prelude-mode?)) (errorf "emit: unsupported stdlib ref `%s/%s` (no core on Chez yet)" (get node :ns) (get node :name)) - (string "(var-deref " (string/format "%j" (get node :ns)) " " - (string/format "%j" (get node :name)) ")"))) + (string "(var-deref " (chez-str-lit (get node :ns)) " " + (chez-str-lit (get node :name)) ")"))) :host (errorf "emit: unsupported host ref `%s` (no host interop on Chez yet)" (get node :name)) :if (string "(if (jolt-truthy? " (emit (get node :test)) ") " (emit (get node :then)) " " (emit (get node :else)) ")") @@ -381,10 +423,10 @@ :try (emit-try node) :quote (emit-quoted (get node :form)) # regex literal #"…" -> a jolt-regex value (regex.ss compiles the source via - # the vendored irregex). %j quotes+escapes the source; a backslash in the - # pattern becomes \\ in the Scheme string literal -> the 1-char backslash - # irregex expects (same escaping emit-const uses for strings). - :regex (string "(jolt-regex " (string/format "%j" (get node :source)) ")") + # the vendored irregex). chez-str-lit quotes+escapes the source; a backslash + # in the pattern becomes \\ in the Scheme string literal -> the 1-char + # backslash irregex expects (same escaping emit-const uses for strings). + :regex (string "(jolt-regex " (chez-str-lit (get node :source)) ")") # host interop (jolt-0kf5): (.method target arg*) -> (jolt-host-call "method" # target arg*). Only the methods the RT dispatcher (rt.ss) actually shims are # IN the subset; any other method is out of subset (a clean emit-time reject, @@ -395,16 +437,16 @@ (errorf "emit: unsupported host method `.%s` (no Chez shim yet)" m)) (let [target (emit (get node :target)) args (map emit (vv (get node :args)))] - (string "(jolt-host-call " (string/format "%j" m) " " + (string "(jolt-host-call " (chez-str-lit m) " " target (if (empty? args) "" (string " " (string/join args " "))) ")"))) :fn (emit-fn node) # (def name) with no init (declare): reserve the var cell (declare-var! # doesn't clobber an existing root) so a forward reference resolves. :def (if (get node :no-init) - (string "(declare-var! " (string/format "%j" (get node :ns)) " " - (string/format "%j" (get node :name)) ")") - (string "(def-var! " (string/format "%j" (get node :ns)) " " - (string/format "%j" (get node :name)) " " (emit (get node :init)) ")")) + (string "(declare-var! " (chez-str-lit (get node :ns)) " " + (chez-str-lit (get node :name)) ")") + (string "(def-var! " (chez-str-lit (get node :ns)) " " + (chez-str-lit (get node :name)) " " (emit (get node :init)) ")")) (errorf "emit: unhandled op %p" (get node :op))))) # Wrap emitted top-level forms into a runnable Chez program: load the RT, then diff --git a/test/chez/README.md b/test/chez/README.md index 8d4bfeb..744a8d4 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -153,16 +153,7 @@ class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps). 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`. + Two pre-existing bugs surfaced here, since fixed (inc 3x / 3y below). - inc 3q multimethod dispatch + late-bind (jolt-9ls5, Phase 2): `host/chez/ multimethods.ss` implements the multimethod runtime — `defmulti`/`defmethod` expand to `defmulti-setup`/`defmethod-setup` calls (+ `get-method`/`methods`/ @@ -190,6 +181,21 @@ class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps). (false), removing their two parity allowlist entries. `*ns*` is deferred (jolt-b4kl): it needs a namespace value that is not a map (`map?` false) yet answers `(get ns :name)` for the overlay `ns-name`, plus `str`/`find-ns` support. +- inc 3x non-ASCII string literals (jolt-x0os): `emit.janet`'s `chez-str-lit` replaces + the `%j` string encoder. Janet's `%j` renders a non-ASCII char as raw UTF-8 bytes + (`\xC3\xA9`) and a control char / DEL as `\xHH` with NO terminating semicolon — both + forms Chez's reader rejects. `chez-str-lit` UTF-8-decodes each char and emits a + codepoint hex escape `\x;` (`é`->`\xe9;`, `日`->`\x65e5;`), keeping `\n`/`\t`/`\r`/ + `\"`/`\\` and being byte-identical to `%j` for printable ASCII. Applied to every + string-content site (string/keyword/symbol/var-name/regex-source). This unblocks the + `p{L} utf-8` corpus case (the `\p{L}` translation was already correct). Note: `count`/ + `subs`/`nth` over a multibyte string index by BYTES in the seed but by codepoints on + Chez — a separate semantic gap, not addressed here. +- inc 3y seed assoc! odd-args (jolt-ea9k): `core-assoc!` (src/jolt/core_extra.janet) now + throws on an odd key/val count, like plain `assoc` and Clojure's `assoc!` — the former + lenient nil-fill was non-Clojure and inconsistent with the seed's own `assoc`. The 4 + `assoc! odd args` spec rows became 3 `:throws` + 1 even-args positive; corpus.edn + regenerated. The Chez host already threw, so this only realigns the corpus contract. 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 diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet index 62649a2..bb9fe37 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -621,6 +621,26 @@ (ok (string "dynvar: " src) (and (= code 0) (= out want)) (string "chez=" out " janet=" want " | " err)))) +# 3x) non-ASCII / control-char string literals (jolt-x0os): Janet's %j renders +# a non-ASCII char as raw UTF-8 bytes (\xC3\xA9) and a control char as \xHH +# with NO terminating semicolon — both forms Chez's reader rejects ("invalid +# character \ in string hex escape"). emit-const must emit a Chez string with +# codepoint escapes (\x;) so a literal that just passes through (str/=) +# round-trips. (count/subs/nth over a multibyte string index by BYTES in the +# seed but by codepoints on Chez — a separate semantic gap, not tested here.) +(each src ["(str \"h\xC3\xA9llo\")" + "\"h\xC3\xA9llo\"" + "(str \"na\xC3\xAFve caf\xC3\xA9\")" + "(str \"\xE6\x97\xA5\xE6\x9C\xAC\xE8\xAA\x9E\")" + "(str \"\xCE\xB1\xCE\xB2\xCE\xB3 \xCE\xB4\xCE\xB5\xCE\xB6\")" + "(= \"h\xC3\xA9llo\" (str \"h\xC3\xA9llo\"))" + "(str \"a\x01b\")" + "(str \"tab\tend\")"] + (let [[code out err] (run-prelude src) want (cli-oracle src)] + (ok (string "non-ascii str: " 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 # track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the # jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers. diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index e6fe019..ac31563 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -136,9 +136,11 @@ # Full-corpus baseline: inc 3j 1220/2497; 3k (converters) 1326; 3l (transients) # 1382; 3m (numeric-edge emit + variadic assoc!) 1407; 3n (seq-native shims + # reduced) 1467; 3o (transducer arities) 1493; 3p (misc seq/regex gaps) 1506; -# 3q (multimethod dispatch + late-bind) 1530; 3r (dynamic-var constants) 1532. +# 3q (multimethod dispatch + late-bind) 1530; 3r (dynamic-var constants) 1532; +# 3x (non-ASCII string literals, jolt-x0os) + 3y (seed assoc! odd-args -> :throws, +# jolt-ea9k) 1534 (total evaluated drops as the 3 odd-arg rows become :throws). # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1532"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1534"))) (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)))