unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
blob 7d864423e3ae76db37f676bfcf086c291480df73 5508 bytes (raw)
name: guix/build-system.scm 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
 
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system)
  #:use-module (guix records)
  #:use-module (guix utils)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:export (build-system
            build-system?
            build-system-name
            build-system-description
            build-system-lower

            bag
            bag?
            bag-name
            bag-system
            bag-target
            bag-build-inputs
            bag-host-inputs
            bag-target-inputs
            bag-outputs
            bag-arguments
            bag-build

            make-bag

            build-system-with-c-toolchain
            build-system-with-target))

(define-record-type* <build-system> build-system make-build-system
  build-system?
  (name        build-system-name)         ; symbol
  (description build-system-description)  ; short description
  (lower       build-system-lower))       ; args ... -> bags

;; "Bags" are low-level representations of "packages".  The system and target
;; of a bag is fixed when it's created.  This is because build systems may
;; choose inputs as a function of the system and target.
(define-record-type* <bag> bag %make-bag
  bag?
  (name          bag-name)               ;string

  (system        bag-system)             ;string
  (target        bag-target              ;string | #f
                 (default #f))

  ;; Here we use build/host/target in the sense of the GNU tool chain (info
  ;; "(autoconf) Specifying Target Triplets").
  (build-inputs  bag-build-inputs        ;list of packages
                 (default '()))
  (host-inputs   bag-host-inputs         ;list of packages
                 (default '()))

  ;; "Target inputs" are packages that are built natively, but that are used
  ;; by target programs in a cross-compilation environment.  Thus, they act
  ;; like 'inputs' as far as search paths are concerned.  The only example of
  ;; that is the cross-libc: it is an input of 'cross-gcc', thus built
  ;; natively; yet, we want it to be considered as a target input for the
  ;; purposes of $CPATH, $LIBRARY_PATH, etc.
  (target-inputs bag-target-inputs
                 (default '()))

  (outputs       bag-outputs             ;list of strings
                 (default '("out")))
  (arguments     bag-arguments           ;list
                 (default '()))
  (build         bag-build))             ;bag -> derivation

(define* (make-bag build-system name
                   #:key source (inputs '()) (native-inputs '())
                   (outputs '()) (arguments '())
                   system target)
  "Ask BUILD-SYSTEM to return a 'bag' for NAME, with the given SOURCE,
INPUTS, NATIVE-INPUTS, OUTPUTS, and additional ARGUMENTS.  If TARGET is not
#f, it must be a string with the GNU triplet of a cross-compilation target.

This is the mechanism by which a package is \"lowered\" to a bag, which is the
intermediate representation just above derivations."
  (match build-system
    (($ <build-system> _ description lower)
     (apply lower name
            #:system system
            #:source source
            #:inputs inputs
            #:native-inputs native-inputs
            #:outputs outputs
            #:target target
            arguments))))

(define (build-system-with-c-toolchain bs toolchain)
  "Return a variant of BS, a build system, that uses TOOLCHAIN instead of the
default GNU C/C++ toolchain.  TOOLCHAIN must be a list of
inputs (label/package tuples) providing equivalent functionality, such as the
'gcc-toolchain' package."
  (define lower
    (build-system-lower bs))

  (define toolchain-packages
    ;; These are the GNU toolchain packages pulled in by GNU-BUILD-SYSTEM and
    ;; all the build systems that inherit from it.  Keep the list in sync with
    ;; 'standard-packages' in (guix build-system gnu).
    '("gcc" "binutils" "libc" "libc:static" "ld-wrapper"))

  (define (lower* . args)
    (let ((lowered (apply lower args)))
      (bag
        (inherit lowered)
        (build-inputs
         (append (fold alist-delete
                       (bag-build-inputs lowered)
                       toolchain-packages)
                 toolchain)))))

  (build-system
    (inherit bs)
    (lower lower*)))

(define (build-system-with-target bs target)
  "Return a variant of @var{bs}, a build system, that user @var{target} instead
of the default target."
  (define lower
    (build-system-lower bs))

  (define (lower* . args)
    (parameterize ((%current-target-system target))
      (apply lower
             (append
               (strip-keyword-arguments (list #:target) args)
               (list #:target target)))))

  (build-system
    (inherit bs)
    (lower lower*)))

debug log:

solving 7d864423e3 ...
found 7d864423e3 in https://yhetil.org/guix-patches/20220716194807.20378-1-julien@lepiller.eu/
found 76d670995c in https://git.savannah.gnu.org/cgit/guix.git
preparing index
index prepared:
100644 76d670995ce02ddf87050c14943b0e805c0480b2	guix/build-system.scm

applying [1/1] https://yhetil.org/guix-patches/20220716194807.20378-1-julien@lepiller.eu/
diff --git a/guix/build-system.scm b/guix/build-system.scm
index 76d670995c..7d864423e3 100644

Checking patch guix/build-system.scm...
Applied patch guix/build-system.scm cleanly.

index at:
100644 7d864423e3ae76db37f676bfcf086c291480df73	guix/build-system.scm

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).