;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; 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 (ice-9 match)
+(use-modules (ice-9 format)
+ (ice-9 match)
(ice-9 threads)
(srfi srfi-1)
(guix build compile)
(current-processor-count))))
(loop tail)))))))))
+(define (% completed total)
+ "Return the completion percentage of COMPLETED over TOTAL as an integer."
+ (inexact->exact (round (* 100. (/ completed total)))))
+
;; Install a SIGINT handler to give unwind handlers in 'compile-file' an
;; opportunity to run upon SIGINT and to remove temporary output files.
(sigaction SIGINT
(match (command-line)
((_ . files)
- (compile-files srcdir (getcwd)
- (filter file-needs-compilation? files)
- #:workers (parallel-job-count)
- #:host host
- #:report-load (lambda (file total completed)
- (when file
- (format #t " LOAD ~a~%" file)))
- #:report-compilation (lambda (file total completed)
- (when file
- (format #t " GUILEC ~a~%"
- (scm->go file)))))))
+ (catch #t
+ (lambda ()
+ (compile-files srcdir (getcwd)
+ (filter file-needs-compilation? files)
+ #:workers (parallel-job-count)
+ #:host host
+ #:report-load (lambda (file total completed)
+ (when file
+ (format #t "[~3d%] LOAD ~a~%"
+ (% (+ 1 completed) (* 2 total))
+ file)
+ (force-output)))
+ #:report-compilation (lambda (file total completed)
+ (when file
+ (format #t "[~3d%] GUILEC ~a~%"
+ (% (+ total completed 1)
+ (* 2 total))
+ (scm->go file))
+ (force-output)))))
+ (lambda _
+ (primitive-exit 1))
+ (lambda args
+ ;; Try to report the error in an intelligible way.
+ (let* ((stack (make-stack #t))
+ (frame (if (> (stack-length stack) 1)
+ (stack-ref stack 1) ;skip the 'throw' frame
+ (stack-ref stack 0)))
+ (ui (false-if-exception
+ (resolve-module '(guix ui))))
+ (report (and ui
+ (false-if-exception
+ (module-ref ui 'report-load-error)))))
+ (if report
+ ;; In Guile <= 2.2.5, 'current-load-port' was not exported.
+ (let ((load-port ((module-ref (resolve-module '(ice-9 ports))
+ 'current-load-port))))
+ (report (or (and=> load-port port-filename) "?.scm")
+ args frame))
+ (begin
+ (print-exception (current-error-port) frame
+ (car args) (cdr args))
+ (display-backtrace stack (current-error-port)))))))))