guix/derivations.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix derivations)
  20   #:use-module (srfi srfi-1)
  21   #:use-module (srfi srfi-9)
  22   #:use-module (srfi srfi-9 gnu)
  23   #:use-module (srfi srfi-26)
  24   #:use-module (srfi srfi-34)
  25   #:use-module (srfi srfi-35)
  26   #:use-module (ice-9 binary-ports)
  27   #:use-module (rnrs bytevectors)
  28   #:use-module (ice-9 match)
  29   #:use-module (ice-9 rdelim)
  30   #:use-module (ice-9 vlist)
  31   #:use-module (guix store)
  32   #:use-module (guix utils)
  33   #:use-module (guix combinators)
  34   #:use-module (guix monads)
  35   #:use-module (guix hash)
  36   #:use-module (guix base32)
  37   #:use-module (guix records)
  38   #:use-module (guix sets)
  39   #:export (<derivation>
  40             derivation?
  41             derivation-outputs
  42             derivation-inputs
  43             derivation-sources
  44             derivation-system
  45             derivation-builder
  46             derivation-builder-arguments
  47             derivation-builder-environment-vars
  48             derivation-file-name
  49             derivation-prerequisites
  50             derivation-prerequisites-to-build
  51
  52             <derivation-output>
  53             derivation-output?
  54             derivation-output-path
  55             derivation-output-hash-algo
  56             derivation-output-hash
  57             derivation-output-recursive?
  58
  59             <derivation-input>
  60             derivation-input?
  61             derivation-input-path
  62             derivation-input-sub-derivations
  63             derivation-input-output-paths
  64             valid-derivation-input?
  65
  66             &derivation-error
  67             derivation-error?
  68             derivation-error-derivation
  69             &derivation-missing-output-error
  70             derivation-missing-output-error?
  71             derivation-missing-output
  72
  73             derivation-name
  74             derivation-output-names
  75             fixed-output-derivation?
  76             fixed-output-path
  77             offloadable-derivation?
  78             substitutable-derivation?
  79             substitution-oracle
  80             derivation-hash
  81
  82             read-derivation
  83             write-derivation
  84             derivation->output-path
  85             derivation->output-paths
  86             derivation-path->output-path
  87             derivation-path->output-paths
  88             derivation
  89             raw-derivation
  90
  91             map-derivation
  92
  93             build-derivations
  94             built-derivations
  95
  96             file-search-error?
  97             file-search-error-file-name
  98             file-search-error-search-path
  99
 100             search-path*
 101             module->source-file-name
 102             build-expression->derivation)
 103
 104   ;; Re-export it from here for backward compatibility.
 105   #:re-export (%guile-for-build))
 106
 107 ;;;
 108 ;;; Error conditions.
 109 ;;;
 110
 111 (define-condition-type &derivation-error &nix-error
 112   derivation-error?
 113   (derivation derivation-error-derivation))
 114
 115 (define-condition-type &derivation-missing-output-error &derivation-error
 116   derivation-missing-output-error?
 117   (output derivation-missing-output))
 118
 119 ;;;
 120 ;;; Nix derivations, as implemented in Nix's `derivations.cc'.
 121 ;;;
 122
 123 (define-record-type <derivation>
 124   (make-derivation outputs inputs sources system builder args env-vars
 125                    file-name)
 126   derivation?
 127   (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
 128   (inputs   derivation-inputs)       ; list of <derivation-input>
 129   (sources  derivation-sources)      ; list of store paths
 130   (system   derivation-system)       ; string
 131   (builder  derivation-builder)      ; store path
 132   (args     derivation-builder-arguments)         ; list of strings
 133   (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
 134   (file-name derivation-file-name))               ; the .drv file name
 135
 136 (define-record-type <derivation-output>
 137   (make-derivation-output path hash-algo hash recursive?)
 138   derivation-output?
 139   (path       derivation-output-path)             ; store path
 140   (hash-algo  derivation-output-hash-algo)        ; symbol | #f
 141   (hash       derivation-output-hash)             ; bytevector | #f
 142   (recursive? derivation-output-recursive?))      ; Boolean
 143
 144 (define-record-type <derivation-input>
 145   (make-derivation-input path sub-derivations)
 146   derivation-input?
 147   (path            derivation-input-path)             ; store path
 148   (sub-derivations derivation-input-sub-derivations)) ; list of strings
 149
 150 (set-record-type-printer! <derivation>
 151                           (lambda (drv port)
 152                             (format port "#<derivation ~a => ~a ~a>"
 153                                     (derivation-file-name drv)
 154                                     (string-join
 155                                      (map (match-lambda
 156                                            ((_ . output)
 157                                             (derivation-output-path output)))
 158                                           (derivation-outputs drv)))
 159                                     (number->string (object-address drv) 16))))
 160
 161 (define (derivation-name drv)
 162   "Return the base name of DRV."
 163   (let ((base (store-path-package-name (derivation-file-name drv))))
 164     (string-drop-right base 4)))
 165
 166 (define (derivation-output-names drv)
 167   "Return the names of the outputs of DRV."
 168   (match (derivation-outputs drv)
 169     (((names . _) ...)
 170      names)))
 171
 172 (define (fixed-output-derivation? drv)
 173   "Return #t if DRV is a fixed-output derivation, such as the result of a
 174 download with a fixed hash (aka. `fetchurl')."
 175   (match drv
 176     (($ <derivation>
 177         (("out" . ($ <derivation-output> _ (? symbol?) (? bytevector?)))))
 178      #t)
 179     (_ #f)))
 180
 181 (define (derivation-input<? input1 input2)
 182   "Compare INPUT1 and INPUT2, two <derivation-input>."
 183   (string<? (derivation-input-path input1)
 184             (derivation-input-path input2)))
 185
 186 (define (derivation-input-output-paths input)
 187   "Return the list of output paths corresponding to INPUT, a
 188 <derivation-input>."
 189   (match input
 190     (($ <derivation-input> path sub-drvs)
 191      (map (cut derivation-path->output-path path <>)
 192           sub-drvs))))
 193
 194 (define (valid-derivation-input? store input)
 195   "Return true if INPUT is valid--i.e., if all the outputs it requests are in
 196 the store."
 197   (every (cut valid-path? store <>)
 198          (derivation-input-output-paths input)))
 199
 200 (define (coalesce-duplicate-inputs inputs)
 201   "Return a list of inputs, such that when INPUTS contains the same DRV twice,
 202 they are coalesced, with their sub-derivations merged.  This is needed because
 203 Nix itself keeps only one of them."
 204   (fold (lambda (input result)
 205           (match input
 206             (($ <derivation-input> path sub-drvs)
 207              ;; XXX: quadratic
 208              (match (find (match-lambda
 209                             (($ <derivation-input> p s)
 210                              (string=? p path)))
 211                           result)
 212                (#f
 213                 (cons input result))
 214                ((and dup ($ <derivation-input> _ sub-drvs2))
 215                 ;; Merge DUP with INPUT.
 216                 (let ((sub-drvs (delete-duplicates
 217                                  (append sub-drvs sub-drvs2))))
 218                   (cons (make-derivation-input path
 219                                                (sort sub-drvs string<?))
 220                         (delq dup result))))))))
 221         '()
 222         inputs))
 223
 224 (define* (derivation-prerequisites drv #:optional (cut? (const #f)))
 225   "Return the list of derivation-inputs required to build DRV, recursively.
 226
 227 CUT? is a predicate that is passed a derivation-input and returns true to
 228 eliminate the given input and its dependencies from the search.  An example of
 229 search a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
 230 result is the set of prerequisites of DRV not already in valid."
 231   (let loop ((drv       drv)
 232              (result    '())
 233              (input-set (set)))
 234     (let ((inputs (remove (lambda (input)
 235                             (or (set-contains? input-set input)
 236                                 (cut? input)))
 237                           (derivation-inputs drv))))
 238       (fold2 loop
 239              (append inputs result)
 240              (fold set-insert input-set inputs)
 241              (map (lambda (i)
 242                     (call-with-input-file (derivation-input-path i)
 243                       read-derivation))
 244                   inputs)))))
 245
 246 (define (offloadable-derivation? drv)
 247   "Return true if DRV can be offloaded, false otherwise."
 248   (match (assoc "preferLocalBuild"
 249                 (derivation-builder-environment-vars drv))
 250     (("preferLocalBuild" . "1") #f)
 251     (_ #t)))
 252
 253 (define (substitutable-derivation? drv)
 254   "Return #t if DRV can be substituted."
 255   (match (assoc "allowSubstitutes"
 256                 (derivation-builder-environment-vars drv))
 257     (("allowSubstitutes" . value)
 258      (string=? value "1"))
 259     (_ #t)))
 260
 261 (define (derivation-output-paths drv sub-drvs)
 262   "Return the output paths of outputs SUB-DRVS of DRV."
 263   (match drv
 264     (($ <derivation> outputs)
 265      (map (lambda (sub-drv)
 266             (derivation-output-path (assoc-ref outputs sub-drv)))
 267           sub-drvs))))
 268
 269 (define* (substitution-oracle store drv
 270                               #:key (mode (build-mode normal)))
 271   "Return a one-argument procedure that, when passed a store file name,
 272 returns #t if it's substitutable and #f otherwise.  The returned procedure
 273 knows about all substitutes for all the derivations listed in DRV, *except*
 274 those that are already valid (that is, it won't bother checking whether an
 275 item is substitutable if it's already on disk); it also knows about their
 276 prerequisites, unless they are themselves substitutable.
 277
 278 Creating a single oracle (thus making a single 'substitutable-paths' call) and
 279 reusing it is much more efficient than calling 'has-substitutes?' or similar
 280 repeatedly, because it avoids the costs associated with launching the
 281 substituter many times."
 282   (define valid?
 283     (cut valid-path? store <>))
 284
 285   (define valid-input?
 286     (cut valid-derivation-input? store <>))
 287
 288   (define (dependencies drv)
 289     ;; Skip prerequisite sub-trees of DRV whose root is valid.  This allows us
 290     ;; to ask the substituter for just as much as needed, instead of asking it
 291     ;; for the whole world, which can be significantly faster when substitute
 292     ;; info is not already in cache.
 293     (append-map derivation-input-output-paths
 294                 (derivation-prerequisites drv valid-input?)))
 295
 296   (let* ((paths (delete-duplicates
 297                  (concatenate
 298                   (fold (lambda (drv result)
 299                           (let ((self (match (derivation->output-paths drv)
 300                                         (((names . paths) ...)
 301                                          paths))))
 302                             (cond ((eqv? mode (build-mode check))
 303                                    (cons (dependencies drv) result))
 304                                   ((every valid? self)
 305                                    result)
 306                                   (else
 307                                    (cons* self (dependencies drv) result)))))
 308                         '()
 309                         drv))))
 310          (subst (list->set (substitutable-paths store paths))))
 311     (cut set-contains? subst <>)))
 312
 313 (define* (derivation-prerequisites-to-build store drv
 314                                             #:key
 315                                             (mode (build-mode normal))
 316                                             (outputs
 317                                              (derivation-output-names drv))
 318                                             (substitutable?
 319                                              (substitution-oracle store
 320                                                                   (list drv)
 321                                                                   #:mode mode)))
 322   "Return two values: the list of derivation-inputs required to build the
 323 OUTPUTS of DRV and not already available in STORE, recursively, and the list
 324 of required store paths that can be substituted.  SUBSTITUTABLE? must be a
 325 one-argument procedure similar to that returned by 'substitution-oracle'."
 326   (define built?
 327     (cut valid-path? store <>))
 328
 329   (define input-built?
 330     (compose (cut any built? <>) derivation-input-output-paths))
 331
 332   (define input-substitutable?
 333     ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
 334     ;; least one is missing, then everything must be rebuilt.
 335     (compose (cut every substitutable? <>) derivation-input-output-paths))
 336
 337   (define (derivation-built? drv* sub-drvs)
 338     ;; In 'check' mode, assume that DRV is not built.
 339     (and (not (and (eqv? mode (build-mode check))
 340                    (eq? drv* drv)))
 341          (every built? (derivation-output-paths drv* sub-drvs))))
 342
 343   (define (derivation-substitutable? drv sub-drvs)
 344     (and (substitutable-derivation? drv)
 345          (every substitutable? (derivation-output-paths drv sub-drvs))))
 346
 347   (let loop ((drv        drv)
 348              (sub-drvs   outputs)
 349              (build      '())
 350              (substitute '()))
 351     (cond ((derivation-built? drv sub-drvs)
 352            (values build substitute))
 353           ((derivation-substitutable? drv sub-drvs)
 354            (values build
 355                    (append (derivation-output-paths drv sub-drvs)
 356                            substitute)))
 357           (else
 358            (let ((build  (if (substitutable-derivation? drv)
 359                              build
 360                              (cons (make-derivation-input
 361                                     (derivation-file-name drv) sub-drvs)
 362                                    build)))
 363                  (inputs (remove (lambda (i)
 364                                    (or (member i build) ; XXX: quadratic
 365                                        (input-built? i)
 366                                        (input-substitutable? i)))
 367                                  (derivation-inputs drv))))
 368              (fold2 loop
 369                     (append inputs build)
 370                     (append (append-map (lambda (input)
 371                                           (if (and (not (input-built? input))
 372                                                    (input-substitutable? input))
 373                                               (derivation-input-output-paths
 374                                                input)
 375                                               '()))
 376                                         (derivation-inputs drv))
 377                             substitute)
 378                     (map (lambda (i)
 379                            (call-with-input-file (derivation-input-path i)
 380                              read-derivation))
 381                          inputs)
 382                     (map derivation-input-sub-derivations inputs)))))))
 383
 384 (define (%read-derivation drv-port)
 385   ;; Actually read derivation from DRV-PORT.
 386
 387   (define comma (string->symbol ","))
 388
 389   (define (ununquote x)
 390     (match x
 391       (('unquote x) (ununquote x))
 392       ((x ...)      (map ununquote x))
 393       (_            x)))
 394
 395   (define (outputs->alist x)
 396     (fold-right (lambda (output result)
 397                   (match output
 398                     ((name path "" "")
 399                      (alist-cons name
 400                                  (make-derivation-output path #f #f #f)
 401                                  result))
 402                     ((name path hash-algo hash)
 403                      ;; fixed-output
 404                      (let* ((rec? (string-prefix? "r:" hash-algo))
 405                             (algo (string->symbol
 406                                    (if rec?
 407                                        (string-drop hash-algo 2)
 408                                        hash-algo)))
 409                             (hash (base16-string->bytevector hash)))
 410                        (alist-cons name
 411                                    (make-derivation-output path algo
 412                                                            hash rec?)
 413                                    result)))))
 414                 '()
 415                 x))
 416
 417   (define (make-input-drvs x)
 418     (fold-right (lambda (input result)
 419                   (match input
 420                     ((path (sub-drvs ...))
 421                      (cons (make-derivation-input path sub-drvs)
 422                            result))))
 423                 '()
 424                 x))
 425
 426   ;; The contents of a derivation are typically ASCII, but choosing
 427   ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
 428   (set-port-encoding! drv-port "UTF-8")
 429
 430   (let loop ((exp    (read drv-port))
 431              (result '()))
 432     (match exp
 433       ((? eof-object?)
 434        (let ((result (reverse result)))
 435          (match result
 436            (('Derive ((outputs ...) (input-drvs ...)
 437                       (input-srcs ...)
 438                       (? string? system)
 439                       (? string? builder)
 440                       ((? string? args) ...)
 441                       ((var value) ...)))
 442             (make-derivation (outputs->alist outputs)
 443                              (make-input-drvs input-drvs)
 444                              input-srcs
 445                              system builder args
 446                              (fold-right alist-cons '() var value)
 447                              (port-filename drv-port)))
 448            (_
 449             (error "failed to parse derivation" drv-port result)))))
 450       ((? (cut eq? <> comma))
 451        (loop (read drv-port) result))
 452       (_
 453        (loop (read drv-port)
 454              (cons (ununquote exp) result))))))
 455
 456 (define %derivation-cache
 457   ;; Maps derivation file names to <derivation> objects.
 458   ;; XXX: This is redundant with 'atts-cache' in the store.
 459   (make-weak-value-hash-table 200))
 460
 461 (define (read-derivation drv-port)
 462   "Read the derivation from DRV-PORT and return the corresponding
 463 <derivation> object."
 464   ;; Memoize that operation because `%read-derivation' is quite expensive,
 465   ;; and because the same argument is read more than 15 times on average
 466   ;; during something like (package-derivation s gdb).
 467   (let ((file (port-filename drv-port)))
 468     (or (and file (hash-ref %derivation-cache file))
 469         (let ((drv (%read-derivation drv-port)))
 470           (hash-set! %derivation-cache file drv)
 471           drv))))
 472
 473 (define-inlinable (write-sequence lst write-item port)
 474   ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
 475   ;; comma.
 476   (match lst
 477     (()
 478      #t)
 479     ((prefix (... ...) last)
 480      (for-each (lambda (item)
 481                  (write-item item port)
 482                  (display "," port))
 483                prefix)
 484      (write-item last port))))
 485
 486 (define-inlinable (write-list lst write-item port)
 487   ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
 488   ;; element.
 489   (display "[" port)
 490   (write-sequence lst write-item port)
 491   (display "]" port))
 492
 493 (define-inlinable (write-tuple lst write-item port)
 494   ;; Same, but write LST as a tuple.
 495   (display "(" port)
 496   (write-sequence lst write-item port)
 497   (display ")" port))
 498
 499 (define (write-derivation drv port)
 500   "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
 501 Eelco Dolstra's PhD dissertation for an overview of a previous version of
 502 that form."
 503
 504   ;; Make sure we're using the faster implementation.
 505   (define format simple-format)
 506
 507   (define (write-string-list lst)
 508     (write-list lst write port))
 509
 510   (define (write-output output port)
 511     (match output
 512      ((name . ($ <derivation-output> path hash-algo hash recursive?))
 513       (write-tuple (list name path
 514                          (if hash-algo
 515                              (string-append (if recursive? "r:" "")
 516                                             (symbol->string hash-algo))
 517                              "")
 518                          (or (and=> hash bytevector->base16-string)
 519                              ""))
 520                    write
 521                    port))))
 522
 523   (define (write-input input port)
 524     (match input
 525       (($ <derivation-input> path sub-drvs)
 526        (display "(\"" port)
 527        (display path port)
 528        (display "\"," port)
 529        (write-string-list sub-drvs)
 530        (display ")" port))))
 531
 532   (define (write-env-var env-var port)
 533     (match env-var
 534       ((name . value)
 535        (display "(" port)
 536        (write name port)
 537        (display "," port)
 538        (write value port)
 539        (display ")" port))))
 540
 541   ;; Assume all the lists we are writing are already sorted.
 542   (match drv
 543     (($ <derivation> outputs inputs sources
 544         system builder args env-vars)
 545      (display "Derive(" port)
 546      (write-list outputs write-output port)
 547      (display "," port)
 548      (write-list inputs write-input port)
 549      (display "," port)
 550      (write-string-list sources)
 551      (simple-format port ",\"~a\",\"~a\"," system builder)
 552      (write-string-list args)
 553      (display "," port)
 554      (write-list env-vars write-env-var port)
 555      (display ")" port))))
 556
 557 (define derivation->string
 558   (memoize
 559    (lambda (drv)
 560      "Return the external representation of DRV as a string."
 561      (with-fluids ((%default-port-encoding "UTF-8"))
 562        (call-with-output-string
 563         (cut write-derivation drv <>))))))
 564
 565 (define* (derivation->output-path drv #:optional (output "out"))
 566   "Return the store path of its output OUTPUT.  Raise a
 567 '&derivation-missing-output-error' condition if OUTPUT is not an output of
 568 DRV."
 569   (let ((output* (assoc-ref (derivation-outputs drv) output)))
 570     (if output*
 571         (derivation-output-path output*)
 572         (raise (condition (&derivation-missing-output-error
 573                            (derivation drv)
 574                            (output output)))))))
 575
 576 (define (derivation->output-paths drv)
 577   "Return the list of name/path pairs of the outputs of DRV."
 578   (map (match-lambda
 579         ((name . output)
 580          (cons name (derivation-output-path output))))
 581        (derivation-outputs drv)))
 582
 583 (define derivation-path->output-path
 584   ;; This procedure is called frequently, so memoize it.
 585   (memoize
 586    (lambda* (path #:optional (output "out"))
 587      "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
 588 path of its output OUTPUT."
 589      (derivation->output-path (call-with-input-file path read-derivation)
 590                               output))))
 591
 592 (define (derivation-path->output-paths path)
 593   "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
 594 list of name/path pairs of its outputs."
 595   (derivation->output-paths (call-with-input-file path read-derivation)))
 596
 597 \f
 598 ;;;
 599 ;;; Derivation primitive.
 600 ;;;
 601
 602 (define (compressed-hash bv size)                 ; `compressHash'
 603   "Given the hash stored in BV, return a compressed version thereof that fits
 604 in SIZE bytes."
 605   (define new (make-bytevector size 0))
 606   (define old-size (bytevector-length bv))
 607   (let loop ((i 0))
 608     (if (= i old-size)
 609         new
 610         (let* ((j (modulo i size))
 611                (o (bytevector-u8-ref new j)))
 612           (bytevector-u8-set! new j
 613                               (logxor o (bytevector-u8-ref bv i)))
 614           (loop (+ 1 i))))))
 615
 616 (define derivation-path->base16-hash
 617   (memoize
 618    (lambda (file)
 619      "Return a string containing the base16 representation of the hash of the
 620 derivation at FILE."
 621      (call-with-input-file file
 622        (compose bytevector->base16-string
 623                 derivation-hash
 624                 read-derivation)))))
 625
 626 (define derivation-hash            ; `hashDerivationModulo' in derivations.cc
 627   (memoize
 628    (lambda (drv)
 629     "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
 630     (match drv
 631       (($ <derivation> ((_ . ($ <derivation-output> path
 632                                 (? symbol? hash-algo) (? bytevector? hash)
 633                                 (? boolean? recursive?)))))
 634        ;; A fixed-output derivation.
 635        (sha256
 636         (string->utf8
 637          (string-append "fixed:out:"
 638                         (if recursive? "r:" "")
 639                         (symbol->string hash-algo)
 640                         ":" (bytevector->base16-string hash)
 641                         ":" path))))
 642       (($ <derivation> outputs inputs sources
 643           system builder args env-vars)
 644        ;; A regular derivation: replace the path of each input with that
 645        ;; input's hash; return the hash of serialization of the resulting
 646        ;; derivation.
 647        (let* ((inputs (map (match-lambda
 648                             (($ <derivation-input> path sub-drvs)
 649                              (let ((hash (derivation-path->base16-hash path)))
 650                                (make-derivation-input hash sub-drvs))))
 651                            inputs))
 652               (drv    (make-derivation outputs
 653                                        (sort (coalesce-duplicate-inputs inputs)
 654                                              derivation-input<?)
 655                                        sources
 656                                        system builder args env-vars
 657                                        #f)))
 658
 659          ;; XXX: At this point this remains faster than `port-sha256', because
 660          ;; the SHA256 port's `write' method gets called for every single
 661          ;; character.
 662          (sha256
 663           (string->utf8 (derivation->string drv)))))))))
 664
 665 (define (store-path type hash name)               ; makeStorePath
 666   "Return the store path for NAME/HASH/TYPE."
 667   (let* ((s (string-append type ":sha256:"
 668                            (bytevector->base16-string hash) ":"
 669                            (%store-prefix) ":" name))
 670          (h (sha256 (string->utf8 s)))
 671          (c (compressed-hash h 20)))
 672     (string-append (%store-prefix) "/"
 673                    (bytevector->nix-base32-string c) "-"
 674                    name)))
 675
 676 (define (output-path output hash name)            ; makeOutputPath
 677   "Return an output path for OUTPUT (the name of the output as a string) of
 678 the derivation called NAME with hash HASH."
 679   (store-path (string-append "output:" output) hash
 680               (if (string=? output "out")
 681                   name
 682                   (string-append name "-" output))))
 683
 684 (define* (fixed-output-path name hash
 685                             #:key
 686                             (output "out")
 687                             (hash-algo 'sha256)
 688                             (recursive? #t))
 689   "Return an output path for the fixed output OUTPUT defined by HASH of type
 690 HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
 691 'add-to-store'."
 692   (if (and recursive? (eq? hash-algo 'sha256))
 693       (store-path "source" hash name)
 694       (let ((tag (string-append "fixed:" output ":"
 695                                 (if recursive? "r:" "")
 696                                 (symbol->string hash-algo) ":"
 697                                 (bytevector->base16-string hash) ":")))
 698         (store-path (string-append "output:" output)
 699                     (sha256 (string->utf8 tag))
 700                     name))))
 701
 702 (define* (derivation store name builder args
 703                      #:key
 704                      (system (%current-system)) (env-vars '())
 705                      (inputs '()) (outputs '("out"))
 706                      hash hash-algo recursive?
 707                      references-graphs
 708                      allowed-references disallowed-references
 709                      leaked-env-vars local-build?
 710                      (substitutable? #t))
 711   "Build a derivation with the given arguments, and return the resulting
 712 <derivation> object.  When HASH and HASH-ALGO are given, a
 713 fixed-output derivation is created---i.e., one whose result is known in
 714 advance, such as a file download.  If, in addition, RECURSIVE? is true, then
 715 that fixed output may be an executable file or a directory and HASH must be
 716 the hash of an archive containing this output.
 717
 718 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 719 pairs.  In that case, the reference graph of each store path is exported in
 720 the build environment in the corresponding file, in a simple text format.
 721
 722 When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
 723 that the derivation's outputs may refer to.  Likewise, DISALLOWED-REFERENCES,
 724 if true, must be a list of things the outputs may not refer to.
 725
 726 When LEAKED-ENV-VARS is true, it must be a list of strings denoting
 727 environment variables that are allowed to \"leak\" from the daemon's
 728 environment to the build environment.  This is only applicable to fixed-output
 729 derivations--i.e., when HASH is true.  The main use is to allow variables such
 730 as \"http_proxy\" to be passed to derivations that download files.
 731
 732 When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
 733 for offloading and should rather be built locally.  This is the case for small
 734 derivations where the costs of data transfers would outweigh the benefits.
 735
 736 When SUBSTITUTABLE? is false, declare that substitutes of the derivation's
 737 output should not be used."
 738   (define (add-output-paths drv)
 739     ;; Return DRV with an actual store path for each of its output and the
 740     ;; corresponding environment variable.
 741     (match drv
 742       (($ <derivation> outputs inputs sources
 743           system builder args env-vars)
 744        (let* ((drv-hash (derivation-hash drv))
 745               (outputs  (map (match-lambda
 746                               ((output-name . ($ <derivation-output>
 747                                                  _ algo hash rec?))
 748                                (let ((path
 749                                       (if hash
 750                                           (fixed-output-path name hash
 751                                                              #:hash-algo algo
 752                                                              #:output output-name
 753                                                              #:recursive? rec?)
 754                                           (output-path output-name
 755                                                        drv-hash name))))
 756                                  (cons output-name
 757                                        (make-derivation-output path algo
 758                                                                hash rec?)))))
 759                              outputs)))
 760          (make-derivation outputs inputs sources system builder args
 761                           (map (match-lambda
 762                                 ((name . value)
 763                                  (cons name
 764                                        (or (and=> (assoc-ref outputs name)
 765                                                   derivation-output-path)
 766                                            value))))
 767                                env-vars)
 768                           #f)))))
 769
 770   (define (user+system-env-vars)
 771     ;; Some options are passed to the build daemon via the env. vars of
 772     ;; derivations (urgh!).  We hide that from our API, but here is the place
 773     ;; where we kludgify those options.
 774     (let ((env-vars `(,@(if local-build?
 775                             `(("preferLocalBuild" . "1"))
 776                             '())
 777                       ,@(if (not substitutable?)
 778                             `(("allowSubstitutes" . "0"))
 779                             '())
 780                       ,@(if allowed-references
 781                             `(("allowedReferences"
 782                                . ,(string-join allowed-references)))
 783                             '())
 784                       ,@(if disallowed-references
 785                             `(("disallowedReferences"
 786                                . ,(string-join disallowed-references)))
 787                             '())
 788                       ,@(if leaked-env-vars
 789                             `(("impureEnvVars"
 790                                . ,(string-join leaked-env-vars)))
 791                             '())
 792                       ,@env-vars)))
 793       (match references-graphs
 794         (((file . path) ...)
 795          (let ((value (map (cut string-append <> " " <>)
 796                            file path)))
 797            ;; XXX: This all breaks down if an element of FILE or PATH contains
 798            ;; white space.
 799            `(("exportReferencesGraph" . ,(string-join value " "))
 800              ,@env-vars)))
 801         (#f
 802          env-vars))))
 803
 804   (define (env-vars-with-empty-outputs env-vars)
 805     ;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
 806     ;; empty string, even outputs that do not appear in ENV-VARS.
 807     (let ((e (map (match-lambda
 808                    ((name . val)
 809                     (if (member name outputs)
 810                         (cons name "")
 811                         (cons name val))))
 812                   env-vars)))
 813       (fold (lambda (output-name env-vars)
 814               (if (assoc output-name env-vars)
 815                   env-vars
 816                   (append env-vars `((,output-name . "")))))
 817             e
 818             outputs)))
 819
 820   (define (set-file-name drv file)
 821     ;; Set FILE as the 'file-name' field of DRV.
 822     (match drv
 823       (($ <derivation> outputs inputs sources system builder
 824           args env-vars)
 825        (make-derivation outputs inputs sources system builder
 826                         args env-vars file))))
 827
 828   (define input->derivation-input
 829     (match-lambda
 830       (((? derivation? drv))
 831        (make-derivation-input (derivation-file-name drv) '("out")))
 832       (((? derivation? drv) sub-drvs ...)
 833        (make-derivation-input (derivation-file-name drv) sub-drvs))
 834       (((? direct-store-path? input))
 835        (make-derivation-input input '("out")))
 836       (((? direct-store-path? input) sub-drvs ...)
 837        (make-derivation-input input sub-drvs))
 838       ((input . _)
 839        (let ((path (add-to-store store (basename input)
 840                                  #t "sha256" input)))
 841          (make-derivation-input path '())))))
 842
 843   ;; Note: lists are sorted alphabetically, to conform with the behavior of
 844   ;; C++ `std::map' in Nix itself.
 845
 846   (let* ((outputs    (map (lambda (name)
 847                             ;; Return outputs with an empty path.
 848                             (cons name
 849                                   (make-derivation-output "" hash-algo
 850                                                           hash recursive?)))
 851                           (sort outputs string<?)))
 852          (inputs     (sort (coalesce-duplicate-inputs
 853                             (map input->derivation-input
 854                                  (delete-duplicates inputs)))
 855                            derivation-input<?))
 856          (env-vars   (sort (env-vars-with-empty-outputs
 857                             (user+system-env-vars))
 858                            (lambda (e1 e2)
 859                              (string<? (car e1) (car e2)))))
 860          (drv-masked (make-derivation outputs
 861                                       (filter (compose derivation-path?
 862                                                        derivation-input-path)
 863                                               inputs)
 864                                       (filter-map (lambda (i)
 865                                                     (let ((p (derivation-input-path i)))
 866                                                       (and (not (derivation-path? p))
 867                                                            p)))
 868                                                   inputs)
 869                                       system builder args env-vars #f))
 870          (drv        (add-output-paths drv-masked)))
 871
 872     (let* ((file (add-text-to-store store (string-append name ".drv")
 873                                     (derivation->string drv)
 874                                     (map derivation-input-path inputs)))
 875            (drv  (set-file-name drv file)))
 876       (hash-set! %derivation-cache file drv)
 877       drv)))
 878
 879 (define* (map-derivation store drv mapping
 880                          #:key (system (%current-system)))
 881   "Given MAPPING, a list of pairs of derivations, return a derivation based on
 882 DRV where all the 'car's of MAPPING have been replaced by its 'cdr's,
 883 recursively."
 884   (define (substitute str initial replacements)
 885     (fold (lambda (path replacement result)
 886             (string-replace-substring result path
 887                                       replacement))
 888           str
 889           initial replacements))
 890
 891   (define (substitute-file file initial replacements)
 892     (define contents
 893       (with-fluids ((%default-port-encoding #f))
 894         (call-with-input-file file read-string)))
 895
 896     (let ((updated (substitute contents initial replacements)))
 897       (if (string=? updated contents)
 898           file
 899           ;; XXX: permissions aren't preserved.
 900           (add-text-to-store store (store-path-package-name file)
 901                              updated))))
 902
 903   (define input->output-paths
 904     (match-lambda
 905      (((? derivation? drv))
 906       (list (derivation->output-path drv)))
 907      (((? derivation? drv) sub-drvs ...)
 908       (map (cut derivation->output-path drv <>)
 909            sub-drvs))
 910      ((file)
 911       (list file))))
 912
 913   (let ((mapping (fold (lambda (pair result)
 914                          (match pair
 915                            (((? derivation? orig) . replacement)
 916                             (vhash-cons (derivation-file-name orig)
 917                                         replacement result))
 918                            ((file . replacement)
 919                             (vhash-cons file replacement result))))
 920                        vlist-null
 921                        mapping)))
 922     (define rewritten-input
 923       ;; Rewrite the given input according to MAPPING, and return an input
 924       ;; in the format used in 'derivation' calls.
 925       (memoize
 926        (lambda (input loop)
 927          (match input
 928            (($ <derivation-input> path (sub-drvs ...))
 929             (match (vhash-assoc path mapping)
 930               ((_ . (? derivation? replacement))
 931                (cons replacement sub-drvs))
 932               ((_ . replacement)
 933                (list replacement))
 934               (#f
 935                (let* ((drv (loop (call-with-input-file path read-derivation))))
 936                  (cons drv sub-drvs)))))))))
 937
 938     (let loop ((drv drv))
 939       (let* ((inputs       (map (cut rewritten-input <> loop)
 940                                 (derivation-inputs drv)))
 941              (initial      (append-map derivation-input-output-paths
 942                                        (derivation-inputs drv)))
 943              (replacements (append-map input->output-paths inputs))
 944
 945              ;; Sources typically refer to the output directories of the
 946              ;; original inputs, INITIAL.  Rewrite them by substituting
 947              ;; REPLACEMENTS.
 948              (sources      (map (lambda (source)
 949                                   (match (vhash-assoc source mapping)
 950                                     ((_ . replacement)
 951                                      replacement)
 952                                     (#f
 953                                      (substitute-file source
 954                                                       initial replacements))))
 955                                 (derivation-sources drv)))
 956
 957              ;; Now augment the lists of initials and replacements.
 958              (initial      (append (derivation-sources drv) initial))
 959              (replacements (append sources replacements))
 960              (name         (store-path-package-name
 961                             (string-drop-right (derivation-file-name drv)
 962                                                4))))
 963         (derivation store name
 964                     (substitute (derivation-builder drv)
 965                                 initial replacements)
 966                     (map (cut substitute <> initial replacements)
 967                          (derivation-builder-arguments drv))
 968                     #:system system
 969                     #:env-vars (map (match-lambda
 970                                      ((var . value)
 971                                       `(,var
 972                                         . ,(substitute value initial
 973                                                        replacements))))
 974                                     (derivation-builder-environment-vars drv))
 975                     #:inputs (append (map list sources) inputs)
 976                     #:outputs (derivation-output-names drv)
 977                     #:hash (match (derivation-outputs drv)
 978                              ((($ <derivation-output> _ algo hash))
 979                               hash)
 980                              (_ #f))
 981                     #:hash-algo (match (derivation-outputs drv)
 982                                   ((($ <derivation-output> _ algo hash))
 983                                    algo)
 984                                   (_ #f)))))))
 985
 986 \f
 987 ;;;
 988 ;;; Store compatibility layer.
 989 ;;;
 990
 991 (define* (build-derivations store derivations
 992                             #:optional (mode (build-mode normal)))
 993   "Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
 994 the specified MODE."
 995   (build-things store (map (match-lambda
 996                             ((? string? file) file)
 997                             ((and drv ($ <derivation>))
 998                              (derivation-file-name drv)))
 999                            derivations)
1000                 mode))
1001
1002 \f
1003 ;;;
1004 ;;; Guile-based builders.
1005 ;;;
1006
1007 (define (parent-directories file-name)
1008   "Return the list of parent dirs of FILE-NAME, in the order in which an
1009 `mkdir -p' implementation would make them."
1010   (let ((not-slash (char-set-complement (char-set #\/))))
1011     (reverse
1012      (fold (lambda (dir result)
1013              (match result
1014                (()
1015                 (list dir))
1016                ((prev _ ...)
1017                 (cons (string-append prev "/" dir)
1018                       result))))
1019            '()
1020            (remove (cut string=? <> ".")
1021                    (string-tokenize (dirname file-name) not-slash))))))
1022
1023 (define* (imported-files store files              ;deprecated
1024                          #:key (name "file-import")
1025                          (system (%current-system))
1026                          (guile (%guile-for-build)))
1027   "Return a derivation that imports FILES into STORE.  FILES must be a list
1028 of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
1029 system, imported, and appears under FINAL-PATH in the resulting store path."
1030   (let* ((files   (map (match-lambda
1031                         ((final-path . file-name)
1032                          (list final-path
1033                                (add-to-store store (basename final-path) #f
1034                                              "sha256" file-name))))
1035                        files))
1036          (builder
1037           `(begin
1038              (mkdir %output) (chdir %output)
1039              ,@(append-map (match-lambda
1040                             ((final-path store-path)
1041                              (append (match (parent-directories final-path)
1042                                        (() '())
1043                                        ((head ... tail)
1044                                         (append (map (lambda (d)
1045                                                        `(false-if-exception
1046                                                          (mkdir ,d)))
1047                                                      head)
1048                                                 `((or (file-exists? ,tail)
1049                                                       (mkdir ,tail))))))
1050                                      `((symlink ,store-path ,final-path)))))
1051                            files))))
1052     (build-expression->derivation store name builder
1053                                   #:system system
1054                                   #:inputs files
1055                                   #:guile-for-build guile
1056                                   #:local-build? #t)))
1057
1058 ;; The "file not found" error condition.
1059 (define-condition-type &file-search-error &error
1060   file-search-error?
1061   (file     file-search-error-file-name)
1062   (path     file-search-error-search-path))
1063
1064 (define search-path*
1065   ;; A memoizing version of 'search-path' so 'imported-modules' does not end
1066   ;; up looking for the same files over and over again.
1067   (memoize (lambda (path file)
1068              "Search for FILE in PATH and memoize the result.  Raise a
1069 '&file-search-error' condition if it could not be found."
1070              (or (search-path path file)
1071                  (raise (condition
1072                          (&file-search-error (file file)
1073                                              (path path))))))))
1074
1075 (define (module->source-file-name module)
1076   "Return the file name corresponding to MODULE, a Guile module name (a list
1077 of symbols.)"
1078   (string-append (string-join (map symbol->string module) "/")
1079                  ".scm"))
1080
1081 (define* (%imported-modules store modules         ;deprecated
1082                             #:key (name "module-import")
1083                             (system (%current-system))
1084                             (guile (%guile-for-build))
1085                             (module-path %load-path))
1086   "Return a derivation that contains the source files of MODULES, a list of
1087 module names such as `(ice-9 q)'.  All of MODULES must be in the MODULE-PATH
1088 search path."
1089   ;; TODO: Determine the closure of MODULES, build the `.go' files,
1090   ;; canonicalize the source files through read/write, etc.
1091   (let ((files (map (lambda (m)
1092                       (let ((f (module->source-file-name m)))
1093                         (cons f (search-path* module-path f))))
1094                     modules)))
1095     (imported-files store files #:name name #:system system
1096                     #:guile guile)))
1097
1098 (define* (%compiled-modules store modules         ;deprecated
1099                             #:key (name "module-import-compiled")
1100                             (system (%current-system))
1101                             (guile (%guile-for-build))
1102                             (module-path %load-path))
1103   "Return a derivation that builds a tree containing the `.go' files
1104 corresponding to MODULES.  All the MODULES are built in a context where
1105 they can refer to each other."
1106   (let* ((module-drv (%imported-modules store modules
1107                                         #:system system
1108                                         #:guile guile
1109                                         #:module-path module-path))
1110          (module-dir (derivation->output-path module-drv))
1111          (files      (map (lambda (m)
1112                             (let ((f (string-join (map symbol->string m)
1113                                                   "/")))
1114                               (cons (string-append f ".go")
1115                                     (string-append module-dir "/" f ".scm"))))
1116                       modules)))
1117     (define builder
1118       `(begin
1119          (use-modules (system base compile))
1120          (let ((out (assoc-ref %outputs "out")))
1121            (mkdir out)
1122            (chdir out))
1123
1124          (set! %load-path
1125                (cons ,module-dir %load-path))
1126
1127          ,@(map (match-lambda
1128                  ((output . input)
1129                   (let ((make-parent-dirs (map (lambda (dir)
1130                                                  `(unless (file-exists? ,dir)
1131                                                     (mkdir ,dir)))
1132                                                (parent-directories output))))
1133                    `(begin
1134                       ,@make-parent-dirs
1135                       (compile-file ,input
1136                                     #:output-file ,output
1137                                     #:opts %auto-compilation-options)))))
1138                 files)))
1139
1140     (build-expression->derivation store name builder
1141                                   #:inputs `(("modules" ,module-drv))
1142                                   #:system system
1143                                   #:guile-for-build guile
1144                                   #:local-build? #t)))
1145
1146 (define* (build-expression->derivation store name exp ;deprecated
1147                                        #:key
1148                                        (system (%current-system))
1149                                        (inputs '())
1150                                        (outputs '("out"))
1151                                        hash hash-algo recursive?
1152                                        (env-vars '())
1153                                        (modules '())
1154                                        guile-for-build
1155                                        references-graphs
1156                                        allowed-references
1157                                        disallowed-references
1158                                        local-build? (substitutable? #t))
1159   "Return a derivation that executes Scheme expression EXP as a builder
1160 for derivation NAME.  INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
1161 tuples; when SUB-DRV is omitted, \"out\" is assumed.  MODULES is a list
1162 of names of Guile modules from the current search path to be copied in
1163 the store, compiled, and made available in the load path during the
1164 execution of EXP.
1165
1166 EXP is evaluated in an environment where %OUTPUT is bound to the main
1167 output path, %OUTPUTS is bound to a list of output/path pairs, and where
1168 %BUILD-INPUTS is bound to an alist of string/output-path pairs made from
1169 INPUTS.  Optionally, ENV-VARS is a list of string pairs specifying the
1170 name and value of environment variables visible to the builder.  The
1171 builder terminates by passing the result of EXP to `exit'; thus, when
1172 EXP returns #f, the build is considered to have failed.
1173
1174 EXP is built using GUILE-FOR-BUILD (a derivation).  When GUILE-FOR-BUILD is
1175 omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
1176
1177 See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
1178 ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?."
1179   (define guile-drv
1180     (or guile-for-build (%guile-for-build)))
1181
1182   (define guile
1183     (string-append (derivation->output-path guile-drv)
1184                    "/bin/guile"))
1185
1186   (define module-form?
1187     (match-lambda
1188      (((or 'define-module 'use-modules) _ ...) #t)
1189      (_ #f)))
1190
1191   (define source-path
1192     ;; When passed an input that is a source, return its path; otherwise
1193     ;; return #f.
1194     (match-lambda
1195      ((_ (? derivation?) _ ...)
1196       #f)
1197      ((_ path _ ...)
1198       (and (not (derivation-path? path))
1199            path))))
1200
1201   (let* ((prologue `(begin
1202                       ,@(match exp
1203                           ((_ ...)
1204                            ;; Module forms must appear at the top-level so
1205                            ;; that any macros they export can be expanded.
1206                            (filter module-form? exp))
1207                           (_ `(,exp)))
1208
1209                       (define %output (getenv "out"))
1210                       (define %outputs
1211                         (map (lambda (o)
1212                                (cons o (getenv o)))
1213                              ',outputs))
1214                       (define %build-inputs
1215                         ',(map (match-lambda
1216                                 ((name drv . rest)
1217                                  (let ((sub (match rest
1218                                               (() "out")
1219                                               ((x) x))))
1220                                    (cons name
1221                                          (cond
1222                                           ((derivation? drv)
1223                                            (derivation->output-path drv sub))
1224                                           ((derivation-path? drv)
1225                                            (derivation-path->output-path drv
1226                                                                          sub))
1227                                           (else drv))))))
1228                                inputs))
1229
1230                       ,@(if (null? modules)
1231                             '()
1232                             ;; Remove our own settings.
1233                             '((unsetenv "GUILE_LOAD_COMPILED_PATH")))
1234
1235                       ;; Guile sets it, but remove it to avoid conflicts when
1236                       ;; building Guile-using packages.
1237                       (unsetenv "LD_LIBRARY_PATH")))
1238          (builder  (add-text-to-store store
1239                                       (string-append name "-guile-builder")
1240
1241                                       ;; Explicitly use UTF-8 for determinism,
1242                                       ;; and also because UTF-8 output is faster.
1243                                       (with-fluids ((%default-port-encoding
1244                                                      "UTF-8"))
1245                                         (call-with-output-string
1246                                          (lambda (port)
1247                                            (write prologue port)
1248                                            (write
1249                                             `(exit
1250                                               ,(match exp
1251                                                  ((_ ...)
1252                                                   (remove module-form? exp))
1253                                                  (_ `(,exp))))
1254                                             port))))
1255
1256                                       ;; The references don't really matter
1257                                       ;; since the builder is always used in
1258                                       ;; conjunction with the drv that needs
1259                                       ;; it.  For clarity, we add references
1260                                       ;; to the subset of INPUTS that are
1261                                       ;; sources, avoiding references to other
1262                                       ;; .drv; otherwise, BUILDER's hash would
1263                                       ;; depend on those, even if they are
1264                                       ;; fixed-output.
1265                                       (filter-map source-path inputs)))
1266
1267          (mod-drv  (and (pair? modules)
1268                         (%imported-modules store modules
1269                                            #:guile guile-drv
1270                                            #:system system)))
1271          (mod-dir  (and mod-drv
1272                         (derivation->output-path mod-drv)))
1273          (go-drv   (and (pair? modules)
1274                         (%compiled-modules store modules
1275                                            #:guile guile-drv
1276                                            #:system system)))
1277          (go-dir   (and go-drv
1278                         (derivation->output-path go-drv))))
1279     (derivation store name guile
1280                 `("--no-auto-compile"
1281                   ,@(if mod-dir `("-L" ,mod-dir) '())
1282                   ,builder)
1283
1284                 #:system system
1285
1286                 #:inputs `((,(or guile-for-build (%guile-for-build)))
1287                            (,builder)
1288                            ,@(map cdr inputs)
1289                            ,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
1290
1291                 ;; When MODULES is non-empty, shamelessly clobber
1292                 ;; $GUILE_LOAD_COMPILED_PATH.
1293                 #:env-vars (if go-dir
1294                                `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
1295                                  ,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
1296                                                  env-vars))
1297                                env-vars)
1298
1299                 #:hash hash #:hash-algo hash-algo
1300                 #:recursive? recursive?
1301                 #:outputs outputs
1302                 #:references-graphs references-graphs
1303                 #:allowed-references allowed-references
1304                 #:disallowed-references disallowed-references
1305                 #:local-build? local-build?
1306                 #:substitutable? substitutable?)))
1307
1308 \f
1309 ;;;
1310 ;;; Monadic interface.
1311 ;;;
1312
1313 (define built-derivations
1314   (store-lift build-derivations))
1315
1316 (define raw-derivation
1317   (store-lift derivation))