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

svn: r13957

collects/redex/private/matcher-test.ss

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

collects/redex/private/matcher.ss

@@ -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]
@@ -529,6 +541,9 @@ before the pattern compiler is invoked.
     [`number #t]
     [`string #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))]
+      [`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?)
        (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

collects/redex/private/reduction-semantics.ss

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

collects/redex/private/underscore-allowed.ss

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

collects/redex/redex.scrbl

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

doc/release-notes/redex/HISTORY.txt

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