From: Chris Hanson Date: Wed, 29 Mar 2017 04:57:20 +0000 (-0700) Subject: Optimize string-in-nfX? since it's important that these be fast. X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~64 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=39242320196e944c2a108e2f63be4579dd5546d3;p=mit-scheme.git Optimize string-in-nfX? since it's important that these be fast. --- diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm index af79646ce..8c236b8df 100644 --- a/src/runtime/ustring.scm +++ b/src/runtime/ustring.scm @@ -584,23 +584,38 @@ USA. string (canonical-composition (string->nfd string)))) -(define-integrable (string-nqc-maker cp-limit char-nqc?) - (lambda (string) - (let ((end (string-length string))) - (let loop ((i 0) (last-ccc 0)) - (if (fix:< i end) - (let ((char (string-ref string i))) - (if (fix:< (char->integer char) cp-limit) - (loop (fix:+ i 1) 0) - (let ((ccc (ucd-ccc-value char))) - (and (or (fix:= ccc 0) (fix:>= ccc last-ccc)) - (char-nqc? char) - (loop (fix:+ i 1) ccc))))) - #t))))) - -(define string-in-nfd? (string-nqc-maker #xC0 char-nfd-quick-check?)) -(define string-in-nfc? (string-nqc-maker #x300 char-nfc-quick-check?)) +(define-integrable (string-nqc-loop cp-limit char-nqc? sref) + (lambda (string start end) + (let loop ((i start) (last-ccc 0)) + (if (fix:< i end) + (let ((char (sref string i))) + (if (fix:< (char->integer char) cp-limit) + (loop (fix:+ i 1) 0) + (let ((ccc (ucd-ccc-value char))) + (and (or (fix:= ccc 0) (fix:>= ccc last-ccc)) + (char-nqc? char) + (loop (fix:+ i 1) ccc))))) + #t)))) +(define string-in-nfd? + (let ((legacy (string-nqc-loop #xC0 char-nfd-quick-check? legacy-string-ref)) + (full (string-nqc-loop #xC0 char-nfd-quick-check? %full-string-ref))) + (lambda (string) + (receive (string start end) + (translate-slice string 0 (string-length string)) + (if (legacy-string? string) + (legacy string start end) + (full string start end)))))) + +(define string-in-nfc? + (let ((full (string-nqc-loop #x300 char-nfc-quick-check? %full-string-ref))) + (lambda (string) + (receive (string start end) + (translate-slice string 0 (string-length string)) + (if (legacy-string? string) + #t + (full string start end)))))) + (define (canonical-decomposition string) (let ((end (string-length string)) (builder (string-builder '->nfc? #f)))