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

[let-regexp] working now

Browse Source
This commit is contained in:
ben 2016-02-23 13:29:37 -05:00
parent 1f114d8fc5
commit d768e59ca2
2 changed files with 42 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
regexp.rkt
View File

@ -29,6 +29,7 @@
(only-in racket/syntax format-id)
syntax/id-table
syntax/parse
syntax/stx
trivial/private/common
))
@ -67,13 +68,15 @@
;; For lets, (let-regexp: ([id val]) ...)
(define-syntax let-f:
(syntax-parser
[(_ ([name:id pat-stx]) e* (... ...))
#:with pat-stx+ (expand-expr #'pat-stx)
#:with (num-groups . T) (count-groups #'pat-stx+)
(free-id-table-set! id+num-groups
#'name
(cons (syntax-e #'num-groups) #'T))
#'(let ([name pat-stx+]) e* (... ...))]
[(_ ([name*:id pat-stx*] (... ...)) e* (... ...))
#:with (pat-stx+* (... ...)) (stx-map expand-expr #'(pat-stx* (... ...)))
#:with ((num-groups* . T*) (... ...)) (stx-map count-groups #'(pat-stx+* (... ...)))
#'(let ([name* pat-stx+*] (... ...))
(let-syntax ([name* (make-rename-transformer
(syntax-property #'name*
num-groups-key
(cons 'num-groups* #'T*)))] (... ...))
e* (... ...)))]
[(_ arg* (... ...))
#'(let arg* (... ...))]))
;; For definitions, (define-regexp: id val)

34
test/regexp-pass.rkt
View File

@ -126,6 +126,36 @@
byte-pregexp:)))
;; -- let-regexp:
(check-equal?
(ann
(let-regexp: ([rx #rx"^y(o+)lo$"])
(cond
[(regexp-match: rx "yolo")
=> (lambda ([x* : (List String String)])
(cadr x*))]
;=> cadr]
[else
(raise-user-error 'nope)]))
String)
"o")
(check-equal?
(ann
(let-regexp: ([rx1 #rx"^y(o+)lo$"]
[rx2 #rx"^w(e+)pa$"]
[rx3 #rx"^y(e+)rrr$"])
(cond
[(regexp-match: rx1 "wepa")
=> cadr]
[(regexp-match: rx2 "yolo")
=> cadr]
[(regexp-match: rx3 "yeeeeeerrr")
=> cadr]
[else
(raise-user-error 'nope)]))
String)
"eeeeee")
(check-equal?
(ann
(let-regexp: ([rx "\\(\\)he(l*)(o*)"])
@ -178,7 +208,7 @@
(ann
(let-pregexp: ([rx #px"he(l*)(o*)"])
(regexp-match: rx "helllooo"))
(u #f (list string string string)))
(U #f (List String String String)))
'("helllooo" "lll" "ooo"))
;; -- define-pregexp:
@ -187,7 +217,7 @@
(let ()
(define-pregexp: rx #px"he(l*)(o*)")
(regexp-match: rx "helllooo"))
(u #f (list string string string)))
(U #f (List String String String)))
'("helllooo" "lll" "ooo"))
(check-equal?