[Chicken-hackers] [PATCH] Make imports faster

[megane]

Hi,

Here's a small patch that makes some things compile a lot faster.

>From d2d8dbfbb8863b7c5cc227e3f1627e9ebd067d89 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 20 Mar 2019 15:15:25 +0200
Subject: [PATCH] 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
---
 modules.scm | 27 ++++++++++++++++++---------
 1 file changed, 18 insertions(+), 9 deletions(-)

diff --git a/modules.scm b/modules.scm
index e018de5..26cf55d 100644
--- a/modules.scm
+++ b/modules.scm
@@ -294,15 +294,24 @@
                          (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
+  (define (make-hash-table #!optional _test _hash (size 301)) (make-vector 
size '()))
+  (define (hash-table-exists? t k) (and (hash-table-ref t k) #t))
+  (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-exists? 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))
-- 
2.7.4