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

[regexp] linear-time group unpacking, hooray for mutability

Browse Source
This commit is contained in:
ben 2015-12-08 03:23:29 -05:00
parent 2b1ab27825
commit c5ea8c032c
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
regexp.rkt
View File

@ -45,15 +45,15 @@
(syntax-parser (syntax-parser
[(f pat-stx arg* ...) [(f pat-stx arg* ...)
#:with num-groups (count-groups #'pat-stx #:src #'f) #:with num-groups (count-groups #'pat-stx #:src #'f)
#:with ((index* . group-id*) ...) #:with (index* ...) #`#,(for/list ([i (in-range (syntax-e #'num-groups))]) i)
#`#,(for/list ([i (in-range (syntax-e #'num-groups))]) #'(let ([maybe-match (regexp-match pat-stx arg* ...)])
(cons i (format-id #'f "group-~a" i))) (if maybe-match
;; Chaining list-ref? (let ([m : (Listof (Option String)) maybe-match])
#'(let ([m (regexp-match pat-stx arg* ...)]) (list (car maybe-match)
(if m (begin (set! m (cdr m))
(let ([group-id* (or (list-ref m index*) (error 'regexp-match! "Internal error, try Racket's `regexp-match`"))] ...) (or (car m) (error 'regexp-match! (format "Internal error at result index ~a, try Racket's regexp-match" index*))))
(list (car m) group-id* ...)) ...))
m))] #f))]
[(f arg* ...) [(f arg* ...)
(syntax/loc #'f (regexp-match arg* ...))])) (syntax/loc #'f (regexp-match arg* ...))]))