all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
blob 5281c13543faba3b1b54791dafed47de6592e89c 2861 bytes (raw)
name: build-aux/compile-all.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
 
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;;
;;; 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/>.

(use-modules (system base target)
             (ice-9 match)
             (ice-9 threads)
             (guix build utils))

(define compile-options '(format unbound-variable arity-mismatch))

(define host (getenv "host"))

(define srcdir (getenv "srcdir"))

(define (relative-file file)
  (if (string-prefix? (string-append srcdir "/") file)
      (string-drop file (+ 1 (string-length srcdir)))
      file))

(define (file-mtime<? f1 f2)
  (< (stat:mtime (stat f1))
     (stat:mtime (stat f2))))

(define (scm->go file)
  (let* ((relative (relative-file file))
         (without-extension (string-drop-right relative 4)))
    (string-append without-extension ".go")))

(define (file-needs-compilation? file)
  (let ((go (scm->go file)))
    (or (not (file-exists? go))
        (file-mtime<? go file))))

(define (file->module file)
  (let* ((relative (relative-file file))
         (module-path (string-drop-right relative 4)))
    (map string->symbol
         (string-split module-path #\/))))

;;; To work around <http://bugs.gnu.org/15602> (FIXME), we want to load all
;;; files to be compiled first.  We do this via resolve-interface so that the
;;; top-level of each file (module) is only executed once.
(define (load-module-file file)
  (let ((module (file->module file)))
    (format #t "  LOAD     ~a~%" module)
    (resolve-interface module)))

(define (compile-file* file output-mutex)
  (let ((go (scm->go file)))
    (with-mutex output-mutex
      (format #t "  GUILEC   ~a~%" go)
      (force-output))
    (mkdir-p (dirname go))
    (with-target host
      (lambda ()
        (compile-file file
                      #:output-file go
                      #:opts compile-options)))))

(match (command-line)
  ((_ . files)
   (let ((files (filter file-needs-compilation? files)))
     (when (null? files) (primitive-exit 77)) ;skip
     (for-each load-module-file files)
     (let ((mutex (make-mutex)))
       (par-for-each (lambda (file)
                       (compile-file* file mutex))
                     files)))))

debug log:

solving c8ccbd1 ...
found c8ccbd1 in https://yhetil.org/guix/20160127203742.52245ef3@openmailbox.org/
found e0877db in https://git.savannah.gnu.org/cgit/guix.git
preparing index
index prepared:
100644 e0877dbe8c10b2bcfe164d0e0160d3dae65344db	build-aux/compile-all.scm

applying [1/1] https://yhetil.org/guix/20160127203742.52245ef3@openmailbox.org/
diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm\r
index e0877db..c8ccbd1 100644\r

Checking patch build-aux/compile-all.scm...
Applied patch build-aux/compile-all.scm cleanly.

index at:
100644 5281c13543faba3b1b54791dafed47de6592e89c	build-aux/compile-all.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 external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.