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