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
(define errloc-key 'regexp-match:)
(define (group-error str reason)
(raise-argument-error
errloc-key
(format "Invalid regexp pattern (unmatched ~a)" reason)
(define (group-error stx str reason)
(raise-user-error errloc-key
"(~a:~a) Invalid regexp pattern (unmatched ~a) in ~a"
(syntax-line stx)
(syntax-column stx)
reason
str))
;; Dispatch for counting groups

16
trivial/untyped/regexp.rkt
View File

@ -42,10 +42,12 @@
(begin-for-syntax
(define errloc-key 'regexp-match:)
(define (group-error str reason)
(raise-argument-error
errloc-key
(format "Invalid regexp pattern (unmatched ~a)" reason)
(define (group-error stx str reason)
(raise-user-error errloc-key
"(~a:~a) Invalid regexp pattern (unmatched ~a) in ~a"
(syntax-line stx)
(syntax-column stx)
reason
str))
;; Dispatch for counting groups
@ -86,9 +88,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?)
@ -110,7 +112,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*)]