From 4c0a17acb0294ea9f3e27c7503742d47deaa71f7 Mon Sep 17 00:00:00 2001 From: Burke Fetscher Date: Thu, 10 Apr 2014 10:34:28 -0500 Subject: [PATCH] fix benchmark logging to flush on every event --- .../redex/examples/benchmark/logging.rkt | 20 ++++++++----------- .../redex/examples/benchmark/test-file.rkt | 1 - 2 files changed, 8 insertions(+), 13 deletions(-) diff --git a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt index 3fdfba75cf..1096737f33 100644 --- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt +++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt @@ -5,17 +5,11 @@ (provide with-logging-to) (define (with-logging-to filename thunk) - (call-with-output-file filename - (λ (out) - (thd-with-log thunk out)) - #:exists 'append)) - -(define (thd-with-log thunk log-port) (define benchmark-logger (make-logger #f (current-logger))) (define bmark-log-recv (make-log-receiver benchmark-logger 'info)) - (define handler (log-handler bmark-log-recv log-port)) + (define handler (log-handler bmark-log-recv filename)) (parameterize ([current-logger benchmark-logger]) (define body-thd (thread thunk)) @@ -34,13 +28,15 @@ (handler log-evt) (loop)]))))))) -(define (log-handler recv log-port) +(define (log-handler recv filename) (λ (log-evt) (define msg (vector-ref log-evt 1)) - (unless - (regexp-match? #rx"cm-accomplice" msg) - (displayln (timestamp) log-port) - (displayln (vector-ref log-evt 1) log-port)))) + (unless (regexp-match? #rx"cm-accomplice" msg) + (call-with-output-file filename + (λ (log-port) + (displayln (string-append (timestamp) " " msg) + log-port)) + #:exists 'append)))) (define (timestamp) (parameterize ([date-display-format 'iso-8601]) diff --git a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt index 642297f3a5..649b90ad14 100644 --- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt +++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt @@ -211,7 +211,6 @@ (define fpath (if (relative-path? maybe-fpath) maybe-fpath (find-relative-path (current-directory) maybe-fpath))) - (displayln fpath) (define tc (dynamic-require fpath 'type-check)) (define check (dynamic-require fpath 'check)) (define gen-term (dynamic-require fpath 'generate-M-term))