From e756fc24afa693ea7c706f32f1ce4e8a930f1464 Mon Sep 17 00:00:00 2001 From: Claude Date: Sun, 11 Oct 2026 04:30:25 +0000 Subject: [PATCH 1/2] Make string primitives count Unicode code points (UTF-8) (#80) Shen strings are now sequences of Unicode code points held as UTF-8: - n->string encodes any code point 0..U+10FFFF except surrogates and raises an error otherwise (was string.char: 0..255, with 128..255 returned as a lone invalid byte). - string->n, pos, tlstr, hdstr, explode, shen.string->bytes, shen.str->bytes and the native hash count characters. ASCII text stays on the byte fast path; the UTF-8 path runs only when a byte >= 0x80 is present. The inline POS/TLSTR/STRN/NSTR helpers check the bytes involved and fall back to the primitive otherwise. - read-file decodes source as UTF-8 into code points before parsing, and shen.my-read-byte (behind read/lineread) reads one UTF-8 character, so non-ASCII literals read as their characters instead of mojibake. read-byte, write-byte and read-file-as-bytelist stay byte primitives. - pr writes strings through shen.write-string (char-stoutput? is true), since write-chars cannot carry a code point through write-byte. - Invalid UTF-8 is lenient and lossless: each ill-formed byte is one character whose code is the byte value. Documented in prims.lua and the README. - Bump the kernel cache format to SHENKC5. fasl and stdlib image keys fold the kernel key, so caches built over the byte primitives are invalidated. Adds test/utf8_strings_spec.lua and a Bifrost suite (bifrost/bifrost.suite.json) for non-ASCII strings. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01DHL2X2i5C1mWW2f5ypuSaw --- README.md | 24 +- bifrost/bifrost.suite.json | 65 +++++ bifrost/programs/unicode-codepoints.shen | 26 ++ bifrost/programs/unicode-literals.shen | 15 + boot.lua | 7 +- prims.lua | 355 ++++++++++++++++++++--- scripts/run-tests.lua | 1 + test/utf8_strings_spec.lua | 220 ++++++++++++++ 8 files changed, 673 insertions(+), 40 deletions(-) create mode 100644 bifrost/bifrost.suite.json create mode 100644 bifrost/programs/unicode-codepoints.shen create mode 100644 bifrost/programs/unicode-literals.shen create mode 100644 test/utf8_strings_spec.lua diff --git a/README.md b/README.md index 5de2391..766f205 100644 --- a/README.md +++ b/README.md @@ -42,6 +42,28 @@ the Kλ boundary — type *checking* is the kernel’s own Shen, unchanged. Numbers, strings, and booleans are Lua’s. Symbols are interned (identity `==`). `()` is a unique `NIL`. Cons is `{h,t}`; vectors are array tables. +### Strings and Unicode + +A Shen string is a sequence of Unicode code points, held as a UTF-8 Lua +string. `pos`, `tlstr`, `hdstr`, `string->n`, `explode`, `hash` (and anything +built on them, such as `string.length`) count characters, not bytes. +`(n->string N)` returns the UTF-8 encoding of any code point 0..U+10FFFF +except the surrogates U+D800..U+DFFF, and raises an error for anything else. +The reader decodes source files, `read-from-string`, and `(read Stream)` as +UTF-8, so `"Zürich"` reads as six characters and prints back unchanged. `pr` +writes UTF-8. `read-byte`, `write-byte`, and `read-file-as-bytelist` stay raw +byte operations. ASCII text stays on a byte-indexed fast path. + +Invalid UTF-8 never raises an error and never loses data. Each byte that does +not start a well-formed sequence counts as one character on its own: a stray +continuation byte, a 0xC0/0xC1/0xF5–0xFF lead byte, a truncated, overlong, or +surrogate sequence, or a value above U+10FFFF. `pos`, `tlstr`, and `explode` +return that raw byte, so `(cn (hdstr S) (tlstr S))` is always `S`. +`string->n` returns the byte's value (0x80–0xFF), so such a byte in source text +reads as the character with that code (Latin-1). One thing does not round-trip: +`(n->string (string->n B))` gives the valid two-byte encoding of that code, not +the original byte. + ## CLI ```sh @@ -128,7 +150,7 @@ luajit run-kernel-tests.lua # official 42 suite → 134/134 ``` The kernel suite is vendored in `tests/`. Port specs cover primitives, REPL, -interop, tail-call lowering, boot caches. +interop, tail-call lowering, boot caches, UTF-8 strings. ## Install diff --git a/bifrost/bifrost.suite.json b/bifrost/bifrost.suite.json new file mode 100644 index 0000000..b536943 --- /dev/null +++ b/bifrost/bifrost.suite.json @@ -0,0 +1,65 @@ +{ + "name": "shen-lua-unicode", + "root": ".", + "programs_dir": "programs", + "default_cwd": ".", + "cases": [ + { + "name": "unicode-n->string-252", + "mode": "eval", + "expr": "(n->string 252)", + "expect": "output", + "golden": "ü", + "doc": "issue #80: U+00FC as UTF-8 (C3 BC). shen-lua <= 0.11.1 printed a lone 0xFC byte" + }, + { + "name": "unicode-n->string-8364", + "mode": "eval", + "expr": "(n->string 8364)", + "expect": "output", + "golden": "€", + "doc": "issue #80: code points above 255. shen-lua <= 0.11.1 raised bad argument to NSTR" + }, + { + "name": "unicode-string->n-roundtrip", + "mode": "eval", + "expr": "(string->n (n->string 8364))", + "expect": "output", + "golden": "8364" + }, + { + "name": "unicode-explode-length", + "mode": "eval", + "expr": "(length (explode (cn \"Z\" (cn (n->string 252) \"rich\"))))", + "expect": "output", + "golden": "6", + "doc": "explode counts characters, not UTF-8 bytes" + }, + { + "name": "unicode-hash-codepoint", + "mode": "eval", + "expr": "(hash (n->string 252) 1000)", + "expect": "output", + "golden": "252", + "doc": "hash folds string->n (code points) per the kernel's sys.kl definition: 252 for U+00FC on shen-lua and Tarver's S42 SBCL build. shen-go hashes strings natively with a different function (874), so this golden is kernel-definition, not cross-port", + "known_divergence": "shen-go-native-string-hash" + }, + { + "name": "unicode-codepoints", + "mode": "script", + "program": "unicode-codepoints.shen", + "expect": "output", + "golden": "n->string-252-is-one-char ok\nn->string-8364-is-one-char ok\nn->string-128512-is-one-char ok\nstring->n-252 ok\nstring->n-8364 ok\nstring->n-1114111 ok\npos-1 ok\npos-5 ok\ntlstr ok\nhdstr ok\nexplode-length ok\nexplode-codes ok\nhash-built-twice ok\nhash-agrees-with-= ok\nequal-built ok\nnot-equal-bytes ok\nput-get ok\nat-s-pattern ok", + "doc": "code-point string primitives over strings built with n->string, so no port's reader is involved" + }, + { + "name": "unicode-literals", + "mode": "script", + "program": "unicode-literals.shen", + "expect": "output", + "golden": "literal-length ok\nliteral-string->n ok\nliteral-euro ok\nliteral-equals-built ok\nliteral-pos ok\nliteral-tlstr ok\nliteral-hash ok\ncontrol-escape ok\nGrüße, Zoë: 5 €", + "known_divergence": "latin1-source-reader", + "doc": "UTF-8 source literals read as code points. Tarver's S42 SBCL build, shen-cl (file loads) and shen-go read source BYTES and rebuild text with n->string per byte, i.e. they decode source as Latin-1: \"ü\" becomes the two characters U+00C3 U+00BC and prints as mojibake. shen-lua decodes UTF-8 (issue #80)" + } + ] +} diff --git a/bifrost/programs/unicode-codepoints.shen b/bifrost/programs/unicode-codepoints.shen new file mode 100644 index 0000000..292da09 --- /dev/null +++ b/bifrost/programs/unicode-codepoints.shen @@ -0,0 +1,26 @@ +\\ unicode-codepoints.shen -- issue #80: strings are sequences of Unicode +\\ code points. Every non-ASCII string here is BUILT with n->string, so the +\\ result does not depend on how a port's reader decodes source bytes. +\\ Output is ASCII only (codes and lengths), one token per line. +(define u.zurich -> (cn "Z" (cn (n->string 252) "rich"))) +(define u.check Name Got Want -> + (do (output "~A ~A~%" Name (if (= Got Want) ok [Got /= Want])) ok)) + +(u.check n->string-252-is-one-char (length (explode (n->string 252))) 1) +(u.check n->string-8364-is-one-char (length (explode (n->string 8364))) 1) +(u.check n->string-128512-is-one-char (length (explode (n->string 128512))) 1) +(u.check string->n-252 (string->n (n->string 252)) 252) +(u.check string->n-8364 (string->n (n->string 8364)) 8364) +(u.check string->n-1114111 (string->n (n->string 1114111)) 1114111) +(u.check pos-1 (string->n (pos (u.zurich) 1)) 252) +(u.check pos-5 (pos (u.zurich) 5) "h") +(u.check tlstr (tlstr (cn (n->string 252) "x")) "x") +(u.check hdstr (string->n (hdstr (cn (n->string 8364) "uro"))) 8364) +(u.check explode-length (length (explode (u.zurich))) 6) +(u.check explode-codes (map (/. C (string->n C)) (explode (u.zurich))) [90 252 114 105 99 104]) +(u.check hash-built-twice (= (hash (n->string 252) 1000) (hash (cn "" (n->string 252)) 1000)) true) +(u.check hash-agrees-with-= (= (hash (u.zurich) 99991) (hash (cn (cn "Z" (n->string 252)) "rich") 99991)) (= (u.zurich) (cn (cn "Z" (n->string 252)) "rich"))) +(u.check equal-built (= (n->string 252) (cn "" (n->string 252))) true) +(u.check not-equal-bytes (= (u.zurich) "Zurich") false) +(u.check put-get (do (put (u.zurich) city yes) (get (cn "Z" (cn (n->string 252) "rich")) city)) yes) +(u.check at-s-pattern ((/. S (length (explode S))) (@s (n->string 252) (n->string 223))) 2) diff --git a/bifrost/programs/unicode-literals.shen b/bifrost/programs/unicode-literals.shen new file mode 100644 index 0000000..7d6932f --- /dev/null +++ b/bifrost/programs/unicode-literals.shen @@ -0,0 +1,15 @@ +\\ unicode-literals.shen -- issue #80: a non-ASCII string LITERAL in a UTF-8 +\\ source file reads as its characters, prints back byte-identical, and agrees +\\ with the same string built from code points. +(define u.check Name Got Want -> + (do (output "~A ~A~%" Name (if (= Got Want) ok [Got /= Want])) ok)) + +(u.check literal-length (length (explode "Zürich")) 6) +(u.check literal-string->n (string->n "ü") 252) +(u.check literal-euro (string->n "€") 8364) +(u.check literal-equals-built (= "ü" (n->string 252)) true) +(u.check literal-pos (pos "Zürich" 1) (n->string 252)) +(u.check literal-tlstr (tlstr "üx") "x") +(u.check literal-hash (hash "ü" 1000) 252) +(u.check control-escape (= "c#252;" "ü") true) +(output "~A~%" "Grüße, Zoë: 5 €") diff --git a/boot.lua b/boot.lua index 9125657..eb628a5 100644 --- a/boot.lua +++ b/boot.lua @@ -211,7 +211,12 @@ P.GLOBALS["*release*"] = "0.1" -- port release; kernel *version* comes f -- select direct-call vs APP codegen), the file list, and the LuaJIT version/ -- arch (bytecode is not portable across either). SHEN_KERNEL_CACHE=off -- disables; any other value overrides the cache path. -local CACHE_FORMAT = "SHENKC4" -- 4: hoisted declare typeforms evaluated before +local CACHE_FORMAT = "SHENKC5" -- 5: code-point string primitives (issue #80): + -- kernel chunks, fasls and stdlib images + -- built over byte-based pos/tlstr/ + -- string->n/n->string/hash are stale + -- (fasl_key and image_path fold this key) + -- 4: hoisted declare typeforms evaluated before -- `declare` (issue #62); 3: per-chunk hoisted -- (declare ...) block + gensym/inference -- counters diff --git a/prims.lua b/prims.lua index 14d79f0..079548d 100644 --- a/prims.lua +++ b/prims.lua @@ -291,23 +291,190 @@ defprim("cn", 2, function(a,b) if type(a)~="string" or type(b)~="string" then ERR("cn: not strings") end return a..b end) +-- ---- strings are sequences of Unicode code points, held as UTF-8 ---------- +-- (issue #80). A Shen string is a Lua string of UTF-8 bytes; the character +-- primitives (pos, tlstr, string->n, n->string, hdstr, explode, hash, the +-- reader) count CODE POINTS, not bytes. Pure-ASCII text stays on the old byte +-- fast path: every helper below first checks for a byte >= 0x80 and only then +-- walks the string as UTF-8, so ASCII text costs a byte check or a C-level +-- scan for a high byte. +-- +-- INVALID UTF-8 is never an error and never loses data. Decoding is lenient: +-- any byte that does not begin a well-formed sequence -- a stray continuation +-- byte, a 0xC0/0xC1/0xF5..0xFF lead, a truncated sequence, an overlong form, +-- an encoded surrogate, anything above U+10FFFF -- is ONE character on its +-- own, consisting of that raw byte, whose code (string->n) is the byte value +-- 0x80..0xFF (the Latin-1 reading of that byte). pos/tlstr/explode keep the +-- raw byte, so (cn (hdstr S) (tlstr S)) == S always holds. The one thing that +-- does not round-trip is (n->string (string->n B)) for such a byte B: it +-- yields the UTF-8 encoding of U+0080..U+00FF, a different (valid) string. +-- The reader decodes source text the same way, so a stray Latin-1 byte in a +-- source string literal reads as the character of the same code. +-- +-- n->string accepts integral 0..0x10FFFF except the surrogates +-- U+D800..U+DFFF and errors on anything else. Everything here is plain Lua +-- 5.1 string/arith code (no `utf8` library), so it runs identically on +-- LuaJIT 2.1 and PUC Lua 5.1..5.4. +local sbyte, ssub, schar, sfind = string.byte, string.sub, string.char, string.find +local mfloor = math.floor +local HIGHPAT = "[\128-\255]" + +-- u8dec(s, i) -> code point, byte length of the character at byte index i +-- (i <= #s). Lenient: an ill-formed sequence decodes as its first byte alone. +local function u8dec(s, i) + local c = sbyte(s, i) + if c < 0x80 then return c, 1 end + if c < 0xC2 then return c, 1 end + if c < 0xE0 then + local c2 = sbyte(s, i + 1) + if c2 and c2 >= 0x80 and c2 < 0xC0 then return (c - 0xC0) * 64 + (c2 - 0x80), 2 end + return c, 1 + end + if c < 0xF0 then + local c2, c3 = sbyte(s, i + 1, i + 2) + if c3 and c2 >= 0x80 and c2 < 0xC0 and c3 >= 0x80 and c3 < 0xC0 then + local cp = (c - 0xE0) * 4096 + (c2 - 0x80) * 64 + (c3 - 0x80) + if cp >= 0x800 and (cp < 0xD800 or cp > 0xDFFF) then return cp, 3 end + end + return c, 1 + end + if c < 0xF5 then + local c2, c3, c4 = sbyte(s, i + 1, i + 3) + if c4 and c2 >= 0x80 and c2 < 0xC0 and c3 >= 0x80 and c3 < 0xC0 + and c4 >= 0x80 and c4 < 0xC0 then + local cp = (c - 0xF0) * 262144 + (c2 - 0x80) * 4096 + (c3 - 0x80) * 64 + (c4 - 0x80) + if cp >= 0x10000 and cp <= 0x10FFFF then return cp, 4 end + end + end + return c, 1 +end + +-- u8enc(n) -> UTF-8 encoding of code point n, or nil if n is not an integral +-- Unicode scalar value (0..0x10FFFF minus the surrogates). +local function u8enc(n) + if type(n) ~= "number" or n ~= mfloor(n) or n < 0 then return nil end + if n < 0x80 then return schar(n) end + if n < 0x800 then return schar(0xC0 + mfloor(n / 64), 0x80 + n % 64) end + if n < 0x10000 then + if n >= 0xD800 and n <= 0xDFFF then return nil end + return schar(0xE0 + mfloor(n / 4096), 0x80 + mfloor(n / 64) % 64, 0x80 + n % 64) + end + if n <= 0x10FFFF then + return schar(0xF0 + mfloor(n / 262144), 0x80 + mfloor(n / 4096) % 64, + 0x80 + mfloor(n / 64) % 64, 0x80 + n % 64) + end + return nil +end + +-- u8len(s): number of characters (code points / lone invalid bytes). +local function u8len(s) + local h = sfind(s, HIGHPAT) + if not h then return #s end + local n, i, len = h - 1, h, #s + while i <= len do + local _, l = u8dec(s, i) + i = i + l; n = n + 1 + end + return n +end + +-- u8pos(s, n): the n-th (0-based) character of s as a string, or nil when n +-- is out of range. ASCII prefix -> one byte substring. +local function u8pos(s, n) + local len = #s + if n >= len then return nil end -- chars <= bytes + local h = sfind(s, HIGHPAT) + if not h or h > n + 1 then return ssub(s, n + 1, n + 1) end + local i, k = h, h - 1 -- k = index of char at byte i + while i <= len do + local _, l = u8dec(s, i) + if k == n then return ssub(s, i, i + l - 1) end + i = i + l; k = k + 1 + end + return nil +end + +-- u8tl(s): s without its first character (s non-empty). +local function u8tl(s) + local c = sbyte(s, 1) + if c < 0xC2 then return ssub(s, 2) end + local _, l = u8dec(s, 1) + return ssub(s, l + 1) +end + +-- u8hd(s): the first character of s as a string (s non-empty). +local function u8hd(s) + local c = sbyte(s, 1) + if c < 0xC2 then return ssub(s, 1, 1) end + local _, l = u8dec(s, 1) + return ssub(s, 1, l) +end + +-- u8explode(s): KL list of the characters of s. +local function u8explode(s) + local acc = NIL + if not sfind(s, HIGHPAT) then + for i = #s, 1, -1 do acc = cons(ssub(s, i, i), acc) end + return acc + end + local chars, i, len = {}, 1, #s + while i <= len do + local _, l = u8dec(s, i) + chars[#chars + 1] = ssub(s, i, i + l - 1) + i = i + l + end + for j = #chars, 1, -1 do acc = cons(chars[j], acc) end + return acc +end + +-- u8codes(s): KL list of the character codes of s (string->n of each char). +local function u8codes(s) + local acc = NIL + if not sfind(s, HIGHPAT) then + for i = #s, 1, -1 do acc = cons(sbyte(s, i), acc) end + return acc + end + local cps, i, len = {}, 1, #s + while i <= len do + local cp, l = u8dec(s, i) + cps[#cps + 1] = cp + i = i + l + end + for j = #cps, 1, -1 do acc = cons(cps[j], acc) end + return acc +end + +P.utf8 = { HIGHPAT = HIGHPAT, dec = u8dec, enc = u8enc, len = u8len, + pos = u8pos, tl = u8tl, hd = u8hd, explode = u8explode, codes = u8codes } + +local function nstr_error(n) + local shown = type(n) == "number" and numToStr(n) or tostring(n) + ERR("n->string: " .. shown .. " is not a Unicode code point (0..1114111, excluding surrogates)") +end + defprim("pos", 2, function(s,n) if type(s)~="string" then ERR("pos: not a string") end - if n < 0 or n >= #s then ERR("pos: index out of range") end - return string.sub(s, n+1, n+1) + if type(n)~="number" or n < 0 or n ~= mfloor(n) then ERR("pos: index out of range") end + local c = u8pos(s, n) + if c == nil then ERR("pos: index out of range") end + return c end) defprim("tlstr", 1, function(s) if type(s)~="string" then ERR("tlstr: not a string") end if #s == 0 then ERR("tlstr: empty string") end - return string.sub(s, 2) + return u8tl(s) end) defprim("string->n", 1, function(s) if type(s) ~= "string" or #s == 0 then ERR("string->n: empty or non-string") end - return string.byte(s,1) + local c = sbyte(s, 1) + if c < 0xC2 then return c end + return (u8dec(s, 1)) end) defprim("n->string", 1, function(n) if type(n) ~= "number" then ERR("n->string: not a number") end - return string.char(n) + local ch = u8enc(n) + if ch == nil then nstr_error(n) end + return ch end) defprim("string->symbol", 1, function(s) return intern(s) end) @@ -388,11 +555,20 @@ end P.mk_out_stream, P.mk_in_stream = mk_out_stream, mk_in_stream -- shen.char-stoutput? : port-specific predicate referenced by `pr` to choose --- between a fast (write-string) and a fallback (write-chars) path. Our streams --- are byte streams, so we return false and the `write-chars` path is used. -defprim("shen.char-stoutput?", 1, function(_st) return false end) +-- between a fast (write-string) and a fallback (write-chars) path. write-chars +-- writes (string->n (pos S I)) per character with write-byte, which cannot +-- carry a code point above 0x7F (issue #80), so every output stream here is a +-- CHARACTER stream for pr: shen.write-string writes the string's UTF-8 bytes +-- as they are. write-byte stays a raw byte primitive. +defprim("shen.char-stoutput?", 1, function(_st) return true end) +defprim("shen.write-string", 2, function(s, st) + if not is_stream(st) or st.kind~="out" then ERR("pr: not an output stream") end + if type(s) ~= "string" then ERR("pr: not a string") end + st.write(s) + return s +end) -- shen.char-stinput? : input-side counterpart used by `read-byte` callers. --- Our streams are byte streams. +-- Our streams are byte streams: (read-byte S) returns raw bytes. defprim("shen.char-stinput?", 1, function(_st) return false end) -- write-byte (N STREAM) -> N : write a single byte to an output stream @@ -402,13 +578,57 @@ defprim("write-byte", 2, function(n, st) return n end) --- read-byte (STREAM) -> N | -1 at EOF -defprim("read-byte", 1, function(st) - if not is_stream(st) or st.kind~="in" then ERR("read-byte: not an input stream") end +-- raw next byte of an input stream, honouring one byte of pushback (used by +-- the UTF-8 decoder below when a sequence turns out to be ill-formed). +local function stream_byte(st) + local pb = st.pb + if pb then st.pb = nil; return pb end if st.eof then return -1 end local b = st.readbyte() if b == nil then st.eof = true; return -1 end return b +end + +-- read-byte (STREAM) -> N | -1 at EOF +defprim("read-byte", 1, function(st) + if not is_stream(st) or st.kind~="in" then ERR("read-byte: not an input stream") end + return stream_byte(st) +end) + +-- stream_char(st) -> code point of the next character of st, or -1 at EOF. +-- Lenient like u8dec: an ill-formed sequence yields its lead byte's value and +-- the offending byte is pushed back to start the next character. +local function stream_char(st) + local c = stream_byte(st) + if c < 0xC2 or c > 0xF4 then return c end -- ASCII, EOF, or lone byte + local need = c < 0xE0 and 1 or (c < 0xF0 and 2 or 3) + local cp = c < 0xE0 and c - 0xC0 or (c < 0xF0 and c - 0xE0 or c - 0xF0) + for _ = 1, need do + local b = stream_byte(st) + if b < 0x80 or b > 0xBF then + if b ~= -1 then st.pb = b end + return c + end + cp = cp * 64 + (b - 0x80) + end + if (need == 2 and (cp < 0x800 or (cp >= 0xD800 and cp <= 0xDFFF))) + or (need == 3 and (cp < 0x10000 or cp > 0x10FFFF)) then + return c -- overlong / surrogate / out of range: lead byte alone + end + return cp +end + +-- shen.my-read-byte (reader.kl) feeds the reader behind `read` and `lineread`. +-- The reader consumes character codes (it rebuilds text with n->string), so +-- the native override (install_native_stdlib) reads one UTF-8 character with +-- stream_char and returns its code point; read-byte on the same stream still +-- sees raw bytes. +-- shen.read-unit-string: one character as a string ("" at EOF). +defprim("shen.read-unit-string", 1, function(st) + if not is_stream(st) or st.kind~="in" then ERR("read-unit-string: not an input stream") end + local cp = stream_char(st) + if cp == -1 then return "" end + return u8enc(cp) or schar(cp) end) -- open (NAME DIRECTION) -> stream ; DIRECTION is symbol `in` or `out` @@ -923,22 +1143,34 @@ function P.install_native_stdlib() -- hash (sys.kl:117) drives EVERY dict operation — get/put and the whole -- property system (arities, source, types, ...). The kernel computes it as -- (shen.mod (shen.prodbutzero (map string->n (explode V)) 1) Bound) - -- i.e. explode V into its printed characters, take each char's first BYTE - -- (string->n = string.byte), and fold them with prodbutzero: multiply while - -- the accumulator stays <= 1e10, switch to ADD once it exceeds (the kernel's - -- own overflow guard — so the key never leaves the double-exact range), then - -- reduce mod Bound with 0 mapped to 1. For a symbol explode yields the bytes - -- of its name; for a string, the bytes of the string (tlstr/pos/string->n - -- are all byte-based here) — verified identical to the compiled-KL hash over - -- every kernel F-name x 5 bounds plus edge strings (empty, embedded NUL, - -- UTF-8, >1e10-triggering lengths): 0 mismatches. Any other value type - -- delegates to the original so its exact printed form is never second-guessed. - -- Boot alone calls hash ~800 times (all on symbol keys); a native fold there - -- and at runtime avoids the per-call explode list + map + KL recursion. + -- i.e. explode V into its printed characters, take each character's code + -- (string->n: its Unicode code point, issue #80), and fold them with + -- prodbutzero: multiply while the accumulator stays <= 1e10, switch to ADD + -- once it exceeds (the kernel's own overflow guard — so the key never + -- leaves the double-exact range), then reduce mod Bound with 0 mapped to 1. + -- For a symbol explode yields the characters of its name; for a string, + -- the characters of the string. ASCII text folds bytes directly (byte == + -- code point); text with a byte >= 0x80 folds code points, exactly as the + -- kernel definition does over the code-point primitives, so the result + -- agrees with the compiled-KL hash and with = (equal strings, equal hash). + -- Any other value type delegates to the original so its exact printed form + -- is never second-guessed. Boot alone calls hash ~800 times (all on symbol + -- keys); a native fold there and at runtime avoids the per-call explode + -- list + map + KL recursion. local orig_hash = F["hash"] - local sbyte = string.byte local function hashkey_bytes(s) local acc = 1 + if sfind(s, HIGHPAT) then + local i, len = 1, #s + while i <= len do + local b, l = u8dec(s, i) + if b ~= 0 then + if acc > 10000000000 then acc = acc + b else acc = acc * b end + end + i = i + l + end + return acc + end for i = 1, #s do local b = sbyte(s, i) if b ~= 0 then @@ -1179,16 +1411,45 @@ function P.install_native_stdlib() elseif type(v) == "boolean" then s = v and "true" or "false" elseif type(v) == "number" then s = numToStr(v) else return orig_explode(v) end - local acc = NIL - for i = #s, 1, -1 do acc = cons(string.sub(s, i, i), acc) end - return acc + return u8explode(s) end + -- shen.string->bytes / shen.str->bytes: despite the names, the kernel + -- builds both from string->n, i.e. character CODES (code points), which is + -- also what the reader consumes (read-from-string = str->bytes + ). local orig_s2b = F["shen.string->bytes"] local function string_to_bytes(s) if type(s) ~= "string" then return orig_s2b(s) end - local acc = NIL - for i = #s, 1, -1 do acc = cons(string.byte(s, i), acc) end - return acc + return u8codes(s) + end + local orig_str2b = F["shen.str->bytes"] + local function str_to_bytes(s) + if type(s) ~= "string" then return orig_str2b(s) end + return u8codes(s) + end + + -- read-file: the kernel reads the file as a BYTE list and feeds it to the + -- reader, whose / rules rebuild text with n->string. With + -- code-point strings that would re-encode every byte of a UTF-8 sequence + -- as its own character (mojibake), so read-file instead decodes the file + -- as UTF-8 into code points (lenient: an invalid byte reads as the code of + -- that byte). read-file-as-bytelist itself keeps returning raw bytes. The + -- body below is the kernel's read-file (reader.kl) over that code list. + local orig_my_read_byte = F["shen.my-read-byte"] + local function my_read_byte(st) + if not is_stream(st) or st.kind ~= "in" then return orig_my_read_byte(st) end + return stream_char(st) + end + local orig_read_file = F["read-file"] + local function read_file(name) + if type(name) ~= "string" then return orig_read_file(name) end + local fh = io.open(name, "rb") + if not fh then return orig_read_file(name) end -- same open error + local data = fh:read("*a") or "" + fh:close() + local codes = u8codes(data) + local ok, parsed = pcall(F["compile"], F["shen."], codes) + if not ok then parsed = F["shen.reader-error"](GLOBALS["shen.*residue*"]) end + return F["shen.process-sexprs"](parsed) end -- concat: (intern (cn (str A) (str B))) — intern("true") is boolean true. @@ -1229,7 +1490,7 @@ function P.install_native_stdlib() local orig_hdstr = F["hdstr"] local function hdstr(s) if type(s) ~= "string" or #s == 0 then return orig_hdstr(s) end - return string.sub(s, 1, 1) + return u8hd(s) end local function byte_to_digit(n) return n - 48 end local function limit(v) return v[2] end @@ -1716,6 +1977,9 @@ function P.install_native_stdlib() install("shen.length-h", length_h, 2) install("explode", explode, 1) install("shen.string->bytes", string_to_bytes, 1) + install("shen.str->bytes", str_to_bytes, 1) + install("read-file", read_file, 1) + install("shen.my-read-byte", my_read_byte, 1) install("concat", concat, 2) install("nth", nth, 2) install("sum", sum, 1) @@ -1993,24 +2257,39 @@ local ENV = { if type(a) == "string" and type(b) == "string" then return a .. b end return F["cn"](a, b) end, + -- Inline string helpers (compiler.lua lowers pos/tlstr/string->n/n->string/ + -- hdstr to these). Fast path: the bytes involved are ASCII (< 0x80, or + -- < 0xC2 for a lone first byte, which can never start a multi-byte + -- character), so one byte is one character. Otherwise fall back to the + -- code-point primitive (issue #80). POS = function(s, n) if type(s) == "string" and type(n) == "number" and n >= 0 and n < #s then - return string.sub(s, n + 1, n + 1) + if n == 0 then + if sbyte(s, 1) < 0xC2 then return ssub(s, 1, 1) end + else + local h = sfind(s, HIGHPAT) -- first non-ASCII byte, if any + if not h or h > n + 1 then return ssub(s, n + 1, n + 1) end + end end return F["pos"](s, n) end, TLSTR = function(s) - if type(s) == "string" and #s > 0 then return string.sub(s, 2) end + if type(s) == "string" then + local c = sbyte(s, 1) + if c and c < 0xC2 then return ssub(s, 2) end + end return F["tlstr"](s) end, STRN = function(s) - if type(s) == "string" and #s > 0 then return string.byte(s, 1) end + if type(s) == "string" then + local c = sbyte(s, 1) + if c and c < 0xC2 then return c end + end return F["string->n"](s) end, NSTR = function(n) - if type(n) == "number" then - local ok, ch = pcall(string.char, n) - if ok then return ch end + if type(n) == "number" and n >= 0 and n < 128 and n == mfloor(n) then + return schar(n) end return F["n->string"](n) end, diff --git a/scripts/run-tests.lua b/scripts/run-tests.lua index a1103bd..29a9dcd 100644 --- a/scripts/run-tests.lua +++ b/scripts/run-tests.lua @@ -51,6 +51,7 @@ local specs = { "test/tailcall_spec.lua", "test/typecheck_api_spec.lua", "test/typecheck_lazy_spec.lua", + "test/utf8_strings_spec.lua", } local function sh_quote(s) return "'" .. tostring(s):gsub("'", "'\\''") .. "'" end diff --git a/test/utf8_strings_spec.lua b/test/utf8_strings_spec.lua new file mode 100644 index 0000000..0044e7a --- /dev/null +++ b/test/utf8_strings_spec.lua @@ -0,0 +1,220 @@ +-- test/utf8_strings_spec.lua — PORT-AUTHORED coverage for issue #80: Shen +-- strings are sequences of Unicode code points, represented as UTF-8. +-- +-- * n->string encodes any code point 0..0x10FFFF except surrogates, and +-- errors otherwise (the old primitive was string.char: 0..255 only, and +-- 128..255 came back as a lone invalid byte); +-- * string->n / pos / tlstr / hdstr / explode / hash / string.length count +-- characters, not bytes; +-- * the reader decodes UTF-8 source (files, read-from-string, streams), so a +-- non-ASCII literal reads as its characters and prints back unchanged; +-- * pr writes strings as UTF-8; read-byte / write-byte / read-file-as-bytelist +-- stay raw byte primitives; +-- * invalid UTF-8 is lenient and lossless: each ill-formed byte is one +-- character whose code is the byte value (see prims.lua). +-- +-- Not the canonical kernel certification suite (run-kernel-tests.lua). +-- +-- luajit test/utf8_strings_spec.lua +local shen = require("shen") +shen.boot{ quiet = true } +local R = require("runtime") + +local npass, nfail = 0, 0 +local function check(cond, name) + if cond then npass = npass + 1 + else + nfail = nfail + 1 + io.write("FAIL: ", name, "\n") + end +end +local function evs(src) return R.to_str(shen.eval(src)) end +local function checkeq(src, want) + local ok, got = pcall(evs, src) + if not ok then + nfail = nfail + 1 + io.write("FAIL: ", src, " (raised: ", tostring(got), ")\n") + elseif got == want then + npass = npass + 1 + else + nfail = nfail + 1 + io.write("FAIL: ", src, "\n want: ", want, "\n got: ", got, "\n") + end +end +-- raw Lua value of an expression +local function ev(src) return shen.eval(src) end +local function trap(src) + return ev("(trap-error " .. src .. " (lambda E (error-to-string E)))") +end +local function bytes(s) + local t = {} + for i = 1, #s do t[#t + 1] = string.format("%02X", s:byte(i)) end + return table.concat(t, " ") +end + +-- --------------------------------------------------------------------------- +-- issue #80 reproduction cases +-- --------------------------------------------------------------------------- +check(bytes(ev("(n->string 8364)")) == "E2 82 AC", "(n->string 8364) is the UTF-8 for U+20AC") +check(bytes(ev("(n->string 252)")) == "C3 BC", "(n->string 252) is the UTF-8 for U+00FC") +checkeq('(string->n "ü")', "252") +checkeq('(pos "Zürich" 1)', '"ü"') +checkeq('(length (explode "Zürich"))', "6") +checkeq('(tlstr "üx")', '"x"') +checkeq('(explode "Zürich")', '("Z" "ü" "r" "i" "c" "h")') +checkeq('(string.length "Zürich")', "6") -- stdlib, via explode +checkeq('(hash "ü" 1000)', "252") -- code point, not 195*188 +checkeq('(= "ü" (n->string 252))', "true") +checkeq('(= (hash "Zürich" 1000) (hash (cn "Z" (cn (n->string 252) "rich")) 1000))', "true") + +-- --------------------------------------------------------------------------- +-- n->string range: every scalar value, nothing else +-- --------------------------------------------------------------------------- +checkeq("(n->string 0)", '"' .. "\0" .. '"') +checkeq("(n->string 127)", '"\127"') +check(bytes(ev("(n->string 128)")) == "C2 80", "(n->string 128) two bytes") +check(bytes(ev("(n->string 2047)")) == "DF BF", "(n->string 2047) two bytes") +check(bytes(ev("(n->string 2048)")) == "E0 A0 80", "(n->string 2048) three bytes") +check(bytes(ev("(n->string 55295)")) == "ED 9F BF", "(n->string #xD7FF)") +check(bytes(ev("(n->string 57344)")) == "EE 80 80", "(n->string #xE000)") +check(bytes(ev("(n->string 65535)")) == "EF BF BF", "(n->string #xFFFF)") +check(bytes(ev("(n->string 65536)")) == "F0 90 80 80", "(n->string #x10000)") +check(bytes(ev("(n->string 1114111)")) == "F4 8F BF BF", "(n->string #x10FFFF)") +for _, bad in ipairs({ "55296", "57343", "1114112", "-1", "65.5" }) do + local msg = trap("(n->string " .. bad .. ")") + check(type(msg) == "string" and msg:find("not a Unicode code point", 1, true), + "(n->string " .. bad .. ") raises: " .. tostring(msg)) +end +check(trap('(n->string "a")') == "n->string: not a number", "(n->string \"a\") raises") + +-- round trips through string->n +for _, n in ipairs({ 65, 127, 128, 233, 252, 255, 256, 2047, 2048, 8364, 65533, 65535, 65536, 128512, 1114111 }) do + checkeq(string.format("(string->n (n->string %d))", n), tostring(n)) + checkeq(string.format("(length (explode (n->string %d)))", n), "1") +end + +-- --------------------------------------------------------------------------- +-- character-indexed primitives +-- --------------------------------------------------------------------------- +checkeq('(pos "Zürich" 0)', '"Z"') +checkeq('(pos "Zürich" 2)', '"r"') +checkeq('(pos "Zürich" 5)', '"h"') +check(trap('(pos "Zürich" 6)') == "pos: index out of range", "(pos \"Zürich\" 6) out of range") +check(trap('(pos "ü" 1)') == "pos: index out of range", "(pos \"ü\" 1) out of range (2 bytes, 1 char)") +checkeq('(pos "a€b😀c" 3)', '"😀"') +checkeq('(pos "a€b😀c" 4)', '"c"') +checkeq('(hdstr "€uro")', '"€"') +checkeq('(tlstr "€uro")', '"uro"') +checkeq('(tlstr "😀")', '""') +checkeq('(string->n "€uro")', "8364") +checkeq('(string->n "😀")', "128512") +checkeq('(explode "a€b😀c")', '("a" "€" "b" "😀" "c")') +checkeq('(cn (hdstr "Grüße") (tlstr "Grüße"))', '"Grüße"') +checkeq('(shen.string->bytes "aü€")', "(97 252 8364)") +checkeq('(shen.str->bytes "aü€")', "(97 252 8364)") +checkeq('(@s "Gr" "ü" "ße")', '"Grüße"') +checkeq('(str "Grüße")', '"Grüße"') +-- @s pattern matching in a define walks characters (hdstr / tlstr) +shen.eval([[(define u-count "" -> 0 (@s _ S) -> (+ 1 (u-count S)))]]) +checkeq('(u-count "Zürich😀")', "7") +shen.eval([[(define u-first (@s C _) -> C)]]) +checkeq('(u-first "über")', '"ü"') + +-- ASCII is unchanged +checkeq('(string->n "A")', "65") +checkeq("(n->string 65)", '"A"') +checkeq('(pos "hello" 4)', '"o"') +checkeq('(tlstr "hello")', '"ello"') +checkeq('(explode "ab")', '("a" "b")') +checkeq('(hash "hello" 1000)', tostring((104*101*108*108*111) % 1000)) + +-- --------------------------------------------------------------------------- +-- = and hash agree on non-ASCII text, however it was built +-- --------------------------------------------------------------------------- +checkeq('(= "Zürich" (cn "Zü" "rich"))', "true") +checkeq('(= "Zürich" "Zurich")', "false") +checkeq('(= (hash "€" 997) (hash (n->string 8364) 997))', "true") +checkeq('(hash (intern "ü") 1000)', "252") +checkeq([[(do (put "Zürich" city yes) (get (cn "Zü" "rich") city))]], "yes") + +-- --------------------------------------------------------------------------- +-- reader: files, read-from-string and streams decode UTF-8 +-- --------------------------------------------------------------------------- +do + local p = os.tmpname() + local fh = assert(io.open(p, "wb")) + fh:write('(define u-greet {string --> string} N -> (@s "Grüß " N "!"))\n') + fh:write('(set u-lit "Zürich")\n') + fh:write('(set u-code (string->n "€"))\n') + fh:close() + shen.eval(string.format('(let H (value *hush*) (do (set *hush* true) (load "%s") (set *hush* H)))', p)) + checkeq('(u-greet "Zoë")', '"Grüß Zoë!"') + checkeq("(value u-lit)", '"Zürich"') + checkeq("(length (explode (value u-lit)))", "6") + checkeq("(value u-code)", "8364") + checkeq(string.format('(length (read-file "%s"))', p), "3") + -- read-file-as-bytelist stays raw bytes; read-file-as-string is the text + checkeq(string.format('(length (read-file-as-bytelist "%s"))', p), + tostring(#('(define u-greet {string --> string} N -> (@s "Grüß " N "!"))\n' + .. '(set u-lit "Zürich")\n(set u-code (string->n "€"))\n'))) + local first = '(define u-greet {string --> string} N -> (@s "Grüß " N "!"))\n' + local ci = first:find("ü", 1, true) - 1 -- ASCII before it: chars == bytes + checkeq(string.format('(string->n (pos (read-file-as-string "%s") %d))', p, ci), "252") + checkeq(string.format('(string->n (pos (read-file-as-string "%s") %d))', p, ci + 1), "223") -- ß + os.remove(p) +end +check(ev([[(hd (read-from-string (cn (n->string 34) (cn "ü€" (n->string 34)))))]]) == "ü€", + "read-from-string of a non-ASCII string literal") +check(ev([[(hd (read-from-string (cn (n->string 34) (cn "c#252;" (n->string 34)))))]]) == "ü", + "c#252; escape inside a string literal is U+00FC") +do + -- (read Stream) on a file stream goes through shen.my-read-byte + local p = os.tmpname() + local fh = assert(io.open(p, "wb")); fh:write('"Grüße" [€]\n'); fh:close() + check(ev(string.format('(let S (open "%s" in) R (read S) (do (close S) R))', p)) == "Grüße", + "(read S) decodes a UTF-8 string literal") + -- read-byte on the same kind of stream still returns raw bytes + checkeq(string.format('(let S (open "%s" in) A (read-byte S) B (read-byte S) C (read-byte S) D (read-byte S) (do (close S) [A B C D]))', p), + "(34 71 114 195)") + os.remove(p) +end + +-- --------------------------------------------------------------------------- +-- output: pr writes UTF-8; write-byte writes one raw byte +-- --------------------------------------------------------------------------- +do + local p = os.tmpname() + shen.eval(string.format('(let S (open "%s" out) (do (pr "Zürich €" S) (pr (n->string 128512) S) (write-byte 255 S) (close S)))', p)) + local fh = assert(io.open(p, "rb")); local data = fh:read("*a"); fh:close() + check(data == "Zürich €😀\255", "pr writes UTF-8, write-byte a raw byte: " .. bytes(data)) + os.remove(p) +end + +-- --------------------------------------------------------------------------- +-- invalid UTF-8: lenient, lossless, one character per ill-formed byte +-- --------------------------------------------------------------------------- +do + -- strings with invalid bytes, built in Lua and bound as globals + local G = require("boot").GLOBALS + G["u-lone"] = "a\252b" -- 0xFC: invalid lead byte + G["u-cont"] = "\188x" -- stray continuation byte + G["u-trunc"] = "\226\130" -- truncated 3-byte sequence (E2 82) + G["u-over"] = "\192\128" -- overlong NUL + G["u-surr"] = "\237\160\128" -- encoded surrogate U+D800 + checkeq("(length (explode (value u-lone)))", "3") + checkeq("(string->n (pos (value u-lone) 1))", "252") + check(ev("(pos (value u-lone) 1)") == "\252", "invalid byte comes back raw from pos") + check(ev("(tlstr (value u-cont))") == "x", "tlstr drops one stray continuation byte") + checkeq("(string->n (value u-cont))", "188") + checkeq("(length (explode (value u-trunc)))", "2") + checkeq("(shen.string->bytes (value u-trunc))", "(226 130)") + checkeq("(length (explode (value u-over)))", "2") + checkeq("(length (explode (value u-surr)))", "3") + check(ev("(cn (hdstr (value u-lone)) (tlstr (value u-lone)))") == "a\252b", + "hdstr/tlstr split of invalid text is lossless") + -- hash still agrees with = + checkeq("(= (hash (value u-lone) 1000) (hash (cn \"a\" (cn (pos (value u-lone) 1) \"b\")) 1000))", "true") +end + +print(string.format("utf8_strings_spec: %d pass, %d fail", npass, nfail)) +os.exit(nfail == 0 and 0 or 1) From db967c638c9fb279ee9425a34c373e117403a734 Mon Sep 17 00:00:00 2001 From: Claude Date: Sun, 11 Oct 2026 04:50:20 +0000 Subject: [PATCH 2/2] Keep string fast paths JIT-compilable; fuse string->n of pos string.find with a pattern is not compiled by LuaJIT 2.1 and aborts any trace that reaches it, which made an ASCII pos loop about 1000x slower. The ASCII checks are now plain string.byte loops, and pos remembers the first non-ASCII byte of the last string it scanned, so a loop indexing one string scans it once. compiler.lua lowers (string->n (pos S I)) and (string->n (hdstr S)) to a new STRNPOS helper that reads the character code in place instead of allocating a one-character string. The guard STRN needs for non-ASCII input otherwise keeps that string alive in a snapshot, which stops LuaJIT from sinking the allocation. Also updates the yggdrasil-build.lua comments: shen.write-string and shen.read-unit-string are prims.lua entries now. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01DHL2X2i5C1mWW2f5ypuSaw --- bin/yggdrasil-build.lua | 10 ++-- compiler.lua | 14 +++++- prims.lua | 99 +++++++++++++++++++++++++++----------- test/utf8_strings_spec.lua | 13 +++++ 4 files changed, 104 insertions(+), 32 deletions(-) diff --git a/bin/yggdrasil-build.lua b/bin/yggdrasil-build.lua index 2882867..e88b3cf 100644 --- a/bin/yggdrasil-build.lua +++ b/bin/yggdrasil-build.lua @@ -121,9 +121,11 @@ local P = require("prims") -- registers primitive arities into C.ARITY -- Contract check: every primitive the manifest expects must be provided by -- this port — a prims.lua F-table entry, a compiler special form, a global -- the generated lib boot sets, or a name that is guarded-dead here (the --- kernel only calls it behind a port predicate this port answers false to: --- shen.char-stoutput?/shen.char-stinput? are hardwired false in prims.lua, --- so the shen.write-string / shen.read-unit-string branches never run). +-- kernel only calls it behind a port predicate this port answers false to). +-- shen.write-string and shen.read-unit-string are prims.lua entries now +-- (shen.char-stoutput? is true so pr writes UTF-8 strings whole, issue #80; +-- shen.char-stinput? stays false); they remain listed below so a manifest +-- from an older stage 1 that names them never warns. local SPECIAL = { ["if"]=true, ["cond"]=true, ["let"]=true, ["do"]=true, ["trap-error"]=true, ["and"]=true, ["or"]=true, ["lambda"]=true, ["freeze"]=true, ["defun"]=true, @@ -162,7 +164,7 @@ end -- 42 kernel (klambda/*.kl) is BACKFILLED into the kernel chunk — with a -- loud warning, because each backfill is a stage-1 shaker bug that should be -- fixed in yggdrasil.shen. Names found nowhere are warn-only (they may be --- guarded-dead, like shen.write-string behind shen.char-stoutput?). +-- guarded-dead, like shen.read-unit-string behind shen.char-stinput?). -- Limitation (same one stage 1 has): only head-position references are -- traced; a function passed by bare name in argument position is invisible. local function walk_calls(form, bound, called) diff --git a/compiler.lua b/compiler.lua index ff48196..fbdd06f 100644 --- a/compiler.lua +++ b/compiler.lua @@ -974,7 +974,19 @@ local function ccall(form, env) if name == "@s" and ar == 2 then return "CN(" .. argstr .. ")" end if name == "pos" and ar == 2 then return "POS(" .. argstr .. ")" end if name == "tlstr" and ar == 1 then return "TLSTR(" .. argstr .. ")" end - if name == "string->n" and ar == 1 then return "STRN(" .. argstr .. ")" end + if name == "string->n" and ar == 1 then + -- (string->n (pos S I)) / (string->n (hdstr S)): read the code in + -- place (STRNPOS) instead of building a one-character string just + -- to take its code. The argument's own lowering is exactly + -- "POS()" (see pos/hdstr below) unless it was hoisted. + local a = args[1] + if is_cons(a) and is_symbol(car(a)) and not env[car(a).name] + and (car(a).name == "pos" or car(a).name == "hdstr") then + local inner = cargs[1]:match("^POS%((.*)%)$") + if inner then return "STRNPOS(" .. inner .. ")" end + end + return "STRN(" .. argstr .. ")" + end if name == "n->string" and ar == 1 then return "NSTR(" .. argstr .. ")" end if name == "hdstr" and ar == 1 then return "POS(" .. argstr .. ", 0)" end if name == "shen.hds=?" and ar == 2 then return "HDS_EQ(" .. argstr .. ")" end diff --git a/prims.lua b/prims.lua index 079548d..c40b1ca 100644 --- a/prims.lua +++ b/prims.lua @@ -296,8 +296,11 @@ end) -- primitives (pos, tlstr, string->n, n->string, hdstr, explode, hash, the -- reader) count CODE POINTS, not bytes. Pure-ASCII text stays on the old byte -- fast path: every helper below first checks for a byte >= 0x80 and only then --- walks the string as UTF-8, so ASCII text costs a byte check or a C-level --- scan for a high byte. +-- walks the string as UTF-8. The checks are plain string.byte loops on +-- purpose: string.find with a pattern is not JIT-compiled by LuaJIT 2.1 and +-- aborts every trace that reaches it, which made an ASCII pos loop ~1000x +-- slower in testing. pos remembers the last string it scanned (first_high), +-- so a loop indexing one string scans it once. -- -- INVALID UTF-8 is never an error and never loses data. Decoding is lenient: -- any byte that does not begin a well-formed sequence -- a stray continuation @@ -315,9 +318,22 @@ end) -- U+D800..U+DFFF and errors on anything else. Everything here is plain Lua -- 5.1 string/arith code (no `utf8` library), so it runs identically on -- LuaJIT 2.1 and PUC Lua 5.1..5.4. -local sbyte, ssub, schar, sfind = string.byte, string.sub, string.char, string.find +local sbyte, ssub, schar = string.byte, string.sub, string.char local mfloor = math.floor -local HIGHPAT = "[\128-\255]" + +-- first_high(s): byte index of the first byte >= 0x80 in s, or false if s is +-- pure ASCII. One-entry memo: strings are interned, so the hit test is a +-- pointer compare, and a loop calling pos on the same string scans it once. +local FH_S, FH_H = nil, false +local function first_high(s) + if s == FH_S then return FH_H end + local h = false + for i = 1, #s do + if sbyte(s, i) >= 0x80 then h = i; break end + end + FH_S, FH_H = s, h + return h +end -- u8dec(s, i) -> code point, byte length of the character at byte index i -- (i <= #s). Lenient: an ill-formed sequence decodes as its first byte alone. @@ -368,7 +384,7 @@ end -- u8len(s): number of characters (code points / lone invalid bytes). local function u8len(s) - local h = sfind(s, HIGHPAT) + local h = first_high(s) if not h then return #s end local n, i, len = h - 1, h, #s while i <= len do @@ -383,7 +399,7 @@ end local function u8pos(s, n) local len = #s if n >= len then return nil end -- chars <= bytes - local h = sfind(s, HIGHPAT) + local h = first_high(s) if not h or h > n + 1 then return ssub(s, n + 1, n + 1) end local i, k = h, h - 1 -- k = index of char at byte i while i <= len do @@ -413,11 +429,17 @@ end -- u8explode(s): KL list of the characters of s. local function u8explode(s) local acc = NIL - if not sfind(s, HIGHPAT) then - for i = #s, 1, -1 do acc = cons(ssub(s, i, i), acc) end - return acc - end - local chars, i, len = {}, 1, #s + local i = #s + while i >= 1 do -- ASCII fast path, back to front + local b = sbyte(s, i) + if b >= 0x80 then break end + acc = cons(schar(b), acc) + i = i - 1 + end + if i == 0 then return acc end + acc = NIL + local chars, len = {}, #s + i = 1 while i <= len do local _, l = u8dec(s, i) chars[#chars + 1] = ssub(s, i, i + l - 1) @@ -430,11 +452,17 @@ end -- u8codes(s): KL list of the character codes of s (string->n of each char). local function u8codes(s) local acc = NIL - if not sfind(s, HIGHPAT) then - for i = #s, 1, -1 do acc = cons(sbyte(s, i), acc) end - return acc - end - local cps, i, len = {}, 1, #s + local i = #s + while i >= 1 do -- ASCII fast path, back to front + local b = sbyte(s, i) + if b >= 0x80 then break end + acc = cons(b, acc) + i = i - 1 + end + if i == 0 then return acc end + acc = NIL + local cps, len = {}, #s + i = 1 while i <= len do local cp, l = u8dec(s, i) cps[#cps + 1] = cp @@ -444,7 +472,7 @@ local function u8codes(s) return acc end -P.utf8 = { HIGHPAT = HIGHPAT, dec = u8dec, enc = u8enc, len = u8len, +P.utf8 = { first_high = first_high, dec = u8dec, enc = u8enc, len = u8len, pos = u8pos, tl = u8tl, hd = u8hd, explode = u8explode, codes = u8codes } local function nstr_error(n) @@ -1160,8 +1188,18 @@ function P.install_native_stdlib() local orig_hash = F["hash"] local function hashkey_bytes(s) local acc = 1 - if sfind(s, HIGHPAT) then - local i, len = 1, #s + local len = #s + for i = 1, len do + local b = sbyte(s, i) + if b >= 0x80 then acc = nil; break end + if b ~= 0 then + if acc > 10000000000 then acc = acc + b else acc = acc * b end + end + end + if acc then return acc end + do -- non-ASCII: fold code points + acc = 1 + local i = 1 while i <= len do local b, l = u8dec(s, i) if b ~= 0 then @@ -1171,13 +1209,6 @@ function P.install_native_stdlib() end return acc end - for i = 1, #s do - local b = sbyte(s, i) - if b ~= 0 then - if acc > 10000000000 then acc = acc + b else acc = acc * b end - end - end - return acc end local function hash(v, bound) local s @@ -2267,7 +2298,7 @@ local ENV = { if n == 0 then if sbyte(s, 1) < 0xC2 then return ssub(s, 1, 1) end else - local h = sfind(s, HIGHPAT) -- first non-ASCII byte, if any + local h = first_high(s) -- first non-ASCII byte, if any if not h or h > n + 1 then return ssub(s, n + 1, n + 1) end end end @@ -2287,6 +2318,20 @@ local ENV = { end return F["string->n"](s) end, + -- (string->n (pos S N)) fused by compiler.lua: the code of the N-th + -- character without allocating the one-character string. + STRNPOS = function(s, n) + if type(s) == "string" and type(n) == "number" and n >= 0 and n < #s then + local c = sbyte(s, n + 1) + if n == 0 then + if c < 0xC2 then return c end + elseif c < 0x80 then + local h = first_high(s) + if not h or h > n + 1 then return c end + end + end + return F["string->n"](F["pos"](s, n)) + end, NSTR = function(n) if type(n) == "number" and n >= 0 and n < 128 and n == mfloor(n) then return schar(n) diff --git a/test/utf8_strings_spec.lua b/test/utf8_strings_spec.lua index 0044e7a..1e4c1ac 100644 --- a/test/utf8_strings_spec.lua +++ b/test/utf8_strings_spec.lua @@ -107,6 +107,19 @@ checkeq('(hdstr "€uro")', '"€"') checkeq('(tlstr "€uro")', '"uro"') checkeq('(tlstr "😀")', '""') checkeq('(string->n "€uro")', "8364") +-- compiler.lua fuses (string->n (pos S I)) / (string->n (hdstr S)) to STRNPOS +checkeq('(string->n (pos "Zürich" 1))', "252") +checkeq('(string->n (pos "Zürich" 2))', "114") +checkeq('(string->n (pos "Zürich" 0))', "90") +checkeq('(string->n (hdstr "€x"))', "8364") +checkeq('(string->n (hdstr "x€"))', "120") +checkeq('(string->n (pos "abc" 2))', "99") +check(trap('(string->n (pos "ü" 1))') == "pos: index out of range", "fused (string->n (pos ...)) keeps pos errors") +shen.eval([[(define u-codes "" -> [] S -> [(string->n (hdstr S)) | (u-codes (tlstr S))])]]) +checkeq('(u-codes "aü€😀")', "(97 252 8364 128512)") +shen.eval([[(define u-codes-at S I N -> [] where (= I N) S I N -> [(string->n (pos S I)) | (u-codes-at S (+ I 1) N)])]]) +checkeq('(u-codes-at "aü€😀b" 0 5)', "(97 252 8364 128512 98)") +checkeq('(u-codes-at "plain" 0 5)', "(112 108 97 105 110)") checkeq('(string->n "😀")', "128512") checkeq('(explode "a€b😀c")', '("a" "€" "b" "😀" "c")') checkeq('(cn (hdstr "Grüße") (tlstr "Grüße"))', '"Grüße"')