suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Drop mstart' and mend' arguments to `success-choose' -- it's getting

Browse Source 
the complete list of submatches anyway, so it can just `caar' and `cdar'
it.
This commit is contained in:
Eli Barzilay 2011-06-04 16:57:16 -04:00
parent 5754312120
commit 768a5fd61d
1 changed files with 38 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
collects/racket/private/string.rkt
View File

@ -119,8 +119,7 @@
(make-bytes n (char->integer #\.)) #")") (make-bytes n (char->integer #\.)) #")")
(format "(?:~a)(?<=~a)" rx (make-bytes n (char->integer #\.))))))) (format "(?:~a)(?<=~a)" rx (make-bytes n (char->integer #\.)))))))
(define-syntax-rule (regexp-loop (define-syntax-rule (regexp-loop
name loop start end pattern string name loop start end pattern string ipre
ipre
success-choose failure-k success-choose failure-k
port-success-k port-success-choose port-failure-k port-success-k port-success-choose port-failure-k
need-leftover? peek?) need-leftover? peek?)
@ -235,14 +234,14 @@
(lambda (acc new-start new-end) (lambda (acc new-start new-end)
(loop acc new-start new-end ipre 0-ok?)) (loop acc new-start new-end ipre 0-ok?))
acc start end mstart mend) acc start end mstart mend)
(loop (success-choose start mstart mend m acc) (loop (success-choose start m acc)
mend end ipre 0-ok?))))))))))) mend end ipre 0-ok?)))))))))))
;; Returns all the positions at which the pattern matched. ;; Returns all the positions at which the pattern matched.
(define (regexp-match-positions* pattern string [start 0] [end #f] [ipre #""]) (define (regexp-match-positions* pattern string [start 0] [end #f] [ipre #""])
(regexp-loop regexp-match-positions* loop start end pattern string ipre (regexp-loop regexp-match-positions* loop start end pattern string ipre
;; success-choose: ;; success-choose:
(lambda (start mstart mend ms acc) (cons (cons mstart mend) acc)) (lambda (start ms acc) (cons (car ms) acc))
;; failure-k: ;; failure-k:
(lambda (acc start end) acc) (lambda (acc start end) acc)
;; port-success-k: need to shift index of rest as reading; cannot ;; port-success-k: need to shift index of rest as reading; cannot
@ -255,10 +254,9 @@
(loop '() 0 (and end (- end mend)))) (loop '() 0 (and end (- end mend))))
(cons (cons mstart mend) acc)))) (cons (cons mstart mend) acc))))
;; other port functions: use string case ;; other port functions: use string case
#f #f #f
#f ;; flags
#f #f #f))
#f))
;; Returns all the positions at which the pattern matched. ;; Returns all the positions at which the pattern matched.
(define (regexp-match-peek-positions* pattern string [start 0] [end #f] (define (regexp-match-peek-positions* pattern string [start 0] [end #f]
@ -266,32 +264,34 @@
(regexp-loop regexp-match-peek-positions* loop start end (regexp-loop regexp-match-peek-positions* loop start end
pattern string ipre pattern string ipre
;; success-choose: ;; success-choose:
(lambda (start mstart mend ms acc) (cons (cons mstart mend) acc)) (lambda (start ms acc) (cons (car ms) acc))
;; failure-k: ;; failure-k:
(lambda (acc start end) acc) (lambda (acc start end) acc)
;; port functions: use string case ;; port functions: use string case
#f #f #f #f
#f ;; flags
#f #f #t))
#f
#t)) ;; Small helper for the functions below
(define (get-buf+sub string pattern)
(let ([buf
(if (and (string? string)
(or (byte-regexp? pattern) (bytes? pattern)))
(string->bytes/utf-8 string (char->integer #\?))
string)])
(values
buf
(if (or (bytes? buf) (and (path? string)
(or (bytes? pattern) (byte-regexp? pattern))))
subbytes substring))))
;; Splits a string into a list by removing any piece which matches ;; Splits a string into a list by removing any piece which matches
;; the pattern. ;; the pattern.
(define (regexp-split pattern string [start 0] [end #f] [ipre #""]) (define (regexp-split pattern string [start 0] [end #f] [ipre #""])
(define buf (define-values [buf sub] (get-buf+sub string pattern))
(if (and (string? string) (or (byte-regexp? pattern) (bytes? pattern)))
(string->bytes/utf-8 string (char->integer #\?))
string))
(define sub
(if (or (bytes? buf)
(and (path? string)
(or (bytes? pattern) (byte-regexp? pattern))))
subbytes
substring))
(regexp-loop regexp-split loop start end pattern buf ipre (regexp-loop regexp-split loop start end pattern buf ipre
;; success-choose: ;; success-choose:
(lambda (start mstart mend ms acc) (cons (sub buf start mstart) acc)) (lambda (start ms acc) (cons (sub buf start (caar ms)) acc))
;; failure-k: ;; failure-k:
(lambda (acc start end) (lambda (acc start end)
(cons (if end (sub buf start end) (sub buf start)) acc)) (cons (if end (sub buf start end) (sub buf start)) acc))
@ -301,19 +301,14 @@
(lambda (match-string leftovers ms acc) (cons leftovers acc)) (lambda (match-string leftovers ms acc) (cons leftovers acc))
;; port-failure-k: ;; port-failure-k:
(lambda (acc leftover) (if leftover (cons leftover acc) acc)) (lambda (acc leftover) (if leftover (cons leftover acc) acc))
#t ;; flags
#f)) #t #f))
;; Like splitting, but insert a replacement between matches ;; Like splitting, but insert a replacement between matches
(define -regexp-replace* (define -regexp-replace*
(let ([regexp-replace* (let ([regexp-replace*
(lambda (pattern string orig-replacement [ipre #""]) (lambda (pattern string orig-replacement [ipre #""])
(define buf (define-values [buf sub] (get-buf+sub string pattern))
(if (and (string? string)
(or (byte-regexp? pattern) (bytes? pattern)))
(string->bytes/utf-8 string (char->integer #\?))
string))
(define sub (if (bytes? buf) subbytes substring))
(define start 0) (define start 0)
(define end #f) (define end #f)
(define needs-string? (define needs-string?
@ -402,43 +397,30 @@
(if (bytes? buf) bytes-append string-append) (if (bytes? buf) bytes-append string-append)
(regexp-loop regexp-replace* loop start end pattern buf ipre (regexp-loop regexp-replace* loop start end pattern buf ipre
;; success-choose: ;; success-choose:
(lambda (start mstart mend ms acc) (lambda (start ms acc)
(list* (if (procedure? replacement) (list* (if (procedure? replacement)
(check (check
replacement replacement
(for/list ([m ms]) (for/list ([m ms])
(and m (sub buf (car m) (cdr m))))) (and m (sub buf (car m) (cdr m)))))
(replac ms replacement)) (replac ms replacement))
(sub buf start mstart) (sub buf start (caar ms))
acc)) acc))
;; failure-k: ;; failure-k:
(lambda (acc start end) (lambda (acc start end)
(cons (if end (sub buf start end) (sub buf start)) acc)) (cons (if end (sub buf start end) (sub buf start)) acc))
;; port-success-k: ;; port functions: use string case
#f #f #f #f
;; port-success-choose: ;; flags
#f #t #f)))])
;; port-failure-k:
#f
#t
#f)))])
regexp-replace*)) regexp-replace*))
;; Returns all the matches for the pattern in the string. ;; Returns all the matches for the pattern in the string.
(define (regexp-match* pattern string [start 0] [end #f] [ipre #""]) (define (regexp-match* pattern string [start 0] [end #f] [ipre #""])
(define buf (define-values [buf sub] (get-buf+sub string pattern))
(if (and (string? string) (or (byte-regexp? pattern) (bytes? pattern)))
(string->bytes/utf-8 string (char->integer #\?))
string))
(define sub
(if (or (bytes? buf)
(and (path? string)
(or (bytes? pattern) (byte-regexp? pattern))))
subbytes
substring))
(regexp-loop regexp-match* loop start end pattern buf ipre (regexp-loop regexp-match* loop start end pattern buf ipre
;; success-choose: ;; success-choose:
(lambda (start mstart mend ms acc) (cons (sub buf mstart mend) acc)) (lambda (start ms acc) (cons (sub buf (caar ms) (cdar ms)) acc))
;; failure-k: ;; failure-k:
(lambda (acc start end) acc) (lambda (acc start end) acc)
;; port-success-k: ;; port-success-k:
@ -447,8 +429,8 @@
(lambda (match-string leftovers ms acc) (cons match-string acc)) (lambda (match-string leftovers ms acc) (cons match-string acc))
;; port-failure-k: ;; port-failure-k:
(lambda (acc leftover) acc) (lambda (acc leftover) acc)
#f ;; flags
#f)) #f #f))
(define (regexp-match-exact? p s) (define (regexp-match-exact? p s)
(let ([m (regexp-match-positions p s)]) (let ([m (regexp-match-positions p s)])