From dc61372f3c01e7d8e6fc881de2113de8e69f1674 Mon Sep 17 00:00:00 2001
From: James Ian Johnson <ianj@moonpatrol.ccs.neu.edu>
Date: Tue, 30 Aug 2011 19:23:36 -0400
Subject: [PATCH] Implemented Sam's suggested changes for new forms, and added
 a new match/values form.

---
 collects/racket/match/define-forms.rkt     | 110 ++++----
 collects/racket/match/legacy-match.rkt     |   2 +-
 collects/racket/match/match.rkt            |   2 +-
 collects/scribblings/reference/match.scrbl |   7 +
 collects/tests/match/examples.rkt          | 286 +++++++++++----------
 5 files changed, 228 insertions(+), 179 deletions(-)

diff --git a/collects/racket/match/define-forms.rkt b/collects/racket/match/define-forms.rkt
index 4671724b82..ec6e1fd758 100644
--- a/collects/racket/match/define-forms.rkt
+++ b/collects/racket/match/define-forms.rkt
@@ -12,18 +12,42 @@
 
 (provide define-forms)
 
+;; each pat matches a value in a multi-valued expression
+(define-for-syntax (match-values-clause->let-clause pats rhs)
+  (with-syntax ([(pats ...) pats]
+                [(ids ...) (generate-temporaries pats)])
+    ;; rhs evaluates to number of ids values.
+    ;; patterns should match against each id.
+    (values #'(ids ...)
+            #`[(ids ...) #,rhs])))
+
+(define-for-syntax (match-values-clauses->let-clauses patses rhses)
+  (for/lists (idses let-clauses)
+      ([pats (syntax->list patses)]
+       [rhs (syntax->list rhses)])
+    (match-values-clause->let-clause pats rhs)))
+
+(define-for-syntax (all-same-length stx-listses)
+  (let loop ([listses (syntax->list stx-listses)]
+             [the-length #f])
+    (cond [(null? listses) #t]
+          [the-length
+           (and (= the-length (length (syntax->list (car listses))))
+                (loop (cdr listses) the-length))]
+          [else (loop (cdr listses) (length (syntax->list (car listses))))])))
+
 (define-syntax-rule (define-forms parse-id
                       match match* match-lambda match-lambda*
 		      match-lambda** match-let match-let*
                       match-let-values match-let*-values
 		      match-define match-define-values match-letrec
-		      match/derived match*/derived)
+		      match/values match/derived match*/derived)
   (...
    (begin
      (provide match match* match-lambda match-lambda* match-lambda**
 	      match-let match-let* match-let-values match-let*-values
               match-define match-define-values match-letrec
-	      match/derived match*/derived match-define-values)
+	      match/values match/derived match*/derived match-define-values)
      (define-syntax (match* stx)
        (syntax-parse stx
          [(_ es . clauses)
@@ -44,6 +68,16 @@
          [(_ arg:expr orig-stx clauses ...)
           (go/one parse-id #'orig-stx #'arg #'(clauses ...))]))
 
+     (define-syntax (match/values stx)
+       (syntax-parse stx
+         [(_ arg:expr [(pats ...) rhs:expr] [(patses ...) rhses:expr] ...)
+          #:fail-unless (all-same-length #'((pats ...) (patses ...) ...))
+          "All clauses must have the same number of patterns"
+          (define-values (ids let-clause)
+            (match-values-clause->let-clause #'(pats ...) #'rhs))
+          #`(let-values ([#,ids arg])
+              (match*/derived #,ids #,stx [(pats ...) rhs] [(patses ...) rhses] ...))]))
+
      (define-syntax (match-lambda stx)
        (syntax-parse stx
          [(_ . clauses)
@@ -65,6 +99,29 @@
                          [body #`(match*/derived vars #,stx clauses ...)])
             (syntax/loc stx (lambda vars body)))]))
 
+
+     (define-syntax (match-let-values stx)
+       (syntax-parse stx
+         [(_ (~and clauses ([(patses ...) rhses:expr] ...)) body1 body ...)
+          (define-values (idses let-clauses)
+            (match-values-clauses->let-clauses #'((patses ...) ...) #'(rhses ...)))
+          #`(let-values #,let-clauses
+              (match*/derived #,(append-map syntax->list idses) #,stx
+                [(patses ... ...)
+                 (let () body1 body ...)]))]))
+
+     (define-syntax (match-let*-values stx)
+       (syntax-parse stx
+         [(_ () body1 body ...)
+          #'(let () body1 body ...)]
+         [(_ ([(pats ...) rhs] rest-pats ...) body1 body ...)
+          (define-values (ids let-clause)
+            (match-values-clause->let-clause #'(pats ...) #'rhs))
+          #`(let-values (#,let-clause)
+              (match*/derived #,ids #,stx
+               [(pats ...) #,(syntax/loc stx (match-let*-values (rest-pats ...)
+                               body1 body ...))]))]))
+
      ;; there's lots of duplication here to handle named let
      ;; some factoring out would do a lot of good
      (define-syntax (match-let stx)
@@ -76,46 +133,11 @@
 					 [(pat ...) (let () body1 body ...)])])
            #'(letrec ([nm (lambda vars loop-body)])
                (nm init-exp ...)))]
-         [(_ (~and clauses ([pat init-exp:expr] ...)) body1 body ...)
-          #`(match*/derived (init-exp ...) #,stx
-			    [(pat ...) (let () body1 body ...)])]))
-
-     (define-syntax (match-let* stx)
-       (syntax-parse stx
-         [(_ () body1 body ...)
-          #'(let () body1 body ...)]
-         [(_ ([pat exp] rest-pats ...) body1 body ...)
-          #`(match*/derived
-             (exp)
-             #,stx
-             [(pat) #,(syntax/loc stx (match-let* (rest-pats ...)
-					 body1 body ...))])]))
-
-     (define-syntax (match-let-values stx)
-       (syntax-parse stx
-         [(_ (~and clauses ([(patses ...) rhses:expr] ...)) body1 body ...)
-          (define-values (let-clauses match-clauses)
-            (for/lists (let-clauses match-clauses)
-                ([pats (syntax->list #'((patses ...) ...))]
-                 [rhs (syntax->list #'(rhses ...))])
-              (with-syntax ([(pats ...) pats]
-                            [(ids ...) (generate-temporaries pats)])
-                (values #`[(ids ...) #,rhs]
-                        #`([pats ids] ...)))))
-          #`(let-values #,let-clauses
-              #,(quasisyntax/loc stx
-                  (match-let #,(append-map syntax->list match-clauses)
-                    (let () body1 body ...))))]))
-
-     (define-syntax (match-let*-values stx)
-       (syntax-parse stx
-         [(_ () body1 body ...)
-          #'(let () body1 body ...)]
-         [(_ ([pats rhs] rest-pats ...) body1 body ...)
-          #`(match-let-values ([pats rhs])
-              #,(syntax/loc stx (match-let*-values (rest-pats ...)
-                                   body1 body ...)))]))
+         [(_ ([pat init-exp:expr] ...) body1 body ...)
+          #`(match-let-values ([(pat) init-exp] ...) body1 body ...)]))
 
+     (define-syntax-rule (match-let* ([pat exp] ...) body1 body ...)
+       (match-let*-values ([(pat) exp] ...) body1 body ...))
 
      (define-syntax (match-letrec stx)
        (syntax-parse stx
@@ -149,6 +171,6 @@
               (define-values vars
                 (let-values ([(ids ...) rhs])
                   (apply values
-                       (append
-                        (match*/derived (ids) #,stx
-                                        [(pats) (list . pat-vars)]) ...))))))])))))
+                         (append
+                          (match*/derived (ids) #,stx
+                                          [(pats) (list . pat-vars)]) ...))))))])))))
diff --git a/collects/racket/match/legacy-match.rkt b/collects/racket/match/legacy-match.rkt
index c30ee7c8fe..e607fbd2b8 100644
--- a/collects/racket/match/legacy-match.rkt
+++ b/collects/racket/match/legacy-match.rkt
@@ -18,4 +18,4 @@
 (define-forms parse/legacy
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
   match-let-values match-let*-values
-  match-define match-define-values match-letrec match/derived match*/derived)
+  match-define match-define-values match-letrec match/values match/derived match*/derived)
diff --git a/collects/racket/match/match.rkt b/collects/racket/match/match.rkt
index 5951422d0c..345b66ea5c 100644
--- a/collects/racket/match/match.rkt
+++ b/collects/racket/match/match.rkt
@@ -20,4 +20,4 @@
 (define-forms parse
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
   match-let-values match-let*-values
-  match-define match-define-values match-letrec match/derived match*/derived)
+  match-define match-define-values match-letrec match/values match/derived match*/derived)
diff --git a/collects/scribblings/reference/match.scrbl b/collects/scribblings/reference/match.scrbl
index 99380f8d3b..ff4a96ca4a 100644
--- a/collects/scribblings/reference/match.scrbl
+++ b/collects/scribblings/reference/match.scrbl
@@ -368,6 +368,13 @@ same number of patterns as the number of @racket[val-expr]s.
 ]
 }
 
