Chez emit: codepoint-escape non-ASCII string literals (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). Replace
the %j string encoder with chez-str-lit: UTF-8-decode each char and emit a
Chez codepoint escape \x<cp>;, keeping \n/\t/\r/\"/\\ and staying
byte-identical to %j for printable ASCII. Applied to every string-content
site (string/keyword/symbol/var-name/regex-source).
Unblocks the p{L} utf-8 corpus case; prelude parity floor 1532 -> 1534.
This commit is contained in:
Yogthos
parent
6cc3dc2c7f
commit
6af3e73595
4 changed files with 99 additions and 29 deletions
|
|
@ -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<cp>; (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 <codepoint> :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
|
||||
|
|
|
|||
|
|
@ -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<cp>;` (`é`->`\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
|
||||
|
|
|
|||
|
|
@ -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<cp>;) 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.
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue