~ chicken-core (chicken-5) 2853220c6b18ca4bb9afb3cace0b9d9c647102ea

commit 2853220c6b18ca4bb9afb3cace0b9d9c647102ea
Author:     megane <meganeka@gmail.com>
AuthorDate: Wed Mar 20 15:15:25 2019 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sun Mar 24 19:49:55 2019 +0100

    Make imports faster
    
    Importing modules with many identifiers (e.g. wrappers for GL
    libraries) most of the time is spent merging the environments in
    merge-se.
    
    * modules.scm (merge-se): Use hash-tables to get O(n) instead of O(n^2) behaviour
    
    Signed-off-by: Kooda <kooda@upyum.com>
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/internal.scm b/internal.scm
index 4594f23e..605a72ad 100644
--- a/internal.scm
+++ b/internal.scm
@@ -50,7 +50,7 @@
     macro-subset fixup-macro-environment
 
     ;; Low-level hash table support
-    hash-table-ref hash-table-set! hash-table-update!
+    make-hash-table hash-table-ref hash-table-set! hash-table-update!
     hash-table-for-each hash-table-size
 
     ;; Modules that are made available to code by default
@@ -174,6 +174,9 @@
 	    (set! cache-h (##core#inline "C_u_i_string_hash" (##sys#slot s 1) rand))
 	    (##core#inline "C_fixnum_modulo" cache-h n))))))
 
+(define (make-hash-table #!optional (size 301))
+  (make-vector size '()))
+
 (define (hash-table-ref ht key)
   (let loop ((bucket (##sys#slot ht (hash-symbol key (##core#inline "C_block_size" ht)))))
     (and (not (eq? '() bucket))
diff --git a/modules.scm b/modules.scm
index e018de5f..debe15c5 100644
--- a/modules.scm
+++ b/modules.scm
@@ -294,15 +294,22 @@
 			  (warn "indirect export of unknown binding" (car iexports))
 			  (loop2 (cdr iexports)))))))))))
 
-(define (merge-se . ses)		; later occurrences take precedence
-  (let bwd ((ses (remove null? ses)))
-    (cond ((null? ses) '())
-	  ((null? (cdr ses)) (car ses))	; Do not re-cons the final list
-	  (else (let fwd ((se (car ses))
-			  (rest (bwd (cdr ses))))
-		  (cond ((null? se) rest)
-			((assq (caar se) rest) (fwd (cdr se) rest))
-			(else (cons (car se) (fwd (cdr se) rest)))))))))
+(define (merge-se . ses*) ; later occurrences take precedence to earlier ones
+  (let ((seen (make-hash-table)) (rses (reverse ses*)))
+    (let loop ((ses (cdr rses)) (last-se #f) (se2 (car rses)))
+      (cond ((null? ses) se2)
+	    ((or (eq? last-se (car ses)) (null? (car ses)))
+	     (loop (cdr ses) last-se se2))
+	    ((not last-se)
+	     (unless (null? ses)
+	       (for-each (lambda (e) (hash-table-set! seen (car e) #t)) se2))
+	     (loop ses se2 se2))
+	    (else (let lp ((se (car ses)) (se2 se2))
+		    (cond ((null? se) (loop (cdr ses) (car ses) se2))
+			  ((hash-table-ref seen (caar se))
+			   (lp (cdr se) se2))
+			  (else (hash-table-set! seen (caar se) #t)
+				(lp (cdr se) (cons (car se) se2))))))))))
 
 (define (##sys#compiled-module-registration mod)
   (let ((dlist (module-defined-list mod))