diff --git a/regexp.rkt b/regexp.rkt index 5eda021..ce41936 100644 --- a/regexp.rkt +++ b/regexp.rkt @@ -6,10 +6,10 @@ ;; TODO groups can be #f when using | ... any other way? (provide - regexp: define-regexp: - pregexp: define-pregexp: - byte-regexp: define-byte-regexp: - byte-pregexp: define-byte-pregexp: + regexp: define-regexp: let-regexp: + pregexp: define-pregexp: let-pregexp: + byte-regexp: define-byte-regexp: let-byte-regexp: + byte-pregexp: define-byte-pregexp: let-byte-pregexp: ;; Expression and definition forms that try checking their argument patterns. ;; If check succeeds, will remember the number of pattern groups ;; for calls to `regexp-match:`. @@ -48,6 +48,7 @@ (syntax-parser [(_ f:id) #:with f: (format-id #'f "~a:" (syntax-e #'f)) + #:with let-f: (format-id #'f "let-~a:" (syntax-e #'f)) #:with define-f: (format-id #'f "define-~a:" (syntax-e #'f)) #'(begin ;; For expressions, (regexp: val) @@ -63,6 +64,18 @@ (cons (syntax-e #'num-groups) #'T))] [(_ arg* (... ...)) #'(f arg* (... ...))])) + ;; 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* (... ...))] + [(_ arg* (... ...)) + #'(let arg* (... ...))])) ;; For definitions, (define-regexp: id val) (define-syntax define-f: (syntax-parser diff --git a/regexp/no-colon.rkt b/regexp/no-colon.rkt index b0bdfe5..3523719 100644 --- a/regexp/no-colon.rkt +++ b/regexp/no-colon.rkt @@ -8,6 +8,10 @@ [pregexp: pregexp] [byte-regexp: byte-regexp] [byte-pregexp: byte-pregexp] + [let-regexp: let-regexp] + [let-pregexp: let-pregexp] + [let-byte-regexp: let-byte-regexp] + [let-byte-pregexp: let-byte-pregexp] [define-regexp: define-regexp] [define-pregexp: define-pregexp] [define-byte-regexp: define-byte-regexp] diff --git a/test/regexp-pass.rkt b/test/regexp-pass.rkt index 3359fe6..7545077 100644 --- a/test/regexp-pass.rkt +++ b/test/regexp-pass.rkt @@ -125,6 +125,14 @@ (f #"ah(oy")) byte-pregexp:))) + ;; -- let-regexp: + (check-equal? + (ann + (let-regexp: ([rx "\\(\\)he(l*)(o*)"]) + (regexp-match: rx "helllooo")) + (U #f (List String String String))) + #f) + ;; -- define-regexp: (check-equal? (ann @@ -165,13 +173,21 @@ (U #f (Listof (U #f String)))) '("hellooo" "ll" "ooo")) + ;; -- let-pregexp: + (check-equal? + (ann + (let-pregexp: ([rx #px"he(l*)(o*)"]) + (regexp-match: rx "helllooo")) + (u #f (list string string string))) + '("helllooo" "lll" "ooo")) + ;; -- define-pregexp: (check-equal? (ann (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? @@ -189,13 +205,21 @@ (U #f (List String String String))) '("hellooo" "ll" "ooo")) - ;; -- define-byte-regexp: (check-equal? (ann (regexp-match: #rx#"he(l*)(o*)" #"helllooo") (U #f (List Bytes Bytes Bytes))) '(#"helllooo" #"lll" #"ooo")) + ;; -- let-byte-regexp: + (check-equal? + (ann + (let-byte-regexp: ([rx #rx#"he(l*)(o*)"]) + (regexp-match: rx #"helllooo")) + (U #f (List Bytes Bytes Bytes))) + '(#"helllooo" #"lll" #"ooo")) + + ;; -- define-byte-regexp: (check-equal? (ann (let () @@ -219,13 +243,21 @@ (U #f (List Bytes Bytes Bytes))) '(#"hellooo" #"ll" #"ooo")) - ;; -- define-byte-pregexp: (check-equal? (ann (regexp-match: #px#"he(l*)(o*)" "helllooo") (U #f (List Bytes Bytes Bytes))) '(#"helllooo" #"lll" #"ooo")) + ;; -- let-byte-pregexp: + (check-equal? + (ann + (let-byte-pregexp: ([rx #px#"he(l*)(o*)"]) + (regexp-match: rx "helllooo")) + (U #f (List Bytes Bytes Bytes))) + '(#"helllooo" #"lll" #"ooo")) + + ;; -- define-byte-pregexp: (check-equal? (ann (let ()