Fixes PR 10843
svn: r18752
This commit is contained in:
parent
52e2b31408
commit
ea2861b03a
|
@ -686,16 +686,6 @@ before the pattern compiler is invoked.
|
|||
(build-flat-context exp)
|
||||
none)))))))
|
||||
#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
|
||||
(values (match-hole none) #t)]
|
||||
[(? string?)
|
||||
|
@ -814,6 +804,12 @@ before the pattern compiler is invoked.
|
|||
[`number (simple-match number?)]
|
||||
[`string (simple-match string?)]
|
||||
[`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)))))]
|
||||
[`integer (simple-match (λ (x) (and (integer? x) (exact? x))))]
|
||||
[`real (simple-match real?)]
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
#lang scheme/base
|
||||
(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))
|
||||
|
|
|
@ -233,6 +233,21 @@
|
|||
(test (pair? (redex-match L x (term a_c))) #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
|
||||
(let ()
|
||||
(define match? #t)
|
||||
|
|
Loading…
Reference in New Issue
Block a user