From 8210272054de4320d79f9ac6045d188e53ccca20 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Tue, 13 May 2014 23:11:50 -0400
Subject: [PATCH] Handle empty matcher in matcher-match-value

---
 minimart/route.rkt | 98 +++++++++++++++++++++++++---------------------
 1 file changed, 53 insertions(+), 45 deletions(-)

diff --git a/minimart/route.rkt b/minimart/route.rkt
index 5b3855c..3163e20 100644
--- a/minimart/route.rkt
+++ b/minimart/route.rkt
@@ -268,51 +268,53 @@
 	[(r1 r2) (walk r1 r2)]))))
 
 (define (matcher-match-value r v)
-  (let walk ((vs (list v)) (stack '(())) (r r))
-    (define (walk-wild vs stack)
-      (match (rlookup r ?)
-	[#f (set)]
-	[k (walk vs stack k)]))
-    (match r
-      [(wildcard-sequence k)
-       (match stack
-	 ['() (set)]
-	 [(cons rest stack1) (walk rest stack1 k)])]
-      [(? set?)
-       (if (and (null? vs)
-		(null? stack))
-	   r
-	   (set))]
-      [(? hash?)
-       (match vs
-	 ['()
-	  (match stack
-	    ['() (set)]
-	    [(cons rest stack1)
-	     (match (rlookup r EOS)
-	       [#f (set)]
-	       [k (walk rest stack1 k)])])]
-	 [(cons (== ?) rest)
-	  (error 'matcher-match-value "Cannot match wildcard as a value")]
-	 [(cons (cons v1 v2) rest)
-	  (match (rlookup r SOP)
-	    [#f (walk-wild rest stack)]
-	    [k (walk (list v1 v2) (cons rest stack) k)])]
-	 [(cons (vector vv ...) rest)
-	  (match (rlookup r SOV)
-	    [#f (walk-wild rest stack)]
-	    [k (walk vv (cons rest stack) k)])]
-	 [(cons (? non-object-struct? s) rest)
-	  (define-values (t skipped?) (struct-info s))
-	  (when skipped? (error 'matcher-match-value "Cannot reflect on struct instance ~v" s))
-	  (define fs (cdr (vector->list (struct->vector s))))
-	  (match (rlookup r t)
-	    [#f (walk-wild rest stack)]
-	    [k (walk fs (cons rest stack) k)])]
-	 [(cons v rest)
-	  (match (rlookup r v)
-	    [#f (walk-wild rest stack)]
-	    [k (walk rest stack k)])])])))
+  (if (matcher-empty? r)
+      (set)
+      (let walk ((vs (list v)) (stack '(())) (r r))
+	(define (walk-wild vs stack)
+	  (match (rlookup r ?)
+	    [#f (set)]
+	    [k (walk vs stack k)]))
+	(match r
+	  [(wildcard-sequence k)
+	   (match stack
+	     ['() (set)]
+	     [(cons rest stack1) (walk rest stack1 k)])]
+	  [(? set?)
+	   (if (and (null? vs)
+		    (null? stack))
+	       r
+	       (set))]
+	  [(? hash?)
+	   (match vs
+	     ['()
+	      (match stack
+		['() (set)]
+		[(cons rest stack1)
+		 (match (rlookup r EOS)
+		   [#f (set)]
+		   [k (walk rest stack1 k)])])]
+	     [(cons (== ?) rest)
+	      (error 'matcher-match-value "Cannot match wildcard as a value")]
+	     [(cons (cons v1 v2) rest)
+	      (match (rlookup r SOP)
+		[#f (walk-wild rest stack)]
+		[k (walk (list v1 v2) (cons rest stack) k)])]
+	     [(cons (vector vv ...) rest)
+	      (match (rlookup r SOV)
+		[#f (walk-wild rest stack)]
+		[k (walk vv (cons rest stack) k)])]
+	     [(cons (? non-object-struct? s) rest)
+	      (define-values (t skipped?) (struct-info s))
+	      (when skipped? (error 'matcher-match-value "Cannot reflect on struct instance ~v" s))
+	      (define fs (cdr (vector->list (struct->vector s))))
+	      (match (rlookup r t)
+		[#f (walk-wild rest stack)]
+		[k (walk fs (cons rest stack) k)])]
+	     [(cons v rest)
+	      (match (rlookup r v)
+		[#f (walk-wild rest stack)]
+		[k (walk rest stack k)])])]))))
 
 (define (matcher-match-matcher re1 re2)
   (let ()
@@ -578,6 +580,12 @@
 				       (string->list expectedstr))))
 	 (walk rest)])))
 
+  (check-matches
+   #f
+   (list 'z 'x) ""
+   'foo ""
+   (list (list 'z (list 'z))) "")
+
   (void (pretty-print-matcher
 	 (matcher-union (pattern->matcher 'A (list (list ?) 'x))
 			(pattern->matcher 'B (list (list ?) 'y)))))