Added natural',
integer', and `real' patterns to Redex.
svn: r13957
This commit is contained in:
parent
c9445be62d
commit
b948caaa92
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user