Commit e4069ec8 authored by mnislaih's avatar mnislaih
Browse files

UNDO: Extend ModBreaks with the srcspan's of the enclosing expressions

Remnants of :stepover
parent 18928fea
......@@ -44,7 +44,6 @@ import Trace.Hpc.Util
import BreakArray
import Data.HashTable ( hashString )
\end{code}
......@@ -82,7 +81,7 @@ addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do
, inScope = emptyVarSet
, blackList = listToFM [ (getSrcSpan (tyConName tyCon),())
| tyCon <- tyCons ]
, declBlock = noSrcSpan })
})
(TT
{ tickBoxCount = 0
, mixEntries = []
......@@ -102,7 +101,7 @@ addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do
createDirectoryIfMissing True hpc_mod_dir
modTime <- getModificationTime orig_file
let entries' = [ (hpcPos, box)
| (span,_,box,_) <- entries, hpcPos <- [mkHpcPos span] ]
| (span,_,box) <- entries, hpcPos <- [mkHpcPos span] ]
when (length entries' /= tickBoxCount st) $ do
panic "the number of .mix entries are inconsistent"
let hashNo = mixHash orig_file modTime tabStop entries'
......@@ -116,16 +115,13 @@ addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do
breakArray <- newBreakArray $ length entries
let locsTicks = listArray (0,tickBoxCount st-1)
[ span | (span,_,_,_) <- entries ]
[ span | (span,_,_) <- entries ]
varsTicks = listArray (0,tickBoxCount st-1)
[ vars | (_,vars,_,_) <- entries ]
declsTicks = listArray (0,tickBoxCount st-1)
[ decls| (_,_,_,decls) <- entries ]
[ vars | (_,vars,_) <- entries ]
modBreaks = emptyModBreaks
{ modBreaks_flags = breakArray
, modBreaks_locs = locsTicks
, modBreaks_vars = varsTicks
, modBreaks_decls = declsTicks
}
doIfSet_dyn dflags Opt_D_dump_hpc $ do
......@@ -154,7 +150,7 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
(fvs, mg@(MatchGroup matches' ty)) <-
getFreeVars $
addPathEntry name pos $
addPathEntry name $
addTickMatchGroup (fun_matches funBind)
blackListed <- isBlackListed pos
......@@ -183,7 +179,7 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
-- TODO: Revisit this
addTickLHsBind (L pos (pat@(PatBind { pat_rhs = rhs }))) = do
let name = "(...)"
rhs' <- addPathEntry name pos $ addTickGRHSs False rhs
rhs' <- addPathEntry name $ addTickGRHSs False rhs
{-
decl_path <- getPathEntry
tick_me <- allocTickBox (if null decl_path
......@@ -413,10 +409,10 @@ addTickGRHSs isOneOfMany (GRHSs guarded local_binds) = do
binders = map unLoc (collectLocalBinders local_binds)
addTickGRHS :: Bool -> GRHS Id -> TM (GRHS Id)
addTickGRHS isOneOfMany (GRHS stmts expr@(L pos _)) = do
addTickGRHS isOneOfMany (GRHS stmts expr) = do
(stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts
(if opt_Hpc then addTickLHsExprOptAlt isOneOfMany expr
else addPathEntry "" pos $ addTickLHsExprAlways expr)
else addTickLHsExprAlways expr)
return $ GRHS stmts' expr'
addTickLStmts :: (Maybe (Bool -> BoxLabel)) -> [LStmt Id] -> TM [LStmt Id]
......@@ -557,7 +553,6 @@ data TickTransEnv = TTE { fileName :: FastString
, declPath :: [String]
, inScope :: VarSet
, blackList :: FiniteMap SrcSpan ()
, declBlock :: SrcSpan
}
-- deriving Show
......@@ -614,8 +609,8 @@ freeVar id = TM $ \ env st ->
then ((), unitOccEnv (nameOccName (idName id)) id, st)
else ((), noFVs, st)
addPathEntry :: String -> SrcSpan -> TM a -> TM a
addPathEntry nm src = withEnv (\ env -> env { declPath = declPath env ++ [nm], declBlock = src })
addPathEntry :: String -> TM a -> TM a
addPathEntry nm = withEnv (\ env -> env { declPath = declPath env ++ [nm] })
getPathEntry :: TM [String]
getPathEntry = declPath `liftM` getEnv
......@@ -655,9 +650,8 @@ allocTickBox boxLabel pos m | isGoodSrcSpan' pos =
let c = tickBoxCount st
ids = occEnvElts fvs
mes = mixEntries st
parentBlock = if declBlock env == noSrcSpan then pos else declBlock env
me = (pos, map (nameOccName.idName) ids, boxLabel, parentBlock)
in
me = (pos, map (nameOccName.idName) ids, boxLabel)
in
( L pos (HsTick c ids (L pos e))
, fvs
, st {tickBoxCount=c+1,mixEntries=me:mes}
......@@ -670,8 +664,7 @@ allocATickBox :: BoxLabel -> SrcSpan -> FreeVars -> TM (Maybe (Int,[Id]))
allocATickBox boxLabel pos fvs | isGoodSrcSpan' pos =
sameFileName pos
(return Nothing) $ TM $ \ env st ->
let parentBlock = if declBlock env == noSrcSpan then pos else declBlock env
me = (pos, map (nameOccName.idName) ids, boxLabel, parentBlock)
let me = (pos, map (nameOccName.idName) ids, boxLabel)
c = tickBoxCount st
mes = mixEntries st
ids = occEnvElts fvs
......@@ -683,10 +676,9 @@ allocATickBox boxLabel pos fvs = return Nothing
allocBinTickBox :: (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
allocBinTickBox boxLabel (L pos e) | isGoodSrcSpan' pos = TM $ \ env st ->
let parentBlock = if declBlock env == noSrcSpan then pos else declBlock env
meT = (pos,[],boxLabel True, parentBlock)
meF = (pos,[],boxLabel False, parentBlock)
meE = (pos,[],ExpBox False, parentBlock)
let meT = (pos,[],boxLabel True)
meF = (pos,[],boxLabel False)
meE = (pos,[],ExpBox False)
c = tickBoxCount st
mes = mixEntries st
in
......@@ -698,7 +690,8 @@ allocBinTickBox boxLabel (L pos e) | isGoodSrcSpan' pos = TM $ \ env st ->
, noFVs
, st {tickBoxCount=c+3 , mixEntries=meF:meT:meE:mes}
)
else ( L pos $ HsTick c [] $ L pos e
else
( L pos $ HsTick c [] $ L pos e
, noFVs
, st {tickBoxCount=c+1,mixEntries=meE:mes}
)
......@@ -741,9 +734,7 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
\begin{code}
type ParentDecl= SrcSpan
type TickSpan = SrcSpan
type MixEntry_ = (TickSpan, [OccName], BoxLabel, ParentDecl)
type MixEntry_ = (SrcSpan, [OccName], BoxLabel)
-- For the hash value, we hash everything: the file name,
-- the timestamp of the original source file, the tab stop,
......
......@@ -1430,8 +1430,6 @@ data ModBreaks
-- An array giving the source span of each breakpoint.
, modBreaks_vars :: !(Array BreakIndex [OccName])
-- An array giving the names of the free variables at each breakpoint.
, modBreaks_decls:: !(Array BreakIndex SrcSpan)
-- An array giving the span of the enclosing expression
}
emptyModBreaks :: ModBreaks
......@@ -1440,6 +1438,5 @@ emptyModBreaks = ModBreaks
-- Todo: can we avoid this?
, modBreaks_locs = array (0,-1) []
, modBreaks_vars = array (0,-1) []
, modBreaks_decls= array (0,-1) []
}
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment