diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2020-09-05 21:56:34 +0300 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2020-09-05 22:30:04 +0300 |
commit | de3c03a47160dec355d9b19ad5ca210d90c15fd7 (patch) | |
tree | 4ca6dc05b5fc9530d812bbb269f1c61ab9efccf3 /guix/derivations.scm | |
parent | ab6fe9d362046231ad6f46eccfd1ea2c9c80b401 (diff) | |
parent | b8477cab7bccc4191ed3dfa3f149aec7917834d8 (diff) | |
download | guix-patches-de3c03a47160dec355d9b19ad5ca210d90c15fd7.tar guix-patches-de3c03a47160dec355d9b19ad5ca210d90c15fd7.tar.gz |
Merge remote-tracking branch 'origin/master' into staging
Diffstat (limited to 'guix/derivations.scm')
-rw-r--r-- | guix/derivations.scm | 84 |
1 files changed, 58 insertions, 26 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index 7db61d272f..2fe684cc18 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -26,6 +26,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 binary-ports) + #:use-module ((ice-9 textual-ports) #:select (put-char put-string)) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -561,33 +562,65 @@ things as appropriate and is thus more efficient." ((prefix (... ...) last) (for-each (lambda (item) (write-item item port) - (display "," port)) + (put-char 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) + (put-char port #\[) (write-sequence lst write-item port) - (display "]" port)) + (put-char port #\])) (define-inlinable (write-tuple lst write-item port) ;; Same, but write LST as a tuple. - (display "(" port) + (put-char port #\() (write-sequence lst write-item port) - (display ")" port)) + (put-char port #\))) + +(define %escape-char-set + ;; Characters that need to be escaped. + (char-set #\" #\\ #\newline #\return #\tab)) + +(define (escaped-string str) + "Escape double quote characters found in STR, if any." + (define escape + (match-lambda + (#\" "\\\"") + (#\\ "\\\\") + (#\newline "\\n") + (#\return "\\r") + (#\tab "\\t"))) + + (let loop ((str str) + (result '())) + (let ((index (string-index str %escape-char-set))) + (if index + (let ((rest (string-drop str (+ 1 index)))) + (loop rest + (cons* (escape (string-ref str index)) + (string-take str index) + result))) + (if (null? result) + str + (string-concatenate-reverse (cons str result))))))) (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 that form." - ;; Make sure we're using the faster implementation. - (define format simple-format) + ;; Use 'put-string', which does less work and is faster than 'display'. + ;; Likewise, 'write-escaped-string' is faster than 'write'. + + (define (write-escaped-string str port) + (put-char port #\") + (put-string port (escaped-string str)) + (put-char port #\")) (define (write-string-list lst) - (write-list lst write port)) + (write-list lst write-escaped-string port)) (define (write-output output port) (match output @@ -599,48 +632,47 @@ that form." "") (or (and=> hash bytevector->base16-string) "")) - write + write-escaped-string port)))) (define (write-input input port) (match input (($ <derivation-input> obj sub-drvs) - (display "(\"" port) + (put-string port "(\"") ;; 'derivation/masked-inputs' produces objects that contain a string ;; instead of a <derivation>, so we need to account for that. - (display (if (derivation? obj) - (derivation-file-name obj) - obj) - port) - (display "\"," port) + (put-string port (if (derivation? obj) + (derivation-file-name obj) + obj)) + (put-string port "\",") (write-string-list sub-drvs) - (display ")" port)))) + (put-char 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)))) + (put-char port #\() + (write-escaped-string name port) + (put-char port #\,) + (write-escaped-string value port) + (put-char port #\))))) ;; Assume all the lists we are writing are already sorted. (match drv (($ <derivation> outputs inputs sources system builder args env-vars) - (display "Derive(" port) + (put-string port "Derive(") (write-list outputs write-output port) - (display "," port) + (put-char port #\,) (write-list inputs write-input port) - (display "," port) + (put-char port #\,) (write-string-list sources) (simple-format port ",\"~a\",\"~a\"," system builder) (write-string-list args) - (display "," port) + (put-char port #\,) (write-list env-vars write-env-var port) - (display ")" port)))) + (put-char port #\))))) (define derivation->bytevector (lambda (drv) |