Added natural', integer', and `real' patterns to Redex.

svn: r13957
This commit is contained in:
Casey Klein 2009-03-04 20:12:36 +00:00
parent c9445be62d
commit b948caaa92
6 changed files with 67 additions and 9 deletions

View File

@ -34,6 +34,19 @@
(test-empty 'number 1 (list (make-test-mtch (make-bindings (list (make-bind 'number 1))) 1 none))) (test-empty 'number 1 (list (make-test-mtch (make-bindings (list (make-bind 'number 1))) 1 none)))
(test-empty 'number 'x #f) (test-empty 'number 'x #f)
(test-empty 'number '() #f) (test-empty 'number '() #f)
(test-empty 'natural 1 (list (make-test-mtch (make-bindings (list (make-bind 'natural 1))) 1 none)))
(test-empty 'natural 'x #f)
(test-empty 'natural '() #f)
(test-empty 'natural -1 #f)
(test-empty 'natural 1.0 #f)
(test-empty 'integer -1 (list (make-test-mtch (make-bindings (list (make-bind 'integer -1))) -1 none)))
(test-empty 'integer 'x #f)
(test-empty 'integer '() #f)
(test-empty 'integer 1.0 #f)
(test-empty 'real 1.1 (list (make-test-mtch (make-bindings (list (make-bind 'real 1.1))) 1.1 none)))
(test-empty 'real 'x #f)
(test-empty 'real '() #f)
(test-empty 'real 2+3i #f)
(test-empty 'string "a" (list (make-test-mtch (make-bindings (list (make-bind 'string "a"))) "a" none))) (test-empty 'string "a" (list (make-test-mtch (make-bindings (list (make-bind 'string "a"))) "a" none)))
(test-empty 'string 1 #f) (test-empty 'string 1 #f)
(test-empty 'string '() #f) (test-empty 'string '() #f)

View File

@ -195,6 +195,9 @@ before the pattern compiler is invoked.
[`any (void)] [`any (void)]
[`number (void)] [`number (void)]
[`string (void)] [`string (void)]
[`natural (void)]
[`integer (void)]
[`real (void)]
[`variable (void)] [`variable (void)]
[`(variable-except ,s ...) (void)] [`(variable-except ,s ...) (void)]
[`(variable-prefix ,s) (void)] [`(variable-prefix ,s) (void)]
@ -230,6 +233,9 @@ before the pattern compiler is invoked.
[`number #f] [`number #f]
[`string #f] [`string #f]
[`variable #f] [`variable #f]
[`natural #f]
[`integer #f]
[`real #f]
[`(variable-except ,vars ...) #f] [`(variable-except ,vars ...) #f]
[`(variable-prefix ,var) #f] [`(variable-prefix ,var) #f]
[`variable-not-otherwise-mentioned #f] [`variable-not-otherwise-mentioned #f]
@ -375,6 +381,9 @@ before the pattern compiler is invoked.
[`any (lambda (l) 'any)] [`any (lambda (l) 'any)]
[`number (lambda (l) 'number)] [`number (lambda (l) 'number)]
[`string (lambda (l) 'string)] [`string (lambda (l) 'string)]
[`natural (lambda (l) 'natural)]
[`integer (lambda (l) 'integer)]
[`real (lambda (l) 'real)]
[`variable (lambda (l) 'variable)] [`variable (lambda (l) 'variable)]
[`(variable-except ,vars ...) (lambda (l) pattern)] [`(variable-except ,vars ...) (lambda (l) pattern)]
[`(variable-prefix ,var) (lambda (l) pattern)] [`(variable-prefix ,var) (lambda (l) pattern)]
@ -482,6 +491,9 @@ before the pattern compiler is invoked.
[`number #f] [`number #f]
[`string #f] [`string #f]
[`variable #f] [`variable #f]
[`natural #f]
[`integer #f]
[`real #f]
[`(variable-except ,vars ...) #f] [`(variable-except ,vars ...) #f]
[`variable-not-otherwise-mentioned #f] [`variable-not-otherwise-mentioned #f]
[`(variable-prefix ,var) #f] [`(variable-prefix ,var) #f]
@ -529,6 +541,9 @@ before the pattern compiler is invoked.
[`number #t] [`number #t]
[`string #t] [`string #t]
[`variable #t] [`variable #t]
[`natural #t]
[`integer #t]
[`real #t]
[`(variable-except ,vars ...) #t] [`(variable-except ,vars ...) #t]
[`variable-not-otherwise-mentioned #t] [`variable-not-otherwise-mentioned #t]
[`(variable-prefix ,prefix) #t] [`(variable-prefix ,prefix) #t]
@ -803,10 +818,13 @@ before the pattern compiler is invoked.
;; compile-id-pattern : symbol[with-out-underscore] -> (values <compiled-pattern-proc> boolean) ;; compile-id-pattern : symbol[with-out-underscore] -> (values <compiled-pattern-proc> boolean)
(define (compile-id-pattern pat) (define (compile-id-pattern pat)
(match pat (match pat
[`any (simple-match 'any (λ (x) #t))] [`any (simple-match (λ (x) #t))]
[`number (simple-match 'number number?)] [`number (simple-match number?)]
[`string (simple-match 'string string?)] [`string (simple-match string?)]
[`variable (simple-match 'variable symbol?)] [`variable (simple-match symbol?)]
[`natural (simple-match (λ (x) (and (integer? x) (exact? x) (not (negative? x)))))]
[`integer (simple-match (λ (x) (and (integer? x) (exact? x))))]
[`real (simple-match real?)]
[(? is-non-terminal?) [(? is-non-terminal?)
(values (values
(lambda (exp hole-info) (lambda (exp hole-info)
@ -825,9 +843,9 @@ before the pattern compiler is invoked.
(define (is-non-terminal? sym) (hash-maps? clang-ht sym)) (define (is-non-terminal? sym) (hash-maps? clang-ht sym))
;; simple-match : sym (any -> bool) -> (values <compiled-pattern> boolean) ;; simple-match : (any -> bool) -> (values <compiled-pattern> boolean)
;; does a match based on a built-in Scheme predicate ;; does a match based on a built-in Scheme predicate
(define (simple-match binder pred) (define (simple-match pred)
(values (lambda (exp hole-info) (values (lambda (exp hole-info)
(and (pred exp) (and (pred exp)
(list (make-mtch (list (make-mtch

View File

@ -1437,7 +1437,7 @@
(for-each (for-each
(λ (name) (λ (name)
(let ([x (syntax->datum name)]) (let ([x (syntax->datum name)])
(when (memq x '(any number string variable variable-except variable-prefix hole name in-hole in-named-hole hide-hole side-condition cross ...)) (when (memq x '(any number string variable natural integer real variable-except variable-prefix hole name in-hole in-named-hole hide-hole side-condition cross ...))
(raise-syntax-error 'language (raise-syntax-error 'language
(format "cannot use pattern language keyword ~a as non-terminal" (format "cannot use pattern language keyword ~a as non-terminal"
x) x)

View File

@ -1,3 +1,3 @@
#lang scheme/base #lang scheme/base
(provide underscore-allowed) (provide underscore-allowed)
(define underscore-allowed '(any number string variable)) (define underscore-allowed '(any number string variable natural integer real))

View File

@ -93,6 +93,9 @@ given term, Redex assumes that it will always match that term.
@(schemegrammar* #:literals (any number string variable variable-except variable-prefix variable-not-otherwise-mentioned hole name in-hole side-condition cross) @(schemegrammar* #:literals (any number string variable variable-except variable-prefix variable-not-otherwise-mentioned hole name in-hole side-condition cross)
[pattern any [pattern any
number number
natural
integer
real
string string
variable variable
(variable-except symbol ...) (variable-except symbol ...)
@ -128,6 +131,28 @@ were an implicit @pattech[name] @pattern) and match the portion
before the underscore. before the underscore.
} }
@item{The @defpattech[natural] @pattern matches any exact
non-negative integer.
This @pattern may also be suffixed with an underscore and another
identifier, in which case they bind the full name (as if it
were an implicit @pattech[name] @pattern) and match the portion
before the underscore.
}
@item{The @defpattech[integer] @pattern matches any exact integer.
This @pattern may also be suffixed with an underscore and another
identifier, in which case they bind the full name (as if it
were an implicit @pattech[name] @pattern) and match the portion
before the underscore.
}
@item{The @defpattech[real] @pattern matches any real number.
This @pattern may also be suffixed with an underscore and another
identifier, in which case they bind the full name (as if it
were an implicit @pattech[name] @pattern) and match the portion
before the underscore.
}
@item{The @defpattech[string] @pattern matches any string. @item{The @defpattech[string] @pattern matches any string.
This @pattern may also be suffixed with an underscore and another This @pattern may also be suffixed with an underscore and another
identifier, in which case they bind the full name (as if it identifier, in which case they bind the full name (as if it

View File

@ -17,6 +17,8 @@ v4.1.5
* traces & traces/ps: added the ability to specify a mixin * traces & traces/ps: added the ability to specify a mixin
to be mixed into the graph pasteboard to be mixed into the graph pasteboard
* added built-in patterns natural, integer, and real
v4.1.4 v4.1.4
* added redex-check, a tool for automatically generating test cases * added redex-check, a tool for automatically generating test cases