[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
08/08: DRAFT gexp: Handle list conversion to <gexp-input> in the expande
From: |
Ludovic Courtès |
Subject: |
08/08: DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code. |
Date: |
Fri, 13 May 2016 21:49:50 +0000 (UTC) |
civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.
commit 640a79877fcc85f086d278a11f666404c29fbb6f
Author: Ludovic Courtès <address@hidden>
Date: Fri May 13 15:39:02 2016 +0200
DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code.
This reduces the number of recursive calls to 'add-reference-inputs' and
'add-reference-output' when 'gexp-inputs' and 'gexp-outputs' is called.
* guix/gexp.scm (gexp-inputs)[add-reference-inputs]: Don't iterate on
the list.
(gexp-outputs)[add-reference-output]: Likewise.
(gexp->sexp)[reference->sexp]: Likewise.
(ensure-input-list): New procedure.
(gexp)[escape->ref]: Have the emitted code use it.
(imported-files)[build]: Use 'ungexp-native-splicing' instead of
'ungexp-native'.
(with-build-variables): Likewise.
* tests/gexp.scm ("input list", "input list + ungexp-native"):
Explicitly use 'gexp-input'.
* guix/packages.scm (patch-and-repack)[build]: For PATCHES, use
ungexp-native-splicing instead of ungexp-native.
---
guix/gexp.scm | 49 +++++++++++++++++++++++--------------------------
guix/packages.scm | 2 +-
tests/gexp.scm | 10 +++++++---
3 files changed, 31 insertions(+), 30 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 396c38f..9cdef2f 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -639,13 +639,7 @@ references; otherwise, return only non-native references."
(cons `(,thing ,output) result)
result))
(($ <gexp-input> (lst ...) output n?)
- (fold-right add-reference-inputs result
- ;; XXX: For now, automatically convert LST to a list of
- ;; gexp-inputs.
- (map (match-lambda
- ((? gexp-input? x) x)
- (x (%gexp-input x "out" (or n? native?))))
- lst)))
+ (fold-right add-reference-inputs result lst))
(_
;; Ignore references to other kinds of objects.
result)))
@@ -668,12 +662,7 @@ references; otherwise, return only non-native references."
(($ <gexp-input> (? gexp? exp))
(append (gexp-outputs exp) result))
(($ <gexp-input> (lst ...) output native?)
- ;; XXX: Automatically convert LST.
- (add-reference-output (map (match-lambda
- ((? gexp-input? x) x)
- (x (%gexp-input x "out" native?)))
- lst)
- result))
+ (add-reference-output lst result))
((lst ...)
(fold-right add-reference-output result lst))
(_
@@ -702,12 +691,7 @@ and in the current monad setting (system type, etc.)"
(($ <gexp-input> (refs ...) output n?)
(sequence %store-monad
(map (lambda (ref)
- ;; XXX: Automatically convert REF to an gexp-input.
- (reference->sexp
- (if (gexp-input? ref)
- ref
- (%gexp-input ref "out" n?))
- native?))
+ (reference->sexp ref native?))
refs)))
(($ <gexp-input> (? struct? thing) output n?)
(let ((target (if (or n? native?) #f target)))
@@ -744,6 +728,17 @@ and in the current monad setting (system type, etc.)"
(simple-format #f "~a:~a" line column)))
"<unknown location>")))
+(define (ensure-input-list lst native?)
+ "Make sure LST is a list of <gexp-input> objects. If LST is not a list (for
+instance, it could be a gexp), return it."
+ (if (pair? lst)
+ (map (lambda (x)
+ (if (gexp-input? x)
+ x
+ (%gexp-input x "out" native?)))
+ lst)
+ lst))
+
(define-syntax gexp
(lambda (s)
(define (collect-escapes exp)
@@ -797,8 +792,8 @@ and in the current monad setting (system type, etc.)"
(define (escape->ref exp)
;; Turn 'ungexp' form EXP into a "reference".
(syntax-case exp (ungexp ungexp-splicing
- ungexp-native ungexp-native-splicing
- output)
+ ungexp-native ungexp-native-splicing
+ output)
((ungexp output)
#'(gexp-output "out"))
((ungexp output name)
@@ -808,13 +803,15 @@ and in the current monad setting (system type, etc.)"
((ungexp drv-or-pkg out)
#'(%gexp-input drv-or-pkg out #f))
((ungexp-splicing lst)
- #'(%gexp-input lst "out" #f))
+ #'(%gexp-input (ensure-input-list lst #f)
+ "out" #f))
((ungexp-native thing)
#'(%gexp-input thing "out" #t))
((ungexp-native drv-or-pkg out)
#'(%gexp-input drv-or-pkg out #t))
((ungexp-native-splicing lst)
- #'(%gexp-input lst "out" #t))))
+ #'(%gexp-input (ensure-input-list lst #t)
+ "out" #t))))
(define (substitute-ungexp exp substs)
;; Given EXP, an 'ungexp' or 'ungexp-native' form, substitute it with
@@ -842,7 +839,7 @@ and in the current monad setting (system type, etc.)"
;; Return a variant of EXP where all the cars of SUBSTS have been
;; replaced by the corresponding cdr.
(syntax-case exp (ungexp ungexp-native
- ungexp-splicing ungexp-native-splicing)
+ ungexp-splicing ungexp-native-splicing)
((ungexp _ ...)
(substitute-ungexp exp substs))
((ungexp-native _ ...)
@@ -907,7 +904,7 @@ system, imported, and appears under FINAL-PATH in the
resulting store path."
((final-path store-path)
(mkdir-p (dirname final-path))
(symlink store-path final-path)))
- '(ungexp files)))))
+ '((ungexp-native-splicing files))))))
;; TODO: Pass FILES as an environment variable so that BUILD remains
;; exactly the same regardless of FILES: less disk space, and fewer
@@ -1014,7 +1011,7 @@ of name/gexp-input tuples, and OUTPUTS, a list of
strings."
(define %build-inputs
(map (lambda (tuple)
(apply cons tuple))
- '(ungexp inputs)))
+ '((ungexp-splicing inputs))))
(define %outputs
(list (ungexp-splicing
(map (lambda (name)
diff --git a/guix/packages.scm b/guix/packages.scm
index df1054c..8c61aa6 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -508,7 +508,7 @@ IMPORTED-MODULES specify modules to use/import for use by
SNIPPET."
"source is under '~a'~%" directory)
(chdir directory)
- (and (every apply-patch '#+patches)
+ (and (every apply-patch '(address@hidden))
#+@(if snippet
#~((let ((module (make-fresh-user-module)))
(module-use-interfaces! module
diff --git a/tests/gexp.scm b/tests/gexp.scm
index edce075..9b9a31c 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -208,7 +208,8 @@
(test-assert "input list"
(let ((exp (gexp (display
- '(ungexp (list %bootstrap-guile coreutils)))))
+ '(ungexp (list (gexp-input %bootstrap-guile)
+ (gexp-input coreutils))))))
(guile (derivation->output-path
(package-derivation %store %bootstrap-guile)))
(cu (derivation->output-path
@@ -222,8 +223,11 @@
(test-assert "input list + ungexp-native"
(let* ((target "mips64el-linux")
(exp (gexp (display
- (cons '(ungexp-native (list %bootstrap-guile coreutils))
- '(ungexp (list glibc binutils))))))
+ (cons '(ungexp-native (map gexp-input
+ (list %bootstrap-guile
+ coreutils)))
+ '(ungexp (map gexp-input
+ (list glibc binutils)))))))
(guile (derivation->output-path
(package-derivation %store %bootstrap-guile)))
(cu (derivation->output-path
- branch wip-build-systems-gexp created (now 640a798), Ludovic Courtès, 2016/05/13
- 05/08: tests: Add 'test-assertm' to (guix tests)., Ludovic Courtès, 2016/05/13
- 03/08: gexp: Micro-optimize sexp serialization., Ludovic Courtès, 2016/05/13
- 08/08: DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code.,
Ludovic Courtès <=
- 06/08: packages: Turn 'bag->derivation' into a monadic procedure., Ludovic Courtès, 2016/05/13
- 01/08: gnu: bootstrap: Move 'use-modules' forms to the beginning of build expressions., Ludovic Courtès, 2016/05/13
- 07/08: store: Add a functional object cache and use it in 'lower-object'., Ludovic Courtès, 2016/05/13
- 04/08: monads: Micro-optimize 'foldm'., Ludovic Courtès, 2016/05/13
- 02/08: build-system: Rewrite using gexps., Ludovic Courtès, 2016/05/13