diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | bin/evaluate.in | 35 | ||||
| -rw-r--r-- | src/cuirass/base.scm | 12 |
3 files changed, 12 insertions, 36 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 50d9520..39820d5 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -11,6 +11,7 @@ (scheme-mode . ((indent-tabs-mode . nil) + (eval . (put 'call-with-time 'scheme-indent-function 1)) (eval . (put 'test-error 'scheme-indent-function 1)) (eval . (put 'make-parameter 'scheme-indent-function 1)) (eval . (put 'with-database 'scheme-indent-function 1))))) diff --git a/bin/evaluate.in b/bin/evaluate.in index 2f38358..99124f3 100644 --- a/bin/evaluate.in +++ b/bin/evaluate.in @@ -1,6 +1,6 @@ #!/bin/sh # -*- scheme -*- -GUILE_LOAD_PATH="$1" +GUILE_LOAD_PATH="$1${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH" export GUILE_LOAD_PATH exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" !# @@ -23,38 +23,11 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" ;;; You should have received a copy of the GNU General Public License ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. -(use-modules (ice-9 format) +(use-modules (cuirass base) + (cuirass utils) (ice-9 match) (ice-9 pretty-print) - (guix store) - (srfi srfi-19)) - -(define-syntax-rule (with-directory-excursion dir body ...) - "Run BODY with DIR as the process's current directory." - (let ((init (getcwd))) - (dynamic-wind - (λ () (chdir dir)) - (λ () body ...) - (λ () (chdir init))))) - -(define (call-with-time thunk kont) - "Call THUNK and pass KONT the elapsed time followed by THUNK's return -value." - (let* ((start (current-time time-monotonic)) - (result (thunk)) - (end (current-time time-monotonic))) - (kont (time-difference end start) result))) - -(define (call-with-time-display thunk) - "Call THUNK and write to the current output port its duration." - (call-with-time thunk - (λ (time result) - (let ((duration (+ (time-second time) - (/ (time-nanosecond time) 1e9)))) - (format (current-error-port) "evaluate '~A': ~,3f seconds~%" - (assq-ref result #:job-name) - duration) - (acons #:duration duration result))))) + (guix store)) (define* (main #:optional (args (command-line))) (match args diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 666757e..496997a 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -47,8 +47,10 @@ values." (define (call-with-time-display thunk) "Call THUNK and write to the current output port its duration." (call-with-time thunk - (λ (time . results) - (format #t "~,3f seconds~%" - (+ (time-second time) - (/ (time-nanosecond time) 1e9))) - (apply values results)))) + (λ (time result) + (let ((duration (+ (time-second time) + (/ (time-nanosecond time) 1e9)))) + (format (current-error-port) "evaluate '~A': ~,3f seconds~%" + (assq-ref result #:job-name) + duration) + (acons #:duration duration result))))) |