X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FCoverage.lhs;h=72c9e664f321c379c2769f1e5a5455c9f2fb3f3f;hb=3f82c82ad95fa95cf0ce3a787c934bcccd2c23c4;hp=ea41d9869b76237cd587557d5c50922d7c2282dc;hpb=add9b7f13aad3a6ec5fdb4512c79ee9c5d95b3d4;p=ghc-hetmet.git

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index ea41d98..72c9e66 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -673,11 +673,11 @@ allocTickBox boxLabel pos m | isGoodSrcSpan' pos =
   sameFileName pos 
     (do e <- m; return (L pos e)) $ do
   (fvs, e) <- getFreeVars m
-  TM $ \ _env st ->
+  TM $ \ env st ->
     let c = tickBoxCount st
         ids = occEnvElts fvs
         mes = mixEntries st
-        me = (pos, declPath _env, map (nameOccName.idName) ids, boxLabel)
+        me = (pos, declPath env, map (nameOccName.idName) ids, boxLabel)
     in
     ( L pos (HsTick c ids (L pos e))
     , fvs
@@ -690,8 +690,11 @@ allocTickBox _boxLabel pos m = do e <- m; return (L pos e)
 allocATickBox :: BoxLabel -> SrcSpan -> FreeVars -> TM (Maybe (Int,[Id]))
 allocATickBox boxLabel pos fvs | isGoodSrcSpan' pos = 
   sameFileName pos 
-    (return Nothing) $ TM $ \ _env st ->
-  let me = (pos, declPath _env, map (nameOccName.idName) ids, boxLabel)
+    (return Nothing) $ TM $ \ env st ->
+  let mydecl_path
+        | null (declPath env), TopLevelBox x <- boxLabel = x
+        | otherwise = declPath env
+      me = (pos, mydecl_path, map (nameOccName.idName) ids, boxLabel)
       c = tickBoxCount st
       mes = mixEntries st
       ids = occEnvElts fvs
@@ -708,10 +711,10 @@ allocBinTickBox boxLabel pos m
  | isGoodSrcSpan' pos =
  do
  e <- m
- TM $ \ _env st ->
-  let meT = (pos,declPath _env, [],boxLabel True)
-      meF = (pos,declPath _env, [],boxLabel False)
-      meE = (pos,declPath _env, [],ExpBox False)
+ TM $ \ env st ->
+  let meT = (pos,declPath env, [],boxLabel True)
+      meF = (pos,declPath env, [],boxLabel False)
+      meE = (pos,declPath env, [],ExpBox False)
       c = tickBoxCount st
       mes = mixEntries st
   in