diff --git a/collects/redex/private/matcher-test.ss b/collects/redex/private/matcher-test.ss index eb7f8d86d6..020641bcc3 100644 --- a/collects/redex/private/matcher-test.ss +++ b/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) diff --git a/collects/redex/private/matcher.ss b/collects/redex/private/matcher.ss index 0445b6ff51..8ac741baf8 100644 --- a/collects/redex/private/matcher.ss +++ b/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] @@ -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 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 boolean) + ;; simple-match : (any -> bool) -> (values 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 diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss index a81b831fe5..2c33844770 100644 --- a/collects/redex/private/reduction-semantics.ss +++ b/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) diff --git a/collects/redex/private/underscore-allowed.ss b/collects/redex/private/underscore-allowed.ss index 79c8920f2a..b7759847c1 100644 --- a/collects/redex/private/underscore-allowed.ss +++ b/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)) diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 3aeb5860eb..40e0b63d14 100644 --- a/collects/redex/redex.scrbl +++ b/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 diff --git a/doc/release-notes/redex/HISTORY.txt b/doc/release-notes/redex/HISTORY.txt index 81c51cbfaf..ad6b0b2972 100644 --- a/doc/release-notes/redex/HISTORY.txt +++ b/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