X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FCoverage.lhs;h=72c9e664f321c379c2769f1e5a5455c9f2fb3f3f;hb=3f82c82ad95fa95cf0ce3a787c934bcccd2c23c4;hp=2d8afbd7ad1b5c5333f8e387cefb26fe9fd144eb;hpb=e6396ceaf29d592785944ca9f4086595d1137836;p=ghc-hetmet.git diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 2d8afbd..72c9e66 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -691,7 +691,10 @@ 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) + 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