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

78
private/regexp.rkt
View File

@ -53,41 +53,55 @@
;; 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)))]
(case (string-ref str i) [(unbox ignore?)
[(#\() (group-error str (format "'[' at index ~a" (car in-paren)))]
;; Watch for (? patterns
(if (and (< i last-index)
(eq? #\? (string-ref str (+ i 1))))
(loop (+ i 2) (cons #f in-paren) num-groups)
(loop (+ i 1) (cons i in-paren) num-groups))]
[(#\))
(cond
[(and (< i last-index)
(eq? #\* (string-ref str (+ i 1))))
;; Group is starred, can't predict num. matches statically
#f]
[(null? in-paren)
(group-error str (format "')' at index ~a" i))]
[(eq? #f (car in-paren))
;; Matched closing paren, but does not count as a group
(loop (+ i 1) (cdr in-paren) num-groups)]
[else
(loop (+ i 1) (cdr in-paren) (+ 1 num-groups))])]
[(#\\)
(if (and (< i last-index)
(eq? #\\ (string-ref str (+ i 1))))
(loop (+ i 3) in-paren num-groups)
(loop (+ i 2) in-paren num-groups))]
[(#\|)
;; Nope! Can't handle pipes
#f]
[else [else
(loop (+ i 1) in-paren num-groups)])))) 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)
(eq? #\? (string-ref str (+ i 1))))
(loop (+ i 2) (cons #f in-paren) num-groups)
(loop (+ i 1) (cons i in-paren) num-groups))]
[(#\))
(cond
[(and (< i last-index)
(eq? #\* (string-ref str (+ i 1))))
;; Group is starred, can't predict num. matches statically
#f]
[(null? in-paren)
(group-error str (format "')' at index ~a" i))]
[(eq? #f (car in-paren))
;; Matched closing paren, but does not count as a group
(loop (+ i 1) (cdr in-paren) num-groups)]
[else
(loop (+ i 1) (cdr in-paren) (+ 1 num-groups))])]
[(#\\)
(if (and (< i last-index)
(eq? #\\ (string-ref str (+ i 1))))
(loop (+ i 3) in-paren num-groups)
(loop (+ i 2) in-paren num-groups))]
[(#\|)
;; Nope! Can't handle pipes
#f]
[else
(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)])