unofficial mirror of guix-devel@gnu.org

 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
 (use-modules (system base target)
             (ice-9 threads))

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

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

(define (scm->go file)
  (string-append (string-drop-right file 4) ".go"))

(let* ((args (cdr (command-line)))
       (target (car args))
       (files (cdr args)))
  (for-each
   (lambda (file)
     (let ((go (scm->go file)))
       (unless (and (file-exists? go)
                    (file-mtime<? file go))
         (format #t "  LOAD ~s~%" file)
         (save-module-excursion
          (lambda ()
            (primitive-load file))))))
   files)
  (with-target target
    (lambda ()
      (let ((mutex (make-mutex)))
        (par-for-each
         (lambda (file)
           (let ((go (scm->go file)))
             (unless (and (file-exists? go)
                          (file-mtime<? file go))
               (with-mutex mutex
                 (format #t "  GUILEC ~s~%" file)
                 (force-output))
               (compile-file file #:output-file go #:opts compile-options)
               (with-mutex mutex
                 (format #t "  WROTE ~s~%" go)
                 (force-output)))))
         files)))))