build-aux/compile-all.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
   3 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (use-modules (ice-9 match)
  21              (ice-9 threads)
  22              (guix build compile)
  23              (guix build utils))
  24
  25 (define host (getenv "host"))
  26 (define srcdir (getenv "srcdir"))
  27
  28 (define (relative-file file)
  29   (if (string-prefix? (string-append srcdir "/") file)
  30       (string-drop file (+ 1 (string-length srcdir)))
  31       file))
  32
  33 (define (file-mtime<? f1 f2)
  34   (< (stat:mtime (stat f1))
  35      (stat:mtime (stat f2))))
  36
  37 (define (scm->go file)
  38   (let* ((relative (relative-file file))
  39          (without-extension (string-drop-right relative 4)))
  40     (string-append without-extension ".go")))
  41
  42 (define (file-needs-compilation? file)
  43   (let ((go (scm->go file)))
  44     (or (not (file-exists? go))
  45         (file-mtime<? go file))))
  46
  47 ;; Install a SIGINT handler to give unwind handlers in 'compile-file' an
  48 ;; opportunity to run upon SIGINT and to remove temporary output files.
  49 (sigaction SIGINT
  50   (lambda args
  51     (exit 1)))
  52
  53 (match (command-line)
  54   ((_ . files)
  55    (compile-files srcdir (getcwd)
  56                   (filter file-needs-compilation? files)
  57                   #:host host
  58                   #:report-load (lambda (file total completed)
  59                                   (when file
  60                                     (format #t "  LOAD     ~a~%" file)))
  61                   #:report-compilation (lambda (file total completed)
  62                                          (when file
  63                                            (format #t "  GUILEC   ~a~%"
  64                                                    (scm->go file)))))))