;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016 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/>.

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

(define warnings
  '(unsupported-warning 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-fluids ((*current-warning-prefix* ""))
      (with-target host
        (lambda ()
          (compile-file file
                        #:output-file go
                        #:opts `(#:warnings ,warnings)))))))

(match (command-line)
  ((_ . files)
   (let ((files (filter file-needs-compilation? files)))
     (for-each load-module-file files)
     (let ((mutex (make-mutex)))
       (par-for-each (lambda (file)
                       (compile-file* file mutex))
                     files)))))

;;; Local Variables:
;;; eval: (put 'with-target 'scheme-indent-function 1)
;;; End:
cad: Update to 19.07.1.</a><span class='msg-avail'>...</span></td><td>Eric Bavier</td></tr>
<tr><td><span title='2019-05-03 08:45:55 +0200'>2019-05-03</span></td><td><a href='/guix/commit/.mailmap?id=3e85909044d8d9b492bcd2ecedde26d71794f145'>Correct email address for ison.</a><span class='msg-avail'>...</span></td><td>ison</td></tr>
<tr><td><span title='2019-03-18 15:05:08 +0100'>2019-03-18</span></td><td><a href='/guix/commit/.mailmap?id=47956fa0c24efcdcba3493f0231c30e9a39ec7df'>Correct name and email address for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2019-01-21 10:10:43 +0100'>2019-01-21</span></td><td><a href='/guix/commit/.mailmap?id=e3634bd0a3480bde3aba5bd6d84d7aff25413207'>Update .mailmap.</a><span class='msg-avail'>...</span></td><td>Mathieu Othacehe</td></tr>
<tr><td><span title='2018-08-27 14:46:26 +0200'>2018-08-27</span></td><td><a href='/guix/commit/.mailmap?id=4715f92ef0b9650cc4075c69f17aa51e84da3f21'>Update email for Pierre Neidhardt.</a><span class='msg-avail'>...</span></td><td>Pierre Neidhardt</td></tr>
<tr><td><span title='2018-07-16 17:14:39 +0200'>2018-07-16</span></td><td><a href='/guix/commit/.mailmap?id=8bbb79cf95a07a40950448a8a09d888254404ed4'>mailmap: Add a line for Pierre-Antoine.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-07-16 16:53:50 +0200'>2018-07-16</span></td><td><a href='/guix/commit/.mailmap?id=33f4d14ab17096984404fc404b4539d784ecbf32'>mailmap: Add another line for myself.</a><span class='msg-avail'>...</span></td><td>Nils Gillmann</td></tr>
<tr><td><span title='2018-03-20 17:17:58 +0100'>2018-03-20</span></td><td><a href='/guix/commit/.mailmap?id=4a78fd4617908546be15d2c101f5cab512c71f8e'>Correct name and Email for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2018-02-11 09:44:11 -0500'>2018-02-11</span></td><td><a href='/guix/commit/.mailmap?id=c275462025917ad7b8e182f29d6580804e585643'>mailmap: Adjust entries for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2017-11-26 18:21:19 -0500'>2017-11-26</span></td><td><a href='/guix/commit/.mailmap?id=9221979e367a95c14a35236742792fb624d8e47c'>Update e-mail for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2017-10-03 17:07:54 +0200'>2017-10-03</span></td><td><a href='/guix/commit/.mailmap?id=d109b1e85c5c1438e66dfc05ea4a018418edaf19'>Update e-mail for Theodoros Foradis.</a><span class='msg-avail'>...</span></td><td>Theodoros Foradis</td></tr>
<tr><td><span title='2017-08-29 20:13:24 -0400'>2017-08-29</span></td><td><a href='/guix/commit/.mailmap?id=3c8ba11a97d3f3b671b8919da8c41f0b0e2ccaf3'>Update e-mail for Kei Kebreau.</a><span class='msg-avail'>...</span></td><td>Kei Kebreau</td></tr>
<tr><td><span title='2017-08-13 16:11:48 -0400'>2017-08-13</span></td><td><a href='/guix/commit/.mailmap?id=79d5ad20e87066a0937a4b61a4857de2b34a7a30'>mailmap: fix entries for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2017-06-16 15:48:17 +0300'>2017-06-16</span></td><td><a href='/guix/commit/.mailmap?id=a235ec3a6aa21980fe70e8d0c133e50986afbded'>mailmap: Adjust entries for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>