summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/derivations.scm106
1 files changed, 74 insertions, 32 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 18a637ae5a..d70bd9dd85 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -235,6 +235,32 @@ DRV and not already available in STORE, recursively."
(hash-set! cache file drv)
drv))))))
+(define-inlinable (write-sequence lst write-item port)
+ ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
+ ;; comma.
+ (match lst
+ (()
+ #t)
+ ((prefix (... ...) last)
+ (for-each (lambda (item)
+ (write-item item port)
+ (display "," port))
+ prefix)
+ (write-item last port))))
+
+(define-inlinable (write-list lst write-item port)
+ ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
+ ;; element.
+ (display "[" port)
+ (write-sequence lst write-item port)
+ (display "]" port))
+
+(define-inlinable (write-tuple lst write-item port)
+ ;; Same, but write LST as a tuple.
+ (display "(" port)
+ (write-sequence lst write-item port)
+ (display ")" port))
+
(define (write-derivation drv port)
"Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of
Eelco Dolstra's PhD dissertation for an overview of a previous version of
@@ -243,11 +269,8 @@ that form."
;; Make sure we're using the faster implementation.
(define format simple-format)
- (define (list->string lst)
- (string-append "[" (string-join lst ",") "]"))
-
- (define (write-list lst)
- (display (list->string lst) port))
+ (define (write-string-list lst)
+ (write-list lst write port))
(define (coalesce-duplicate-inputs inputs)
;; Return a list of inputs, such that when INPUTS contains the same DRV
@@ -272,6 +295,34 @@ that form."
'()
inputs))
+ (define (write-output output port)
+ (match output
+ ((name . ($ <derivation-output> path hash-algo hash))
+ (write-tuple (list name path
+ (or (and=> hash-algo symbol->string) "")
+ (or (and=> hash bytevector->base16-string)
+ ""))
+ write
+ port))))
+
+ (define (write-input input port)
+ (match input
+ (($ <derivation-input> path sub-drvs)
+ (display "(" port)
+ (write path port)
+ (display "," port)
+ (write-string-list (sort sub-drvs string<?))
+ (display ")" port))))
+
+ (define (write-env-var env-var port)
+ (match env-var
+ ((name . value)
+ (display "(" port)
+ (write name port)
+ (display "," port)
+ (write value port)
+ (display ")" port))))
+
;; Note: lists are sorted alphabetically, to conform with the behavior of
;; C++ `std::map' in Nix itself.
@@ -279,37 +330,28 @@ that form."
(($ <derivation> outputs inputs sources
system builder args env-vars)
(display "Derive(" port)
- (write-list (map (match-lambda
- ((name . ($ <derivation-output> path hash-algo hash))
- (format #f "(~s,~s,~s,~s)"
- name path
- (or (and=> hash-algo symbol->string) "")
- (or (and=> hash bytevector->base16-string)
- ""))))
- (sort outputs
- (lambda (o1 o2)
- (string<? (car o1) (car o2))))))
+ (write-list (sort outputs
+ (lambda (o1 o2)
+ (string<? (car o1) (car o2))))
+ write-output
+ port)
(display "," port)
- (write-list (map (match-lambda
- (($ <derivation-input> path sub-drvs)
- (format #f "(~s,~a)" path
- (list->string (map object->string
- (sort sub-drvs string<?))))))
- (sort (coalesce-duplicate-inputs inputs)
- (lambda (i1 i2)
- (string<? (derivation-input-path i1)
- (derivation-input-path i2))))))
+ (write-list (sort (coalesce-duplicate-inputs inputs)
+ (lambda (i1 i2)
+ (string<? (derivation-input-path i1)
+ (derivation-input-path i2))))
+ write-input
+ port)
(display "," port)
- (write-list (map object->string (sort sources string<?)))
+ (write-string-list (sort sources string<?))
(format port ",~s,~s," system builder)
- (write-list (map object->string args))
+ (write-string-list args)
(display "," port)
- (write-list (map (match-lambda
- ((name . value)
- (format #f "(~s,~s)" name value)))
- (sort env-vars
- (lambda (e1 e2)
- (string<? (car e1) (car e2))))))
+ (write-list (sort env-vars
+ (lambda (e1 e2)
+ (string<? (car e1) (car e2))))
+ write-env-var
+ port)
(display ")" port))))
(define derivation-path->output-path