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

[regexp] only check balanced parans in presence of pipes

Browse Source
This commit is contained in:
Ben Greenman 2016-06-09 02:24:59 -04:00
parent e2d6d365f6
commit 4ef1c7a10b
3 changed files with 32 additions and 31 deletions
test
regexp-pass.rkt
trivial
private
regexp.rkt
untyped
regexp.rkt

26
test/regexp-pass.rkt
View File

@ -8,6 +8,11 @@
trivial/regexp
typed/rackunit)
;; -- regexp
(let ()
;; TODO (what groups does this return? re-read regexp spec)
(check-true (and (regexp: "^(\r|\n|(\r\n))") #t)))
;; -- regexp-match:
(check-equal?
(ann
@ -308,17 +313,18 @@
'("alot"))
;; -- pipes = take min groups
(check-equal?
(ann
(regexp-match: "^(a*)|(b*)$" "aaa")
(U #f (List String (U #f String) (U #f String))))
'("aaa" "aaa" #f))
;; 2016-06-08: currently disabled
;(check-equal?
; (ann
; (regexp-match: "^(a*)|(b*)$" "aaa")
; (U #f (List String (U #f String) (U #f String))))
; '("aaa" "aaa" #f))
(check-equal?
(ann
(regexp-match: "^(aa*)(c*)|(b*)$" "b")
(U #f (List String (U #f String) (U #f String) (U #f String))))
'("b" #f #f "b"))
;(check-equal?
; (ann
; (regexp-match: "^(aa*)(c*)|(b*)$" "b")
; (U #f (List String (U #f String) (U #f String) (U #f String))))
; '("b" #f #f "b"))
;; -- nested gropus
(check-equal?

26
trivial/private/regexp.rkt
View File

@ -72,12 +72,14 @@
[(null? (cdr alt*))
(parse-groups-for-alt (car alt*) #:src stx)]
[else
(define num-groups
(for/fold ([num-groups 0])
([alt (in-list alt*)])
(define ng+null* (parse-groups-for-alt alt #:src stx))
(+ num-groups (car ng+null*))))
(list num-groups (range num-groups))]))
;(define num-groups
; (for/fold ([num-groups 0])
; ([alt (in-list alt*)])
; (define ng+null* (parse-groups-for-alt alt #:src stx))
; (+ num-groups (car ng+null*))))
(parse-groups-for-alt str #:src stx)
#f
#;(list num-groups (range num-groups))]))
;; Count the number of matched parentheses in a regexp pattern.
;; Raise an exception if there are unmatched parens.
@ -88,9 +90,9 @@
(if (> i last-index)
(cond
[(not (null? in-paren))
(group-error str (format "'(' at index ~a" (car in-paren)))]
(group-error stx str (format "'(' at index ~a" (car in-paren)))]
[(unbox in-square?)
(group-error str (format "'[' at index ~a" (car in-paren)))]
(group-error stx str (format "'[' at index ~a" (car in-paren)))]
[else
(list num-groups null-idx*)])
(if (unbox in-square?)
@ -112,7 +114,7 @@
[(#\))
(cond
[(null? in-paren)
(group-error str (format "')' at index ~a" i))]
(group-error stx 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 null-idx*)]
@ -129,9 +131,9 @@
(eq? #\\ (string-ref str (+ i 1))))
(loop (+ i 3) in-paren num-groups null-idx*)
(loop (+ i 2) in-paren num-groups null-idx*))]
[(#\|)
;; Nope! Can't handle pipes
(error 'internal-error "Found '|' character in regexp string.")]
;[(#\|)
; ;; Nope! Can't handle pipes
; (error 'internal-error "Found '|' character in regexp string.")]
[else
(loop (+ i 1) in-paren num-groups null-idx*)])))))

11
trivial/untyped/regexp.rkt
View File

@ -72,12 +72,8 @@
[(null? (cdr alt*))
(parse-groups-for-alt (car alt*) #:src stx)]
[else
(define num-groups
(for/fold ([num-groups 0])
([alt (in-list alt*)])
(define ng+null* (parse-groups-for-alt alt #:src stx))
(+ num-groups (car ng+null*))))
(list num-groups (range num-groups))]))
(parse-groups-for-alt str #:src stx)
#f]))
;; Count the number of matched parentheses in a regexp pattern.
;; Raise an exception if there are unmatched parens.
@ -129,9 +125,6 @@
(eq? #\\ (string-ref str (+ i 1))))
(loop (+ i 3) in-paren num-groups null-idx*)
(loop (+ i 2) in-paren num-groups null-idx*))]
[(#\|)
;; Nope! Can't handle pipes
(error 'internal-error "Found '|' character in regexp string.")]
[else
(loop (+ i 1) in-paren num-groups null-idx*)])))))