From 0499f7e6534fd519815cffae5f890eac1b8549ce Mon Sep 17 00:00:00 2001
From: Spencer Florence <florence@ccs.neu.edu>
Date: Fri, 23 Jan 2015 23:44:01 -0500
Subject: [PATCH] minor changes to naming

---
 cover.rkt  | 35 +++++++++++++++++++----------------
 strace.rkt | 41 +++++++++++++++++++++--------------------
 2 files changed, 40 insertions(+), 36 deletions(-)

diff --git a/cover.rkt b/cover.rkt
index e1dbd0b..ec96309 100644
--- a/cover.rkt
+++ b/cover.rkt
@@ -107,22 +107,25 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
   (define reg (namespace-module-registry ns))
   (define phase (namespace-base-phase ns))
   (define annotate-top (get-annotate-top))
-  (lambda (e immediate-eval?)
-    (define to-compile
-      (cond [(or (compiled-expression? (if (syntax? e) (syntax-e e) e))
-                 (not (eq? reg (namespace-module-registry (current-namespace))))
-                 (not (equal? phase (namespace-base-phase (current-namespace)))))
-             e]
-            [else
-             (vprintf "compiling ~s with coverage annotations\n"
-                      (if (not (syntax? e))
-                          e
-                          (or (syntax-source-file-name e)
-                              (syntax-source e)
-                              (syntax->datum e))))
+  ;; define so its named in stack traces
+  (define cover-compile
+    (lambda (e immediate-eval?)
+      (define to-compile
+        (cond [(or (compiled-expression? (if (syntax? e) (syntax-e e) e))
+                   (not (eq? reg (namespace-module-registry (current-namespace))))
+                   (not (equal? phase (namespace-base-phase (current-namespace)))))
+               e]
+              [else
+               (vprintf "compiling ~s with coverage annotations\n"
+                        (if (not (syntax? e))
+                            e
+                            (or (syntax-source-file-name e)
+                                (syntax-source e)
+                                (syntax->datum e))))
                (annotate-top (if (syntax? e) (expand-syntax e) (datum->syntax #f e))
-                            phase)]))
-    (compile to-compile immediate-eval?)))
+                             phase)]))
+      (compile to-compile immediate-eval?)))
+  cover-compile)
 
 (define (remove-unneeded-results paths)
   (define c (get-raw-coverage))
@@ -235,7 +238,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
     (for-each (lambda (f) (when (file-exists? f) (delete-file f)))
               compiled)
     (check-false (ormap file-exists? compiled))
-    (check-not-exn
+    (#;check-not-exn
      (lambda ()
        (parameterize ([current-compile (make-cover-compile)]
                       [current-namespace ns])
diff --git a/strace.rkt b/strace.rkt
index 7311ffd..cb69a22 100644
--- a/strace.rkt
+++ b/strace.rkt
@@ -65,28 +65,29 @@
   (define e (add-cover-require stx))
   (if e (annotate-clean (annotate-top e phase)) stx))
 
-(define (add-cover-require expr [top #t])
+(define (add-cover-require expr)
   (define inspector (variable-reference->module-declaration-inspector
                      (#%variable-reference)))
-  (syntax-parse (syntax-disarm expr inspector)
-    #:literal-sets (kernel-literals)
-    [(module name lang mb)
-     (with-syntax ([cover cover-name]
-                   [srcloc srcloc-name])
-       (syntax-parse (syntax-disarm #'mb inspector)
-         [(#%module-begin b ...)
-          (with-syntax ([(body ...)
-                         (map (lambda (e) (add-cover-require e #f)) (syntax->list #'(b ...)))])
-            (syntax-rearm
-             (namespace-syntax-introduce
-              (quasisyntax/loc expr
-                (module name lang
-                  (#%module-begin
-                   (#%require (rename cover/coverage cover coverage))
-                   (#%require (rename racket/base srcloc make-srcloc))
-                   body ...))))
-             expr))]))]
-      [_ (if top #f expr)]))
+  (let loop ([expr expr] [top #t])
+    (syntax-parse (syntax-disarm expr inspector)
+      #:literal-sets (kernel-literals)
+      [(module name lang mb)
+       (with-syntax ([cover cover-name]
+                     [srcloc srcloc-name])
+         (syntax-parse (syntax-disarm #'mb inspector)
+           [(#%module-begin b ...)
+            (with-syntax ([(body ...)
+                           (map (lambda (e) (loop e #f)) (syntax->list #'(b ...)))])
+              (syntax-rearm
+               (namespace-syntax-introduce
+                (quasisyntax/loc expr
+                  (module name lang
+                    (#%module-begin
+                     (#%require (rename cover/coverage cover coverage))
+                     (#%require (rename racket/base srcloc make-srcloc))
+                     body ...))))
+               expr))]))]
+      [_ (if top #f expr)])))
 
 ;; in order to write modules to disk the top level needs to
 ;; be a module. so we trust that the module is loaded and trim the expression