guix/derivations.scm

   1 ;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
   2 ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of Guix.
   5 ;;;
   6 ;;; 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 ;;; 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 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-26)
  23   #:use-module (rnrs io ports)
  24   #:use-module (rnrs bytevectors)
  25   #:use-module (ice-9 match)
  26   #:use-module (ice-9 rdelim)
  27   #:use-module (guix store)
  28   #:use-module (guix utils)
  29   #:use-module (guix base32)
  30   #:export (<derivation>
  31             derivation?
  32             derivation-outputs
  33             derivation-inputs
  34             derivation-sources
  35             derivation-system
  36             derivation-builder-arguments
  37             derivation-builder-environment-vars
  38             derivation-prerequisites
  39             derivation-prerequisites-to-build
  40
  41             <derivation-output>
  42             derivation-output?
  43             derivation-output-path
  44             derivation-output-hash-algo
  45             derivation-output-hash
  46
  47             <derivation-input>
  48             derivation-input?
  49             derivation-input-path
  50             derivation-input-sub-derivations
  51
  52             fixed-output-derivation?
  53             derivation-hash
  54
  55             read-derivation
  56             write-derivation
  57             derivation-path->output-path
  58             derivation
  59
  60             %guile-for-build
  61             build-expression->derivation
  62             imported-files))
  63
  64 ;;;
  65 ;;; Nix derivations, as implemented in Nix's `derivations.cc'.
  66 ;;;
  67
  68 (define-record-type <derivation>
  69   (make-derivation outputs inputs sources system builder args env-vars)
  70   derivation?
  71   (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
  72   (inputs   derivation-inputs)       ; list of <derivation-input>
  73   (sources  derivation-sources)      ; list of store paths
  74   (system   derivation-system)       ; string
  75   (builder  derivation-builder)      ; store path
  76   (args     derivation-builder-arguments)         ; list of strings
  77   (env-vars derivation-builder-environment-vars)) ; list of name/value pairs
  78
  79 (define-record-type <derivation-output>
  80   (make-derivation-output path hash-algo hash)
  81   derivation-output?
  82   (path       derivation-output-path)             ; store path
  83   (hash-algo  derivation-output-hash-algo)        ; symbol | #f
  84   (hash       derivation-output-hash))            ; bytevector | #f
  85
  86 (define-record-type <derivation-input>
  87   (make-derivation-input path sub-derivations)
  88   derivation-input?
  89   (path            derivation-input-path)             ; store path
  90   (sub-derivations derivation-input-sub-derivations)) ; list of strings
  91
  92 (define (fixed-output-derivation? drv)
  93   "Return #t if DRV is a fixed-output derivation, such as the result of a
  94 download with a fixed hash (aka. `fetchurl')."
  95   (match drv
  96     (($ <derivation>
  97         (($ <derivation-output> _ (? symbol?) (? string?))))
  98      #t)
  99     (_ #f)))
 100
 101 (define (derivation-prerequisites drv)
 102   "Return the list of derivation-inputs required to build DRV, recursively."
 103   (let loop ((drv    drv)
 104              (result '()))
 105     (let ((inputs (remove (cut member <> result)  ; XXX: quadratic
 106                           (derivation-inputs drv))))
 107       (fold loop
 108             (append inputs result)
 109             (map (lambda (i)
 110                    (call-with-input-file (derivation-input-path i)
 111                      read-derivation))
 112                  inputs)))))
 113
 114 (define (derivation-prerequisites-to-build store drv)
 115   "Return the list of derivation-inputs required to build DRV and not already
 116 available in STORE, recursively."
 117   (define input-built?
 118     (match-lambda
 119      (($ <derivation-input> path sub-drvs)
 120       (let ((out (map (cut derivation-path->output-path path <>)
 121                       sub-drvs)))
 122         (any (cut valid-path? store <>) out)))))
 123
 124   (let loop ((drv    drv)
 125              (result '()))
 126     (let ((inputs (remove (lambda (i)
 127                             (or (member i result) ; XXX: quadratic
 128                                 (input-built? i)))
 129                           (derivation-inputs drv))))
 130       (fold loop
 131             (append inputs result)
 132             (map (lambda (i)
 133                    (call-with-input-file (derivation-input-path i)
 134                      read-derivation))
 135                  inputs)))))
 136
 137 (define (read-derivation drv-port)
 138   "Read the derivation from DRV-PORT and return the corresponding
 139 <derivation> object."
 140
 141   (define comma (string->symbol ","))
 142
 143   (define (ununquote x)
 144     (match x
 145       (('unquote x) (ununquote x))
 146       ((x ...)      (map ununquote x))
 147       (_            x)))
 148
 149   (define (outputs->alist x)
 150     (fold-right (lambda (output result)
 151                   (match output
 152                     ((name path "" "")
 153                      (alist-cons name
 154                                  (make-derivation-output path #f #f)
 155                                  result))
 156                     ((name path hash-algo hash)
 157                      ;; fixed-output
 158                      (let ((algo (string->symbol hash-algo))
 159                            (hash (base16-string->bytevector hash)))
 160                        (alist-cons name
 161                                    (make-derivation-output path algo hash)
 162                                    result)))))
 163                 '()
 164                 x))
 165
 166   (define (make-input-drvs x)
 167     (fold-right (lambda (input result)
 168                   (match input
 169                     ((path (sub-drvs ...))
 170                      (cons (make-derivation-input path sub-drvs)
 171                            result))))
 172                 '()
 173                 x))
 174
 175   ;; The contents of a derivation are typically ASCII, but choosing
 176   ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
 177   (set-port-encoding! drv-port "UTF-8")
 178
 179   (let loop ((exp    (read drv-port))
 180              (result '()))
 181     (match exp
 182       ((? eof-object?)
 183        (let ((result (reverse result)))
 184          (match result
 185            (('Derive ((outputs ...) (input-drvs ...)
 186                       (input-srcs ...)
 187                       (? string? system)
 188                       (? string? builder)
 189                       ((? string? args) ...)
 190                       ((var value) ...)))
 191             (make-derivation (outputs->alist outputs)
 192                              (make-input-drvs input-drvs)
 193                              input-srcs
 194                              system builder args
 195                              (fold-right alist-cons '() var value)))
 196            (_
 197             (error "failed to parse derivation" drv-port result)))))
 198       ((? (cut eq? <> comma))
 199        (loop (read drv-port) result))
 200       (_
 201        (loop (read drv-port)
 202              (cons (ununquote exp) result))))))
 203
 204 (define (write-derivation drv port)
 205   "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
 206 Eelco Dolstra's PhD dissertation for an overview of a previous version of
 207 that form."
 208
 209   ;; Make sure we're using the faster implementation.
 210   (define format simple-format)
 211
 212   (define (list->string lst)
 213     (string-append "[" (string-join lst ",") "]"))
 214
 215   (define (write-list lst)
 216     (display (list->string lst) port))
 217
 218   (define (coalesce-duplicate-inputs inputs)
 219     ;; Return a list of inputs, such that when INPUTS contains the same DRV
 220     ;; twice, they are coalesced, with their sub-derivations merged.  This is
 221     ;; needed because Nix itself keeps only one of them.
 222     (fold (lambda (input result)
 223             (match input
 224               (($ <derivation-input> path sub-drvs)
 225                ;; XXX: quadratic
 226                (match (find (match-lambda
 227                              (($ <derivation-input> p s)
 228                               (string=? p path)))
 229                             result)
 230                  (#f
 231                   (cons input result))
 232                  ((and dup ($ <derivation-input> _ sub-drvs2))
 233                   ;; Merge DUP with INPUT.
 234                   (let ((sub-drvs (delete-duplicates
 235                                    (append sub-drvs sub-drvs2))))
 236                     (cons (make-derivation-input path sub-drvs)
 237                           (delq dup result))))))))
 238           '()
 239           inputs))
 240
 241   ;; Note: lists are sorted alphabetically, to conform with the behavior of
 242   ;; C++ `std::map' in Nix itself.
 243
 244   (match drv
 245     (($ <derivation> outputs inputs sources
 246         system builder args env-vars)
 247      (display "Derive(" port)
 248      (write-list (map (match-lambda
 249                        ((name . ($ <derivation-output> path hash-algo hash))
 250                         (format #f "(~s,~s,~s,~s)"
 251                                 name path
 252                                 (or (and=> hash-algo symbol->string) "")
 253                                 (or (and=> hash bytevector->base16-string)
 254                                     ""))))
 255                       (sort outputs
 256                             (lambda (o1 o2)
 257                               (string<? (car o1) (car o2))))))
 258      (display "," port)
 259      (write-list (map (match-lambda
 260                        (($ <derivation-input> path sub-drvs)
 261                         (format #f "(~s,~a)" path
 262                                 (list->string (map object->string
 263                                                    (sort sub-drvs string<?))))))
 264                       (sort (coalesce-duplicate-inputs inputs)
 265                             (lambda (i1 i2)
 266                               (string<? (derivation-input-path i1)
 267                                         (derivation-input-path i2))))))
 268      (display "," port)
 269      (write-list (map object->string (sort sources string<?)))
 270      (format port ",~s,~s," system builder)
 271      (write-list (map object->string args))
 272      (display "," port)
 273      (write-list (map (match-lambda
 274                        ((name . value)
 275                         (format #f "(~s,~s)" name value)))
 276                       (sort env-vars
 277                             (lambda (e1 e2)
 278                               (string<? (car e1) (car e2))))))
 279      (display ")" port))))
 280
 281 (define derivation-path->output-path
 282   ;; This procedure is called frequently, so memoize it.
 283   (memoize
 284    (lambda* (path #:optional (output "out"))
 285      "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store
 286 path of its output OUTPUT."
 287      (let* ((drv     (call-with-input-file path read-derivation))
 288             (outputs (derivation-outputs drv)))
 289        (and=> (assoc-ref outputs output) derivation-output-path)))))
 290
 291 \f
 292 ;;;
 293 ;;; Derivation primitive.
 294 ;;;
 295
 296 (define (compressed-hash bv size)                 ; `compressHash'
 297   "Given the hash stored in BV, return a compressed version thereof that fits
 298 in SIZE bytes."
 299   (define new (make-bytevector size 0))
 300   (define old-size (bytevector-length bv))
 301   (let loop ((i 0))
 302     (if (= i old-size)
 303         new
 304         (let* ((j (modulo i size))
 305                (o (bytevector-u8-ref new j)))
 306           (bytevector-u8-set! new j
 307                               (logxor o (bytevector-u8-ref bv i)))
 308           (loop (+ 1 i))))))
 309
 310 (define derivation-hash            ; `hashDerivationModulo' in derivations.cc
 311   (memoize
 312    (lambda (drv)
 313     "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
 314     (match drv
 315       (($ <derivation> ((_ . ($ <derivation-output> path
 316                                 (? symbol? hash-algo) (? bytevector? hash)))))
 317        ;; A fixed-output derivation.
 318        (sha256
 319         (string->utf8
 320          (string-append "fixed:out:" (symbol->string hash-algo)
 321                         ":" (bytevector->base16-string hash)
 322                         ":" path))))
 323       (($ <derivation> outputs inputs sources
 324           system builder args env-vars)
 325        ;; A regular derivation: replace the path of each input with that
 326        ;; input's hash; return the hash of serialization of the resulting
 327        ;; derivation.
 328        (let* ((inputs (map (match-lambda
 329                             (($ <derivation-input> path sub-drvs)
 330                              (let ((hash (call-with-input-file path
 331                                            (compose bytevector->base16-string
 332                                                     derivation-hash
 333                                                     read-derivation))))
 334                                (make-derivation-input hash sub-drvs))))
 335                            inputs))
 336               (drv    (make-derivation outputs inputs sources
 337                                        system builder args env-vars)))
 338          (sha256
 339           (string->utf8 (call-with-output-string
 340                          (cut write-derivation drv <>))))))))))
 341
 342 (define (store-path type hash name)               ; makeStorePath
 343   "Return the store path for NAME/HASH/TYPE."
 344   (let* ((s (string-append type ":sha256:"
 345                            (bytevector->base16-string hash) ":"
 346                            (%store-prefix) ":" name))
 347          (h (sha256 (string->utf8 s)))
 348          (c (compressed-hash h 20)))
 349     (string-append (%store-prefix) "/"
 350                    (bytevector->nix-base32-string c) "-"
 351                    name)))
 352
 353 (define (output-path output hash name)            ; makeOutputPath
 354   "Return an output path for OUTPUT (the name of the output as a string) of
 355 the derivation called NAME with hash HASH."
 356   (store-path (string-append "output:" output) hash
 357               (if (string=? output "out")
 358                   name
 359                   (string-append name "-" output))))
 360
 361 (define* (derivation store name system builder args env-vars inputs
 362                      #:key (outputs '("out")) hash hash-algo hash-mode)
 363   "Build a derivation with the given arguments.  Return the resulting
 364 store path and <derivation> object.  When HASH, HASH-ALGO, and HASH-MODE
 365 are given, a fixed-output derivation is created---i.e., one whose result is
 366 known in advance, such as a file download."
 367   (define (add-output-paths drv)
 368     ;; Return DRV with an actual store path for each of its output and the
 369     ;; corresponding environment variable.
 370     (match drv
 371       (($ <derivation> outputs inputs sources
 372           system builder args env-vars)
 373        (let* ((drv-hash (derivation-hash drv))
 374               (outputs  (map (match-lambda
 375                               ((output-name . ($ <derivation-output>
 376                                                  _ algo hash))
 377                                (let ((path (output-path output-name
 378                                                         drv-hash name)))
 379                                  (cons output-name
 380                                        (make-derivation-output path algo
 381                                                                hash)))))
 382                              outputs)))
 383          (make-derivation outputs inputs sources system builder args
 384                           (map (match-lambda
 385                                 ((name . value)
 386                                  (cons name
 387                                        (or (and=> (assoc-ref outputs name)
 388                                                   derivation-output-path)
 389                                            value))))
 390                                env-vars))))))
 391
 392   (define (env-vars-with-empty-outputs)
 393     ;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
 394     ;; empty string, even outputs that do not appear in ENV-VARS.
 395     (let ((e (map (match-lambda
 396                    ((name . val)
 397                     (if (member name outputs)
 398                         (cons name "")
 399                         (cons name val))))
 400                   env-vars)))
 401       (fold (lambda (output-name env-vars)
 402               (if (assoc output-name env-vars)
 403                   env-vars
 404                   (append env-vars `((,output-name . "")))))
 405             e
 406             outputs)))
 407
 408   (let* ((outputs    (map (lambda (name)
 409                             ;; Return outputs with an empty path.
 410                             (cons name
 411                                   (make-derivation-output "" hash-algo hash)))
 412                           outputs))
 413          (inputs     (map (match-lambda
 414                            (((? store-path? input))
 415                             (make-derivation-input input '("out")))
 416                            (((? store-path? input) sub-drvs ...)
 417                             (make-derivation-input input sub-drvs))
 418                            ((input . _)
 419                             (let ((path (add-to-store store
 420                                                       (basename input)
 421                                                       (hash-algo sha256) #t #t
 422                                                       input)))
 423                               (make-derivation-input path '()))))
 424                           (delete-duplicates inputs)))
 425          (env-vars   (env-vars-with-empty-outputs))
 426          (drv-masked (make-derivation outputs
 427                                       (filter (compose derivation-path?
 428                                                        derivation-input-path)
 429                                               inputs)
 430                                       (filter-map (lambda (i)
 431                                                     (let ((p (derivation-input-path i)))
 432                                                       (and (not (derivation-path? p))
 433                                                            p)))
 434                                                   inputs)
 435                                       system builder args env-vars))
 436          (drv        (add-output-paths drv-masked)))
 437
 438     ;; (write-derivation drv-masked (current-error-port))
 439     ;; (newline (current-error-port))
 440     (values (add-text-to-store store (string-append name ".drv")
 441                                (call-with-output-string
 442                                 (cut write-derivation drv <>))
 443                                (map derivation-input-path
 444                                     inputs))
 445             drv)))
 446
 447 \f
 448 ;;;
 449 ;;; Guile-based builders.
 450 ;;;
 451
 452 (define %guile-for-build
 453   ;; The derivation of the Guile to be used within the build environment,
 454   ;; when using `build-expression->derivation'.
 455   (make-parameter #f))
 456
 457 (define (parent-directories file-name)
 458   "Return the list of parent dirs of FILE-NAME, in the order in which an
 459 `mkdir -p' implementation would make them."
 460   (let ((not-slash (char-set-complement (char-set #\/))))
 461     (reverse
 462      (fold (lambda (dir result)
 463              (match result
 464                (()
 465                 (list dir))
 466                ((prev _ ...)
 467                 (cons (string-append prev "/" dir)
 468                       result))))
 469            '()
 470            (remove (cut string=? <> ".")
 471                    (string-tokenize (dirname file-name) not-slash))))))
 472
 473 (define* (imported-files store files
 474                          #:key (name "file-import")
 475                          (system (%current-system))
 476                          (guile (%guile-for-build)))
 477   "Return a derivation that imports FILES into STORE.  FILES must be a list
 478 of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
 479 system, imported, and appears under FINAL-PATH in the resulting store path."
 480   (let* ((files   (map (match-lambda
 481                         ((final-path . file-name)
 482                          (list final-path
 483                                (add-to-store store (basename final-path) #t #f
 484                                              "sha256" file-name))))
 485                        files))
 486          (builder
 487           `(begin
 488              (mkdir %output) (chdir %output)
 489              ,@(append-map (match-lambda
 490                             ((final-path store-path)
 491                              (append (match (parent-directories final-path)
 492                                        (() '())
 493                                        ((head ... tail)
 494                                         (append (map (lambda (d)
 495                                                        `(false-if-exception
 496                                                          (mkdir ,d)))
 497                                                      head)
 498                                                 `((or (file-exists? ,tail)
 499                                                       (mkdir ,tail))))))
 500                                      `((symlink ,store-path ,final-path)))))
 501                            files))))
 502     (build-expression->derivation store name system
 503                                   builder files
 504                                   #:guile-for-build guile)))
 505
 506 (define* (imported-modules store modules
 507                            #:key (name "module-import")
 508                            (system (%current-system))
 509                            (guile (%guile-for-build)))
 510   "Return a derivation that contains the source files of MODULES, a list of
 511 module names such as `(ice-9 q)'.  All of MODULES must be in the current
 512 search path."
 513   ;; TODO: Determine the closure of MODULES, build the `.go' files,
 514   ;; canonicalize the source files through read/write, etc.
 515   (let ((files (map (lambda (m)
 516                       (let ((f (string-append
 517                                 (string-join (map symbol->string m) "/")
 518                                 ".scm")))
 519                         (cons f (search-path %load-path f))))
 520                     modules)))
 521     (imported-files store files #:name name #:system system
 522                     #:guile guile)))
 523
 524 (define* (compiled-modules store modules
 525                            #:key (name "module-import-compiled")
 526                            (system (%current-system))
 527                            (guile (%guile-for-build)))
 528   "Return a derivation that builds a tree containing the `.go' files
 529 corresponding to MODULES.  All the MODULES are built in a context where
 530 they can refer to each other."
 531   (let* ((module-drv (imported-modules store modules
 532                                        #:system system
 533                                        #:guile guile))
 534          (module-dir (derivation-path->output-path module-drv))
 535          (files      (map (lambda (m)
 536                             (let ((f (string-join (map symbol->string m)
 537                                                   "/")))
 538                               (cons (string-append f ".go")
 539                                     (string-append module-dir "/" f ".scm"))))
 540                       modules)))
 541     (define builder
 542       `(begin
 543          (use-modules (system base compile))
 544          (let ((out (assoc-ref %outputs "out")))
 545            (mkdir out)
 546            (chdir out))
 547
 548          (set! %load-path
 549                (cons ,module-dir %load-path))
 550
 551          ,@(map (match-lambda
 552                  ((output . input)
 553                   (let ((make-parent-dirs (map (lambda (dir)
 554                                                  `(unless (file-exists? ,dir)
 555                                                     (mkdir ,dir)))
 556                                                (parent-directories output))))
 557                    `(begin
 558                       ,@make-parent-dirs
 559                       (compile-file ,input
 560                                     #:output-file ,output
 561                                     #:opts %auto-compilation-options)))))
 562                 files)))
 563
 564     (build-expression->derivation store name system builder
 565                                   `(("modules" ,module-drv))
 566                                   #:guile-for-build guile)))
 567
 568 (define* (build-expression->derivation store name system exp inputs
 569                                        #:key (outputs '("out"))
 570                                        hash hash-algo
 571                                        (env-vars '())
 572                                        (modules '())
 573                                        guile-for-build)
 574   "Return a derivation that executes Scheme expression EXP as a builder for
 575 derivation NAME.  INPUTS must be a list of (NAME DRV-PATH SUB-DRV) tuples;
 576 when SUB-DRV is omitted, \"out\" is assumed.  EXP is evaluated in an
 577 environment where %OUTPUT is bound to the main output path, %OUTPUTS is bound
 578 to a list of output/path pairs, and where %BUILD-INPUTS is bound to an alist
 579 of string/output-path pairs made from INPUTS.  Optionally, ENV-VARS is a list
 580 of string pairs specifying the name and value of environment variables
 581 visible to the builder.  The builder terminates by passing the result of EXP
 582 to `exit'; thus, when EXP returns #f, the build is considered to have
 583 failed.
 584
 585 EXP is built using GUILE-FOR-BUILD (a derivation).  When GUILE-FOR-BUILD is
 586 omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
 587   (define guile-drv
 588     (or guile-for-build (%guile-for-build)))
 589
 590   (define guile
 591     (string-append (derivation-path->output-path guile-drv)
 592                    "/bin/guile"))
 593
 594   (define module-form?
 595     (match-lambda
 596       (((or 'define-module 'use-modules) _ ...) #t)
 597       (_ #f)))
 598
 599   (define source-path
 600     ;; When passed an input that is a source, return its path; otherwise
 601     ;; return #f.
 602     (match-lambda
 603      ((_ path _ ...)
 604       (and (not (derivation-path? path))
 605            path))))
 606
 607   (let* ((prologue `(begin
 608                       ,@(match exp
 609                           ((_ ...)
 610                            ;; Module forms must appear at the top-level so
 611                            ;; that any macros they export can be expanded.
 612                            (filter module-form? exp))
 613                           (_ `(,exp)))
 614
 615                       (define %output (getenv "out"))
 616                       (define %outputs
 617                         (map (lambda (o)
 618                                (cons o (getenv o)))
 619                              ',outputs))
 620                       (define %build-inputs
 621                         ',(map (match-lambda
 622                                 ((name drv . rest)
 623                                  (let ((sub (match rest
 624                                               (() "out")
 625                                               ((x) x))))
 626                                    (cons name
 627                                          (if (derivation-path? drv)
 628                                              (derivation-path->output-path drv
 629                                                                            sub)
 630                                              drv)))))
 631                                inputs))
 632
 633                       ,@(if (null? modules)
 634                             '()
 635                             ;; Remove our own settings.
 636                             '((unsetenv "GUILE_LOAD_COMPILED_PATH")))
 637
 638                       ;; Guile sets it, but remove it to avoid conflicts when
 639                       ;; building Guile-using packages.
 640                       (unsetenv "LD_LIBRARY_PATH")))
 641          (builder  (add-text-to-store store
 642                                       (string-append name "-guile-builder")
 643                                       (string-append
 644                                        (object->string prologue)
 645                                        (object->string
 646                                         `(exit
 647                                           ,(match exp
 648                                              ((_ ...)
 649                                               (remove module-form? exp))
 650                                              (_ `(,exp))))))
 651
 652                                       ;; The references don't really matter
 653                                       ;; since the builder is always used in
 654                                       ;; conjunction with the drv that needs
 655                                       ;; it.  For clarity, we add references
 656                                       ;; to the subset of INPUTS that are
 657                                       ;; sources, avoiding references to other
 658                                       ;; .drv; otherwise, BUILDER's hash would
 659                                       ;; depend on those, even if they are
 660                                       ;; fixed-output.
 661                                       (filter-map source-path inputs)))
 662
 663          (mod-drv  (and (pair? modules)
 664                         (imported-modules store modules
 665                                           #:guile guile-drv
 666                                           #:system system)))
 667          (mod-dir  (and mod-drv
 668                         (derivation-path->output-path mod-drv)))
 669          (go-drv   (and (pair? modules)
 670                         (compiled-modules store modules
 671                                           #:guile guile-drv
 672                                           #:system system)))
 673          (go-dir   (and go-drv
 674                         (derivation-path->output-path go-drv))))
 675     (derivation store name system guile
 676                 `("--no-auto-compile"
 677                   ,@(if mod-dir `("-L" ,mod-dir) '())
 678                   ,builder)
 679
 680                 ;; When MODULES is non-empty, shamelessly clobber
 681                 ;; $GUILE_LOAD_COMPILED_PATH.
 682                 (if go-dir
 683                     `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
 684                       ,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
 685                                       env-vars))
 686                     env-vars)
 687
 688                 `((,(or guile-for-build (%guile-for-build)))
 689                   (,builder)
 690                   ,@(map cdr inputs)
 691                   ,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
 692                 #:hash hash #:hash-algo hash-algo
 693                 #:outputs outputs)))