diff --git a/collects/scheme/match/parse-helper.ss b/collects/scheme/match/parse-helper.ss index d41d63bcbe..e80b4acbba 100644 --- a/collects/scheme/match/parse-helper.ss +++ b/collects/scheme/match/parse-helper.ss @@ -8,9 +8,11 @@ "compiler.ss" (only-in srfi/1 delete-duplicates)) -(provide ddk? parse-literal all-vars pattern-var? match:syntax-err) - +(provide ddk? parse-literal all-vars pattern-var? match:syntax-err + matchable?) +(define (matchable? e) + (or (string? e) (bytes? e))) ;; raise an error, blaming stx (define (match:syntax-err stx msg) diff --git a/collects/scheme/match/parse.ss b/collects/scheme/match/parse.ss index a7f3e83ef0..e430aee5c2 100644 --- a/collects/scheme/match/parse.ss +++ b/collects/scheme/match/parse.ss @@ -1,6 +1,6 @@ #lang scheme/base -(require (for-template scheme/base) +(require (for-template scheme/base "parse-helper.ss") syntax/boundmap syntax/stx scheme/struct-info @@ -49,18 +49,18 @@ (let ([ps (map (compose make-Not parse) (syntax->list #'(p ...)))]) (make-And ps))] [(regexp r) - (make-And (list (make-Pred #'string?) (make-App #'(lambda (e) (regexp-match r e)) (make-Pred #'values))))] + (make-And (list (make-Pred #'matchable?) (make-App #'(lambda (e) (regexp-match r e)) (make-Pred #'values))))] [(regexp r p) - (make-And (list (make-Pred #'string?) (make-App #'(lambda (e) (regexp-match r e)) (parse #'p))))] + (make-And (list (make-Pred #'matchable?) (make-App #'(lambda (e) (regexp-match r e)) (parse #'p))))] [(pregexp r) - (make-And (list (make-Pred #'string?) (make-App (syntax/loc #'r + (make-And (list (make-Pred #'matchable?) (make-App (syntax/loc #'r (lambda (e) (regexp-match (if (pregexp? r) r (pregexp r)) e))) (make-Pred #'values))))] [(pregexp r p) - (make-And (list (make-Pred #'string?) (make-App (syntax/loc #'r + (make-And (list (make-Pred #'matchable?) (make-App (syntax/loc #'r (lambda (e) (regexp-match (if (pregexp? r) r (pregexp r))