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

[regexp] add src lines to group error message

Browse Source
This commit is contained in:
Ben Greenman 2016-06-09 01:34:09 -04:00
parent c7b99a2396
commit 7cd78a842b
2 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
trivial/private/regexp.rkt
View File

@ -42,10 +42,12 @@
(begin-for-syntax (begin-for-syntax
(define errloc-key 'regexp-match:) (define errloc-key 'regexp-match:)
(define (group-error str reason) (define (group-error stx str reason)
(raise-argument-error (raise-user-error errloc-key
errloc-key "(~a:~a) Invalid regexp pattern (unmatched ~a) in ~a"
(format "Invalid regexp pattern (unmatched ~a)" reason) (syntax-line stx)
(syntax-column stx)
reason
str)) str))
;; Dispatch for counting groups ;; Dispatch for counting groups

16
trivial/untyped/regexp.rkt
View File

@ -42,10 +42,12 @@
(begin-for-syntax (begin-for-syntax
(define errloc-key 'regexp-match:) (define errloc-key 'regexp-match:)
(define (group-error str reason) (define (group-error stx str reason)
(raise-argument-error (raise-user-error errloc-key
errloc-key "(~a:~a) Invalid regexp pattern (unmatched ~a) in ~a"
(format "Invalid regexp pattern (unmatched ~a)" reason) (syntax-line stx)
(syntax-column stx)
reason
str)) str))
;; Dispatch for counting groups ;; Dispatch for counting groups
@ -86,9 +88,9 @@
(if (> i last-index) (if (> i last-index)
(cond (cond
[(not (null? in-paren)) [(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?) [(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 [else
(list num-groups null-idx*)]) (list num-groups null-idx*)])
(if (unbox in-square?) (if (unbox in-square?)
@ -110,7 +112,7 @@
[(#\)) [(#\))
(cond (cond
[(null? in-paren) [(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)) [(eq? #f (car in-paren))
;; Matched closing paren, but does not count as a group ;; Matched closing paren, but does not count as a group
(loop (+ i 1) (cdr in-paren) num-groups null-idx*)] (loop (+ i 1) (cdr in-paren) num-groups null-idx*)]