~ 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