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)
|
(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?)]
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user