[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/07: gexp: Export 'gexp-input' constructor.
From: |
Ludovic Courtès |
Subject: |
04/07: gexp: Export 'gexp-input' constructor. |
Date: |
Mon, 16 Mar 2015 22:27:52 +0000 |
civodul pushed a commit to branch wip-extensible-gexps
in repository guix.
commit dbbf9ffa39406b3813cffb5a44e3ddd8ad69e539
Author: Ludovic Courtès <address@hidden>
Date: Sun Mar 15 21:45:37 2015 +0100
gexp: Export 'gexp-input' constructor.
* guix/gexp.scm (<gexp-input>)[gexp-input]: Rename to...
[%gexp-input]: ... this. Adjust callers accordingly.
(gexp-input): New procedure.
(gexp-inputs)[add-reference-inputs]: When the input is a list, check
whether each item is already 'gexp-input?' and to not rewrap those.
(gexp-outputs)[add-reference-output]: Likewise.
(gexp->sexp): Likewise.
* tests/gexp.scm ("input list splicing + gexp-input +
ungexp-native-splicing"): New test.
---
guix/gexp.scm | 42 +++++++++++++++++++++++++++++++-----------
tests/gexp.scm | 10 ++++++++++
2 files changed, 41 insertions(+), 11 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 5be5577..76ce267 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -29,6 +29,10 @@
#:use-module (ice-9 match)
#:export (gexp
gexp?
+
+ gexp-input
+ gexp-input?
+
gexp->derivation
gexp->file
gexp->script
@@ -81,12 +85,19 @@
;; The input of a gexp.
(define-record-type <gexp-input>
- (gexp-input thing output native?)
+ (%gexp-input thing output native?)
gexp-input?
(thing gexp-input-thing) ;<package> | <origin> | <derivation> | ...
(output gexp-input-output) ;string
(native? gexp-input-native?)) ;Boolean
+(define* (gexp-input thing ;convenience procedure
+ #:optional (output "out")
+ #:key native?)
+ "Return a new <gexp-input> for the OUTPUT of THING; NATIVE? determines
+whether this should be considered a \"native\" input or not."
+ (%gexp-input thing output native?))
+
;; Reference to one of the derivation's outputs, for gexps used in
;; derivations.
(define-record-type <gexp-output>
@@ -309,7 +320,10 @@ references."
(fold-right add-reference-inputs result
;; XXX: For now, automatically convert LST to a list of
;; gexp-inputs.
- (map (cut gexp-input <> output native?) lst)))
+ (map (match-lambda
+ ((? gexp-input? x) x)
+ (x (%gexp-input x "out" native?)))
+ lst)))
(_
;; Ignore references to other kinds of objects.
result)))
@@ -331,7 +345,10 @@ references."
(append (gexp-outputs exp) result))
(($ <gexp-input> (lst ...) output native?)
;; XXX: Automatically convert LST.
- (add-reference-output (map (cut gexp-input <> output native?) lst)
+ (add-reference-output (map (match-lambda
+ ((? gexp-input? x) x)
+ (x (%gexp-input x "out" native?)))
+ lst)
result))
((lst ...)
(fold-right add-reference-output result lst))
@@ -379,8 +396,11 @@ and in the current monad setting (system type, etc.)"
(sequence %store-monad
(map (lambda (ref)
;; XXX: Automatically convert REF to an gexp-input.
- (reference->sexp (gexp-input ref "out"
- (or n? native?))))
+ (reference->sexp
+ (if (gexp-input? ref)
+ ref
+ (%gexp-input ref "out" n?))
+ native?))
refs)))
(($ <gexp-input> x)
(return x))
@@ -453,17 +473,17 @@ and in the current monad setting (system type, etc.)"
((ungexp output name)
#'(gexp-output name))
((ungexp thing)
- #'(gexp-input thing "out" #f))
+ #'(%gexp-input thing "out" #f))
((ungexp drv-or-pkg out)
- #'(gexp-input drv-or-pkg out #f))
+ #'(%gexp-input drv-or-pkg out #f))
((ungexp-splicing lst)
- #'(gexp-input lst "out" #f))
+ #'(%gexp-input lst "out" #f))
((ungexp-native thing)
- #'(gexp-input thing "out" #t))
+ #'(%gexp-input thing "out" #t))
((ungexp-native drv-or-pkg out)
- #'(gexp-input drv-or-pkg out #t))
+ #'(%gexp-input drv-or-pkg out #t))
((ungexp-native-splicing lst)
- #'(gexp-input lst "out" #t))))
+ #'(%gexp-input lst "out" #t))))
(define (substitute-ungexp exp substs)
;; Given EXP, an 'ungexp' or 'ungexp-native' form, substitute it with
diff --git a/tests/gexp.scm b/tests/gexp.scm
index ac2842d..1e27407 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -219,6 +219,16 @@
(equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux")))))
+(test-assert "input list splicing + gexp-input + ungexp-native-splicing"
+ (let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
+ (exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
+ (and (lset= equal?
+ `((,glibc "debug") (,%bootstrap-guile "out"))
+ (gexp-native-inputs exp))
+ (null? (gexp-inputs exp))
+ (equal? (gexp->sexp* exp) ;native
+ (gexp->sexp* exp "mips64el-linux")))))
+
(test-equal "output list"
2
(let ((exp (gexp (begin (mkdir (ungexp output))
- branch wip-extensible-gexps created (now 20a3daa), Ludovic Courtès, 2015/03/16
- 01/07: tests: Add an indirection for white-box testing., Ludovic Courtès, 2015/03/16
- 02/07: gexp: Rename <output-ref> to <gexp-output>., Ludovic Courtès, 2015/03/16
- 03/07: gexp: Add <gexp-input>., Ludovic Courtès, 2015/03/16
- 04/07: gexp: Export 'gexp-input' constructor.,
Ludovic Courtès <=
- 05/07: profiles: Use 'gexp-input' instead of two-element lists., Ludovic Courtès, 2015/03/16
- 06/07: gexp: Remove special meaning of forms (PACKAGE OUTPUT) in ungexp., Ludovic Courtès, 2015/03/16
- 07/07: gexp: Separate "compilers" for origins and packages from the core., Ludovic Courtès, 2015/03/16