From 77a7620bdc43670953ce10cfa116a054e0019a99 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 22 May 2014 22:34:24 -0400 Subject: [PATCH] Fix bug in projection against wildcards --- minimart/route.rkt | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/minimart/route.rkt b/minimart/route.rkt index 01b36c3..030a6ca 100644 --- a/minimart/route.rkt +++ b/minimart/route.rkt @@ -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 ?))