From dba74f8f15c36dbacb0c18ee7a71dcf693d3969c Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Sat, 14 Feb 2009 02:33:15 +0000
Subject: [PATCH] Make a table of the original imports these came from for easy
 lookup.  This way we can actually bind only the identifiers which were in the
 original signature over the contract.

svn: r13567
---
 collects/mzlib/unit.ss | 20 +++++++++-----------
 1 file changed, 9 insertions(+), 11 deletions(-)

diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index a9a8d49ad5..3c1720252a 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -661,11 +661,7 @@
         target-import-sigs)
       (define def-table (make-bound-identifier-mapping))
       (define ctc-table (make-bound-identifier-mapping))
-      (define sig-of-all-import-sigs
-        (list (apply append (map car import-sigs))
-              (apply append (map cadr import-sigs))
-              (apply append (map caddr import-sigs))
-              (apply append (map cadddr import-sigs))))
+      (define sig-table (make-bound-identifier-mapping))
       (for-each
        (lambda (tagged-info sig)
          (define v
@@ -677,7 +673,10 @@
                                            #`(vector-ref #,v #,index))
             (bound-identifier-mapping-put! ctc-table
                                            (car int/ext-name)
-                                           ctc))
+                                           ctc)
+            (bound-identifier-mapping-put! sig-table
+                                           (car int/ext-name)
+                                           sig))
           (car sig)
           (iota (length (car sig)))
           (cadddr sig)))
@@ -686,10 +685,6 @@
       (with-syntax ((((eloc ...) ...) 
                      (map
                       (lambda (target-sig)
-                        (define rename-bindings
-                          (get-member-bindings def-table 
-                                               sig-of-all-import-sigs 
-                                               #'(current-contract-region)))
                         (map
                          (lambda (target-int/ext-name target-ctc)
                            (let* ([var (car target-int/ext-name)]
@@ -703,7 +698,10 @@
                                                   "identifier ~a is not present in new imports"
                                                   "identifier ~a is not present in old exports")
                                               (syntax-e (car target-int/ext-name))))))]
-                                  [ctc (bound-identifier-mapping-get ctc-table var)])
+                                  [ctc (bound-identifier-mapping-get ctc-table var)]
+                                  [rename-bindings (get-member-bindings def-table
+                                                                        (bound-identifier-mapping-get sig-table var)
+                                                                        #'(current-contract-region))])
                              (if (or target-ctc ctc)
                                  #`(cons
                                     (λ ()