[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
07/08: DRAFT gexp: Add 'object-sources'.
From: |
guix-commits |
Subject: |
07/08: DRAFT gexp: Add 'object-sources'. |
Date: |
Fri, 6 Dec 2019 18:28:11 -0500 (EST) |
civodul pushed a commit to branch wip-system-bootstrap
in repository guix.
commit 204480aa5dacfab7fe48237a856d138edfe8debb
Author: Ludovic Courtès <address@hidden>
Date: Fri Dec 6 23:20:00 2019 +0100
DRAFT gexp: Add 'object-sources'.
DRAFT: Add tests.
* guix/gexp.scm (<object-sources>): New record type.
(object-sources-compiler): New gexp compiler.
---
guix/gexp.scm | 47 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 47 insertions(+)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8c05a39..494f094 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -84,6 +84,9 @@
raw-derivation-closure
raw-derivation-closure?
+ object-sources
+ object-sources?
+
load-path-expression
gexp-modules
@@ -316,6 +319,50 @@ The expander specifies how an object is converted to its
sexp representation."
(text-file "graph" (object->string refs)))
(return obj))))
+;; Representation of all the sources and fixed-output derivations OBJ refers
+;; to, directly or indirectly.
+(define-record-type <object-sources>
+ (object-sources obj)
+ object-sources?
+ (obj object-sources-object))
+
+(define-gexp-compiler (object-sources-compiler (obj <object-sources>)
+ system target)
+ (define (derivation-fixed-output-requirements drv)
+ (derivation-input-fold (lambda (input result)
+ (let ((drv (derivation-input-derivation input)))
+ (if (fixed-output-derivation? drv)
+ (cons drv result)
+ result)))
+ '()
+ (derivation-inputs drv)))
+
+ (define (derivation-recursive-sources drv)
+ (delete-duplicates
+ (derivation-input-fold (lambda (input result)
+ (let ((drv (derivation-input-derivation input)))
+ (append (derivation-sources drv)
+ result)))
+ '()
+ (derivation-inputs drv))))
+
+ (mlet %store-monad ((obj (lower-object (object-sources-object obj)
+ system #:target target)))
+ (if (derivation? obj)
+ (let* ((drvs (derivation-fixed-output-requirements obj))
+ (sources (derivation-recursive-sources obj))
+ (pairs (append (map (lambda (drv)
+ `(,(store-path-package-name
+ (derivation-file-name drv))
+ ,drv))
+ drvs)
+ (map (lambda (file)
+ `(,(basename file) ,file))
+ sources)))
+ (union (file-union "sources" pairs)))
+ (lower-object union system #:target target))
+ (return obj))))
+
;;;
;;; File declarations.
- branch wip-system-bootstrap created (now 6ab64e3), guix-commits, 2019/12/06
- 01/08: machine: ssh: Deprecate missing 'host-key' field., guix-commits, 2019/12/06
- 04/08: monads: Add portability to Guile 2.0., guix-commits, 2019/12/06
- 03/08: utils: 'version-compare' delays 'dynamic-link' code., guix-commits, 2019/12/06
- 02/08: derivations: Add 'derivation-input-fold'., guix-commits, 2019/12/06
- 06/08: DRAFT gexp: Add 'raw-derivation-closure'., guix-commits, 2019/12/06
- 05/08: DRAFT gexp: Add 'raw-derivation-file'., guix-commits, 2019/12/06
- 07/08: DRAFT gexp: Add 'object-sources'.,
guix-commits <=
- 08/08: DRAFT system: Add (gnu system bootstrap)., guix-commits, 2019/12/06