~ chicken-core (chicken-5) f2cc9230c6920814d0a4fb6854ec9e56ba578b01


commit f2cc9230c6920814d0a4fb6854ec9e56ba578b01
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Apr 28 23:01:59 2018 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sun Apr 29 00:02:39 2018 +0200

    Include identifiers from "chicken.foreign" in modules.db
    
    We need to load chicken-ffi-syntax in chicken-install so that the
    `##sys#chicken-ffi-macro-environment' list has been populated before
    `update-db' is run.
    
    Also, skip "main" (the module that wraps chicken-install.scm) and add
    some more detailed messaging when "-verbose" is used with "-update-db".
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/chicken-install.scm b/chicken-install.scm
index 25f735ac..527a7de2 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -23,6 +23,8 @@
 ; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ; POSSIBILITY OF SUCH DAMAGE.
 
+(declare
+  (uses chicken-ffi-syntax)) ; populate ##sys#chicken-ffi-macro-environment
 
 (module main ()
 
@@ -36,6 +38,7 @@
 (import (chicken fixnum))
 (import (chicken format))
 (import (chicken irregex))
+(import (chicken module))
 (import (chicken tcp))
 (import (chicken port))
 (import (chicken platform))
@@ -927,6 +930,7 @@
 		 (print-error-message 
 		  ex (current-error-port) 
 		  (sprintf "Failed to import from `~a'" file))
+	       (unless quiet (print "loading " file " ..."))
 	       (eval `(import-syntax ,(string->symbol module-name))))))
          files))
       (print "generating database ...")
@@ -937,7 +941,9 @@
                 (lambda (m)
                   (and-let* ((mod (cdr m))
                              (mname (##sys#module-name mod))
-                             ((not (memq mname +internal-modules+))))
+                             ((not (memq mname +internal-modules+)))
+                             ((not (eq? mname (current-module)))))
+                    (unless quiet (print "processing " 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)))))
@@ -947,6 +953,7 @@
         (with-output-to-file dbfile
           (lambda ()
             (for-each (lambda (x) (write x) (newline)) db)))
+        (unless quiet (print "installing " +module-db+ " ..."))
         (copy-file dbfile (make-pathname (install-path) +module-db+) #t))))
 
 
Trap