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

use tail-calls for regexp iterations

Browse Source 
svn: r8549
This commit is contained in:
Eli Barzilay 2008-02-06 02:49:19 +00:00
parent 8bac4b1d28
commit 2ae21adbff
1 changed files with 36 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
collects/scheme/private/string.ss
View File

@ -98,7 +98,7 @@
(raise-type-error name "input port" string)) (raise-type-error name "input port" string))
(unless (or len (input-port? string)) (unless (or len (input-port? string))
(raise-type-error name "string, byte string or input port" string))) (raise-type-error name "string, byte string or input port" string)))
(lambda (start end) (lambda (acc start end)
(unless (and (number? start) (exact? start) (integer? start) (unless (and (number? start) (exact? start) (integer? start)
(start . >= . 0)) (start . >= . 0))
(raise-type-error name "non-negative exact integer" start)) (raise-type-error name "non-negative exact integer" start))
@ -155,13 +155,14 @@
(get-output-bytes leftover-port)))]) (get-output-bytes leftover-port)))])
(if match (if match
(port-success-k (port-success-k
acc
(car match) (car match)
(and end (- end (if need-leftover? (and end (- end (if need-leftover?
(+ (bstring-length leftovers) start) (+ (bstring-length leftovers) start)
discarded) discarded)
(bstring-length (car match)))) (bstring-length (car match))))
leftovers) leftovers)
(port-failure-k leftovers)))) (port-failure-k acc leftovers))))
;; String/port match, get positions ;; String/port match, get positions
(let ([match ((if peek? (let ([match ((if peek?
regexp-match-peek-positions regexp-match-peek-positions
@ -173,8 +174,8 @@
(if (= match-start match-end) (if (= match-start match-end)
(error name (error name
"pattern matched a zero-length substring: ~e" rx) "pattern matched a zero-length substring: ~e" rx)
(success-k start end match-start match-end))) (success-k acc start end match-start match-end)))
(failure-k start end))))))])) (failure-k acc start end))))))]))
;; 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]) (define (regexp-match-positions* pattern string [start 0] [end #f])
@ -183,23 +184,25 @@
(make-regexp-loop (make-regexp-loop
'regexp-match-positions* rx string 'regexp-match-positions* rx string
;; success-k: ;; success-k:
(lambda (start end match-start match-end) (lambda (acc start end match-start match-end)
(cons (cons match-start match-end) (let ([acc (cons (cons match-start match-end) acc)])
(if (or (string? string) (bytes? string)) (if (or (string? string) (bytes? string))
(loop match-end end) (loop acc match-end end)
;; Need to shift index of rest as reading: ;; Need to shift index of rest as reading, cannot do a
(map (lambda (p) ;; tail call without adding another state variable to the loop:
(cons (+ match-end (car p)) (+ match-end (cdr p)))) (append (map (lambda (p)
(loop 0 (and end (- end match-end))))))) (cons (+ match-end (car p)) (+ match-end (cdr p))))
(loop '() 0 (and end (- end match-end))))
acc))))
;; port-success-k: use string case ;; port-success-k: use string case
#f #f
;; failure-k: ;; failure-k:
(lambda (start end) null) (lambda (acc start end) acc)
;; port-fail-k: use string case ;; port-fail-k: use string case
#f #f
#f #f
#f)) #f))
(loop start end)) (reverse (loop '() start end)))
;; 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])
@ -208,18 +211,17 @@
(make-regexp-loop (make-regexp-loop
'regexp-match-peek-positions* rx string 'regexp-match-peek-positions* rx string
;; success-k: ;; success-k:
(lambda (start end match-start match-end) (lambda (acc start end match-start match-end)
(cons (cons match-start match-end) (loop (cons (cons match-start match-end) acc) match-end end))
(loop match-end end)))
;; port-success-k: use string case ;; port-success-k: use string case
#f #f
;; failure-k: ;; failure-k:
(lambda (start end) null) (lambda (acc start end) acc)
;; port-fail-k: use string case ;; port-fail-k: use string case
#f #f
#f #f
#t)) #t))
(loop start end)) (reverse (loop '() start end)))
;; 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.
@ -233,20 +235,19 @@
(make-regexp-loop (make-regexp-loop
'regexp-split rx buf 'regexp-split rx buf
;; success-k: ;; success-k:
(lambda (start end match-start match-end) (lambda (acc start end match-start match-end)
(cons (sub buf start match-start) (loop (cons (sub buf start match-start) acc) match-end end))
(loop match-end end)))
;; port-success-k: ;; port-success-k:
(lambda (match-string new-end leftovers) (lambda (acc match-string new-end leftovers)
(cons leftovers (loop 0 new-end))) (loop (cons leftovers acc) 0 new-end))
;; failure-k: ;; failure-k:
(lambda (start end) (lambda (acc start end)
(list (sub buf start (or end (bstring-length buf))))) (cons (sub buf start (or end (bstring-length buf))) acc))
;; port-fail-k ;; port-fail-k
(lambda (leftover) (list leftover)) (lambda (acc leftover) (cons leftover acc))
#t #t
#f)) #f))
(loop start end)) (reverse (loop '() start end)))
;; 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]) (define (regexp-match* pattern string [start 0] [end #f])
@ -259,19 +260,18 @@
(make-regexp-loop (make-regexp-loop
'regexp-match* rx buf 'regexp-match* rx buf
;; success-k: ;; success-k:
(lambda (start end match-start match-end) (lambda (acc start end match-start match-end)
(cons (sub buf match-start match-end) (loop (cons (sub buf match-start match-end) acc) match-end end))
(loop match-end end)))
;; port-success-k: ;; port-success-k:
(lambda (match-string new-end leftovers) (lambda (acc match-string new-end leftovers)
(cons match-string (loop 0 new-end))) (loop (cons match-string acc) 0 new-end))
;; failure-k: ;; failure-k:
(lambda (start end) null) (lambda (acc start end) acc)
;; port-fail-k: ;; port-fail-k:
(lambda (leftover) null) (lambda (acc leftover) acc)
#f #f
#f)) #f))
(loop start end)) (reverse (loop '() start end)))
(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)])