Skip substring copy in pregexp-match for unanchored patterns
ober
1e94abb986a84b07adfc2736feb340c9d0ba8017
--- a/src/jerboa-pcre2/pcre2.ss +++ b/src/jerboa-pcre2/pcre2.ss @@ -46,6 +46,9 @@ pcre2-pregexp-replace pcre2-pregexp-replace* pcre2-pregexp-quote + ;; Pregexp offset-fast-path diagnostics + pcre2-pregexp-offset-path-hits pcre2-pregexp-offset-path-hits-reset! + ;; Re-export constants for convenience PCRE2_CASELESS PCRE2_MULTILINE PCRE2_DOTALL PCRE2_EXTENDED PCRE2_UTF PCRE2_UCP PCRE2_ANCHORED PCRE2_ENDANCHORED @@ -407,14 +410,20 @@ ;; 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) + ;; end is an optional exclusive char bound (#f for the whole subject). It is + ;; passed to PCRE2 as the subject length so the match cannot run past it and + ;; end anchors ($/\z/\Z) see it as the subject end — exactly mirroring a + ;; substring copy without allocating one. + (def (pcre2-do-match/core rx subject start end 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)]) + [byte-len (if end + (char-index->byte-offset/table table end) + (bytevector-length bv))]) (with-live-regex 'pcre2-do-match rx (lambda (code) (let ([md (ensure-match-data 'pcre2-do-match @@ -453,11 +462,16 @@ (def pcre2-do-match (case-lambda [(rx subject start options) - (pcre2-do-match/core rx subject start options #f #f)] + (pcre2-do-match/core rx subject start #f options #f #f)] [(rx subject start options subject-bytes) - (pcre2-do-match/core rx subject start options subject-bytes #f)] + (pcre2-do-match/core rx subject start #f options subject-bytes #f)] [(rx subject start options subject-bytes subject-table) - (pcre2-do-match/core rx subject start options subject-bytes subject-table)])) + (pcre2-do-match/core rx subject start #f options subject-bytes subject-table)])) + + ;; Match over SUBJECT restricted to the char range [start, end); used by the + ;; pregexp offset fast path so it can bound the match without copying. + (def (pcre2-do-match/end rx subject start end options) + (pcre2-do-match/core rx subject start end options #f #f)) ;; ----------------------------------------------------------------------- ;; Matching API @@ -720,47 +734,95 @@ ;; Pregexp-compatible API ;; ----------------------------------------------------------------------- + ;; Conservative source scan: #t when PATTERN holds a start-sensitive anchor + ;; (^, \A, \b, \B, \G) outside a character class. PCRE2 does NOT treat a + ;; non-zero startoffset as a subject/line start, so such patterns can match + ;; differently when searched at an offset; they keep the substring-copy path + ;; to preserve anchor semantics. Over-detection is safe (it only forgoes the + ;; copy-free fast path); under-detection would break correctness, so any of + ;; these anchors anywhere outside a class forces the copy. + (def (pcre2-start-anchored-pattern? pattern) + (let ([n (string-length pattern)]) + (let loop ([i 0] [in-class? #f]) + (if (>= i n) + #f + (let ([c (string-ref pattern i)]) + (cond + [(char=? c #\\) + (if (>= (+ i 1) n) + #f + (let ([nx (string-ref pattern (+ i 1))]) + (if in-class? + (loop (+ i 2) #t) + (if (or (char=? nx #\A) (char=? nx #\b) + (char=? nx #\B) (char=? nx #\G)) + #t + (loop (+ i 2) #f)))))] + [in-class? (loop (+ i 1) (not (char=? c #\])))] + [(char=? c #\[) (loop (+ i 1) #t)] + [(char=? c #\^) #t] + [else (loop (+ i 1) #f)])))))) + + ;; Diagnostic counter: how many pregexp searches took the copy-free offset + ;; fast path. Lets tests confirm the optimization is actually exercised. The + ;; increment is negligible next to the match cost and the substring copy it + ;; replaces; benign under concurrency (a lost count never affects correctness). + (def *offset-path-hits* (box 0)) + (def (pcre2-pregexp-offset-path-hits) (unbox *offset-path-hits*)) + (def (pcre2-pregexp-offset-path-hits-reset!) (set-box! *offset-path-hits* 0)) + + ;; Search PATTERN in SUBJECT over [start, end). Returns (values match absolute?) + ;; where match is #f on no match and absolute? reports whether the match offsets + ;; are relative to the full subject (offset fast path, #t) or to a copied + ;; substring (anchored path, #f). Unanchored patterns skip the substring copy. + (def (pcre2-search/bounded pattern subject start end) + (let* ([rx (ensure-regex pattern)] + [e (or end (string-length subject))]) + (if (pcre2-start-anchored-pattern? (pcre-regex-pattern rx)) + (values (pcre2-do-match rx (substring subject start e) 0 0) #f) + (begin + (set-box! *offset-path-hits* (+ (unbox *offset-path-hits*) 1)) + (values (pcre2-do-match/end rx subject start e 0) #t))))) + (def pcre2-pregexp-match (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-values ([(m absolute?) (pcre2-search/bounded pattern subject start end)]) + (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-values ([(m absolute?) (pcre2-search/bounded pattern subject start end)]) + (and m + (let* ([sv (pcre-match-span-vec m)] + [n (vector-length sv)] + ;; Offset-path offsets are already relative to the full + ;; subject; substring-path offsets are relative to the + ;; copied substring and must be shifted by start. + [base (if absolute? 0 start)]) + (let loop ([i 0] [acc '()]) + (if (= i n) + (reverse acc) + (let ([pair (vector-ref sv i)]) + (loop (+ i 1) + (cons (if pair + (cons (+ base (car pair)) + (+ base (cdr pair))) + #f) + acc))))))))])) (def (pcre2-pregexp-replace pattern subject replacement) (pcre2-replace pattern subject replacement)) --- a/tests/pcre2-test.ss +++ b/tests/pcre2-test.ss @@ -394,6 +394,59 @@ (check (string? (pcre2-pregexp-quote "a.b[c]")) ? values))) ;; ----------------------------------------------------------------- +(test-group "pregexp offset optimization (anchor-aware)" + ;; Unanchored patterns take the copy-free offset fast path; start-anchored + ;; patterns keep the substring copy so ^/\A/\b/\B semantics are preserved + ;; (PCRE2 does not treat a non-zero startoffset as a subject/line start). + + (test-case "anchored ^ at non-zero start still matches (copy preserved)" + (check (car (pcre2-pregexp-match "^def" "abc def" 4)) => "def")) + + (test-case "anchored \\A at non-zero start still matches (copy preserved)" + (check (car (pcre2-pregexp-match "\\Adef" "abc def" 4)) => "def")) + + (test-case "anchored \\b at non-zero start still matches (copy preserved)" + (check (car (pcre2-pregexp-match "\\bdef" "abcdef" 3)) => "def")) + + (test-case "anchored \\B at non-zero start preserves no-match semantics" + (check (pcre2-pregexp-match "\\Bdef" "abcdef" 3) => #f)) + + (test-case "unanchored pattern at non-zero start matches via offset path" + (check (car (pcre2-pregexp-match "def" "abc def" 4)) => "def") + (check (car (pcre2-pregexp-match "\\d+" "abc 42" 4)) => "42")) + + (test-case "offset path is used for unanchored, not for anchored" + (pcre2-pregexp-offset-path-hits-reset!) + (pcre2-pregexp-match "^def" "abc def" 4) + (pcre2-pregexp-match "\\Adef" "abc def" 4) + (pcre2-pregexp-match "\\bdef" "abcdef" 3) + (check (pcre2-pregexp-offset-path-hits) => 0) + (pcre2-pregexp-match "def" "abc def" 4) + (check (pcre2-pregexp-offset-path-hits) => 1) + (pcre2-pregexp-match "\\d+" "abc 42" 4) + (check (pcre2-pregexp-offset-path-hits) => 2)) + + (test-case "caret inside a character class is not a start anchor" + (pcre2-pregexp-offset-path-hits-reset!) + (check (car (pcre2-pregexp-match "[^x]+" "ab cd" 2)) => " cd") + (check (pcre2-pregexp-offset-path-hits) => 1)) + + (test-case "positions are absolute for both anchored and offset paths" + (check (car (pcre2-pregexp-match-positions "^def" "abc def" 4)) => '(4 . 7)) + (check (car (pcre2-pregexp-match-positions "def" "abc def" 4)) => '(4 . 7)) + (check (car (pcre2-pregexp-match-positions "(\\d+)" "abc 42 def" 4)) => '(4 . 6))) + + (test-case "offset path honors the end bound" + (check (car (pcre2-pregexp-match "def" "abc def ghi" 4 7)) => "def") + (check (pcre2-pregexp-match "defg" "abc def ghi" 4 7) => #f)) + + (test-case "offset path preserves end-anchor semantics with a bound" + (check (car (pcre2-pregexp-match "def$" "abc def" 4)) => "def")) + + (test-case "offset path works on UTF-8 subjects" + (check (car (pcre2-pregexp-match "\\d+" "caf\x00e9; 42" 4)) => "42"))) + +;; ----------------------------------------------------------------- (test-group "UTF-8 support" (test-case "compile pattern with non-ASCII" (define rx (pcre2-compile "(?=\x00e9;)"))