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

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/redex/private/matcher-test.ss
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 'x #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 1 #f)
(test-empty 'string '() #f)

32
collects/redex/private/matcher.ss
View File

@ -195,6 +195,9 @@ before the pattern compiler is invoked.
[`any (void)]
[`number (void)]
[`string (void)]
[`natural (void)]
[`integer (void)]
[`real (void)]
[`variable (void)]
[`(variable-except ,s ...) (void)]
[`(variable-prefix ,s) (void)]
@ -230,6 +233,9 @@ before the pattern compiler is invoked.
[`number #f]
[`string #f]
[`variable #f]
[`natural #f]
[`integer #f]
[`real #f]
[`(variable-except ,vars ...) #f]
[`(variable-prefix ,var) #f]
[`variable-not-otherwise-mentioned #f]
@ -375,6 +381,9 @@ before the pattern compiler is invoked.
[`any (lambda (l) 'any)]
[`number (lambda (l) 'number)]
[`string (lambda (l) 'string)]
[`natural (lambda (l) 'natural)]
[`integer (lambda (l) 'integer)]
[`real (lambda (l) 'real)]
[`variable (lambda (l) 'variable)]
[`(variable-except ,vars ...) (lambda (l) pattern)]
[`(variable-prefix ,var) (lambda (l) pattern)]
@ -482,6 +491,9 @@ before the pattern compiler is invoked.
[`number #f]
[`string #f]
[`variable #f]
[`natural #f]
[`integer #f]
[`real #f]
[`(variable-except ,vars ...) #f]
[`variable-not-otherwise-mentioned #f]
[`(variable-prefix ,var) #f]
@ -528,7 +540,10 @@ before the pattern compiler is invoked.
[`any #t]
[`number #t]
[`string #t]
[`variable #t]
[`variable #t]
[`natural #t]
[`integer #t]
[`real #t]
[`(variable-except ,vars ...) #t]
[`variable-not-otherwise-mentioned #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)
(define (compile-id-pattern pat)
(match pat
[`any (simple-match 'any (λ (x) #t))]
[`number (simple-match 'number number?)]
[`string (simple-match 'string string?)]
[`variable (simple-match 'variable symbol?)]
[`any (simple-match (λ (x) #t))]
[`number (simple-match number?)]
[`string (simple-match string?)]
[`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?)
(values
(lambda (exp hole-info)
@ -825,9 +843,9 @@ before the pattern compiler is invoked.
(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
(define (simple-match binder pred)
(define (simple-match pred)
(values (lambda (exp hole-info)
(and (pred exp)
(list (make-mtch

2
collects/redex/private/reduction-semantics.ss
View File

@ -1437,7 +1437,7 @@
(for-each
(λ (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
(format "cannot use pattern language keyword ~a as non-terminal"
x)

2
collects/redex/private/underscore-allowed.ss
View File

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

25
collects/redex/redex.scrbl
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)
[pattern any
number
natural
integer
real
string
variable
(variable-except symbol ...)
@ -128,6 +131,28 @@ were an implicit @pattech[name] @pattern) and match the portion
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.
This @pattern may also be suffixed with an underscore and another
identifier, in which case they bind the full name (as if it

2
doc/release-notes/redex/HISTORY.txt
View File

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