guix: split (guix store) and (guix derivations).

* guix/store.scm (&store-error, store-error?, %store-prefix, store-path,
  output-path, fixed-output-path, store-path?, direct-store-path?,
  derivation-path?, store-path-base, store-path-package-name,
  store-path-hash-part, direct-store-path, derivation-log-file): Moved
  to (guix store files) and re-exported from here.
  ((guix store files)): use it.

* guix/store/files.scm: new module.
  above named variables: added.

* guix/derivations.scm (&derivation-error, derivation-error?,
  derivation-error-derivation, &derivation-missing-output-error,
  derivation-missing-output-error?, derivation-missing-output, <derivation>,
  make-derivation, derivation?, derivation-outputs, derivation-inputs,
  derivation-sources, derivation-system, derivation-builder,
  derivation-builder-arguments, derivation-builder-environment-vars,
  derivation-file-name, <derivation-output>, derivation-output?,
  derivation-output-path, derivation-output-hash-algo, derivation-output-hash,
  derivation-output-recursive?, derivation-output-names, <derivation-input>,
  derivation-input?, derivation-input-derivation,
  derivation-input-sub-derivations, derivation-input-path, derivation-input,
  derivation-input-key, coalesce-duplicate-inputs, derivation-name,
  derivation-base16-hash, derivation-output-names, derivation-hash,
  derivation-properties, fixed-output-derivation?, offloadable-derivation?,
  substitutable-derivation?, derivation-input-fold, derivation-input<?,
  derivation-input-output-path, derivation-input-output-paths,
  derivation-output-paths, derivation->output-path, derivation->output-paths,
  derivation-path->output-path, derivation-path->output-paths,
  derivation-prerequisites, derivation/masked-inputs, read-derivation,
  read-derivation-from-file, derivation->bytevector, %derivation-cache,
  write-derivation, invalidate-derivation-caches!): Moved to (guix store
  derivations) and re-exported from here.
  ((guix store derivations)): use it.

* guix/store/derivations.scm: new module.
  above named variables: added.

4 files changed, 868 insertions, 699 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index f6d6f7db25..657c6da2e3 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -43,64 +43,15 @@
   #:use-module (guix base32)
   #:use-module (guix records)
   #:use-module (guix sets)
-  #:export (<derivation>
-            derivation?
-            derivation-outputs
-            derivation-inputs
-            derivation-sources
-            derivation-system
-            derivation-builder
-            derivation-builder-arguments
-            derivation-builder-environment-vars
-            derivation-file-name
-            derivation-prerequisites
-            derivation-build-plan
-            derivation-prerequisites-to-build     ;deprecated
-
-            <derivation-output>
-            derivation-output?
-            derivation-output-path
-            derivation-output-hash-algo
-            derivation-output-hash
-            derivation-output-recursive?
-
-            <derivation-input>
-            derivation-input?
-            derivation-input
-            derivation-input-path
-            derivation-input-derivation
-            derivation-input-sub-derivations
-            derivation-input-output-paths
-            derivation-input-output-path
+  #:use-module (guix store derivations)
+  #:export (derivation-build-plan
+	    derivation-prerequisites-to-build     ;deprecated
             valid-derivation-input?
 
-            &derivation-error
-            derivation-error?
-            derivation-error-derivation
-            &derivation-missing-output-error
-            derivation-missing-output-error?
-            derivation-missing-output
-
-            derivation-name
-            derivation-output-names
-            fixed-output-derivation?
-            offloadable-derivation?
-            substitutable-derivation?
-            derivation-input-fold
             substitution-oracle
-            derivation-hash
-            derivation-properties
-
-            read-derivation
-            read-derivation-from-file
-            write-derivation
-            derivation->output-path
-            derivation->output-paths
-            derivation-path->output-path
-            derivation-path->output-paths
+
             derivation
             raw-derivation
-            invalidate-derivation-caches!
 
             map-derivation
 
@@ -116,119 +67,66 @@
             build-expression->derivation)
 
   ;; Re-export it from here for backward compatibility.
-  #:re-export (%guile-for-build))
-
-;;;
-;;; Error conditions.
-;;;
-
-(define-condition-type &derivation-error &store-error
-  derivation-error?
-  (derivation derivation-error-derivation))
-
-(define-condition-type &derivation-missing-output-error &derivation-error
-  derivation-missing-output-error?
-  (output derivation-missing-output))
+  #:re-export (%guile-for-build
+
+               &derivation-error
+               derivation-error?
+               derivation-error-derivation
+
+               &derivation-missing-output-error
+               derivation-missing-output-error?
+               derivation-missing-output
+
+               <derivation>
+               derivation?
+               derivation-outputs
+               derivation-inputs
+               derivation-sources
+               derivation-system
+               derivation-builder
+               derivation-builder-arguments
+               derivation-builder-environment-vars
+               derivation-file-name
+
+               <derivation-output>
+               derivation-output?
+               derivation-output-path
+               derivation-output-hash-algo
+               derivation-output-hash
+               derivation-output-recursive?
+	       derivation-output-names
+
+               <derivation-input>
+               derivation-input?
+	       derivation-input-derivation
+               derivation-input-sub-derivations
+	       derivation-input-path
+	       derivation-input
+
+               derivation-name
+               derivation-output-names
+               derivation-hash
+               derivation-properties
+               fixed-output-derivation?
+               offloadable-derivation?
+               substitutable-derivation?
+
+               derivation-input<?
+	       derivation-input-output-path
+               derivation-input-output-paths
+               derivation-input-fold
+               derivation->output-path
+               derivation->output-paths
+               derivation-path->output-path
+               derivation-path->output-paths
+
+               derivation-prerequisites
+
+               read-derivation
+               read-derivation-from-file
+               write-derivation
+               invalidate-derivation-caches!))
 
