Fixes PR 10843

svn: r18752
This commit is contained in:
Casey Klein 2010-04-07 15:33:36 +00:00
parent 52e2b31408
commit ea2861b03a
3 changed files with 22 additions and 11 deletions

View File

@ -686,16 +686,6 @@ before the pattern compiler is invoked.
(build-flat-context exp) (build-flat-context exp)
none))))))) none)))))))
#f)] #f)]
[`variable-not-otherwise-mentioned
(values
(let ([literals (compiled-lang-literals clang)])
(lambda (exp hole-info)
(and (symbol? exp)
(not (memq exp literals))
(list (make-mtch (make-bindings null)
(build-flat-context exp)
none)))))
#f)]
[`hole [`hole
(values (match-hole none) #t)] (values (match-hole none) #t)]
[(? string?) [(? string?)
@ -814,6 +804,12 @@ before the pattern compiler is invoked.
[`number (simple-match number?)] [`number (simple-match number?)]
[`string (simple-match string?)] [`string (simple-match string?)]
[`variable (simple-match symbol?)] [`variable (simple-match symbol?)]
[`variable-not-otherwise-mentioned
(let ([literals (compiled-lang-literals clang)])
(simple-match
(λ (exp)
(and (symbol? exp)
(not (memq exp literals))))))]
[`natural (simple-match (λ (x) (and (integer? x) (exact? x) (not (negative? x)))))] [`natural (simple-match (λ (x) (and (integer? x) (exact? x) (not (negative? x)))))]
[`integer (simple-match (λ (x) (and (integer? x) (exact? x))))] [`integer (simple-match (λ (x) (and (integer? x) (exact? x))))]
[`real (simple-match real?)] [`real (simple-match real?)]

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 natural integer real)) (define underscore-allowed '(any number string variable variable-not-otherwise-mentioned natural integer real))

View File

@ -233,6 +233,21 @@
(test (pair? (redex-match L x (term a_c))) #t) (test (pair? (redex-match L x (term a_c))) #t)
(test (pair? (redex-match L y (term a_bc))) #t)) (test (pair? (redex-match L y (term a_bc))) #t))
; underscores allowed on built-in non-terminals and names bound
(let ([m (redex-match
grammar
(any_1 number_1 natural_1 integer_1
real_1 string_1 variable_1
variable-not-otherwise-mentioned_1)
'(1 2 3 4 5 "s" s t))])
(test (if m
(map bind-exp
(sort (match-bindings (car m))
string<=?
#:key (compose symbol->string bind-name)))
'())
'(1 4 3 2 5 "s" t s)))
;; test caching ;; test caching
(let () (let ()
(define match? #t) (define match? #t)