kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

derivations: Import modules with 'add-file-tree-to-store'.

Browse Source 
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 2020-01-30 01:20:49 +01:00
parent 68dbd5c9de
commit 46312064de
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
guix/derivations.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -1098,39 +1098,13 @@ recursively."
(string-tokenize (dirname file-name) not-slash)))))) (string-tokenize (dirname file-name) not-slash))))))
(define* (imported-files store files ;deprecated (define* (imported-files store files ;deprecated
#:key (name "file-import") #:key (name "file-import"))
(system (%current-system)) "Return a store item that contains FILES. FILES must be a list
(guile (%guile-for-build)))
"Return a derivation that imports FILES into STORE. FILES must be a list
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file 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." system, imported, and appears under FINAL-PATH in the resulting store path."
(let* ((files (map (match-lambda (add-file-tree-to-store store
((final-path . file-name) `(,name directory
(list final-path ,@(file-mapping->tree files))))
(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)))
;; The "file not found" error condition. ;; The "file not found" error condition.
(define-condition-type &file-search-error &error (define-condition-type &file-search-error &error
@ -1157,10 +1131,8 @@ of symbols.)"
(define* (%imported-modules store modules ;deprecated (define* (%imported-modules store modules ;deprecated
#:key (name "module-import") #:key (name "module-import")
(system (%current-system))
(guile (%guile-for-build))
(module-path %load-path)) (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 module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
search path." search path."
;; TODO: Determine the closure of MODULES, build the `.go' files, ;; TODO: Determine the closure of MODULES, build the `.go' files,
@ -1169,8 +1141,7 @@ search path."
(let ((f (module->source-file-name m))) (let ((f (module->source-file-name m)))
(cons f (search-path* module-path f)))) (cons f (search-path* module-path f))))
modules))) modules)))
(imported-files store files #:name name #:system system (imported-files store files #:name name)))
#:guile guile)))
(define* (%compiled-modules store modules ;deprecated (define* (%compiled-modules store modules ;deprecated
#:key (name "module-import-compiled") #:key (name "module-import-compiled")
@ -1180,11 +1151,8 @@ search path."
"Return a derivation that builds a tree containing the `.go' files "Return a derivation that builds a tree containing the `.go' files
corresponding to MODULES. All the MODULES are built in a context where corresponding to MODULES. All the MODULES are built in a context where
they can refer to each other." they can refer to each other."
(let* ((module-drv (%imported-modules store modules (let* ((module-dir (%imported-modules store modules
#:system system
#:guile guile
#:module-path module-path)) #:module-path module-path))
(module-dir (derivation->output-path module-drv))
(files (map (lambda (m) (files (map (lambda (m)
(let ((f (string-join (map symbol->string m) (let ((f (string-join (map symbol->string m)
"/"))) "/")))
@ -1215,7 +1183,7 @@ they can refer to each other."
files))) files)))
(build-expression->derivation store name builder (build-expression->derivation store name builder
#:inputs `(("modules" ,module-drv)) #:inputs `(("modules" ,module-dir))
#:system system #:system system
#:guile-for-build guile #:guile-for-build guile
#:local-build? #t))) #:local-build? #t)))
@ -1233,8 +1201,7 @@ MODULES are compiled."
(list modules (derivation-file-name guile) system)) (list modules (derivation-file-name guile) system))
(or (hash-ref %module-cache key) (or (hash-ref %module-cache key)
(let ((result (cons (%imported-modules store modules (let ((result (cons (%imported-modules store modules)
#:system system #:guile guile)
(%compiled-modules store modules (%compiled-modules store modules
#:system system #:guile guile)))) #:system system #:guile guile))))
(hash-set! %module-cache key result) (hash-set! %module-cache key result)
@ -1368,10 +1335,8 @@ and PROPERTIES."
#:guile guile-drv #:guile guile-drv
#:system system) #:system system)
'(#f . #f))) '(#f . #f)))
(mod-drv (car mod+go-drv)) (mod-dir (car mod+go-drv))
(go-drv (cdr mod+go-drv)) (go-drv (cdr mod+go-drv))
(mod-dir (and mod-drv
(derivation->output-path mod-drv)))
(go-dir (and go-drv (go-dir (and go-drv
(derivation->output-path go-drv)))) (derivation->output-path go-drv))))
(derivation store name guile (derivation store name guile
@ -1388,7 +1353,7 @@ and PROPERTIES."
#:inputs `((,(or guile-for-build (%guile-for-build))) #:inputs `((,(or guile-for-build (%guile-for-build)))
(,builder) (,builder)
,@(map cdr inputs) ,@(map cdr inputs)
,@(if mod-drv `((,mod-drv) (,go-drv)) '())) ,@(if mod-dir `((,mod-dir) (,go-drv)) '()))
;; When MODULES is non-empty, shamelessly clobber ;; When MODULES is non-empty, shamelessly clobber
;; $GUILE_LOAD_COMPILED_PATH. ;; $GUILE_LOAD_COMPILED_PATH.