~ chicken-core (chicken-5) a3c4c45e7d7467bd24c089476ff4f7d98e7b638f


commit a3c4c45e7d7467bd24c089476ff4f7d98e7b638f
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Thu Nov 9 18:27:37 2017 +1300
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sat Nov 11 16:04:00 2017 +0100

    Omit internal modules from modules.db
    
    The chicken.internal namespace is "private" and not meant for user code,
    so avoid suggesting that people import if when they use an identifier
    that happens to be defined there (e.g. 'hash-table-ref').
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/chicken-install.scm b/chicken-install.scm
index 9c2ba068..09580d35 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -55,6 +55,7 @@
 (define +status-file+ "STATUS")
 (define +egg-extension+ "egg")
 (define +version-file+ "VERSION")
+(define +internal-modules+ '(chicken.internal chicken.internal.syntax))
 
 (include "mini-srfi-1.scm")
 (include "egg-environment.scm")
@@ -936,16 +937,17 @@
       (print "generating database")
       (let ((db
              (sort
-              (append-map
-               (lambda (m)
-                 (let* ((mod (cdr m))
-                        (mname (##sys#module-name mod)))
-                   (print* " " mname)
-                   (let-values (((_ ve se) (##sys#module-exports mod)))
-                     (append
-                      (map (lambda (se) (list (car se) 'syntax mname)) se)
-                      (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
-               ##sys#module-table)
+              (concatenate
+               (filter-map
+                (lambda (m)
+                  (and-let* ((mod (cdr m))
+                             (mname (##sys#module-name mod))
+                             ((not (memq mname +internal-modules+))))
+                    (print* " " mname)
+                    (let-values (((_ ve se) (##sys#module-exports mod)))
+                      (append (map (lambda (se) (list (car se) 'syntax mname)) se)
+                              (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
+                ##sys#module-table))
               (lambda (e1 e2)
                 (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
         (newline)
Trap