From 163915100ab5c771d65290b9a116e5268b0ea576 Mon Sep 17 00:00:00 2001
From: Spencer Florence <florence@ccs.neu.edu>
Date: Sat, 24 Jan 2015 10:40:01 -0500
Subject: [PATCH] fixed compile looping. Final fix for Issue #21

---
 cover.rkt  | 22 +++++++++++++---------
 strace.rkt | 10 ++++------
 2 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/cover.rkt b/cover.rkt
index ec96309..328c275 100644
--- a/cover.rkt
+++ b/cover.rkt
@@ -40,9 +40,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
           (->absolute p))))
   (define abs-paths (map (lambda (p) (if (list? p) (first p) p)) abs))
   (parameterize ([current-load/use-compiled (make-cover-load/use-compiled abs-paths)]
-                 [use-compiled-file-paths
-                  (cons (build-path "compiled" "cover")
-                        (use-compiled-file-paths))]
+                 
                  [current-output-port
                   (if (verbose) (current-output-port) (open-output-nowhere))])
     (define tests-failed #f)
@@ -88,20 +86,25 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
 (define (make-cover-load/use-compiled paths)
   (define load/use-compiled (current-load/use-compiled))
   (define load (current-load))
-  (define compile (current-compile))
   (define cover-compile (make-cover-compile))
+  (define cover-use-compiled-file-paths
+    (cons (build-path "compiled" "cover")
+          (use-compiled-file-paths)))
   (lambda (path sym)
     (define abs (->absolute path))
     (define lst (explode-path abs))
     (define dir-list (take lst (sub1 (length lst))))
     (parameterize ([current-load-relative-directory (apply build-path dir-list)])
       (if (member abs paths)
-          (parameterize ([current-compile cover-compile])
+          (parameterize ([current-compile cover-compile]
+                         [use-compiled-file-paths
+                          cover-use-compiled-file-paths])
             (load path sym))
-          (parameterize ([current-compile compile])
-            (load/use-compiled path sym))))))
+          (load/use-compiled path sym)))))
 
 ;; -> Compiler
+;; makes a value sutable for current-compile, such that compile
+;; annotates the source code. should only be used by `make-cover-load/uze-compiled`
 (define (make-cover-compile)
   (define compile (current-compile))
   (define reg (namespace-module-registry ns))
@@ -238,9 +241,10 @@ 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)]
+       (parameterize ([current-load/use-compiled
+                       (make-cover-load/use-compiled (list (->absolute prog.rkt)))]
                       [current-namespace ns])
          (managed-compile-zo prog.rkt))))
     (check-true (andmap file-exists? compiled))
diff --git a/strace.rkt b/strace.rkt
index cb69a22..b34e9f6 100644
--- a/strace.rkt
+++ b/strace.rkt
@@ -3,8 +3,8 @@
 (require errortrace/stacktrace
          racket/function
          racket/syntax
-         syntax/parse
          racket/unit
+         syntax/kerncase
          racket/runtime-path
          "private/file-utils.rkt"
          "private/shared.rkt"
@@ -69,12 +69,11 @@
   (define inspector (variable-reference->module-declaration-inspector
                      (#%variable-reference)))
   (let loop ([expr expr] [top #t])
-    (syntax-parse (syntax-disarm expr inspector)
-      #:literal-sets (kernel-literals)
+    (kernel-syntax-case (syntax-disarm expr inspector) #f
       [(module name lang mb)
        (with-syntax ([cover cover-name]
                      [srcloc srcloc-name])
-         (syntax-parse (syntax-disarm #'mb inspector)
+         (syntax-case (syntax-disarm #'mb inspector) ()
            [(#%module-begin b ...)
             (with-syntax ([(body ...)
                            (map (lambda (e) (loop e #f)) (syntax->list #'(b ...)))])
@@ -92,8 +91,7 @@
 ;; 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
 (define (annotate-clean e)
-  (syntax-parse e
-    #:literal-sets (kernel-literals)
+  (kernel-syntax-case e #f
     [(begin e mod)
      (eval #'e)
      #'mod]