~ chicken-core (chicken-5) 7f4200526af79d47fa84738bb4b0e712767a14ac

commit 7f4200526af79d47fa84738bb4b0e712767a14ac
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Fri Apr 27 13:15:08 2018 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Apr 28 23:20:48 2018 +0200

    Speed up compiled module registration by avoid unnecessary work
    
    The merge-se calls are still of quadratic complexity, but we can avoid
    doing a lot of the work when there are no macros exported by a module,
    since we do not need to patch up any syntax environments.
    
    Also avoid consing up a full list if all syntax environments are
    empty; we can just use that one list.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/modules.scm b/modules.scm
index f8a00553..c450e525 100644
--- a/modules.scm
+++ b/modules.scm
@@ -295,14 +295,14 @@
 			  (loop2 (cdr iexports)))))))))))
 
 (define (merge-se . ses)		; later occurrences take precedence
-  (let bwd ((ses ses))
-    (if (null? ses)
-	'()
-	(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))))))))
+  (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 (##sys#compiled-module-registration mod)
   (let ((dlist (module-defined-list mod))
@@ -368,10 +368,13 @@
 		 (list (car ne) #f (##sys#ensure-transformer (cdr ne) (car ne))))
 	       sdefs))
 	 (mod (make-module name lib '() vexports sexps iexports))
-	 (senv (merge-se 
-		(##sys#macro-environment)
-		(##sys#current-environment)
-		iexports vexports sexps nexps)))
+	 (senv (if (or (not (null? sexps))  ; Only macros have an senv
+		       (not (null? nexps))) ; which must be patched up
+		   (merge-se
+		    (##sys#macro-environment)
+		    (##sys#current-environment)
+		    iexports vexports sexps nexps)
+		   '())))
     (for-each
      (lambda (sexp)
        (set-car! (cdr sexp) (merge-se (or (cadr sexp) '()) senv)))