From a4acf188280364f05a200232669373d5fd2e787d Mon Sep 17 00:00:00 2001
From: Burke Fetscher <bfetscher@racket-lang.org>
Date: Fri, 11 Apr 2014 15:21:06 -0500
Subject: [PATCH] add 10 sec heartbeat to benchmark logging

also, enable caching by default
---
 .../redex/examples/benchmark/logging.rkt      |  8 +++++-
 .../redex/examples/benchmark/test-file.rkt    | 27 +++++++++++++++----
 2 files changed, 29 insertions(+), 6 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 8a5fbc6cda..73f010f7ff 100644
--- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt
+++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt
@@ -8,7 +8,8 @@
          log-gen-timeout
          log-check-timeout
          log-start
-         log-finished)
+         log-finished
+         log-heartbeat)
 
 (struct bmark-log-data (data))
 (struct bmark-log-end ())
@@ -95,6 +96,11 @@
                                                 'N/A
                                                 (exact->inexact (/ tries countxmps))))))
 
+(define (log-heartbeat model gen)
+  (bmark-log 'heartbeat
+             `(#:model ,(path-format model)
+               #:type ,gen)))
+
 (define path-format (compose string->symbol path->string))
 
 (define (bmark-log event data)
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 f40e982c51..301c05d432 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
@@ -97,6 +97,20 @@
    (handle-evt res-chan
                (λ (result-of-thunk) result-of-thunk))))
 
+(define (with-heartbeat name type thunk)
+  (define thd (thread (λ () (thunk))))
+  (define heartbeat-thd
+    (thread (λ () 
+              (let loop () 
+                (log-heartbeat name type) 
+                (sleep 10)
+                (loop)))))
+  (sync
+   (handle-evt thd
+               (λ (_) (kill-thread heartbeat-thd)))
+   (handle-evt heartbeat-thd
+               (λ (_) (error 'with-hearbeat "heartbeat thread ended")))))
+
 (define (run/spawn-generations fname verbose? no-errs? get-gen check seconds type)
   (if n-procs
       (spawn-parallel fname verbose? no-errs? get-gen check seconds type)
@@ -125,6 +139,11 @@
 (struct reached-limit (tries))
 
 (define (run-generations fname verbose? no-errs? get-gen check seconds type)
+  (log-start fname type)
+  (with-heartbeat fname type
+   (λ () (run-gens fname verbose? no-errs? get-gen check seconds type))))
+
+(define (run-gens fname verbose? no-errs? get-gen check seconds type)
   (collect-garbage)
   (define s-time (current-process-milliseconds))
   (define time-limit (+ s-time (* 1000 seconds)))
@@ -218,7 +237,6 @@
   (printf "~a has the error: ~a\n\n" fpath err)
   (printf "Running ~a....\n" fpath)
   (printf "Using generator: ~s\n" gen-type)
-  (log-start fpath gen-type)
   (cond
     [(equal? gen-type 'fixed)
      (define small-counter-example
@@ -274,10 +292,9 @@
        (run/spawn-generations fpath verbose? no-errs? (λ () gen)
                         check seconds gen-type))])) 
 
-(parameterize ([caching-enabled? #f])
-  (for ([gen-type (in-list types)])
-    (with-logging-to (log-file-name gen-type)
-                     (λ () (test-file filename verbose #f gen-type (* minutes 60))))))
+(for ([gen-type (in-list types)])
+  (with-logging-to (log-file-name gen-type)
+                   (λ () (test-file filename verbose #f gen-type (* minutes 60)))))
 
 (unless (member 'fixed types)
   (call-with-output-file output-file