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