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

Remnants of :stepover

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 3a3b745..f2ad77c 100644 (file)
--- 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 (file)
--- 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}