diff options
Diffstat (limited to 'guix/build/gnu-cross-build.scm')
-rw-r--r-- | guix/build/gnu-cross-build.scm | 138 |
1 files changed, 0 insertions, 138 deletions
diff --git a/guix/build/gnu-cross-build.scm b/guix/build/gnu-cross-build.scm deleted file mode 100644 index dab60684ac..0000000000 --- a/guix/build/gnu-cross-build.scm +++ /dev/null @@ -1,138 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 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 gnu-cross-build) - #:use-module (guix build utils) - #:use-module ((guix build gnu-build-system) - #:renamer (symbol-prefix-proc 'build:)) - #:use-module (ice-9 ftw) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:export (%standard-cross-phases - gnu-cross-build)) - -;;; Commentary: -;;; -;;; Extension of `gnu-build-system.scm' to support cross-compilation. -;;; -;;; Code: - -(define* (set-paths #:key inputs native-inputs - (search-paths '()) (native-search-paths '()) - #:allow-other-keys) - (define input-directories - (match inputs - (((_ . dir) ...) - dir))) - - (define native-input-directories - (match native-inputs - (((_ . dir) ...) - dir))) - - ;; $PATH must refer only to native (host) inputs since target inputs are not - ;; executable. - (set-path-environment-variable "PATH" '("bin" "sbin") - native-input-directories) - - ;; Search paths for target inputs. - (for-each (match-lambda - ((env-var (directories ...) separator) - (set-path-environment-variable env-var directories - input-directories - #:separator separator))) - search-paths) - - ;; Search paths for native inputs. - (for-each (match-lambda - ((env-var (directories ...) separator) - (set-path-environment-variable env-var directories - native-input-directories - #:separator separator))) - native-search-paths) - - ;; Dump the environment variables as a shell script, for handy debugging. - (system "export > environment-variables")) - -(define* (configure #:key - inputs outputs (configure-flags '()) out-of-source? - target native-inputs - #:allow-other-keys) - (format #t "configuring for cross-compilation to `~a'~%" target) - (apply (assoc-ref build:%standard-phases 'configure) - #:configure-flags (cons (string-append "--host=" target) - configure-flags) - - ;; XXX: The underlying `configure' phase looks for Bash among - ;; #:inputs, so fool it this way. - #:inputs native-inputs - - #:outputs outputs - #:out-of-source? out-of-source? - '())) - -(define* (strip #:key target outputs (strip-binaries? #t) - (strip-flags '("--strip-debug")) - (strip-directories '("lib" "lib64" "libexec" - "bin" "sbin")) - #:allow-other-keys) - ;; TODO: The only difference with `strip' in gnu-build-system.scm is the - ;; name of the strip command; factorize it. - - (define (strip-dir dir) - (format #t "stripping binaries in ~s with flags ~s~%" - dir strip-flags) - (file-system-fold (const #t) - (lambda (path stat result) ; leaf - (zero? (apply system* - (string-append target "-strip") - (append strip-flags (list path))))) - (const #t) ; down - (const #t) ; up - (const #t) ; skip - (lambda (path stat errno result) - (format (current-error-port) - "strip: failed to access `~a': ~a~%" - path (strerror errno)) - #f) - #t - dir)) - - (or (not strip-binaries?) - (every strip-dir - (append-map (match-lambda - ((_ . dir) - (filter-map (lambda (d) - (let ((sub (string-append dir "/" d))) - (and (directory-exists? sub) sub))) - strip-directories))) - outputs)))) - -(define %standard-cross-phases - ;; The standard phases when cross-building. - (let ((replacements `((set-paths ,set-paths) - (configure ,configure) - (strip ,strip)))) - (fold (lambda (replacement phases) - (match replacement - ((name proc) - (alist-replace name proc phases)))) - (alist-delete 'check build:%standard-phases) - replacements))) - -;;; gnu-cross-build.scm ends here |