Handle empty matcher in matcher-match-value
This commit is contained in:
parent
f788caf754
commit
8210272054
|
@ -268,6 +268,8 @@
|
||||||
[(r1 r2) (walk r1 r2)]))))
|
[(r1 r2) (walk r1 r2)]))))
|
||||||
|
|
||||||
(define (matcher-match-value r v)
|
(define (matcher-match-value r v)
|
||||||
|
(if (matcher-empty? r)
|
||||||
|
(set)
|
||||||
(let walk ((vs (list v)) (stack '(())) (r r))
|
(let walk ((vs (list v)) (stack '(())) (r r))
|
||||||
(define (walk-wild vs stack)
|
(define (walk-wild vs stack)
|
||||||
(match (rlookup r ?)
|
(match (rlookup r ?)
|
||||||
|
@ -312,7 +314,7 @@
|
||||||
[(cons v rest)
|
[(cons v rest)
|
||||||
(match (rlookup r v)
|
(match (rlookup r v)
|
||||||
[#f (walk-wild rest stack)]
|
[#f (walk-wild rest stack)]
|
||||||
[k (walk rest stack k)])])])))
|
[k (walk rest stack k)])])]))))
|
||||||
|
|
||||||
(define (matcher-match-matcher re1 re2)
|
(define (matcher-match-matcher re1 re2)
|
||||||
(let ()
|
(let ()
|
||||||
|
@ -578,6 +580,12 @@
|
||||||
(string->list expectedstr))))
|
(string->list expectedstr))))
|
||||||
(walk rest)])))
|
(walk rest)])))
|
||||||
|
|
||||||
|
(check-matches
|
||||||
|
#f
|
||||||
|
(list 'z 'x) ""
|
||||||
|
'foo ""
|
||||||
|
(list (list 'z (list 'z))) "")
|
||||||
|
|
||||||
(void (pretty-print-matcher
|
(void (pretty-print-matcher
|
||||||
(matcher-union (pattern->matcher 'A (list (list ?) 'x))
|
(matcher-union (pattern->matcher 'A (list (list ?) 'x))
|
||||||
(pattern->matcher 'B (list (list ?) 'y)))))
|
(pattern->matcher 'B (list (list ?) 'y)))))
|
||||||
|
|
Loading…
Reference in New Issue