Build one UTF-8 byte/char offset table per subject
ober
178422c848a2ca5fbb33695296dd5aba27085397
--- a/src/jerboa-pcre2/pcre2.ss +++ b/src/jerboa-pcre2/pcre2.ss @@ -216,6 +216,37 @@ (loop (+ bi (utf8-byte-length (bytevector-u8-ref bv bi))) (+ ci 1))))) + ;; A per-subject offset table makes byte<->char conversion O(1) instead of + ;; O(len). byte-offset->char-index / char-index->byte-offset above walk the + ;; whole bytevector each call, which is O(n^2) when a match has many capture + ;; groups or when fold/split/partition match repeatedly over one long + ;; multi-byte subject. Build the table once per subject and index into it. + ;; Returns #(byte->char char->byte); both vectors map an offset to the + ;; corresponding char index / byte offset (clamped at the ends). + (def (make-utf8-offset-table bv) + (let* ([n (bytevector-length bv)] + [b2c (make-vector (+ n 1) 0)]) + (let loop ([bi 0] [ci 0] [c2b-rev '()]) + (if (>= bi n) + (begin + (vector-set! b2c n ci) + (vector b2c (list->vector (reverse (cons bi c2b-rev))))) + (let ([len (utf8-byte-length (bytevector-u8-ref bv bi))]) + (vector-set! b2c bi ci) + (let fill ([k (+ bi 1)] [end (+ bi len)]) + (when (and (<= k end) (< k n)) + (vector-set! b2c k (+ ci 1)) + (fill (+ k 1) end))) + (loop (+ bi len) (+ ci 1) (cons bi c2b-rev))))))) + + (def (byte-offset->char-index/table table byte-off) + (let ([b2c (vector-ref table 0)]) + (vector-ref b2c (min byte-off (- (vector-length b2c) 1))))) + + (def (char-index->byte-offset/table table char-idx) + (let ([c2b (vector-ref table 1)]) + (vector-ref c2b (min char-idx (- (vector-length c2b) 1))))) + ;; ----------------------------------------------------------------------- ;; Name table parsing ;; ----------------------------------------------------------------------- @@ -372,50 +403,61 @@ ;; Internal matching helper ;; ----------------------------------------------------------------------- + ;; subject-bytes / subject-table may be #f to compute them from subject; the + ;; iteration helpers (fold/split/partition) precompute and reuse them across + ;; the many matches they run over one subject so the byte<->char offset table + ;; is built once per subject rather than walked per capture group per match. + (def (pcre2-do-match/core rx subject start options subject-bytes subject-table) + (let* ([subject (ensure-string 'pcre2-do-match 'subject subject)] + [start (ensure-start-index 'pcre2-do-match subject start)] + [options (ensure-u32 'pcre2-do-match 'options options)] + [bv (if subject-bytes subject-bytes (string->utf8 subject))] + [table (if subject-table subject-table (make-utf8-offset-table bv))] + [byte-start (if (zero? start) 0 (char-index->byte-offset/table table start))] + [byte-len (bytevector-length bv)]) + (with-live-regex 'pcre2-do-match rx + (lambda (code) + (let ([md (ensure-match-data 'pcre2-do-match + (ffi-pcre2-match-data-create-from-pattern code))]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([rc (if (pcre-regex-jit? rx) + (ffi-pcre2-jit-match code bv byte-len + byte-start options md) + (ffi-pcre2-match code bv byte-len + byte-start options md))]) + (cond + [(= rc PCRE2_ERROR_NOMATCH) #f] + [(pcre2-limit-rc? rc) + (raise-match-limit-error 'pcre2-do-match rc)] + [(< rc 0) + (error 'pcre2-do-match + (ffi-pcre2-get-error-message rc) rc)] + [else + (let* ([ncap (+ (pcre-regex-capture-count rx) 1)] + [sv (make-vector ncap #f)]) + (let loop ([i 0]) + (when (< i ncap) + (unless (ffi-pcre2-ovector-is-unset? md i) + (let ([bstart (ffi-pcre2-ovector-start md i)] + [bend (ffi-pcre2-ovector-end md i)]) + (vector-set! sv i + (cons (byte-offset->char-index/table table bstart) + (byte-offset->char-index/table table bend))))) + (loop (+ i 1)))) + (make-pcre-match sv subject + (pcre-regex-name-table rx)))]))) + (lambda () (ffi-pcre2-match-data-free md)))))))) + (def pcre2-do-match (case-lambda [(rx subject start options) - (pcre2-do-match rx subject start options #f)] + (pcre2-do-match/core rx subject start options #f #f)] [(rx subject start options subject-bytes) - (let* ([subject (ensure-string 'pcre2-do-match 'subject subject)] - [start (ensure-start-index 'pcre2-do-match subject start)] - [options (ensure-u32 'pcre2-do-match 'options options)] - [bv (if subject-bytes subject-bytes (string->utf8 subject))] - [byte-start (if (zero? start) 0 (char-index->byte-offset bv start))]) - (with-live-regex 'pcre2-do-match rx - (lambda (code) - (let ([md (ensure-match-data 'pcre2-do-match - (ffi-pcre2-match-data-create-from-pattern code))]) - (dynamic-wind - (lambda () (void)) - (lambda () - (let ([rc (if (pcre-regex-jit? rx) - (ffi-pcre2-jit-match code bv (bytevector-length bv) - byte-start options md) - (ffi-pcre2-match code bv (bytevector-length bv) - byte-start options md))]) - (cond - [(= rc PCRE2_ERROR_NOMATCH) #f] - [(pcre2-limit-rc? rc) - (raise-match-limit-error 'pcre2-do-match rc)] - [(< rc 0) - (error 'pcre2-do-match - (ffi-pcre2-get-error-message rc) rc)] - [else - (let* ([ncap (+ (pcre-regex-capture-count rx) 1)] - [sv (make-vector ncap #f)]) - (let loop ([i 0]) - (when (< i ncap) - (unless (ffi-pcre2-ovector-is-unset? md i) - (let ([bstart (ffi-pcre2-ovector-start md i)] - [bend (ffi-pcre2-ovector-end md i)]) - (vector-set! sv i - (cons (byte-offset->char-index bv bstart) - (byte-offset->char-index bv bend))))) - (loop (+ i 1)))) - (make-pcre-match sv subject - (pcre-regex-name-table rx)))]))) - (lambda () (ffi-pcre2-match-data-free md)))))))])) + (pcre2-do-match/core rx subject start options subject-bytes #f)] + [(rx subject start options subject-bytes subject-table) + (pcre2-do-match/core rx subject start options subject-bytes subject-table)])) ;; ----------------------------------------------------------------------- ;; Matching API @@ -567,9 +609,10 @@ [start (ensure-start-index 'pcre2-fold subject start)] [rx (ensure-regex rx/str)] [slen (string-length subject)] - [bv (string->utf8 subject)]) + [bv (string->utf8 subject)] + [table (make-utf8-offset-table bv)]) (let loop ([pos start] [acc knil]) - (let ([m (pcre2-do-match rx subject pos 0 bv)]) + (let ([m (pcre2-do-match rx subject pos 0 bv table)]) (if (not m) acc (let* ([span (vector-ref (pcre-match-span-vec m) 0)] @@ -602,13 +645,14 @@ (let* ((subject (ensure-string 'pcre2-split 'subject subject)) (rx (ensure-regex rx/str)) (slen (string-length subject)) - (bv (string->utf8 subject))) + (bv (string->utf8 subject)) + (table (make-utf8-offset-table bv))) (when (and limit (not (and (integer? limit) (> limit 0)))) (error 'pcre2-split "limit must be a positive integer or #f" limit)) (let loop ((pos 0) (seg-start 0) (acc '()) (count 1)) (if (and limit (>= count limit)) (reverse (cons (substring subject seg-start slen) acc)) - (let ((m (pcre2-do-match rx subject pos 0 bv))) + (let ((m (pcre2-do-match rx subject pos 0 bv table))) (if (not m) (reverse (cons (substring subject seg-start slen) acc)) (let* ((span (vector-ref (pcre-match-span-vec m) 0)) @@ -630,9 +674,10 @@ (let* ((subject (ensure-string 'pcre2-partition 'subject subject)) (rx (ensure-regex rx/str)) (slen (string-length subject)) - (bv (string->utf8 subject))) + (bv (string->utf8 subject)) + (table (make-utf8-offset-table bv))) (let loop ((pos 0) (acc '())) - (let ((m (pcre2-do-match rx subject pos 0 bv))) + (let ((m (pcre2-do-match rx subject pos 0 bv table))) (if (not m) (reverse (cons (substring subject pos slen) acc)) (let* ((span (vector-ref (pcre-match-span-vec m) 0)) @@ -679,43 +724,43 @@ (case-lambda [(pattern subject) (pcre2-pregexp-match pattern subject 0 #f)] [(pattern subject start) (pcre2-pregexp-match pattern subject start #f)] - [(pattern subject start end) - (ensure-string 'pcre2-pregexp-match 'subject subject) - (ensure-start-index 'pcre2-pregexp-match subject start) - (when (and end (not (and (integer? end) (>= end start) (<= end (string-length subject))))) - (error 'pcre2-pregexp-match "invalid end index" end)) - (let* ([subj (if end - (substring subject start end) - (substring subject start (string-length subject)))] - [m (pcre2-search pattern subj 0)]) - (and m (pcre-match->list m)))])) + [(pattern subject start end) + (ensure-string 'pcre2-pregexp-match 'subject subject) + (ensure-start-index 'pcre2-pregexp-match subject start) + (when (and end (not (and (integer? end) (>= end start) (<= end (string-length subject))))) + (error 'pcre2-pregexp-match "invalid end index" end)) + (let* ([subj (if end + (substring subject start end) + (substring subject start (string-length subject)))] + [m (pcre2-search pattern subj 0)]) + (and m (pcre-match->list m)))])) (def pcre2-pregexp-match-positions (case-lambda [(pattern subject) (pcre2-pregexp-match-positions pattern subject 0 #f)] [(pattern subject start) (pcre2-pregexp-match-positions pattern subject start #f)] - [(pattern subject start end) - (ensure-string 'pcre2-pregexp-match-positions 'subject subject) - (ensure-start-index 'pcre2-pregexp-match-positions subject start) - (when (and end (not (and (integer? end) (>= end start) (<= end (string-length subject))))) - (error 'pcre2-pregexp-match-positions "invalid end index" end)) - (let* ([subj (if end - (substring subject start end) - (substring subject start (string-length subject)))] - [m (pcre2-search pattern subj 0)]) - (and m - (let* ([sv (pcre-match-span-vec m)] - [n (vector-length sv)]) - (let loop ([i 0] [acc '()]) - (if (= i n) - (reverse acc) - (let ([pair (vector-ref sv i)]) - (loop (+ i 1) - (cons (if pair - (cons (+ start (car pair)) - (+ start (cdr pair))) - #f) - acc))))))))])) + [(pattern subject start end) + (ensure-string 'pcre2-pregexp-match-positions 'subject subject) + (ensure-start-index 'pcre2-pregexp-match-positions subject start) + (when (and end (not (and (integer? end) (>= end start) (<= end (string-length subject))))) + (error 'pcre2-pregexp-match-positions "invalid end index" end)) + (let* ([subj (if end + (substring subject start end) + (substring subject start (string-length subject)))] + [m (pcre2-search pattern subj 0)]) + (and m + (let* ([sv (pcre-match-span-vec m)] + [n (vector-length sv)]) + (let loop ([i 0] [acc '()]) + (if (= i n) + (reverse acc) + (let ([pair (vector-ref sv i)]) + (loop (+ i 1) + (cons (if pair + (cons (+ start (car pair)) + (+ start (cdr pair))) + #f) + acc))))))))])) (def (pcre2-pregexp-replace pattern subject replacement) (pcre2-replace pattern subject replacement))