-;;;
-;;; Nix derivations, as implemented in Nix's `derivations.cc'.
-;;;
-
-(define-immutable-record-type <derivation>
-  (make-derivation outputs inputs sources system builder args env-vars
-                   file-name)
-  derivation?
-  (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
-  (inputs   derivation-inputs)       ; list of <derivation-input>
-  (sources  derivation-sources)      ; list of store paths
-  (system   derivation-system)       ; string
-  (builder  derivation-builder)      ; store path
-  (args     derivation-builder-arguments)         ; list of strings
-  (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
-  (file-name derivation-file-name))               ; the .drv file name
-
-(define-immutable-record-type <derivation-output>
-  (make-derivation-output path hash-algo hash recursive?)
-  derivation-output?
-  (path       derivation-output-path)             ; store path
-  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
-  (hash       derivation-output-hash)             ; bytevector | #f
-  (recursive? derivation-output-recursive?))      ; Boolean
-
-(define-immutable-record-type <derivation-input>
-  (make-derivation-input drv sub-derivations)
-  derivation-input?
-  (drv             derivation-input-derivation)       ; <derivation>
-  (sub-derivations derivation-input-sub-derivations)) ; list of strings
-
-
-(define (derivation-input-path input)
-  "Return the file name of the derivation INPUT refers to."
-  (derivation-file-name (derivation-input-derivation input)))
-
-(define* (derivation-input drv #:optional
-                           (outputs (derivation-output-names drv)))
-  "Return a <derivation-input> for the OUTPUTS of DRV."
-  ;; This is a public interface meant to be more convenient than
-  ;; 'make-derivation-input' and giving us more control.
-  (make-derivation-input drv outputs))
-
-(define (derivation-input-key input)
-  "Return an object for which 'equal?' and 'hash' are constant-time, and which
-can thus be used as a key for INPUT in lookup tables."
-  (cons (derivation-input-path input)
-        (derivation-input-sub-derivations input)))
-
-(set-record-type-printer! <derivation>
-                          (lambda (drv port)
-                            (format port "#<derivation ~a => ~a ~a>"
-                                    (derivation-file-name drv)
-                                    (string-join
-                                     (map (match-lambda
-                                           ((_ . output)
-                                            (derivation-output-path output)))
-                                          (derivation-outputs drv)))
-                                    (number->string (object-address drv) 16))))
-
-(define (derivation-name drv)
-  "Return the base name of DRV."
-  (let ((base (store-path-package-name (derivation-file-name drv))))
-    (string-drop-right base 4)))
-
-(define (derivation-output-names drv)
-  "Return the names of the outputs of DRV."
-  (match (derivation-outputs drv)
-    (((names . _) ...)
-     names)))
-
-(define (fixed-output-derivation? drv)
-  "Return #t if DRV is a fixed-output derivation, such as the result of a
-download with a fixed hash (aka. `fetchurl')."
-  (match drv
-    (($ <derivation>
-        (("out" . ($ <derivation-output> _ (? symbol?) (? bytevector?)))))
-     #t)
-    (_ #f)))
-
-(define (derivation-input<? input1 input2)
-  "Compare INPUT1 and INPUT2, two <derivation-input>."
-  (string<? (derivation-input-path input1)
-            (derivation-input-path input2)))
-
-(define (derivation-input-output-paths input)
-  "Return the list of output paths corresponding to INPUT, a
-<derivation-input>."
-  (match input
-    (($ <derivation-input> drv sub-drvs)
-     (map (cut derivation->output-path drv <>)
-          sub-drvs))))
-
-(define (derivation-input-output-path input)
-  "Return the output file name of INPUT.  If INPUT has more than one outputs,
-an error is raised."
-  (match input
-    (($ <derivation-input> drv (output))
-     (derivation->output-path drv output))))
 
 (define (valid-derivation-input? store input)
   "Return true if INPUT is valid--i.e., if all the outputs it requests are in
@@ -236,104 +134,6 @@ the store."
   (every (cut valid-path? store <>)
          (derivation-input-output-paths input)))
 
-(define (coalesce-duplicate-inputs inputs)
-  "Return a list of inputs, such that when INPUTS contains the same DRV twice,
-they are coalesced, with their sub-derivations merged.  This is needed because
-Nix itself keeps only one of them."
-  (define (find pred lst)                         ;inlinable copy of 'find'
-    (let loop ((lst lst))
-      (match lst
-        (() #f)
-        ((head . tail)
-         (if (pred head) head (loop tail))))))
-
-  (fold (lambda (input result)
-          (match input
-            (($ <derivation-input> (= derivation-file-name path) sub-drvs)
-             ;; XXX: quadratic
-             (match (find (match-lambda
-                            (($ <derivation-input> (= derivation-file-name p)
-                                                   s)
-                             (string=? p path)))
-                          result)
-               (#f
-                (cons input result))
-               ((and dup ($ <derivation-input> drv sub-drvs2))
-                ;; Merge DUP with INPUT.
-                (let ((sub-drvs (delete-duplicates
-                                 (append sub-drvs sub-drvs2))))
-                  (cons (make-derivation-input drv (sort sub-drvs string<?))
-                        (delq dup result))))))))
-        '()
-        inputs))
-
-(define* (derivation-prerequisites drv #:optional (cut? (const #f)))
-  "Return the list of derivation-inputs required to build DRV, recursively.
-
-CUT? is a predicate that is passed a derivation-input and returns true to
-eliminate the given input and its dependencies from the search.  An example of
-such a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
-result is the set of prerequisites of DRV not already in valid."
-  (let loop ((drv       drv)
-             (result    '())
-             (input-set (set)))
-    (let ((inputs (remove (lambda (input)
-                            (or (set-contains? input-set
-                                               (derivation-input-key input))
-                                (cut? input)))
-                          (derivation-inputs drv))))
-      (fold2 loop
-             (append inputs result)
-             (fold set-insert input-set
-                   (map derivation-input-key inputs))
-             (map derivation-input-derivation inputs)))))
-
-(define (offloadable-derivation? drv)
-  "Return true if DRV can be offloaded, false otherwise."
-  (match (assoc "preferLocalBuild"
-                (derivation-builder-environment-vars drv))
-    (("preferLocalBuild" . "1") #f)
-    (_ #t)))
-
-(define (substitutable-derivation? drv)
-  "Return #t if DRV can be substituted."
-  (match (assoc "allowSubstitutes"
-                (derivation-builder-environment-vars drv))
-    (("allowSubstitutes" . value)
-     (string=? value "1"))
-    (_ #t)))
-
-(define (derivation-output-paths drv sub-drvs)
-  "Return the output paths of outputs SUB-DRVS of DRV."
-  (match drv
-    (($ <derivation> outputs)
-     (map (lambda (sub-drv)
-            (derivation-output-path (assoc-ref outputs sub-drv)))
-          sub-drvs))))
-
-(define* (derivation-input-fold proc seed inputs
-                                #:key (cut? (const #f)))
-  "Perform a breadth-first traversal of INPUTS, calling PROC on each input
-with the current result, starting from SEED.  Skip recursion on inputs that
-match CUT?."
-  (let loop ((inputs inputs)
-             (result seed)
-             (visited (set)))
-    (match inputs
-      (()
-       result)
-      ((input rest ...)
-       (let ((key (derivation-input-key input)))
-         (cond ((set-contains? visited key)
-                (loop rest result visited))
-               ((cut? input)
-                (loop rest result (set-insert key visited)))
-               (else
-                (let ((drv (derivation-input-derivation input)))
-                  (loop (append (derivation-inputs drv) rest)
-                        (proc input result)
-                        (set-insert key visited))))))))))
-
 (define* (substitution-oracle store inputs-or-drv
                               #:key (mode (build-mode normal)))
   "Return a one-argument procedure that, when passed a store file name,
@@ -456,287 +256,13 @@ by 'substitution-oracle'."
                        (list (derivation-input drv)) rest)))
     (values (map derivation-input build) download)))
 
-(define* (read-derivation drv-port
-                          #:optional (read-derivation-from-file
-                                      read-derivation-from-file))
-  "Read the derivation from DRV-PORT and return the corresponding <derivation>
-object.  Call READ-DERIVATION-FROM-FILE to read derivations declared as inputs
-of the derivation being parsed.
-
-Most of the time you'll want to use 'read-derivation-from-file', which caches
-things as appropriate and is thus more efficient."
-
-  (define comma (string->symbol ","))
-
-  (define (ununquote x)
-    (match x
-      (('unquote x) (ununquote x))
-      ((x ...)      (map ununquote x))
-      (_            x)))
-
-  (define (outputs->alist x)
-    (fold-right (lambda (output result)
-                  (match output
-                    ((name path "" "")
-                     (alist-cons name
-                                 (make-derivation-output path #f #f #f)
-                                 result))
-                    ((name path hash-algo hash)
-                     ;; fixed-output
-                     (let* ((rec? (string-prefix? "r:" hash-algo))
-                            (algo (string->symbol
-                                   (if rec?
-                                       (string-drop hash-algo 2)
-                                       hash-algo)))
-                            (hash (base16-string->bytevector hash)))
-                       (alist-cons name
-                                   (make-derivation-output path algo
-                                                           hash rec?)
-                                   result)))))
-                '()
-                x))
-
-  (define (make-input-drvs x)
-    (fold-right (lambda (input result)
-                  (match input
-                    ((path (sub-drvs ...))
-                     (let ((drv (read-derivation-from-file path)))
-                       (cons (make-derivation-input drv sub-drvs)
-                             result)))))
-                '()
-                x))
-
-  ;; The contents of a derivation are typically ASCII, but choosing
-  ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
-  (set-port-encoding! drv-port "UTF-8")
-
-  (let loop ((exp    (read drv-port))
-             (result '()))
-    (match exp
-      ((? eof-object?)
-       (let ((result (reverse result)))
-         (match result
-           (('Derive ((outputs ...) (input-drvs ...)
-                      (input-srcs ...)
-                      (? string? system)
-                      (? string? builder)
-                      ((? string? args) ...)
-                      ((var value) ...)))
-            (make-derivation (outputs->alist outputs)
-                             (make-input-drvs input-drvs)
-                             input-srcs
-                             system builder args
-                             (fold-right alist-cons '() var value)
-                             (port-filename drv-port)))
-           (_
-            (error "failed to parse derivation" drv-port result)))))
-      ((? (cut eq? <> comma))
-       (loop (read drv-port) result))
-      (_
-       (loop (read drv-port)
-             (cons (ununquote exp) result))))))
-
-(define %derivation-cache
-  ;; Maps derivation file names to <derivation> objects.
-  ;; XXX: This is redundant with 'atts-cache' in the store.
-  (make-weak-value-hash-table 200))
-
-(define (read-derivation-from-file file)
-  "Read the derivation in FILE, a '.drv' file, and return the corresponding
-<derivation> object."
-  ;; Memoize that operation because 'read-derivation' is quite expensive,
-  ;; and because the same argument is read more than 15 times on average
-  ;; during something like (package-derivation s gdb).
-  (or (and file (hash-ref %derivation-cache file))
-      (let ((drv (call-with-input-file file read-derivation)))
-        (hash-set! %derivation-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
-that form."
-
-  ;; Make sure we're using the faster implementation.
-  (define format simple-format)
-
-  (define (write-string-list lst)
-    (write-list lst write port))
-
-  (define (write-output output port)
-    (match output
-     ((name . ($ <derivation-output> path hash-algo hash recursive?))
-      (write-tuple (list name path
-                         (if hash-algo
-                             (string-append (if recursive? "r:" "")
-                                            (symbol->string hash-algo))
-                             "")
-                         (or (and=> hash bytevector->base16-string)
-                             ""))
-                   write
-                   port))))
-
-  (define (write-input input port)
-    (match input
-      (($ <derivation-input> obj sub-drvs)
-       (display "(\"" 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)
-       (write-string-list sub-drvs)
-       (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))))
-
-  ;; Assume all the lists we are writing are already sorted.
-  (match drv
-    (($ <derivation> outputs inputs sources
-        system builder args env-vars)
-     (display "Derive(" port)
-     (write-list outputs write-output port)
-     (display "," port)
-     (write-list inputs write-input port)
-     (display "," port)
-     (write-string-list sources)
-     (simple-format port ",\"~a\",\"~a\"," system builder)
-     (write-string-list args)
-     (display "," port)
-     (write-list env-vars write-env-var port)
-     (display ")" port))))
-
-(define derivation->bytevector
-  (lambda (drv)
-    "Return the external representation of DRV as a UTF-8-encoded string."
-    (with-fluids ((%default-port-encoding "UTF-8"))
-      (call-with-values open-bytevector-output-port
-        (lambda (port get-bytevector)
-          (write-derivation drv port)
-          (get-bytevector))))))
-
-(define* (derivation->output-path drv #:optional (output "out"))
-  "Return the store path of its output OUTPUT.  Raise a
-'&derivation-missing-output-error' condition if OUTPUT is not an output of
-DRV."
-  (let ((output* (assoc-ref (derivation-outputs drv) output)))
-    (if output*
-        (derivation-output-path output*)
-        (raise (condition (&derivation-missing-output-error
-                           (derivation drv)
-                           (output output)))))))
-
-(define (derivation->output-paths drv)
-  "Return the list of name/path pairs of the outputs of DRV."
-  (map (match-lambda
-        ((name . output)
-         (cons name (derivation-output-path output))))
-       (derivation-outputs drv)))
-
-(define derivation-path->output-path
-  ;; This procedure is called frequently, so memoize it.
-  (let ((memoized (mlambda (path output)
-                    (derivation->output-path (read-derivation-from-file path)
-                                             output))))
-    (lambda* (path #:optional (output "out"))
-      "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
-path of its output OUTPUT."
-      (memoized path output))))
-
-(define (derivation-path->output-paths path)
-  "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
-list of name/path pairs of its outputs."
-  (derivation->output-paths (read-derivation-from-file path)))
+
 
 
 ;;;
 ;;; Derivation primitive.
 ;;;
 
-(define derivation-base16-hash
-  (mlambdaq (drv)
-    "Return a string containing the base16 representation of the hash of DRV."
-    (bytevector->base16-string (derivation-hash drv))))
-
-(define (derivation/masked-inputs drv)
-  "Assuming DRV is a regular derivation (not fixed-output), replace the file
-name of each input with that input's hash."
-  (match drv
-    (($ <derivation> outputs inputs sources
-                     system builder args env-vars)
-     (let ((inputs (map (match-lambda
-                          (($ <derivation-input> drv sub-drvs)
-                           (let ((hash (derivation-base16-hash drv)))
-                             (make-derivation-input hash sub-drvs))))
-                        inputs)))
-       (make-derivation outputs
-                        (sort (delete-duplicates inputs)
-                              (lambda (drv1 drv2)
-                                (string<? (derivation-input-derivation drv1)
-                                          (derivation-input-derivation drv2))))
-                        sources
-                        system builder args env-vars
-                        #f)))))
-
-(define derivation-hash            ; `hashDerivationModulo' in derivations.cc
-  (lambda (drv)
-    "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
-    (match drv
-      (($ <derivation> ((_ . ($ <derivation-output> path
-                                                    (? symbol? hash-algo) (? bytevector? hash)
-                                                    (? boolean? recursive?)))))
-       ;; A fixed-output derivation.
-       (sha256
-        (string->utf8
-         (string-append "fixed:out:"
-                        (if recursive? "r:" "")
-                        (symbol->string hash-algo)
-                        ":" (bytevector->base16-string hash)
-                        ":" path))))
-      (_
-
-       ;; XXX: At this point this remains faster than `port-sha256', because
-       ;; the SHA256 port's `write' method gets called for every single
-       ;; character.
-       (sha256 (derivation->bytevector (derivation/masked-inputs drv)))))))
-
-
 (define (warn-about-derivation-deprecation name)
   ;; TRANSLATORS: 'derivation' must not be translated; it refers to the
   ;; 'derivation' procedure.
@@ -935,25 +461,6 @@ derivation.  It is kept as-is, uninterpreted, in the derivation."
             (hash-set! %derivation-cache file drv*)
             drv*)))))
 
