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

.

Browse Source 
original commit: d5ba39c5bada3984ad12527a4852bb9b39a488d9
This commit is contained in:
Matthew Flatt 2002-12-29 22:50:13 +00:00
parent df207766c5
commit 88b3e4f18a
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mzlib/string.ss
View File

@ -11,7 +11,8 @@
regexp-match*
regexp-match-positions*
regexp-split
regexp-match-exact?)
regexp-match-exact?
regexp-match/fail-without-reading)
(require (lib "etc.ss"))
@ -128,6 +129,25 @@
(raise-type-error 'regexp-replace-quote "string" s))
(regexp-replace* "\\\\" s "\\\\\\\\"))
(define regexp-match/fail-without-reading
(opt-lambda (pattern input-port [start-k 0] [end-k #f] [output-port #f])
(unless (input-port? input-port)
(raise-type-error 'regexp-match/fail-without-reading "input port" input-port))
(let ([m (apply regexp-match-peek-positions
pattern input-port start-k end-k
(if output-port
(list output-port)
null))])
(and m
;; What happens if someone swipes our chars before we can get them?
(begin
;; drop prefix before match:
(read-string (caar m) input-port)
(let ([s (read-string (- (cdar m) (caar m)) input-port)])
(cons s
(map (lambda (p)
(substring s (- (car p) (caar m)) (- (cdr p) (caar m))))
(cdr m)))))))))
;; Helper function for the regexp functions below.
(define (regexp-fn name success failure)