From e4069ec804ff2a5208b29cfded019da66a8dd7e3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 29 Aug 2007 10:23:14 +0000 Subject: [PATCH] UNDO: Extend ModBreaks with the srcspan's of the enclosing expressions Remnants of :stepover --- compiler/deSugar/Coverage.lhs | 47 +++++++++++++++++------------------------ compiler/main/HscTypes.lhs | 3 --- 2 files changed, 19 insertions(+), 31 deletions(-) diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 3a3b745..f2ad77c 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -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, diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index cb5022e..719df2d 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -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} -- 1.7.10.4