Add match-letrec-values.

Implemented by J. Ian Johnson.

Closes #762.

pkgs/racket-doc/scribblings/reference/match.scrbl

@@ -509,6 +509,10 @@ Like @racket[match-let*], but generalizes @racket[let*-values].}
 Like @racket[match-let], but generalizes @racket[letrec].}
 
 
+@defform[(match-letrec-values ([(pat ...) expr] ...) body ...+)]{
+
+Like @racket[match-let], but generalizes @racket[letrec-values].}
+ 
 @defform[(match-define pat expr)]{
 
 Defines the names bound by @racket[pat] to the values produced by

racket/collects/racket/match/define-forms.rkt

@@ -10,7 +10,7 @@
                      syntax/parse/lib/function-header))
 
 (begin-for-syntax
- (lazy-require [racket/match/patterns (bound-vars)]
+ (lazy-require [racket/match/patterns (bound-vars pats->bound-vars)]
                [racket/match/gen-match (go go/one)]))
 
 (provide define-forms)
@@ -19,14 +19,16 @@
                       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-define match-define-values
+                      match-letrec match-letrec-values
 		      match/values match/derived match*/derived
                       define/match)
   (...
    (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-define match-define-values
+              match-letrec match-letrec-values
 	      match/values match/derived match*/derived match-define-values
               define/match)
      (define-syntax (match* stx)
@@ -130,6 +132,17 @@
                                  (quasisyntax/loc c (match-define #,p #,e)))
                             body1 body ...))]))
 
+     (define-syntax (match-letrec-values stx)
+       (syntax-parse stx
+         [(_ ((~and cl [(pat ...) exp]) ...) body1 body ...)
+          (quasisyntax/loc stx
+			   (let ()
+                            #,@(for/list ([c (in-syntax #'(cl ...))]
+                                          [p (in-syntax #'((pat ...) ...))]
+                                          [e (in-syntax #'(exp ...))])
+                                 (quasisyntax/loc c (match-define-values #,p #,e)))
+                            body1 body ...))]))
+
      (define-syntax (match-define stx)
        (syntax-parse stx
          [(_ pat rhs:expr)
@@ -142,16 +155,11 @@
      (define-syntax (match-define-values stx)
        (syntax-parse stx
          [(_ (pats ...) rhs:expr)
-          (define bound-vars-list (remove-duplicates
+          (with-syntax ([(ids ...) (pats->bound-vars parse-id (syntax->list #'(pats ...)))])
-                                   (foldr (λ (pat vars)
+            (syntax/loc stx
-                                             (append (bound-vars (parse-id pat)) vars))
+              (define-values (ids ...)
-                                          '() (syntax->list #'(pats ...)))
-                                   bound-identifier=?))
-          (with-syntax ([(ids ...) (generate-temporaries #'(pats ...))])
-            (quasisyntax/loc stx
-              (define-values #,bound-vars-list
                 (match/values rhs
-                  [(pats ...) (values . #,bound-vars-list)]))))]))
+                  [(pats ...) (values ids ...)]))))]))
 
      (define-syntax (define/match stx)
        (syntax-parse stx

racket/collects/racket/match/legacy-match.rkt

@@ -17,5 +17,5 @@
 (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/values match/derived match*/derived
+  match-define match-define-values match-letrec match-letrec-values match/values match/derived match*/derived
   define/match)

racket/collects/racket/match/match.rkt

@@ -30,6 +30,6 @@
 (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/values
+  match-define match-define-values match-letrec match-letrec-values match/values
   match/derived match*/derived
   define/match)

racket/collects/racket/match/patterns.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require syntax/boundmap
-         racket/contract
+         racket/contract racket/list
          "stxtime.rkt"
          (for-syntax racket/base))
 
@@ -180,6 +180,11 @@
     [(Exact? p) null]
     [else (error 'match "bad pattern: ~a" p)]))
 
+(define (pats->bound-vars parse-id pats)
+  (remove-duplicates
+   (foldr (λ (pat vars) (append (bound-vars (parse-id pat)) vars)) '() pats)
+   bound-identifier=?))
+
 (define current-renaming (make-parameter (make-free-identifier-mapping)))
 
 (define (copy-mapping ht)