syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix bug in projection against wildcards

This commit is contained in:
Tony Garnock-Jones 2014-05-22 22:34:24 -04:00
parent 9a5d9cb579
commit 77a7620bdc
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
minimart/route.rkt
View File

@ -529,12 +529,16 @@
values)
(match m
[(wildcard-sequence mk)
(if (key-close? sigma)
(walk capturing? mk k)
(walk capturing? m k))]
(cond
[(key-open? sigma) (walk capturing? (rwildseq m) k)]
[(key-close? sigma) (walk capturing? mk k)]
[else (walk capturing? m k)])]
[(? hash?)
(matcher-union (walk capturing? (rlookup m sigma) k)
(walk capturing? (rlookup m ?) k))]
(cond
[(key-open? sigma) (walk capturing? (rwildseq (rlookup m ?)) k)]
[(key-close? sigma) #f]
[else (walk capturing? (rlookup m ?) k)]))]
[_ (matcher-empty)]))]))
(lambda (m spec)
@ -638,6 +642,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module+ test
(require racket/pretty)
(define SA (set 'A))
(define SB (set 'B))
(define SC (set 'C))
@ -1106,6 +1112,11 @@
(compile-projection (cons (?!) (?!)))))
(set '#(1 2) '#(3 4))))
(check-equal? (matcher-project (matcher-union (pattern->matcher SA ?)
(pattern->matcher SB (list 'a)))
(compile-projection (?! (list (list ?)))))
(pattern->matcher SA (vector (list (list ?)))))
(check-equal? (projection->pattern (list 'a 'b)) (list 'a 'b))
(check-equal? (projection->pattern (list 'a ?)) (list 'a ?))
(check-equal? (projection->pattern (list 'a (?!))) (list 'a ?))