diff --git a/collects/mzlib/match.ss b/collects/mzlib/match.ss
index bdf7275..17f2d9c 100644
--- a/collects/mzlib/match.ss
+++ b/collects/mzlib/match.ss
@@ -124,460 +124,74 @@
    match-let
    match-let*
    match-letrec
-   match-define
-   match-test
+   match-define   
+   match-equality-test
    exn:misc:match?
-   exn:misc:match-value)
-
-  (require-for-syntax (lib "stx.ss" "syntax")
-                      (lib "etc.ss")
-                      (lib "list.ss")
-                      (lib "include.ss")
-                      (lib "pretty.ss")
-                      (lib "struct.ss" "syntax"))
-
-  (require (lib "etc.ss")
-           (lib "list.ss"))
-
-  (define-struct (exn:misc:match exn:fail) (value))
-
-  (define match:error
-    (case-lambda
-      ((val)
-       (raise
-        (make-exn:misc:match
-         (string->immutable-string (format "match: no matching clause for ~e" val))
-         (current-continuation-marks)
-         val)))
-      ((val expr)
-       (raise
-        (make-exn:misc:match
-         (string->immutable-string (format "match: no matching clause for ~e: ~s" val expr))
-         (current-continuation-marks)
-         val)))))
-
-  (define-syntax-set (match
-                      match-lambda
-                      match-lambda*
-                      match-let
-                      match-let*
-                      match-letrec
-                      match-define
-                      match-test
-                      m:match-test)
-
-    (include (build-path "private" "plt-match" "match-inc.scm"))
-
-    (define node-count 0)
-
-    (define (match-func-plt stx stx-orig)
-      (syntax-case stx (=>)
-        ((_ exp clause ...)
-         (quasisyntax/loc 
-          stx-orig 
-          (let ((x exp))
-            #,(gen-match (syntax x)
-                         '()
-                         (syntax (clause ...))
-                         stx-orig))))))
-    
-    (define match-lambda-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(k clause ...)
-           (quasisyntax/loc 
-             stx-orig 
-             (lambda (exp) #,(match-func
-                         (syntax/loc stx (match exp clause ...))
-                         stx-orig)))])))
-    
-    (define match-lambda*-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(k clause ...)
-           (quasisyntax/loc 
-            stx-orig 
-            (lambda exp #,(match-func
-                      (syntax/loc stx (match exp clause ...))
-                      stx-orig)))])))
-    
-    (define match-let-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(_ name () body1 body ...)
-           (syntax/loc stx-orig (let name () body1 body ...))]
-          [(_ name ([pat1 exp1] [pat exp]...) body1 body ...)
-           (identifier? (syntax name))
-           (let ((pat-list (syntax-object->datum (syntax (pat1 pat ...))))
-                 (real-name (syntax-object->datum (syntax name))))
-             (if (andmap pattern-var? pat-list)
-                 (syntax/loc 
-                   stx-orig 
-                   (let name ([pat1 exp1] [pat exp] ...) body1 body ...))
-                 (quasisyntax/loc 
-                   stx-orig
-                   (letrec ([name
-                             #,(match-lambda*-func (syntax/loc stx-orig (match-lambda* ((pat1 pat ...) body1 body ...)))
-                                              stx-orig)
-                             ])
-                     (name exp1 exp ...)))))]
-          [(_ () body1 body ...)
-           (syntax/loc stx-orig (begin body1 body...))]
-          [(_ ([pat1 exp1] [pat exp]...) body1 body ...)
-           (quasisyntax/loc 
-             stx-orig 
-             ( #,(match-lambda*-func (syntax/loc stx-orig (match-lambda* ((pat1 pat ...) body1 body ...)))
-                                stx-orig)
-              exp1 exp ...))])))
-
-    (define match-let*-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          ((_ () body body1 ...)
-           (syntax/loc stx-orig (let* () body body1 ...)))
-          ((_ ([pat exp] rest ...) body body1 ...)
-           (if (pattern-var? (syntax-object->datum (syntax pat)))
-               (quasisyntax/loc 
-                 stx-orig
-                 (let ([pat exp])
-                   #,(match-let*-func (syntax/loc stx-orig (match-let* (rest ...) body body1 ...)) stx-orig)
-                   )
-                 )
-               (match-func
-                (quasisyntax/loc
-                 stx-orig
-                 (match exp [pat #,(match-let*-func
-                                    (syntax/loc stx-orig (match-let* (rest ...) body body1 ...))
-                                    stx-orig)]))
-                stx-orig))))))
-
-    (define match-letrec-func-plt
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          ((_ () body body1 ...)
-           (syntax/loc stx (let () body body1 ...)))
-          ((_ ([pat exp] ...) body body1 ...)
-           (andmap pattern-var?
-                   (syntax-object->datum (syntax (pat ...)))) 
-           (syntax/loc stx (letrec ([pat exp] ...) body body1 ...)))
-          ((_ ([pat exp] ...) body body1 ...)
-           (let* ((**match-bound-vars** '())
-                  (compiled-match 
-                   (gen-match (syntax the-exp);(syntax (list exp ...))
-                              '()
-                              (syntax (((list pat ...) never-used)))
-                              stx-orig
-                              (lambda (sf bv)
-                                (set! **match-bound-vars** bv)
-                                (quasisyntax/loc 
-                                 stx 
-                                 (begin
-                                   #,@(map (lambda (x)
-                                             (quasisyntax/loc 
-                                              stx 
-                                              (set! #,(car x) #,(cdr x))))
-                                           (reverse bv))
-                                   body body1 ...))))))
-             (quasisyntax/loc 
-              stx-orig 
-              (letrec (#,@(map
-                           (lambda (x) (quasisyntax/loc stx (#,(car x) #f)))
-                           (reverse **match-bound-vars**))
-                       (the-exp (list exp ...)))
-                #,compiled-match)))))))
-
-    (define match-define-func-plt
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(_ pat exp)
-           (identifier? (syntax pat))
-           (syntax/loc stx-orig (begin (define pat exp)))]
-          [(_ pat exp)
-           (let* ((**match-bound-vars** '())
-                  (compiled-match
-                   (gen-match (syntax the-exp)
-                              '()
-                              (syntax/loc (syntax pat) ((pat never-used)))
-                              stx-orig
-                              (lambda (sf bv)
-                                (set! **match-bound-vars** bv)
-                                (quasisyntax/loc 
-                                 stx-orig 
-                                 (begin
-                                   #,@(map (lambda (x)
-                                             (quasisyntax/loc 
-                                              stx-orig
-                                              (set! #,(car x) #,(cdr x))))
-                                           (reverse bv))))))))
-             (quasisyntax/loc stx-orig
-                              (begin #,@(map
-                                         (lambda (x) (quasisyntax/loc 
-                                                      stx 
-                                                      (define #,(car x) #f)))
-                                         (reverse **match-bound-vars**))
-                                     (let ((the-exp exp))
-                                       #,compiled-match))))])))
-    
-    ;; these are the translators
-    (define m:match-test/proc 
-      (lambda (stx)
-        (syntax-case stx (=>)
-          ((_ clause ...)
-           (begin
-             (set! node-count 0)
-              (let-values (((stx t rt gc) (time-apply gen-match 
-                                   (list (syntax x)
-                                         '()
-                                         (syntax (clause ...))
-                                         stx))))
-                #`(list ; (let ((dat-struct (seconds->date (current-seconds))))
-                        ;         (list (date-month dat-struct)
-                        ;              (date-day dat-struct)
-                        ;           (date-year dat-struct)));
-                        ;           (list #,@(get-date)) 
-                        #,node-count
-                        #,rt)))))))
-
-    (define match-test/proc
-      (lambda (stx)
-        (syntax-case stx ()
-          ((_ clause ...)
-           (quasisyntax/loc 
-            stx 
-            (m:match-test  
-             #,@(map handle-clause 
-                     (syntax-e (syntax (clause ...))))))))))
-
-    (define match/proc 
-      (lambda (stx)
-        (match-func stx stx)))
-    
-    (define match-lambda/proc
-      (lambda (stx)
-        (match-lambda-func stx stx)))
-
-    (define match-lambda*/proc
-      (lambda (stx)
-        (match-lambda*-func stx stx))) 
-    
-    (define match-let/proc
-      (lambda (stx)
-        (match-let-func stx stx)))
-    
-    (define match-let*/proc
-      (lambda (stx)
-        (match-let*-func stx stx)))
-
-    (define match-letrec/proc
-      (lambda (stx)
-        (match-letrec-func stx stx)))
-
-    (define match-define/proc
-      (lambda (stx)
-        (match-define-func stx stx)))
-
-   (define match-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          ((_ exp clause ...)
-            (match-func-plt
-             (quasisyntax/loc
-              stx-orig
-              (match exp 
-                     #,@(map handle-clause 
-                             (syntax-e (syntax (clause ...))))))
-             stx-orig)))))
-
-    (define match-letrec-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          ((_ () body body1 ...)
-           (syntax/loc stx (let () body body1 ...)))
-          ((_ ([pat exp] ...) body body1 ...)
-           (andmap pattern-var?
-                   (syntax-object->datum (syntax (pat ...))))
-           (syntax/loc stx (letrec ([pat exp] ...) body body1 ...)))
-          ((_ ([pat exp] ...) body body1 ...)
-           (match-letrec-func-plt
-            (quasisyntax/loc
-             stx
-             (match-letrec #,(map 
-                              handle-let-clause 
-                              (syntax->list (syntax ([pat exp] ...))))
-                           body body1 ...))
-            stx-orig)))))
-           
-
-    (define match-define-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(_ pat exp)
-           (identifier? (syntax pat))
-           (syntax/loc stx (begin (define pat exp)))]
-          [(_ pat exp)
-           (match-define-func-plt
-            (quasisyntax/loc
-             stx-orig
-             (match-define #,(convert-pat (syntax pat)) exp))
-            stx-orig)])))
-            
-
-
-    ;; these functions convert the patterns from the old syntax 
-    ;; to the new syntax
-    (define (handle-let-clause stx)
-      (syntax-case stx ()
-        ((pat exp)
-         (quasisyntax/loc
-          stx
-          (#,(convert-pat (syntax pat)) exp)))))
-
-    (define handle-clause
-      (lambda (stx)
-        (syntax-case stx (=>)
-          ((pat (=> id) expr ...)
-           (quasisyntax/loc 
-            stx 
-            (#,(convert-pat (syntax pat)) (=> id) expr ...)))
-          ((pat expr ...)
-           (quasisyntax/loc 
-            stx 
-            (#,(convert-pat (syntax pat)) expr ...))))))
-
-
-    (define (convert-pat stx)
-      (define (imp-list? x)
-        (define (keyword? x)
-          (member (syntax-object->datum x)
-                  '(
-                    quote
-                    quasiquote
-                    ?
-                    =
-                    and
-                    or
-                    not
-                    $
-                    set!
-                    get!
-                    ;unquote
-                    ;unquote-splicing
-                    )))
-        (let/ec out
-          (let loop ((x x))
-            (cond ((null? x) (out #f))
-                  ((or (not (pair? x))
-                       (and (list? x)
-                            (keyword? (car x)))) 
-                   (list 
-                    (quasisyntax/loc stx #,x)))
-                  (else (cons (car x) (loop (cdr x))))))))
-      (define stx-equal? 
-        (lambda (a b)
-          (equal? (syntax-object->datum a)
-                  (syntax-object->datum b))))
-      (define (convert-quasi stx)
-        (syntax-case stx (unquote quasiquote unquote-splicing)
-          (,pat
-           (quasisyntax/loc stx ,#,(convert-pat (syntax pat))))
-          (,@pat
-           (quasisyntax/loc stx ,@#,(convert-pat (syntax pat))))
-          ((x . y)
-           (quasisyntax/loc 
-            stx (#,(convert-quasi (syntax x)) . #,(convert-quasi (syntax y)))))
-          (pat
-           (vector? (syntax-e stx))
-           (quasisyntax/loc 
-            stx 
-            #,(list->vector (map convert-quasi 
-                                 (vector->list (syntax-e stx))))))
-          (pat
-           (box? (syntax-e stx))
-           (quasisyntax/loc 
-            stx #,(box (convert-quasi (unbox (syntax-e stx))))))
-          (pat stx)))
-      ;(write (syntax-object->datum stx))(newline)
-      (syntax-case* 
-       stx
-       (_ ? = and or not $ set! get! quasiquote 
-          quote unquote unquote-splicing) stx-equal?
-          (p
-           (dot-dot-k? (syntax-object->datum (syntax p)))
-           stx)
-          (_ stx)
-          (() (quasisyntax/loc stx (list)))
-          ('() (quasisyntax/loc stx (list)))
-          ('item stx)
-          (p
-           (let ((old-pat (syntax-object->datum stx)))
-             (or (string? old-pat)
-                 (boolean? old-pat)
-                 (char? old-pat)
-                 (number? old-pat)))
-           stx)
-          ((? pred)
-           stx)
-          ((? pred a ...)
-           (quasisyntax/loc
-            stx
-            (? pred #,@(map convert-pat 
-                            (syntax-e (syntax (a ...)))))))
-          (`pat
-           (quasisyntax/loc stx `#,(convert-quasi (syntax pat))))
-          ((= op pat)
-           (quasisyntax/loc
-            stx
-            (app op #,(convert-pat (syntax pat)))))
-          ((and pats ...)
-           (quasisyntax/loc
-            stx
-            (and #,@(map convert-pat 
-                         (syntax-e (syntax (pats ...)))))))
-          ((or pats ...)
-           (quasisyntax/loc
-            stx
-            (or #,@(map convert-pat 
-                        (syntax-e (syntax (pats ...)))))))
-          ((not pat)
-           (quasisyntax/loc
-            stx
-            (not #,(convert-pat (syntax pat)))))
-          (($ struct-name fields ...)
-           (quasisyntax/loc
-            stx
-            (struct struct-name 
-                    #,(map convert-pat 
-                           (syntax-e (syntax (fields ...)))))))
-          ((get! id)
-           stx)
-          ((set! id)
-           stx)
-          ((quote p) stx)
-          ((car-pat . cdr-pat)
-           (let ((l (imp-list? (syntax-e stx))))
-             (if l
-                 (quasisyntax/loc 
-                  stx (list-rest #,@(map convert-pat l)))
-                 (quasisyntax/loc 
-                  stx (list #,@(map convert-pat (syntax-e stx)))))))
-          (pt
-           (vector? (syntax-object->datum stx))
-           (quasisyntax/loc 
-            stx 
-            (vector #,@(map convert-pat 
-                            (vector->list (syntax-e stx))))))
-          (pt
-           (box? (syntax-e stx))
-           (quasisyntax/loc 
-            stx 
-            (box #,(convert-pat (unbox (syntax-e stx))))))
-          (pt
-           (identifier? stx)
-           stx)
-          (got-too-far 
-           (match:syntax-err
-            (syntax/loc stx got-too-far)
-            "syntax error in pattern"))))
-    )
+   exn:misc:match-value
+   define-match-expander)
+  
+  (require-for-syntax "private/convert-pat.ss"
+                      "private/match-helper.ss")
+  
+  (require-for-template mzscheme  (prefix plt: "private/match-internal-func.ss"))
+                      
+  (require  (prefix plt: "private/match-internal-func.ss")
+   "private/match-expander.ss"
+   "private/match-helper.ss"
+   "private/match-error.ss")
+  
+  (define-syntax (match-lambda stx)
+    (syntax-case stx ()
+      [(k clause ...)
+       (with-syntax ([(new-clauses ...) (handle-clauses #'(clause ...))]) 
+          #'(plt:match-lambda new-clauses ...))]))
+  
+  (define-syntax (match-lambda* stx)
+    (syntax-case stx ()
+      [(k clause ...)
+       (with-syntax ([(new-clauses ...) (handle-clauses #'(clause ...))])
+         #'(plt:match-lambda* new-clauses ...))]))
+  
+  (define-syntax (match-let stx)
+    (syntax-case stx ()
+      [(k name (clauses ...) body ...)
+       (identifier? (syntax name))
+       (with-syntax ([(new-clauses ...) (handle-clauses #'(clauses ...))])
+          #'(plt:match-let name (new-clauses ...) body ...))]          
+      [(k (clauses ...) body ...)
+       (with-syntax ([(new-clauses ...) (handle-clauses #'(clauses ...))])
+          #'(plt:match-let (new-clauses ...) body ...))]))          
+  
+  (define-syntax (match-let* stx)
+    (syntax-case stx ()
+      [(k (clauses ...) body ...)
+       (with-syntax
+           ([(new-clauses ...) (handle-clauses #'(clauses ...))])
+         #'(plt:match-let* (new-clauses ...) body ...))]))
+  
+  (define-syntax (match stx)
+    (syntax-case stx ()
+      [(_ exp clause ...)
+       (with-syntax 
+           ([(new-clauses ...) (handle-clauses #'(clause ...))])
+         #'(plt:match exp new-clauses ...))]))
+  
+  (define-syntax (match-letrec stx)
+    (syntax-case stx ()
+      [(k (clauses ...) body ...)
+       (with-syntax 
+           ([(new-clauses ...) (handle-clauses #'(clauses ...))])
+         #'(plt:match-letrec (new-clauses ...) body ...))]))
 
+  
+  (define-syntax (match-define stx)
+    (syntax-case stx ()
+      [(k pat exp)
+       (with-syntax ([new-pat (convert-pat #'pat)])
+         #'(plt:match-define new-pat exp))]))
+  
+  
+  
   )
+
+
diff --git a/collects/mzlib/plt-match.ss b/collects/mzlib/plt-match.ss
index 1d6fb60..9d069aa 100644
--- a/collects/mzlib/plt-match.ss
+++ b/collects/mzlib/plt-match.ss
@@ -138,308 +138,21 @@
    match-let*
    match-letrec
    match-define
-   match-test
    match:test-no-order
    pregexp-match-with-error
    exn:misc:match?
-   exn:misc:match-value) 
+   exn:misc:match-value
+   match-equality-test
+   define-match-expander) 
   
-  (require-for-syntax (lib "stx.ss" "syntax")
-                      (lib "etc.ss")
-                      (lib "list.ss")
-                      (lib "include.ss")
-                      (lib "struct.ss" "syntax")
-                      (lib "pretty.ss"))
-  (require (lib "pregexp.ss")
-           (lib "etc.ss")
-           (lib "list.ss"))
+  (require "private/match-internal-func.ss"
+           "private/match-expander.ss"
+           "private/match-helper.ss"
+           "private/match-error.ss"
+           "private/render-helpers.ss")
   
-  ;; this makes pregexp errors a little more friendly
-  (define (pregexp-match-with-error regex str)
-    (if (or (string? regex)
-            (and (pair? regex)
-                 (equal? ':sub (car regex))))
-        (pregexp-match regex str)
-        (error 'match:pregex 
-               (string-append 
-                "this pattern expects either a S-regexp or a U-regexp,"
-                " given " (format "~s" regex) "; "
-                "other argument was " (format "~s" str)))))
-
-  (define-struct (exn:misc:match exn:fail) (value))
-  
-  (define match:error
-    (case-lambda
-      ((val)
-       (raise
-        (make-exn:misc:match
-         (string->immutable-string (format "match: no matching clause for ~e" val))
-         (current-continuation-marks)
-         val)))
-      ((val expr)
-       (raise
-        (make-exn:misc:match
-         (string->immutable-string (format "match: no matching clause for ~e: ~s" val expr))
-         (current-continuation-marks)
-         val)))))
-  
-  (define-syntax-set (match
-                      match-lambda
-                      match-lambda*
-                      match-let
-                      match-let*
-                      match-letrec
-                      match-define
-                      match-test
-                      )
-
-    (include (build-path "private" "plt-match" "match-inc.scm"))
-
-    (define node-count 0)
-
-
-    ;;!(syntax match-test)
-    ;; This macro only returns a list of two numbers.  
-    ;; The first number represents the
-    ;; number of nodes generated in the process of compiling the match 
-    ;; expression.  This gives one and idea as to the size of the 
-    ;; compiled expression.  
-    ;; The second number is the amount of "real" time in milliseconds 
-    ;; it took to compile the patterns.
-    (define match-test/proc 
-      (lambda (stx)
-        (syntax-case stx (=>)
-          ((_ clause ...)
-           (begin
-             (set! node-count 0)
-              (let-values (((stx t rt gc) (time-apply gen-match 
-                                   (list (syntax x)
-                                         '()
-                                         (syntax (clause ...))
-                                         stx))))
-                #`(list #,(add1 node-count)
-                        #,rt)))))))
+  )
 
 
 
-    (define (match-func stx stx-orig)
-      (syntax-case stx (=>)
-        ((_ exp clause ...)
-         (quasisyntax/loc 
-          stx 
-          (let ((x exp))
-            #,(gen-match (syntax x)
-                         '()
-                         (syntax (clause ...))
-                         stx-orig))))))
-    
-    (define match-lambda-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(k clause ...)
-           (quasisyntax/loc 
-             stx 
-             (lambda (exp) #,(match-func
-                         (syntax/loc stx (match exp clause ...))
-                         stx-orig)))])))
-    
-    (define match-lambda*-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(k clause ...)
-           (quasisyntax/loc 
-            stx 
-            (lambda exp #,(match-func
-                      (syntax/loc stx (match exp clause ...))
-                      stx-orig)))])))
-    
-    (define match-let-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(_ name () body1 body ...)
-           (syntax/loc stx (let name () body1 body ...))]
-          [(_ name ([pat1 exp1] [pat exp]...) body1 body ...)
-           (identifier? (syntax name))
-           (let ((pat-list (syntax-object->datum (syntax (pat1 pat ...))))
-                 (real-name (syntax-object->datum (syntax name))))
-             (if (andmap pattern-var? pat-list)
-                 (syntax/loc 
-                   stx 
-                   (let name ([pat1 exp1] [pat exp] ...) body1 body ...))
-                 (quasisyntax/loc 
-                   stx
-                   (letrec ([name
-                             #,(match-lambda*-func (syntax/loc stx (match-lambda* ((list pat1 pat ...) body1 body ...)))
-                                              stx-orig)
-                             ])
-                     (name exp1 exp ...)))))]
-          [(_ () body1 body ...)
-           (syntax/loc stx (begin body1 body...))]
-          [(_ ([pat1 exp1] [pat exp]...) body1 body ...)
-           (quasisyntax/loc 
-             stx 
-             ( #,(match-lambda*-func (syntax/loc stx (match-lambda* ((list pat1 pat ...) body1 body ...)))
-                                stx-orig)
-              exp1 exp ...))])))
-
-    (define match-let*-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          ((_ () body body1 ...)
-           (syntax/loc stx (let* () body body1 ...)))
-          ((_ ([pat exp] rest ...) body body1 ...)
-           (if (pattern-var? (syntax-object->datum (syntax pat)))
-               (quasisyntax/loc 
-                 stx 
-                 (let ([pat exp])
-                   #,(match-let*-func (syntax (match-let* (rest ...) body body1 ...)) stx-orig)
-                   )
-                 )
-               (match-func
-                (quasisyntax/loc
-                 stx
-                 (match exp [pat #,(match-let*-func
-                                    (syntax (match-let* (rest ...) body body1 ...))
-                                    stx-orig)]))
-                stx-orig))))))
-
-    (define match-letrec-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          ((_ () body body1 ...)
-           (syntax/loc stx (let () body body1 ...)))
-          ((_ ([pat exp] ...) body body1 ...)
-           (andmap pattern-var?
-                   (syntax-object->datum (syntax (pat ...)))) 
-           (syntax/loc stx (letrec ([pat exp] ...) body body1 ...)))
-          ((_ ([pat exp] ...) body body1 ...)
-           (let* ((**match-bound-vars** '())
-                  (compiled-match 
-                   (gen-match (syntax the-exp);(syntax (list exp ...))
-                              '()
-                              (syntax (((list pat ...) never-used)))
-                              stx-orig
-                              (lambda (sf bv)
-                                (set! **match-bound-vars** bv)
-                                (quasisyntax/loc 
-                                 stx 
-                                 (begin
-                                   #,@(map (lambda (x)
-                                             (quasisyntax/loc 
-                                              stx 
-                                              (set! #,(car x) #,(cdr x))))
-                                           (reverse bv))
-                                   body body1 ...))))))
-             (quasisyntax/loc 
-              stx 
-              (letrec (#,@(map
-                           (lambda (x) (quasisyntax/loc stx (#,(car x) #f)))
-                           (reverse **match-bound-vars**))
-                       (the-exp (list exp ...)))
-                #,compiled-match)))))))
-
-    (define match-define-func
-      (lambda (stx stx-orig)
-        (syntax-case stx ()
-          [(_ pat exp)
-           (identifier? (syntax pat))
-           (syntax/loc stx (begin (define pat exp)))]
-          [(_ pat exp)
-           (let* ((**match-bound-vars** '())
-                  (compiled-match
-                   (gen-match (syntax the-exp)
-                              '()
-                              (syntax/loc (syntax pat) ((pat never-used)))
-                              stx-orig
-                              (lambda (sf bv)
-                                (set! **match-bound-vars** bv)
-                                (quasisyntax/loc 
-                                 stx 
-                                 (begin
-                                   #,@(map (lambda (x)
-                                             (quasisyntax/loc 
-                                              stx
-                                              (set! #,(car x) #,(cdr x))))
-                                           (reverse bv))))))))
-             (quasisyntax/loc stx
-                              (begin #,@(map
-                                         (lambda (x) (quasisyntax/loc 
-                                                      stx 
-                                                      (define #,(car x) #f)))
-                                         (reverse **match-bound-vars**))
-                                     (let ((the-exp exp))
-                                       #,compiled-match))))])))
-    (define match/proc 
-      (lambda (stx)
-        (match-func stx stx)))
-    
-    (define match-lambda/proc
-      (lambda (stx)
-        (match-lambda-func stx stx)))
-
-    (define match-lambda*/proc
-      (lambda (stx)
-        (match-lambda*-func stx stx))) 
-    
-    (define match-let/proc
-      (lambda (stx)
-        (match-let-func stx stx)))
-    
-    (define match-let*/proc
-      (lambda (stx)
-        (match-let*-func stx stx)))
-
-    (define match-letrec/proc
-      (lambda (stx)
-        (match-letrec-func stx stx)))
-
-    (define match-define/proc
-      (lambda (stx)
-        (match-define-func stx stx)))
-
-    )
-  
-  ;;!(function match:test-no-order 
-  ;;          (form (match:test-no-order tests l last-test ddk-num)
-  ;;                -> 
-  ;;                bool)
-  ;;          (contract (list list test integer) -> bool))
-  ;; This is a recursive depth first search for a sequence of
-  ;; items in list l which will satisfy all of the tests in list
-  ;; tests.  This is used for list-no-order and hash-table patterns.
-  ;; This function also handles ddk patterns by passing it the last
-  ;; test before the ddk and the value of k.
-  (define (match:test-no-order tests l last-test ddk-num)
-    (define (handle-last-test test l)
-      (and (>= (length l) ddk-num) 
-           (andmap test l)))
-    (define (dep-first-test head rest tests)
-      (cond ((null? tests) 
-             (if last-test 
-                 (handle-last-test last-test (cons head rest)) 
-                 #f))
-            ((null? rest)
-             (if last-test
-                 (and (= 0 ddk-num)
-                      (= 1 (length tests))
-                      ((car tests) head))
-                 (and (= 1 (length tests))
-                      ((car tests) head))))
-            (else (and (pair? tests)
-                       ((car tests) head)
-                       (match:test-no-order (cdr tests) 
-                                            rest 
-                                            last-test 
-                                            ddk-num)))))
-    (let loop ((lst l))
-      (if (null? lst) 
-          #f
-          (or (dep-first-test (car lst) (remove (car lst) l) tests)
-              (loop (cdr lst))))))
-
-
-)
-                                 
-                                 
-