From 112e00a6e607dfcc7b94c3da0cd1fc56d6a6f33f Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Thu, 13 Dec 2007 06:15:21 -0500
Subject: [PATCH] get-import-spec* now uses an eq-hash-table to detect most
 dups.

---
 scheme/last-revision       |  2 +-
 scheme/psyntax.expander.ss | 34 ++++++++++++++++++++++++----------
 2 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/scheme/last-revision b/scheme/last-revision
index 7b6369b..9853791 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1237
+1238
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index f8596c9..8802d11 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -2976,6 +2976,8 @@
   ;;; returns: ((z . z$label) (y . x$label) (q . q$label))
   ;;;     and  (#<library (foo)> #<library (bar)>)
   (define (parse-import-spec* imp*)
+    (define (dup-error name)
+      (error 'import "two imports with different bindings" name))
     (define (merge-substs s subst)
       (define (insert-to-subst a subst)
         (let ((name (car a)) (label (cdr a)))
@@ -2984,10 +2986,7 @@
              (lambda (x)
                (cond
                  ((eq? (cdr x) label) subst)
-                 (else
-                  (error 'import
-                     "two imports with different bindings"
-                     name)))))
+                 (else (dup-error name)))))
             (else
              (cons a subst)))))
       (cond
@@ -3090,8 +3089,11 @@
     (define (get-import spec)
       (syntax-match spec ()
         ((rename isp (old* new*) ...) 
-         (and (eq? rename 'rename) (for-all symbol? old*) (for-all symbol? new*))
+         (and (eq? rename 'rename) 
+              (for-all symbol? old*) 
+              (for-all symbol? new*))
          (let ((subst (get-import isp)))
+           ;;; rewrite this to eliminate find* and rem* and merge
            (let ((old-label* (find* old* subst)))
              (let ((subst (rem* old* subst)))
                ;;; FIXME: make sure map is valid
@@ -3139,14 +3141,26 @@
          (not (memq x '(rename except only prefix library)))
          (get-import `(library (,x . ,x*))))
         (spec (error 'import "invalid import spec" spec))))
-    (let f ((imp* imp*) (subst '()))
+    (define (add-imports! imp h)
+      (let ([subst (get-import imp)])
+        (for-each
+          (lambda (x) 
+            (let ([name (car x)] [label (cdr x)])
+              (cond
+                [(hashtable-ref h name #f) =>
+                 (lambda (l)
+                   (unless (eq? l label) 
+                     (dup-error name)))]
+                [else 
+                 (hashtable-set! h name label)])))
+          subst)))
+    (let f ((imp* imp*) (h (make-eq-hashtable)))
       (cond
         ((null? imp*) 
-         (values
-           (list->vector (map car subst))
-           (list->vector (map cdr subst))))
+         (hashtable-entries h))
         (else
-         (f (cdr imp*) (merge-substs (get-import (car imp*)) subst))))))
+         (add-imports! (car imp*) h)
+         (f (cdr imp*) h)))))
 
   ;;; a top rib is constructed as follows:
   ;;; given a subst: name* -> label*,