From 1e2e38be4397a31155b33a34b9abc36e08305093 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Thu, 21 May 2009 16:36:36 +0000
Subject: [PATCH] Fix open so that it respects contracts.

svn: r14902

original commit: 732e93b9dc5a1e589af6355228ff47313682d0f4
---
 collects/mzlib/unit.ss | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index 84c81fc..54bb4a7 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -234,17 +234,23 @@
   
   
   (define-signature-form (open stx)
+    (define (build-sig-elems sig)
+      (map (λ (p c)
+             (if c #`(contracted [#,(car p) #,c]) (car p)))
+           (car sig)
+           (cadddr sig)))
     (parameterize ([error-syntax stx])
       (syntax-case stx ()
         ((_ export-spec)
          (let ([sig (process-spec #'export-spec)])
-           (with-syntax ((((int . ext) ...) (car sig))
+           (with-syntax (((sig-elem ...)
+                          (build-sig-elems sig))
                          ((renames
                            (((mac-name ...) mac-body) ...) 
                            (((val-name ...) val-body) ...))
                           (build-val+macro-defs sig)))
              (syntax->list
-              #'(int ...
+              #'(sig-elem ...
                  (define-syntaxes . renames)
                  (define-syntaxes (mac-name ...) mac-body) ...
                  (define-values (val-name ...) val-body) ...)))))