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

add matchable?

Browse Source 
svn: r9067
This commit is contained in:
Sam Tobin-Hochstadt 2008-03-22 17:07:59 +00:00
parent eedaebefaf
commit 63df5e13f7
2 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scheme/match/parse-helper.ss
View File

@ -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)

10
collects/scheme/match/parse.ss
View File

@ -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))