-(define (invalidate-derivation-caches!)
-  "Invalidate internal derivation caches.  This is mostly useful for
-long-running processes that know what they're doing.  Use with care!"
-  ;; Typically this is meant to be used by Cuirass and Hydra, which can clear
-  ;; caches when they start evaluating packages for another architecture.
-  (invalidate-memoization! derivation-base16-hash)
-
-  ;; FIXME: Comment out to work around <https://bugs.gnu.org/36487>.
-  ;; (hash-clear! %derivation-cache)
-  )
-
-(define derivation-properties
-  (mlambdaq (drv)
-    "Return the property alist associated with DRV."
-    (match (assoc "guix properties"
-                  (derivation-builder-environment-vars drv))
-      ((_ . str) (call-with-input-string str read))
-      (#f        '()))))
-
 (define* (map-derivation store drv mapping
                          #:key (system (%current-system)))
   "Given MAPPING, a list of pairs of derivations, return a derivation based on
diff --git a/guix/store.scm b/guix/store.scm
index fb4b92e0c4..261b700bfe 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -20,6 +20,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix store)
+  #:use-module (guix store files)
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix deprecation)
@@ -69,7 +70,6 @@
             current-store-protocol-version        ;for internal use
             mcached
 
-            &store-error store-error?
             &store-connection-error store-connection-error?
             store-connection-error-file
             store-connection-error-code
@@ -170,19 +170,20 @@
             interned-file
             interned-file-tree
 
-            %store-prefix
-            store-path
-            output-path
-            fixed-output-path
-            store-path?
-            direct-store-path?
-            derivation-path?
-            store-path-base
-            store-path-package-name
-            store-path-hash-part
-            direct-store-path
-            derivation-log-file
-            log-file))
+            log-file)
+  #:re-export (&store-error store-error?
+               %store-prefix
+               store-path
+               output-path
+               fixed-output-path
+               store-path?
+               direct-store-path?
+               derivation-path?
+	       store-path-base
+               store-path-package-name
+               store-path-hash-part
+               direct-store-path
+               derivation-log-file))
 
 (define %protocol-version #x163)
 
@@ -396,9 +397,6 @@
 (define-deprecated/alias nix-server-socket store-connection-socket)
 
 
-(define-condition-type &store-error &error
-  store-error?)
-
 (define-condition-type &store-connection-error &store-error
   store-connection-error?
   (file   store-connection-error-file)
@@ -1982,131 +1980,7 @@ connection, and return the result."
         result))))
 
 
