WASM: fix UTF-8 string-length to count codepoints, not bytes
ober
05be1177f6db0993b597581b9b947e8d0545de69
--- a/lib/jerboa/wasm/scheme-runtime.sls +++ b/lib/jerboa/wasm/scheme-runtime.sls @@ -201,9 +201,22 @@ (define runtime-string-forms '( - ;; string-length: returns tagged fixnum (byte length for now) - ;; TODO: proper UTF-8 codepoint counting + ;; string-length: returns tagged fixnum of UTF-8 codepoint count. + ;; Counts non-continuation bytes: a byte is a continuation byte + ;; if (byte & 0xC0) == 0x80. Everything else starts a codepoint. (define (scheme-string-length s) + (let ([len (string-length-bytes s)] + [count 0] + [i 0]) + (while (< i len) + (when (!= (bitwise-and (string-byte-ref s i) 192) 128) + (set! count (+ count 1))) + (set! i (+ i 1))) + (tag-fixnum count))) + + ;; string-length-bytes-tagged: returns tagged fixnum of byte length + ;; (kept for code that needs raw byte counts, e.g. bytevector interop) + (define (scheme-string-byte-length s) (tag-fixnum (string-length-bytes s))) ;; string-ref: returns tagged fixnum (byte value) --- a/tests/test-slang-wasm.ss +++ b/tests/test-slang-wasm.ss @@ -391,6 +391,50 @@ (check (> (bytevector-length wasm) 20) => #t)) ;; ================================================================ +;; UTF-8 String Length +;; ================================================================ + +(section "UTF-8 String Length") + +;; runtime-string-forms should contain scheme-string-length +(check-pred pair? runtime-string-forms) + +;; Verify the scheme-string-length function uses codepoint counting +;; (not byte counting) by checking it references bitwise-and +(let ([src (with-output-to-string (lambda () (write runtime-string-forms)))]) + (check-pred string? src) + ;; Should contain bitwise-and (UTF-8 continuation byte check) + (check (string? (let loop ([i 0]) + (cond + [(> i (- (string-length src) 11)) #f] + [(string=? (substring src i (+ i 11)) "bitwise-and") src] + [else (loop (+ i 1))]))) + => #t)) + +;; Verify scheme-string-byte-length is also defined (as a runtime form) +(let ([names (map (lambda (f) + (and (pair? f) (eq? (car f) 'define) (pair? (cadr f)) + (caadr f))) + runtime-string-forms)]) + (check-pred pair? (memq 'scheme-string-byte-length names))) + +;; Full runtime with UTF-8 string-length compiles to valid WASM +(let ([wasm (compile-program + (append + value-memory-forms + value-global-forms + value-tag-forms + value-predicate-forms + value-accessor-forms + gc-all-forms + value-constructor-forms + runtime-all-forms + '((define (test-strlen) + (scheme-string-length (tag-fixnum 0))))))]) + (check-pred bytevector? wasm) + (check (> (bytevector-length wasm) 100) => #t)) + +;; ================================================================ ;; Summary ;; ================================================================