From 805ae055c6050869cd5f27153da35be2b0ef045c Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 21 Mar 2018 17:43:18 -0700
Subject: [PATCH] add `report/time` and `time-name`

---
 sugar/debug.rkt | 28 +++++++++++++++++++++++++---
 1 file changed, 25 insertions(+), 3 deletions(-)

diff --git a/sugar/debug.rkt b/sugar/debug.rkt
index 1743e54..69a914c 100644
--- a/sugar/debug.rkt
+++ b/sugar/debug.rkt
@@ -1,7 +1,8 @@
 #lang racket/base
 (require racket/string (for-syntax racket/base) "define.rkt")
 
-(provide+safe report report/line report/file
+(provide+safe report report/time time-name
+              report/line report/file
               report* report*/line report*/file
               report-apply repeat time-repeat time-repeat* compare)
 
@@ -9,7 +10,7 @@
   (format (if (= 1 (length expr-results))
               "~a"
               "(values ~a)") (string-join (for/list ([r (in-list expr-results)])
-                                            (format "~v" r)) " ")))
+                                                    (format "~v" r)) " ")))
 
 (define-syntax (report stx)
   (syntax-case stx ()
@@ -20,6 +21,17 @@
          (apply values expr-results))]))
 
 
+(define-syntax (report/time stx)
+  (syntax-case stx ()
+    [(MACRO EXPR) #'(MACRO EXPR EXPR)]
+    [(_ EXPR NAME)
+     #'(let* ([op (open-output-string)]
+              [expr-results (parameterize ([current-output-port op])
+                              (time (call-with-values (λ () EXPR) list)))]) 
+         (eprintf "~a = ~a [~a]\n" 'NAME (stringify-results expr-results) (string-trim (get-output-string op)))
+         (apply values expr-results))]))
+
+
 (define-syntax (report/line stx)
   (syntax-case stx ()
     [(MACRO EXPR) #'(MACRO EXPR EXPR)]
@@ -64,7 +76,7 @@
 
 (define-syntax-rule (repeat NUM EXPR ...)
   (for/last ([i (in-range NUM)])
-    EXPR ...))
+            EXPR ...))
 
 
 (define-syntax-rule (time-repeat NUM EXPR ...)
@@ -78,6 +90,16 @@
          (values (time-repeat n EXPR) ...))]))
 
 
+(define-syntax (time-name stx)
+  (syntax-case stx ()
+    [(_ NAME EXPR ...)
+     #'(let* ([op (open-output-string)]
+              [expr-results (parameterize ([current-output-port op])
+                              (time (call-with-values (λ () EXPR ...) values)))])
+              (display (format "~a: ~a" 'NAME (get-output-string op)))
+              expr-results)]))
+
+
 (define-syntax (compare stx)
   (syntax-case stx ()
     [(_ EXPR ID ID-ALT ...)