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

[regexp] now using syntax classes

Browse Source
This commit is contained in:
ben 2016-03-04 10:13:30 -05:00
parent 5db0b3a5ed
commit 9f88e4c773
1 changed files with 27 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
regexp.rkt
View File

@ -39,6 +39,18 @@
(define-for-syntax errloc-key 'regexp-match:) (define-for-syntax errloc-key 'regexp-match:)
(define-for-syntax id+num-groups (make-free-id-table)) (define-for-syntax id+num-groups (make-free-id-table))
(begin-for-syntax (define-syntax-class pattern/groups
#:attributes (expanded num-groups type)
(pattern e
#:with e+ (expand-expr #'e)
#:with (g . t) (count-groups #'e+)
#:when (syntax-e #'g)
#:attr expanded #'e+
#:attr num-groups #'g
#:attr type #'t)))
;; -----------------------------------------------------------------------------
;; (define-matcher f) ;; (define-matcher f)
;; Expand to two forms: ;; Expand to two forms:
;; - (f: arg) ;; - (f: arg)
@ -57,38 +69,31 @@
(syntax-parser (syntax-parser
[g:id [g:id
(syntax/loc #'g f)] (syntax/loc #'g f)]
[(_ pat-stx) [(_ pat:pattern/groups)
#:with pat-stx+ (expand-expr #'pat-stx) (syntax-property #'(f pat.expanded)
#:with (num-groups . T) (count-groups #'pat-stx+)
(syntax-property #'(f pat-stx+)
num-groups-key num-groups-key
(cons (syntax-e #'num-groups) #'T))] (cons (syntax-e #'pat.num-groups) #'pat.type))]
[(_ arg* (... ...)) [(_ arg* (... ...))
#'(f arg* (... ...))])) #'(f arg* (... ...))]))
;; For lets, (let-regexp: ([id val]) ...) ;; For lets, (let-regexp: ([id val]) ...)
(define-syntax let-f: (define-syntax let-f:
(syntax-parser (syntax-parser
[(_ ([name*:id pat-stx*] (... ...)) e* (... ...)) [(_ ([name*:id pat*:pattern/groups] (... ...)) e* (... ...))
#:with (pat-stx+* (... ...)) (stx-map expand-expr #'(pat-stx* (... ...))) #'(let ([name* pat*.expanded] (... ...))
#:with ((num-groups* . T*) (... ...)) (stx-map count-groups #'(pat-stx+* (... ...)))
#'(let ([name* pat-stx+*] (... ...))
(let-syntax ([name* (make-rename-transformer (let-syntax ([name* (make-rename-transformer
(syntax-property #'name* (syntax-property #'name* num-groups-key
num-groups-key (cons 'pat*.num-groups #'pat*.type)))] (... ...))
(cons 'num-groups* #'T*)))] (... ...))
e* (... ...)))] e* (... ...)))]
[(_ arg* (... ...)) [(_ arg* (... ...))
#'(let arg* (... ...))])) #'(let arg* (... ...))]))
;; For definitions, (define-regexp: id val) ;; For definitions, (define-regexp: id val)
(define-syntax define-f: (define-syntax define-f:
(syntax-parser (syntax-parser
[(_ name:id pat-stx) [(_ name:id pat:pattern/groups)
#:with pat-stx+ (expand-expr #'pat-stx)
#:with (num-groups . T) (count-groups #'pat-stx+)
(free-id-table-set! id+num-groups (free-id-table-set! id+num-groups
#'name #'name
(cons (syntax-e #'num-groups) #'T)) (cons (syntax-e #'pat.num-groups) #'pat.type))
#'(define name pat-stx+)] #'(define name pat.expanded)]
[(_ arg* (... ...)) [(_ arg* (... ...))
#'(define arg* (... ...))]))) ])) #'(define arg* (... ...))]))) ]))
@ -99,17 +104,14 @@
(define-syntax regexp-match: (define-syntax regexp-match:
(syntax-parser (syntax-parser
[(f pat-stx arg* ...) [(f pat:pattern/groups arg* ...)
#:with pat-stx+ (expand-expr #'pat-stx) #:with (index* ...) (for/list ([i (in-range (syntax-e #'pat.num-groups))]) i)
#:with (num-groups . T) (count-groups #'pat-stx+) #'(let ([maybe-match (regexp-match pat.expanded arg* ...)])
#:when (syntax-e #'num-groups)
#:with (index* ...) #`#,(for/list ([i (in-range (syntax-e #'num-groups))]) i)
#'(let ([maybe-match (regexp-match pat-stx+ arg* ...)])
(if maybe-match (if maybe-match
(let ([m : (Listof (Option T)) maybe-match]) (let ([m : (Listof (Option pat.type)) maybe-match])
(list (car maybe-match) (list (car maybe-match)
(begin (set! m (cdr m)) (begin (set! m (cdr m))
(or (car m) (error 'regexp-match: (format "Internal error at result index ~a, try using Racket's regexp-match" index*)))) (or (car m) (error 'regexp-match: (format "Internal error at result index ~a, try using Racket's regexp-match" 'index*))))
...)) ...))
#f))] #f))]
[f:id [f:id