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

[regexp] handle [ ... ]

Browse Source
This commit is contained in:
ben 2016-03-14 11:43:46 -04:00
parent f38240e42c
commit aa200c3747
1 changed files with 46 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
private/regexp.rkt
View File

@ -53,12 +53,26 @@
;; Raise an exception if there are unmatched parens.
(define (parse-groups/untyped str #:src stx)
(define last-index (- (string-length str) 1))
(define ignore? (box #f))
(let loop ([i 0] [in-paren '()] [num-groups 0])
(if (> i last-index)
(if (null? in-paren)
num-groups
(group-error str (format "'(' at index ~a" (car in-paren))))
(cond
[(not (null? in-paren))
(group-error str (format "'(' at index ~a" (car in-paren)))]
[(unbox ignore?)
(group-error str (format "'[' at index ~a" (car in-paren)))]
[else
num-groups])
(if (unbox ignore?)
(if (eq? #\] (string-ref str i))
(begin (set-box! ignore? #f)
(loop (+ i 1) (cdr in-paren) num-groups))
(loop (+ i 1) in-paren num-groups))
(case (string-ref str i)
[(#\[)
;; Ignore things between [ ... ]
(set-box! ignore? #t)
(loop (+ i 1) (cons i in-paren) num-groups)]
[(#\()
;; Watch for (? patterns
(if (and (< i last-index)
@ -87,7 +101,7 @@
;; Nope! Can't handle pipes
#f]
[else
(loop (+ i 1) in-paren num-groups)]))))
(loop (+ i 1) in-paren num-groups)])))))
(define (parse-groups/string str #:src stx)
(let ([ng (parse-groups/untyped str #:src stx)])