+@defform[(match/values expr clause clause ...)]{
+If @racket[expr] evaluates to @racket[n] values, then match all @racket[n]
+values against the patterns in @racket[clause ...]. Each clause must contain
+exactly @racket[n] patterns. At least one clause is required to determine how
+many values to expect from @racket[expr].
+}
+
 @defform[(match-lambda clause ...)]{
 
 Equivalent to @racket[(lambda (id) (match id clause ...))].
diff --git a/collects/tests/match/examples.rkt b/collects/tests/match/examples.rkt
index d7f2ad870a..e26d375315 100644
--- a/collects/tests/match/examples.rkt
+++ b/collects/tests/match/examples.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require scheme/match 
+(require scheme/match
 	 scheme/mpair
          scheme/control scheme/foreign
          (for-syntax scheme/base)
@@ -54,10 +54,10 @@
 (provide new-tests)
 
 (define new-tests
-  (test-suite 
+  (test-suite
    "new tests for match"
-   
-   (comp 
+
+   (comp
     1
     (match (list 1 2 3)
       [(list x ...) (=> unmatch)
@@ -66,26 +66,26 @@
                                (error 'bad))
                         0)]
       [_ 1]))
-   
-   (comp 
+
+   (comp
     '(1 2 3)
     (match (vector 1 2 3)
       [(vector (? number? x) ...) x]
       [_ 2]))
-   
+
    (comp
     2
     (match (vector 'a 1 2 3)
       [(vector (? number? x) ...) x]
       [_ 2]))
-   
+
    (comp
     3
     (match (list 'a 1 2 3)
       [(vector (? number? x) ...) x]
       [_ 3]))
-   
-   
+
+
    (comp -1
          (match (vector 1 2 3)
            [(or (list x) x) -1]
@@ -94,7 +94,7 @@
            [(vector a b) 2]
            [(vector a b c) 3]
            [(box _) 4]))
-   
+
    (comp 12
          (match (list 12 12)
            [(list x x) x]
@@ -103,8 +103,8 @@
          (match (list 1 0)
            [(list x x) x]
            [_ 13]))
-   
-   
+
+
    (comp
     6
     (let ()
@@ -123,84 +123,84 @@
         [(cons x y) (+ x y)]
         [_ 0])))
 
-   
+
    (comp
     6
     (match (make-X 1 2 3)
       [(X: a b c) (+ a b c)]))
-   
 
-   
-   (comp 
+
+
+   (comp
     '(6 3 100 6)
     (list
      (f (cons 1 2) (cons 3 4))
      (f (box 1) (box 2))
      (f (list 10 20 30) (list 40))
      (f (vector 1 2 3) (vector 4))))
-   
+
    (comp '(one (2 num) bool neither)
          (list
           (g 1)
           (g 2)
           (g #f)
           (g "foo")))
-   
+
    (comp
     (split (list (list 1 2) (list 'a 'b) (list 'x 'y)))
     '((1 a x) (2 b y)))
    (comp
     (split2 (list (list 1 2) (list 'a 'b) (list 'x 'y)))
     '((1 a) (2 b) (x y)))
-   
+
    (comp
     'yes
     (match (list (box 2) 2)
       [(list (or (box x) (list x)) x) 'yes]
       [_ 'no]))
-   
+
    (comp
     'no
     (parameterize ([match-equality-test eq?])
       (match (list (cons 1 1) (cons 1 1))
         [(list x x) 'yes]
         [_ 'no])))
-   
+
    (comp
     'no
     (match (list (box 2) 3)
       [(list (or (box x) (list x)) x) 'yes]
       [_ 'no]))
-   
+
    (comp
     2
     (match (list 'one 'three)
       [(list 'one 'two) 1]
       [(list 'one 'three) 2]
       [(list 'two 'three) 3]))
-   (comp 
+   (comp
     2
     (match (list 'one 'three)
       [(cons 'one (cons 'two '())) 1]
       [(cons 'one (cons 'three '())) 2]
       [(cons 'two (cons 'three '())) 3]))
-   
+
    (comp 'yes
          (match '(1 x 2 y 3 z)
            [(list-no-order 1 2 3 'x 'y 'z) 'yes]
            [_ 'no]))
-   
+
    ;; NOT WORKING YET
    (comp '(x y z)
          (match '(1 x 2 y 3 z)
            [(list-no-order 1 2 3 r1 r2 r3) (list r1 r2 r3)]
            [_ 'no]))
-   
+
    (comp '(x y z)
          (match '(1 x 2 y 3 z)
            [(list-no-order 1 2 3 rest ...) rest]
            [_ 'no]))
-   
+
    (comp
     'yes
     (match '(a (c d))
@@ -209,18 +209,18 @@
                          (list-no-order 'c 'd)))
        'yes]
       [_ 'no]))
-   
-   
-   (comp 
+
+
+   (comp
     '((1 2) (a b 1 2))
     (let ()
       (define-syntax-rule (match-lambda . cl)
         (lambda (e) (match e . cl)))
-      
+
       (define (make-nil)
         '())
       (define nil? null?)
-      
+
       (define make-::
         (match-lambda
           ((list-no-order (list '|1| a) (list '|2| d))
@@ -229,7 +229,7 @@
       (define (::-content p)
         (list (list '|1| (car p))
               (list '|2| (cdr p))))
-      
+
       (define my-append
         (match-lambda
           ((list-no-order (list '|1| (? nil?))
@@ -245,11 +245,11 @@
       (list
        (my-append (list (list '|1| '())
                         (list '|2| '(1 2))))
-       
+
        (my-append (list (list '|1| '(a b))
                         (list '|2| '(1 2)))))))
-   
-   
+
+
    (comp
     'yes
     (match
@@ -260,63 +260,63 @@
                                        (cons '|2| (cdr p)))))
                               (hash-table ('|1| _) ('|2| _))))) 'yes]
       [_ 'no]))
-   
+
    ;; examples from docs
-   
+
    (comp 'yes
          (match '(1 2 3)
            [(list (not 4) ...) 'yes]
            [_ 'no]))
-   
+
    (comp 'no
          (match '(1 4 3)
            [(list (not 4) ...) 'yes]
            [_ 'no]))
-   
+
    (comp 1
          (match '(1 2)
            [(or (list a 1) (list a 2)) a]
            [_ 'bad]))
-   
+
    (comp '(2 3)
-         (match '(1 (2 3) 4)          
+         (match '(1 (2 3) 4)
            [(list _ (and a (list _ ...)) _) a]
            [_ 'bad]))
-   
-   
-   
-   (comp 
+
+
+
+   (comp
     'yes
     (match "apple"
       [(regexp #rx"p+(.)" (list _ "l")) 'yes]
       [_ 'no]))
-   (comp 
+   (comp
     'no
     (match "append"
       [(regexp #rx"p+(.)" (list _ "l")) 'yes]
       [_ 'no]))
-   
-   
-   (comp 
+
+
+   (comp
     'yes
     (match "apple"
       [(regexp #rx"p+" ) 'yes]
       [_ 'no]))
-   (comp 
+   (comp
     'no
     (match "banana"
       [(regexp #rx"p+") 'yes]
       [_ 'no]))
-   
-   (comp 
+
+   (comp
     '(0 1)
     (let ()
       (define-struct tree (val left right))
-      
-      (match (make-tree 0 (make-tree 1 #f #f) #f)   
+
+      (match (make-tree 0 (make-tree 1 #f #f) #f)
         [(struct tree (a (struct tree (b  _ _)) _)) (list a b)]
         [_ 'no])))
-   
+
    (comp 1
          (match #&1
            [(box a) a]
@@ -325,120 +325,120 @@
          (match #hasheq(("a" . 1) ("b" . 2))
            [(hash-table ("b" b) ("a" a)) (list b a)]
            [_ 'no]))
-   
+
    (comp #t
          (andmap string?
                  (match #hasheq(("b" . 2) ("a" . 1))
                    [(hash-table (key val) ...) key]
                    [_ 'no])))
-   
+
    (comp
     (match #(1 (2) (2) (2) 5)
       [(vector 1 (list a) ..3 5) a]
       [_ 'no])
     '(2 2 2))
-   
+
    (comp '(1 3 4 5)
-         (match '(1 2 3 4 5 6)          
+         (match '(1 2 3 4 5 6)
            [(list-no-order 6 2 y ...) y]
            [_ 'no]))
-   
+
    (comp 1
-         (match '(1 2 3)          
+         (match '(1 2 3)
            [(list-no-order 3 2 x) x]))
    (comp '((1 2 3) 4)
-         (match '(1 2 3 . 4)          
+         (match '(1 2 3 . 4)
            [(list-rest a ... d) (list a d)]))
-   
+
    (comp 4
          (match '(1 2 3 . 4)
            [(list-rest a b c d) d]))
-   
+
    ;; different behavior from the way match used to be
    (comp '(2 3 4)
          (match '(1 2 3 4 5)
-           [(list 1 a ..3 5) a]      
+           [(list 1 a ..3 5) a]
            [_ 'else]))
-   
+
    (comp '((1 2 3 4) ())
          (match (list 1 2 3 4 5)
            [(list x ... y ... 5) (list x y)]
            [_ 'no]))
-   
+
    (comp '((1 3 2) (4))
          (match (list 1 3 2 3 4 5)
            [(list x ... 3 y ... 5) (list x y)]
            [_ 'no]))
-   
+
    (comp '(3 2 1)
          (match '(1 2 3)
            [(list a b c) (list c b a)]))
-   
+
    (comp '(2 3)
          (match '(1 2 3)
            [(list 1 a ...) a]))
-   
+
    (comp 'else
          (match '(1 2 3)
            [(list 1 a ..3) a]
            [_ 'else]))
-   
+
    (comp '(2 3 4)
          (match '(1 2 3 4)
            [(list 1 a ..3) a]
            [_ 'else]))
-   
+
    (comp
     '(2 2 2)
     (match '(1 (2) (2) (2) 5)
       [(list 1 (list a) ..3 5) a]
       [_ 'else]))
-   
+
    (comp
     #t
     (match "yes"
       ["yes" #t]
       ["no" #f]))
-   
+
    (comp 3
          (match '(1 2 3)
            [(list _ _ a) a]))
    (comp '(3 2 1)
-         (match '(1 2 3)          
-           [(list a b a) (list a b)]          
+         (match '(1 2 3)
+           [(list a b a) (list a b)]
            [(list a b c) (list c b a)]))
-   
+
    (comp '(2 '(x y z) 1)
-         (match '(1 '(x y z) 2) 
-           [(list a b a) (list a b)]          
+         (match '(1 '(x y z) 2)
+           [(list a b a) (list a b)]
            [(list a b c) (list c b a)]))
-   
+
    (comp '(1 '(x y z))
-         (match '(1 '(x y z) 1) 
-           [(list a b a) (list a b)]          
+         (match '(1 '(x y z) 1)
+           [(list a b a) (list a b)]
            [(list a b c) (list c b a)]))
-   
+
    (comp '(2 3)
          (match '(1 2 3)
            [`(1 ,a ,(? odd? b)) (list a b)]))
-   
+
    (comp '(2 1 (1 2 3 4))
-         (match-let ([(list a b) '(1 2)]                  
-                     [(vector x ...) #(1 2 3 4)])        
+         (match-let ([(list a b) '(1 2)]
+                     [(vector x ...) #(1 2 3 4)])
            (list b a x)))
-   
-   
-   
+
+
+
    (comp '(1 2 3 4)
-         (match-let* ([(list a b) '(#(1 2 3 4) 2)]                   
-                      [(vector x ...) a])   
+         (match-let* ([(list a b) '(#(1 2 3 4) 2)]
+                      [(vector x ...) a])
            x))
-   
+
    (comp 2
          (let ()
            (match-define (list a b) '(1 2))
            b))
-   
+
    (comp 'yes
          (match '(number_1 . number_2)
            [`(variable-except ,@(list vars ...))
@@ -446,7 +446,7 @@
            [(? list?)
             'no]
            [_ 'yes]))
-   
+
    (comp "yes"
          (match
              '((555))
@@ -454,7 +454,7 @@
                                 (list-no-order 555)))
             "yes")
            (_ "no"))) ;; prints "no"
-   
+
    (comp "yes"
          (match
              '((555))
@@ -462,7 +462,7 @@
                                 (list 555)))
             "yes")
            (_ "no"))) ;; prints "yes"
-   
+
    (comp "yes"
          (match
              '((555))
@@ -470,36 +470,36 @@
                        (list-no-order 555)))
             "yes")
            (_ "no"))) ;; prints "yes"
-   
+
    (comp  '("a") (match "a"  ((regexp #rx"a" x) x)))
-   (comp  '(#"a") 
+   (comp  '(#"a")
           (match #"a"
             ((regexp #rx"a" x) x)
             [_ 'no]))
-   
+
    (comp 'yes (match #"a" (#"a" 'yes)))
-   
+
    (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]) (expand #'(match-lambda ((a ?) #f))) 'no))
    (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]) (expand #'(match-lambda ((?) #f))) 'no))
-   
+
    (comp
     'yes
     (let ()
-      
+
       (m:define-match-expander exp1
                                #:plt-match
                                (lambda (stx)
                                  (syntax-case stx ()
                                    ((_match (x y))
                                     #'(list (list x y))))))
-      
+
       (m:define-match-expander exp2
                                #:plt-match
                                (lambda (stx)
                                  (syntax-case stx ()
                                    ((_match x y)
                                     #'(exp1 (x y))))))
-      
+
       (define (test tp)
         (match tp ((exp2 x y) x)))
       'yes))
@@ -510,28 +510,28 @@
          (let ()
            (define (foo x) (match x [1 (+ x x)]))
            (foo 1)))
-   
-   
+
+
    (comp 'yes
          (match (make-empt)
            [(struct empt ()) 'yes]
            [_ 'no]))
-   
+
    (comp 'yes
          (m:match (make-empt)
                   [($ empt) 'yes]
                   [_ 'no]))
-   
+
    (comp 3
          (match (mcons 1 2)
            [(mcons a b) (+ a b)]
            [_ 'no]))
-   
+
    (comp 3
          (match (mlist 1 2)
            [(mlist a b) (+ a b)]
            [_ 'no]))
-   
+
    (comp 3
          (match (mlist 1 2)
            [(mlist a ...) (apply + a)]
@@ -539,7 +539,7 @@
 
    (comp 1
          (match (box 'x) ('#&x 1) (else #f)))
-   
+
    (comp 2
          (match (vector 1 2) ('#(1 2) 2) (else #f)))
 
@@ -548,7 +548,7 @@
                          [values (lambda _ 'no)])
                 (match 1)
                 'no))
-   
+
    (comp 'yes
          (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]
                          [values (lambda _ 'no)])
@@ -560,49 +560,49 @@
                        0))))
 
    ;; raises error
-   (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)]) 
+   (comp 'yes (with-handlers ([exn:fail:syntax? (lambda _ 'yes)])
                 (expand (quote-syntax (match '(1 x 2 y 3 z)
                                         [(list-no-order 1 2 3 rest ... e) rest]
                                         [_ 'no])))
                 'no))
-   (comp '((2 4) (2 1))   
+   (comp '((2 4) (2 1))
          (match '(3 2 4 3 2 1)
-           [(list x y ... x z ...) 
+           [(list x y ... x z ...)
             (list y z)]))
 
    (comp '(1 2)
          (match-let ([(vector a b) (vector 1 2)])
                     (list a b)))
-   
+
    (comp '(4 5)
          (let-values ([(x y)
                        (match 1
                          [(or (and x 2) (and x 3) (and x 4)) 3]
                          [_ (values 4 5)])])
            (list x y)))
-   
+
    (comp 'bad
-         (match #(1) 
+         (match #(1)
            [(vector a b) a]
            [else 'bad]))
 
    (comp '(1 2)
-         (call-with-values 
-          (lambda () 
+         (call-with-values
+          (lambda ()
             (match 'foo [_ (=> skip) (skip)] [_ (values 1 2)]))
           list))
    (comp 0
          (let ([z (make-parameter 0)])
            (match 1
-             [(? number?) (=> f) (parameterize ([z 1]) (f))] 
+             [(? number?) (=> f) (parameterize ([z 1]) (f))]
              [(? number?) (z)])))
-   
+
    ;; make sure the prompts don't interfere
    (comp 12
          (%
           (let ([z (make-parameter 0)])
             (match 1
-              [(? number?) (=> f) (parameterize ([z 1]) (fcontrol 5))] 
+              [(? number?) (=> f) (parameterize ([z 1]) (fcontrol 5))]
               [(? number?) (z)]))
           (lambda _ 12)))
 
@@ -611,7 +611,7 @@
 	 (match 3
 	  [(or) 1]
 	  [_ 4]))
-   
+
    (comp '((1 2) 3)
          (match `(begin 1 2 3)
            [`(begin ,es ... ,en)
@@ -619,14 +619,14 @@
 
    (comp '(a b c)
 	 (let ()
-	   
+
 	   (define-struct foo (a b c) #:prefab)
 	   (match (make-foo 'a 'b 'c)
 		  [`#s(foo ,x ,y ,z)
 		   (list x y z)])))
    (comp '(a b c)
 	 (let ()
-	   
+
 	   (define-struct foo (a b c) #:prefab)
 	   (define-struct (bar foo) (d) #:prefab)
 	   (match (make-bar 'a 'b 'c 1)
@@ -639,11 +639,11 @@
              ([x _double*]
               [y _double*]
               [a _double*]))
-           
+
            (match (make-pose 1 2 3)
              [(struct pose (x y a)) "Gotcha!"]
              [else "Epic fail!"])))
-   
+
    (comp #f
          (match (list 'a 'b 'c)
            [(or (list a b)
@@ -653,17 +653,17 @@
                          (list a))))
             #t]
            [_ #f]))
-   
+
    (comp '(2 7)
          (let ()
            (define-match-expander foo
              (syntax-rules () [(_) 1])
-             (syntax-id-rules (set!) 
+             (syntax-id-rules (set!)
                [(set! _ v) v]
                [(_) 2]))
            (list (foo)
                  (set! foo 7))))
-   
+
    (comp 0
          (let ()
            (define-match-expander foo
@@ -672,4 +672,24 @@
              [(foo) 0]
              [_ 1])))
 
+   (comp '(1 2 4)
+         (call-with-values
+           (λ () (match-let-values ([(x y) (values 1 2)] [(3 w) (values 3 4)])
+                   (list x y w)))
+           list))
+
+   (comp '(1 3 4)
+         (call-with-values
+           (λ () (match-let*-values ([(x y) (values 1 2)] [(y w) (values 3 4)])
+                   (list x y w)))
+           list))
+
+   (comp '(1 2 3)
+         (match/values (values 1 2 3)
+           [(x y z) (list x y z)]))
+
+   (comp '(1 2)
+         (let () (match-define-values (x y 3) (values 1 2 3))
+              (list x y)))
+
 ))