From a4bc5b89951b97df30db7b49474d1ae11105056b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 22 Jun 2005 21:31:11 +0000
Subject: [PATCH] match phase clean-up and minor contract-expansion improvement

svn: r232

original commit: e4a71a9b3c0975ce37000e7c971a143379b72182
---
 collects/mzlib/contract.ss  | 43 +++++++++++++++++++------------------
 collects/mzlib/match.ss     | 11 +++++-----
 collects/mzlib/plt-match.ss |  4 +---
 3 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index 185ade7..0ecd64b 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -2516,17 +2516,18 @@ add struct contracts for immutable structs?
   (define-syntax (coerce/select-contract stx)
     (syntax-case stx ()
       [(_ name val)
-       (syntax
-        (let ([x val])
-          (cond
-            [(contract? x)
-             (contract-proc x)]
-            [(and (procedure? x) (procedure-arity-includes? x 1))
-             (contract-proc (flat-contract x))]
-            [else
-             (error 'name 
-                    "expected contract or procedure of arity 1, got ~e"
-                    x)])))]))
+       (syntax (coerce/select-contract/proc 'name val))]))
+
+  (define (coerce/select-contract/proc name x)
+    (cond
+     [(contract? x)
+      (contract-proc x)]
+     [(and (procedure? x) (procedure-arity-includes? x 1))
+      (contract-proc (flat-contract x))]
+     [else
+      (error name 
+	     "expected contract or procedure of arity 1, got ~e"
+	     x)]))
   
   ;; coerce-contract : id (union contract? procedure-arity-1) -> contract
   ;; contract-proc = sym sym stx -> alpha -> alpha
@@ -2535,17 +2536,17 @@ add struct contracts for immutable structs?
   (define-syntax (coerce-contract stx)
     (syntax-case stx ()
       [(_ name val)
-       (syntax
-        (let ([x val])
-          (cond
-            [(contract? x) x]
-            [(and (procedure? x) (procedure-arity-includes? x 1))
-             (flat-contract x)]
-            [else
-             (error 'name 
-                    "expected contract or procedure of arity 1, got ~e"
-                    x)])))]))
+       (syntax (coerce-contract/proc 'name val))]))
 
+  (define (coerce-contract/proc name x)
+    (cond
+     [(contract? x) x]
+     [(and (procedure? x) (procedure-arity-includes? x 1))
+      (flat-contract x)]
+     [else
+      (error name 
+             "expected contract or procedure of arity 1, got ~e"
+              x)]))
 
 ;                                                                                                   
 ;                                                                                                   
diff --git a/collects/mzlib/match.ss b/collects/mzlib/match.ss
index 17f2d9c..6142238 100644
--- a/collects/mzlib/match.ss
+++ b/collects/mzlib/match.ss
@@ -130,15 +130,16 @@
    exn:misc:match-value
    define-match-expander)
   
+  ;; FIXME: match-helper and match-error should each be split
+  ;; into a compile-time part and a run-time part.
+
   (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")
+	    "private/match-expander.ss"
+	    "private/match-helper.ss"
+	    "private/match-error.ss")
   
   (define-syntax (match-lambda stx)
     (syntax-case stx ()
diff --git a/collects/mzlib/plt-match.ss b/collects/mzlib/plt-match.ss
index 9d069aa..c733ac1 100644
--- a/collects/mzlib/plt-match.ss
+++ b/collects/mzlib/plt-match.ss
@@ -138,7 +138,6 @@
    match-let*
    match-letrec
    match-define
-   match:test-no-order
    pregexp-match-with-error
    exn:misc:match?
    exn:misc:match-value
@@ -148,8 +147,7 @@
   (require "private/match-internal-func.ss"
            "private/match-expander.ss"
            "private/match-helper.ss"
-           "private/match-error.ss"
-           "private/render-helpers.ss")
+           "private/match-error.ss")
   
   )