derivations: Import modules with 'add-file-tree-to-store'.
This reduces the number of RPCs on "guix build libreoffice -nd" from 2,589 to 2,558 (1%). * guix/derivations.scm (imported-files): Rewrite to call to 'add-file-tree-to-store'. Remove #:system and #:guile parameters. (%imported-modules): Adjust docstring to say that result is a store item, and adjust 'imported-files' call. (%compiled-modules): Adjust accordingly. (imported+compiled-modules): Likewise. (build-expression->derivation): Likewise.
This commit is contained in:
Ludovic Courtès
parent
68dbd5c9de
commit
46312064de
@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
@ -1098,39 +1098,13 @@ recursively."
|
||||
(string-tokenize (dirname file-name) not-slash))))))
|
||||
|
||||
(define* (imported-files store files ;deprecated
|
||||
#:key (name "file-import")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build)))
|
||||
"Return a derivation that imports FILES into STORE. FILES must be a list
|
||||
#:key (name "file-import"))
|
||||
"Return a store item that contains FILES. FILES must be a list
|
||||
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
|
||||
system, imported, and appears under FINAL-PATH in the resulting store path."
|
||||
(let* ((files (map (match-lambda
|
||||
((final-path . file-name)
|
||||
(list final-path
|
||||
(add-to-store store (basename final-path) #f
|
||||
"sha256" file-name))))
|
||||
files))
|
||||
(builder
|
||||
`(begin
|
||||
(mkdir %output) (chdir %output)
|
||||
,@(append-map (match-lambda
|
||||
((final-path store-path)
|
||||
(append (match (parent-directories final-path)
|
||||
(() '())
|
||||
((head ... tail)
|
||||
(append (map (lambda (d)
|
||||
`(false-if-exception
|
||||
(mkdir ,d)))
|
||||
head)
|
||||
`((or (file-exists? ,tail)
|
||||
(mkdir ,tail))))))
|
||||
`((symlink ,store-path ,final-path)))))
|
||||
files))))
|
||||
(build-expression->derivation store name builder
|
||||
#:system system
|
||||
#:inputs files
|
||||
#:guile-for-build guile
|
||||
#:local-build? #t)))
|
||||
(add-file-tree-to-store store
|
||||
`(,name directory
|
||||
,@(file-mapping->tree files))))
|
||||
|
||||
;; The "file not found" error condition.
|
||||
(define-condition-type &file-search-error &error
|
||||
@ -1157,10 +1131,8 @@ of symbols.)"
|
||||
|
||||
(define* (%imported-modules store modules ;deprecated
|
||||
#:key (name "module-import")
|
||||
(system (%current-system))
|
||||
(guile (%guile-for-build))
|
||||
(module-path %load-path))
|
||||
"Return a derivation that contains the source files of MODULES, a list of
|
||||
"Return a store item that contains the source files of MODULES, a list of
|
||||
module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
|
||||
search path."
|
||||
;; TODO: Determine the closure of MODULES, build the `.go' files,
|
||||
@ -1169,8 +1141,7 @@ search path."
|
||||
(let ((f (module->source-file-name m)))
|
||||
(cons f (search-path* module-path f))))
|
||||
modules)))
|
||||
(imported-files store files #:name name #:system system
|
||||
#:guile guile)))
|
||||
(imported-files store files #:name name)))
|
||||
|
||||
(define* (%compiled-modules store modules ;deprecated
|
||||
#:key (name "module-import-compiled")
|
||||
@ -1180,11 +1151,8 @@ search path."
|
||||
"Return a derivation that builds a tree containing the `.go' files
|
||||
corresponding to MODULES. All the MODULES are built in a context where
|
||||
they can refer to each other."
|
||||
(let* ((module-drv (%imported-modules store modules
|
||||
#:system system
|
||||
#:guile guile
|
||||
(let* ((module-dir (%imported-modules store modules
|
||||
#:module-path module-path))
|
||||
(module-dir (derivation->output-path module-drv))
|
||||
(files (map (lambda (m)
|
||||
(let ((f (string-join (map symbol->string m)
|
||||
"/")))
|
||||
@ -1215,7 +1183,7 @@ they can refer to each other."
|
||||
files)))
|
||||
|
||||
(build-expression->derivation store name builder
|
||||
#:inputs `(("modules" ,module-drv))
|
||||
#:inputs `(("modules" ,module-dir))
|
||||
#:system system
|
||||
#:guile-for-build guile
|
||||
#:local-build? #t)))
|
||||
@ -1233,8 +1201,7 @@ MODULES are compiled."
|
||||
(list modules (derivation-file-name guile) system))
|
||||
|
||||
(or (hash-ref %module-cache key)
|
||||
(let ((result (cons (%imported-modules store modules
|
||||
#:system system #:guile guile)
|
||||
(let ((result (cons (%imported-modules store modules)
|
||||
(%compiled-modules store modules
|
||||
#:system system #:guile guile))))
|
||||
(hash-set! %module-cache key result)
|
||||
@ -1368,10 +1335,8 @@ and PROPERTIES."
|
||||
#:guile guile-drv
|
||||
#:system system)
|
||||
'(#f . #f)))
|
||||
(mod-drv (car mod+go-drv))
|
||||
(mod-dir (car mod+go-drv))
|
||||
(go-drv (cdr mod+go-drv))
|
||||
(mod-dir (and mod-drv
|
||||
(derivation->output-path mod-drv)))
|
||||
(go-dir (and go-drv
|
||||
(derivation->output-path go-drv))))
|
||||
(derivation store name guile
|
||||
@ -1388,7 +1353,7 @@ and PROPERTIES."
|
||||
#:inputs `((,(or guile-for-build (%guile-for-build)))
|
||||
(,builder)
|
||||
,@(map cdr inputs)
|
||||
,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
|
||||
,@(if mod-dir `((,mod-dir) (,go-drv)) '()))
|
||||
|
||||
;; When MODULES is non-empty, shamelessly clobber
|
||||
;; $GUILE_LOAD_COMPILED_PATH.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user