-;;;
-;;; Store paths.
-;;;
-
-(define %store-prefix
-  ;; Absolute path to the Nix store.
-  (make-parameter %store-directory))
-
-(define (compressed-hash bv size)                 ; `compressHash'
-  "Given the hash stored in BV, return a compressed version thereof that fits
-in SIZE bytes."
-  (define new (make-bytevector size 0))
-  (define old-size (bytevector-length bv))
-  (let loop ((i 0))
-    (if (= i old-size)
-        new
-        (let* ((j (modulo i size))
-               (o (bytevector-u8-ref new j)))
-          (bytevector-u8-set! new j
-                              (logxor o (bytevector-u8-ref bv i)))
-          (loop (+ 1 i))))))
-
-(define (store-path type hash name)               ; makeStorePath
-  "Return the store path for NAME/HASH/TYPE."
-  (let* ((s (string-append type ":sha256:"
-                           (bytevector->base16-string hash) ":"
-                           (%store-prefix) ":" name))
-         (h (sha256 (string->utf8 s)))
-         (c (compressed-hash h 20)))
-    (string-append (%store-prefix) "/"
-                   (bytevector->nix-base32-string c) "-"
-                   name)))
-
-(define (output-path output hash name)            ; makeOutputPath
-  "Return an output path for OUTPUT (the name of the output as a string) of
-the derivation called NAME with hash HASH."
-  (store-path (string-append "output:" output) hash
-              (if (string=? output "out")
-                  name
-                  (string-append name "-" output))))
-
-(define* (fixed-output-path name hash
-                            #:key
-                            (output "out")
-                            (hash-algo 'sha256)
-                            (recursive? #t))
-  "Return an output path for the fixed output OUTPUT defined by HASH of type
-HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
-'add-to-store'."
-  (if (and recursive? (eq? hash-algo 'sha256))
-      (store-path "source" hash name)
-      (let ((tag (string-append "fixed:" output ":"
-                                (if recursive? "r:" "")
-                                (symbol->string hash-algo) ":"
-                                (bytevector->base16-string hash) ":")))
-        (store-path (string-append "output:" output)
-                    (sha256 (string->utf8 tag))
-                    name))))
-
-(define (store-path? path)
-  "Return #t if PATH is a store path."
-  ;; This is a lightweight check, compared to using a regexp, but this has to
-  ;; be fast as it's called often in `derivation', for instance.
-  ;; `isStorePath' in Nix does something similar.
-  (string-prefix? (%store-prefix) path))
-
-(define (direct-store-path? path)
-  "Return #t if PATH is a store path, and not a sub-directory of a store path.
-This predicate is sometimes needed because files *under* a store path are not
-valid inputs."
-  (and (store-path? path)
-       (not (string=? path (%store-prefix)))
-       (let ((len (+ 1 (string-length (%store-prefix)))))
-         (not (string-index (substring path len) #\/)))))
-
-(define (direct-store-path path)
-  "Return the direct store path part of PATH, stripping components after
-'/gnu/store/xxxx-foo'."
-  (let ((prefix-length (+ (string-length (%store-prefix)) 35)))
-    (if (> (string-length path) prefix-length)
-        (let ((slash (string-index path #\/ prefix-length)))
-          (if slash (string-take path slash) path))
-        path)))
-
-(define (derivation-path? path)
-  "Return #t if PATH is a derivation path."
-  (and (store-path? path) (string-suffix? ".drv" path)))
-
-(define (store-path-base path)
-  "Return the base path of a path in the store."
-  (and (string-prefix? (%store-prefix) path)
-       (let ((base (string-drop path (+ 1 (string-length (%store-prefix))))))
-         (and (> (string-length base) 33)
-              (not (string-index base #\/))
-              base))))
-
-(define (store-path-package-name path)
-  "Return the package name part of PATH, a file name in the store."
-  (let ((base (store-path-base path)))
-    (string-drop base (+ 32 1)))) ;32 hash part + 1 hyphen
-
-(define (store-path-hash-part path)
-  "Return the hash part of PATH as a base32 string, or #f if PATH is not a
-syntactically valid store path."
-  (let* ((base (store-path-base path))
-         (hash (string-take base 32)))
-    (and (string-every %nix-base32-charset hash)
-         hash)))
-
-(define (derivation-log-file drv)
-  "Return the build log file for DRV, a derivation file name, or #f if it
-could not be found."
-  (let* ((base    (basename drv))
-         (log     (string-append (or (getenv "GUIX_LOG_DIRECTORY")
-                                     (string-append %localstatedir "/log/guix"))
-                                 "/drvs/"
-                                 (string-take base 2) "/"
-                                 (string-drop base 2)))
-         (log.gz  (string-append log ".gz"))
-         (log.bz2 (string-append log ".bz2")))
-    (cond ((file-exists? log.gz) log.gz)
-          ((file-exists? log.bz2) log.bz2)
-          ((file-exists? log) log)
-          (else #f))))
-
+;; Uses VALID-DERIVERS, so can't go in (guix store files)
 (define (log-file store file)
   "Return the build log file for FILE, or #f if none could be found.  FILE
 must be an absolute store file name, or a derivation file name."
diff --git a/guix/store/derivations.scm b/guix/store/derivations.scm
new file mode 100644
index 0000000000..188396953d
--- /dev/null
+++ b/guix/store/derivations.scm
@@ -0,0 +1,612 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (guix store derivations)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (gcrypt hash)
+  #:use-module (guix base16)
+  #:use-module (guix combinators)
+  #:use-module (guix memoization)
+  #:use-module (guix sets)
+  #:use-module (guix store files)
+  #:export (&derivation-error
+            derivation-error?
+            derivation-error-derivation
+
+            &derivation-missing-output-error
+            derivation-missing-output-error?
+            derivation-missing-output
+
+            <derivation>
+            make-derivation
+            derivation?
+            derivation-outputs
+            derivation-inputs
+            derivation-sources
+            derivation-system
+            derivation-builder
+            derivation-builder-arguments
+            derivation-builder-environment-vars
+            derivation-file-name
+
+            <derivation-output>
+            make-derivation-output
+            derivation-output?
+            derivation-output-path
+            derivation-output-hash-algo
+            derivation-output-hash
+            derivation-output-recursive?
+            derivation-output-names
+
+            <derivation-input>
+            make-derivation-input
+            derivation-input?
+            derivation-input-derivation
+            derivation-input-sub-derivations
+            derivation-input-path
+            derivation-input
+            derivation-input-key
+            coalesce-duplicate-inputs
+
+            derivation-name
+            derivation-base16-hash
+            derivation-output-names
+            derivation-hash
+            derivation-properties
+            fixed-output-derivation?
+            offloadable-derivation?
+            substitutable-derivation?
+
+            derivation-input<?
+            derivation-input-output-path
+            derivation-input-output-paths
+            derivation-output-paths
+            derivation-input-fold
+            derivation->output-path
+            derivation->output-paths
+            derivation-path->output-path
+            derivation-path->output-paths
+
+            derivation-prerequisites
+
+            derivation/masked-inputs
+            read-derivation
+            read-derivation-from-file
+            derivation->bytevector
+            %derivation-cache
+            write-derivation
+            invalidate-derivation-caches!))
+
+;;;
+;;; Nix derivations, as implemented in Nix's `derivations.cc'.
+;;;
+
+(define-immutable-record-type <derivation>
+  (make-derivation outputs inputs sources system builder args env-vars
+                   file-name)
+  derivation?
+  (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
+  (inputs   derivation-inputs)       ; list of <derivation-input>
+  (sources  derivation-sources)      ; list of store paths
+  (system   derivation-system)       ; string
+  (builder  derivation-builder)      ; store path
+  (args     derivation-builder-arguments)         ; list of strings
+  (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
+  (file-name derivation-file-name))               ; the .drv file name
+
+(define-immutable-record-type <derivation-output>
+  (make-derivation-output path hash-algo hash recursive?)
+  derivation-output?
+  (path       derivation-output-path)             ; store path
+  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
+  (hash       derivation-output-hash)             ; bytevector | #f
+  (recursive? derivation-output-recursive?))      ; Boolean
+
+(define-immutable-record-type <derivation-input>
+  (make-derivation-input drv sub-derivations)
+  derivation-input?
+  (drv             derivation-input-derivation)       ; <derivation>
+  (sub-derivations derivation-input-sub-derivations)) ; list of strings
+
+
+(define (derivation-input-path input)
+  "Return the file name of the derivation INPUT refers to."
+  (derivation-file-name (derivation-input-derivation input)))
+
+(define* (derivation-input drv #:optional
+                           (outputs (derivation-output-names drv)))
+  "Return a <derivation-input> for the OUTPUTS of DRV."
+  ;; This is a public interface meant to be more convenient than
+  ;; 'make-derivation-input' and giving us more control.
+  (make-derivation-input drv outputs))
+
+(define (derivation-input-key input)
+  "Return an object for which 'equal?' and 'hash' are constant-time, and which
+can thus be used as a key for INPUT in lookup tables."
+  (cons (derivation-input-path input)
+        (derivation-input-sub-derivations input)))
+
+(set-record-type-printer! <derivation>
+                          (lambda (drv port)
+                            (format port "#<derivation ~a => ~a ~a>"
+                                    (derivation-file-name drv)
+                                    (string-join
+                                     (map (match-lambda
+                                           ((_ . output)
+                                            (derivation-output-path output)))
+                                          (derivation-outputs drv)))
+                                    (number->string (object-address drv)
+                                                    16))))
+
+;;;
+;;; Error conditions.
+;;;
+
+(define-condition-type &derivation-error &store-error
+  derivation-error?
+  (derivation derivation-error-derivation))
+
+(define-condition-type &derivation-missing-output-error &derivation-error
+  derivation-missing-output-error?
+  (output derivation-missing-output))
+
+
+(define (derivation-name drv)
+  "Return the base name of DRV."
+  (let ((base (store-path-package-name (derivation-file-name drv))))
+    (string-drop-right base 4)))
+
+(define (derivation-output-names drv)
+  "Return the names of the outputs of DRV."
+  (match (derivation-outputs drv)
+    (((names . _) ...)
+     names)))
+
+(define (fixed-output-derivation? drv)
+  "Return #t if DRV is a fixed-output derivation, such as the result of a
+download with a fixed hash (aka. `fetchurl')."
+  (match drv
+    (($ <derivation>
+        (("out" . ($ <derivation-output> _ (? symbol?) (? bytevector?)))))
+     #t)
+    (_ #f)))
+
+(define (derivation-input<? input1 input2)
+  "Compare INPUT1 and INPUT2, two <derivation-input>."
+  (string<? (derivation-input-path input1)
+            (derivation-input-path input2)))
+
+(define (coalesce-duplicate-inputs inputs)
+  "Return a list of inputs, such that when INPUTS contains the same DRV twice,
+they are coalesced, with their sub-derivations merged.  This is needed because
+Nix itself keeps only one of them."
+  (define (find pred lst)                         ;inlinable copy of 'find'
+    (let loop ((lst lst))
+      (match lst
+        (() #f)
+        ((head . tail)
+         (if (pred head) head (loop tail))))))
+
+  (fold (lambda (input result)
+          (match input
+            (($ <derivation-input> (= derivation-file-name path) sub-drvs)
+             ;; XXX: quadratic
+             (match (find (match-lambda
+                            (($ <derivation-input> (= derivation-file-name p)
+                                                   s)
+                             (string=? p path)))
+                          result)
+               (#f
+                (cons input result))
+               ((and dup ($ <derivation-input> drv sub-drvs2))
+                ;; Merge DUP with INPUT.
+                (let ((sub-drvs (delete-duplicates
+                                 (append sub-drvs sub-drvs2))))
+                  (cons (make-derivation-input drv (sort sub-drvs string<?))
+                        (delq dup result))))))))
+        '()
+        inputs))
+
+(define* (derivation-prerequisites drv #:optional (cut? (const #f)))
+  "Return the list of derivation-inputs required to build DRV, recursively.
+
+CUT? is a predicate that is passed a derivation-input and returns true to
+eliminate the given input and its dependencies from the search.  An example of
+such a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
+result is the set of prerequisites of DRV not already in valid."
+  (let loop ((drv       drv)
+             (result    '())
+             (input-set (set)))
+    (let ((inputs (remove (lambda (input)
+                            (or (set-contains? input-set
+                                               (derivation-input-key input))
+                                (cut? input)))
+                          (derivation-inputs drv))))
+      (fold2 loop
+             (append inputs result)
+             (fold set-insert input-set
+                   (map derivation-input-key inputs))
+             (map derivation-input-derivation inputs)))))
+
+(define (offloadable-derivation? drv)
+  "Return true if DRV can be offloaded, false otherwise."
+  (match (assoc "preferLocalBuild"
+                (derivation-builder-environment-vars drv))
+    (("preferLocalBuild" . "1") #f)
+    (_ #t)))
+
+(define (substitutable-derivation? drv)
+  "Return #t if DRV can be substituted."
+  (match (assoc "allowSubstitutes"
+                (derivation-builder-environment-vars drv))
+    (("allowSubstitutes" . value)
+     (string=? value "1"))
+    (_ #t)))
+
+(define (derivation-output-paths drv sub-drvs)
+  "Return the output paths of outputs SUB-DRVS of DRV."
+  (match drv
+    (($ <derivation> outputs)
+     (map (lambda (sub-drv)
+            (derivation-output-path (assoc-ref outputs sub-drv)))
+          sub-drvs))))
+
+(define* (derivation-input-fold proc seed inputs
+                                #:key (cut? (const #f)))
+  "Perform a breadth-first traversal of INPUTS, calling PROC on each input
+with the current result, starting from SEED.  Skip recursion on inputs that
+match CUT?."
+  (let loop ((inputs inputs)
+             (result seed)
+             (visited (set)))
+    (match inputs
+      (()
+       result)
+      ((input rest ...)
+       (let ((key (derivation-input-key input)))
+         (cond ((set-contains? visited key)
+                (loop rest result visited))
+               ((cut? input)
+                (loop rest result (set-insert key visited)))
+               (else
+                (let ((drv (derivation-input-derivation input)))
+                  (loop (append (derivation-inputs drv) rest)
+                        (proc input result)
+                        (set-insert key visited))))))))))
+
+(define derivation-base16-hash
+  (mlambdaq (drv)
+    "Return a string containing the base16 representation of the hash of DRV."
+    (bytevector->base16-string (derivation-hash drv))))
+
+(define (derivation/masked-inputs drv)
+  "Assuming DRV is a regular derivation (not fixed-output), replace the file
+name of each input with that input's hash."
+  (match drv
+    (($ <derivation> outputs inputs sources
+                     system builder args env-vars)
+     (let ((inputs (map (match-lambda
+                          (($ <derivation-input> drv sub-drvs)
+                           (let ((hash (derivation-base16-hash drv)))
+                             (make-derivation-input hash sub-drvs))))
+                        inputs)))
+       (make-derivation outputs
+                        (sort inputs
+                              (lambda (drv1 drv2)
+                                (string<? (derivation-input-derivation drv1)
+                                          (derivation-input-derivation drv2))))
+                        sources
+                        system builder args env-vars
+                        #f)))))
+
+(define derivation-hash            ; `hashDerivationModulo' in derivations.cc
+  (lambda (drv)
+    "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
+    (match drv
+      (($ <derivation> ((_ . ($ <derivation-output> path
+                                                    (? symbol? hash-algo) (? bytevector? hash)
+                                                    (? boolean? recursive?)))))
+       ;; A fixed-output derivation.
+       (sha256
+        (string->utf8
+         (string-append "fixed:out:"
+                        (if recursive? "r:" "")
+                        (symbol->string hash-algo)
+                        ":" (bytevector->base16-string hash)
+                        ":" path))))
+      (_
+
+       ;; XXX: At this point this remains faster than `port-sha256', because
+       ;; the SHA256 port's `write' method gets called for every single
+       ;; character.
+       (sha256 (derivation->bytevector (derivation/masked-inputs drv)))))))
+
+(define (invalidate-derivation-caches!)
+  "Invalidate internal derivation caches.  This is mostly useful for
+long-running processes that know what they're doing.  Use with care!"
+  ;; Typically this is meant to be used by Cuirass and Hydra, which can clear
+  ;; caches when they start evaluating packages for another architecture.
+  (invalidate-memoization! derivation->bytevector)
+  (invalidate-memoization! derivation-base16-hash)
+
+  ;; FIXME: Comment out to work around <https://bugs.gnu.org/36487>.
+  ;; (hash-clear! %derivation-cache)
+  )
+
+(define derivation-properties
+  (mlambdaq (drv)
+    "Return the property alist associated with DRV."
+    (match (assoc "guix properties"
+                  (derivation-builder-environment-vars drv))
+      ((_ . str) (call-with-input-string str read))
+      (#f        '()))))
+
+(define (derivation-input-output-path input)
+  "Return the output file name of INPUT.  If INPUT has more than one outputs,
+an error is raised."
+  (match input
+    (($ <derivation-input> drv (output))
+     (derivation->output-path drv output))))
+
+(define (derivation-input-output-paths input)
+  "Return the list of output paths corresponding to INPUT, a
+<derivation-input>."
+  (match input
+    (($ <derivation-input> drv sub-drvs)
+     (map (cut derivation->output-path drv <>)
+          sub-drvs))))
+
+(define* (derivation->output-path drv #:optional (output "out"))
+  "Return the store path of its output OUTPUT.  Raise a
+'&derivation-missing-output-error' condition if OUTPUT is not an output of
+DRV."
+  (let ((output* (assoc-ref (derivation-outputs drv) output)))
+    (if output*
+        (derivation-output-path output*)
+        (raise (condition (&derivation-missing-output-error
+                           (derivation drv)
+                           (output output)))))))
+
+(define (derivation->output-paths drv)
+  "Return the list of name/path pairs of the outputs of DRV."
+  (map (match-lambda
+        ((name . output)
+         (cons name (derivation-output-path output))))
+       (derivation-outputs drv)))
+
+(define derivation-path->output-path
+  ;; This procedure is called frequently, so memoize it.
+  (let ((memoized (mlambda (path output)
+                    (derivation->output-path (read-derivation-from-file path)
+                                             output))))
+    (lambda* (path #:optional (output "out"))
+      "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
+path of its output OUTPUT."
+      (memoized path output))))
+
+(define (derivation-path->output-paths path)
+  "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
+list of name/path pairs of its outputs."
+  (derivation->output-paths (read-derivation-from-file path)))
+
+
+(define* (read-derivation drv-port
+                          #:optional (read-derivation-from-file
+                                      read-derivation-from-file))
+  "Read the derivation from DRV-PORT and return the corresponding <derivation>
+object.  Call READ-DERIVATION-FROM-FILE to read derivations declared as inputs
+of the derivation being parsed.
+
+Most of the time you'll want to use 'read-derivation-from-file', which caches
+things as appropriate and is thus more efficient."
+
+  (define comma (string->symbol ","))
+
+  (define (ununquote x)
+    (match x
+      (('unquote x) (ununquote x))
+      ((x ...)      (map ununquote x))
+      (_            x)))
+
+  (define (outputs->alist x)
+    (fold-right (lambda (output result)
+                  (match output
+                    ((name path "" "")
+                     (alist-cons name
+                                 (make-derivation-output path #f #f #f)
+                                 result))
+                    ((name path hash-algo hash)
+                     ;; fixed-output
+                     (let* ((rec? (string-prefix? "r:" hash-algo))
+                            (algo (string->symbol
+                                   (if rec?
+                                       (string-drop hash-algo 2)
+                                       hash-algo)))
+                            (hash (base16-string->bytevector hash)))
+                       (alist-cons name
+                                   (make-derivation-output path algo
+                                                           hash rec?)
+                                   result)))))
+                '()
+                x))
+
+  (define (make-input-drvs x)
+    (fold-right (lambda (input result)
+                  (match input
+                    ((path (sub-drvs ...))
+                     (let ((drv (read-derivation-from-file path)))
+                       (cons (make-derivation-input drv sub-drvs)
+                             result)))))
+                '()
+                x))
+
+  ;; The contents of a derivation are typically ASCII, but choosing
+  ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
+  (set-port-encoding! drv-port "UTF-8")
+
+  (let loop ((exp    (read drv-port))
+             (result '()))
+    (match exp
+      ((? eof-object?)
+       (let ((result (reverse result)))
+         (match result
+           (('Derive ((outputs ...) (input-drvs ...)
+                      (input-srcs ...)
+                      (? string? system)
+                      (? string? builder)
+                      ((? string? args) ...)
+                      ((var value) ...)))
+            (make-derivation (outputs->alist outputs)
+                             (make-input-drvs input-drvs)
+                             input-srcs
+                             system builder args
+                             (fold-right alist-cons '() var value)
+                             (port-filename drv-port)))
+           (_
+            (error "failed to parse derivation" drv-port result)))))
+      ((? (cut eq? <> comma))
+       (loop (read drv-port) result))
+      (_
+       (loop (read drv-port)
+             (cons (ununquote exp) result))))))
+
+(define %derivation-cache
+  ;; Maps derivation file names to <derivation> objects.
+  ;; XXX: This is redundant with 'atts-cache' in the store.
+  (make-weak-value-hash-table 200))
+
+(define (read-derivation-from-file file)
+  "Read the derivation in FILE, a '.drv' file, and return the corresponding
+<derivation> object."
+  ;; Memoize that operation because 'read-derivation' is quite expensive,
+  ;; and because the same argument is read more than 15 times on average
+  ;; during something like (package-derivation s gdb).
+  (or (and file (hash-ref %derivation-cache file))
+      (let ((drv (call-with-input-file file read-derivation)))
+        (hash-set! %derivation-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
+that form."
+
+  ;; Make sure we're using the faster implementation.
+  (define format simple-format)
+
+  (define (write-string-list lst)
+    (write-list lst write port))
+
+  (define (write-output output port)
+    (match output
+     ((name . ($ <derivation-output> path hash-algo hash recursive?))
+      (write-tuple (list name path
+                         (if hash-algo
+                             (string-append (if recursive? "r:" "")
+                                            (symbol->string hash-algo))
+                             "")
+                         (or (and=> hash bytevector->base16-string)
+                             ""))
+                   write
+                   port))))
+
+  (define (write-input input port)
+    (match input
+      (($ <derivation-input> obj sub-drvs)
+       (display "(\"" 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)
+       (write-string-list sub-drvs)
+       (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))))
+
+  ;; Assume all the lists we are writing are already sorted.
+  (match drv
+    (($ <derivation> outputs inputs sources
+        system builder args env-vars)
+     (display "Derive(" port)
+     (write-list outputs write-output port)
+     (display "," port)
+     (write-list inputs write-input port)
+     (display "," port)
+     (write-string-list sources)
+     (simple-format port ",\"~a\",\"~a\"," system builder)
+     (write-string-list args)
+     (display "," port)
+     (write-list env-vars write-env-var port)
+     (display ")" port))))
+
+(define derivation->bytevector
+  (mlambda (drv)
+    "Return the external representation of DRV as a UTF-8-encoded string."
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (call-with-values open-bytevector-output-port
+        (lambda (port get-bytevector)
+          (write-derivation drv port)
+          (get-bytevector))))))
diff --git a/guix/store/files.scm b/guix/store/files.scm
new file mode 100644
index 0000000000..84ea7374ef
--- /dev/null
+++ b/guix/store/files.scm
@@ -0,0 +1,176 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix store files)
+  #:use-module (ice-9 regex)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
+  #:use-module (gcrypt hash)
+  #:use-module (guix base32)
+  #:use-module (guix base16)
+  #:use-module (guix config)
+  #:use-module (guix memoization)
+  #:export (&store-error
+            store-error?
+            %store-prefix
+            store-path
+            output-path
+            fixed-output-path
+            store-path?
+            direct-store-path?
+            derivation-path?
+            store-path-base
+            store-path-package-name
+            store-path-hash-part
+            direct-store-path
+            derivation-log-file
+            log-file
+            compressed-hash))
+
+(define-condition-type &store-error &error
+  store-error?)
+
+;;;
+;;; Store paths.
+;;;
+
+(define %store-prefix
+  ;; Absolute path to the Nix store.
+  (make-parameter %store-directory))
+
+(define (compressed-hash bv size)                 ; `compressHash'
+  "Given the hash stored in BV, return a compressed version thereof that fits
+in SIZE bytes."
+  (define new (make-bytevector size 0))
+  (define old-size (bytevector-length bv))
+  (let loop ((i 0))
+    (if (= i old-size)
+        new
+        (let* ((j (modulo i size))
+               (o (bytevector-u8-ref new j)))
+          (bytevector-u8-set! new j
+                              (logxor o (bytevector-u8-ref bv i)))
+          (loop (+ 1 i))))))
+
+(define (store-path type hash name)               ; makeStorePath
+  "Return the store path for NAME/HASH/TYPE."
+  (let* ((s (string-append type ":sha256:"
+                           (bytevector->base16-string hash) ":"
+                           (%store-prefix) ":" name))
+         (h (sha256 (string->utf8 s)))
+         (c (compressed-hash h 20)))
+    (string-append (%store-prefix) "/"
+                   (bytevector->nix-base32-string c) "-"
+                   name)))
+
+(define (output-path output hash name)            ; makeOutputPath
+  "Return an output path for OUTPUT (the name of the output as a string) of
+the derivation called NAME with hash HASH."
+  (store-path (string-append "output:" output) hash
+              (if (string=? output "out")
+                  name
+                  (string-append name "-" output))))
+
+(define* (fixed-output-path name hash
+                            #:key
+                            (output "out")
+                            (hash-algo 'sha256)
+                            (recursive? #t))
+  "Return an output path for the fixed output OUTPUT defined by HASH of type
+HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
+'add-to-store'."
+  (if (and recursive? (eq? hash-algo 'sha256))
+      (store-path "source" hash name)
+      (let ((tag (string-append "fixed:" output ":"
+                                (if recursive? "r:" "")
+                                (symbol->string hash-algo) ":"
+                                (bytevector->base16-string hash) ":")))
+        (store-path (string-append "output:" output)
+                    (sha256 (string->utf8 tag))
+                    name))))
+
+(define (store-path? path)
+  "Return #t if PATH is a store path."
+  ;; This is a lightweight check, compared to using a regexp, but this has to
+  ;; be fast as it's called often in `derivation', for instance.
+  ;; `isStorePath' in Nix does something similar.
+  (string-prefix? (%store-prefix) path))
+
+(define (direct-store-path? path)
+  "Return #t if PATH is a store path, and not a sub-directory of a store path.
+This predicate is sometimes needed because files *under* a store path are not
+valid inputs."
+  (and (store-path? path)
+       (not (string=? path (%store-prefix)))
+       (let ((len (+ 1 (string-length (%store-prefix)))))
+         (not (string-index (substring path len) #\/)))))
+
+(define (direct-store-path path)
+  "Return the direct store path part of PATH, stripping components after
+'/gnu/store/xxxx-foo'."
+  (let ((prefix-length (+ (string-length (%store-prefix)) 35)))
+    (if (> (string-length path) prefix-length)
+        (let ((slash (string-index path #\/ prefix-length)))
+          (if slash (string-take path slash) path))
+        path)))
+
+(define (derivation-path? path)
+  "Return #t if PATH is a derivation path."
+  (and (store-path? path) (string-suffix? ".drv" path)))
+
+(define (store-path-base path)
+  "Return the base path of a path in the store."
+  (and (string-prefix? (%store-prefix) path)
+       (let ((base (string-drop path (+ 1 (string-length (%store-prefix))))))
+         (and (> (string-length base) 33)
+              (not (string-index base #\/))
+              base))))
+
+(define (store-path-package-name path)
+  "Return the package name part of PATH, a file name in the store."
+  (let ((base (store-path-base path)))
+    (string-drop base (+ 32 1)))) ;32 hash part + 1 hyphen
+
+(define (store-path-hash-part path)
+  "Return the hash part of PATH as a base32 string, or #f if PATH is not a
+syntactically valid store path."
+  (let* ((base (store-path-base path))
+         (hash (string-take base 32)))
+    (and (string-every %nix-base32-charset hash)
+         hash)))
+
+(define (derivation-log-file drv)
+  "Return the build log file for DRV, a derivation file name, or #f if it
+could not be found."
+  (let* ((base    (basename drv))
+         (log     (string-append (or (getenv "GUIX_LOG_DIRECTORY")
+                                     (string-append %localstatedir "/log/guix"))
+                                 "/drvs/"
+                                 (string-take base 2) "/"
+                                 (string-drop base 2)))
+         (log.gz  (string-append log ".gz"))
+         (log.bz2 (string-append log ".bz2")))
+    (cond ((file-exists? log.gz) log.gz)
+          ((file-exists? log.bz2) log.bz2)
+          ((file-exists? log) log)
+          (else #f))))
+
+