summaryrefslogtreecommitdiff
path: root/compiler/stgSyn
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2011-10-27 13:47:27 +0100
committerSimon Marlow <marlowsd@gmail.com>2011-11-02 16:34:05 +0000
commit7bb0447df9a783c222c2a077e35e5013c7c68d91 (patch)
tree78d6d2a14f7e42df5cda32199c71ced973f169ef /compiler/stgSyn
parentbd72eeb184a95ae0ae79ccad19c8ccc2b45a12e0 (diff)
downloadhaskell-7bb0447df9a783c222c2a077e35e5013c7c68d91.tar.gz
Overhaul of infrastructure for profiling, coverage (HPC) and breakpoints
User visible changes ==================== Profilng -------- Flags renamed (the old ones are still accepted for now): OLD NEW --------- ------------ -auto-all -fprof-auto -auto -fprof-exported -caf-all -fprof-cafs New flags: -fprof-auto Annotates all bindings (not just top-level ones) with SCCs -fprof-top Annotates just top-level bindings with SCCs -fprof-exported Annotates just exported bindings with SCCs -fprof-no-count-entries Do not maintain entry counts when profiling (can make profiled code go faster; useful with heap profiling where entry counts are not used) Cost-centre stacks have a new semantics, which should in most cases result in more useful and intuitive profiles. If you find this not to be the case, please let me know. This is the area where I have been experimenting most, and the current solution is probably not the final version, however it does address all the outstanding bugs and seems to be better than GHC 7.2. Stack traces ------------ +RTS -xc now gives more information. If the exception originates from a CAF (as is common, because GHC tends to lift exceptions out to the top-level), then the RTS walks up the stack and reports the stack in the enclosing update frame(s). Result: +RTS -xc is much more useful now - but you still have to compile for profiling to get it. I've played around a little with adding 'head []' to GHC itself, and +RTS -xc does pinpoint the problem quite accurately. I plan to add more facilities for stack tracing (e.g. in GHCi) in the future. Coverage (HPC) -------------- * derived instances are now coloured yellow if they weren't used * likewise record field names * entry counts are more accurate (hpc --fun-entry-count) * tab width is now correct (markup was previously off in source with tabs) Internal changes ================ In Core, the Note constructor has been replaced by Tick (Tickish b) (Expr b) which is used to represent all the kinds of source annotation we support: profiling SCCs, HPC ticks, and GHCi breakpoints. Depending on the properties of the Tickish, different transformations apply to Tick. See CoreUtils.mkTick for details. Tickets ======= This commit closes the following tickets, test cases to follow: - Close #2552: not a bug, but the behaviour is now more intuitive (test is T2552) - Close #680 (test is T680) - Close #1531 (test is result001) - Close #949 (test is T949) - Close #2466: test case has bitrotted (doesn't compile against current version of vector-space package)
Diffstat (limited to 'compiler/stgSyn')
-rw-r--r--compiler/stgSyn/CoreToStg.lhs27
-rw-r--r--compiler/stgSyn/StgLint.lhs2
-rw-r--r--compiler/stgSyn/StgSyn.lhs13
3 files changed, 23 insertions, 19 deletions
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 2a72489ebf..3194974c8f 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -340,17 +340,16 @@ coreToStgExpr expr@(Lam _ _)
return (result_expr, fvs, escs)
-coreToStgExpr (Note (SCC cc) expr) = do
- (expr2, fvs, escs) <- coreToStgExpr expr
- return (StgSCC cc expr2, fvs, escs)
+coreToStgExpr (Tick (HpcTick m n) expr)
+ = do (expr2, fvs, escs) <- coreToStgExpr expr
+ return (StgTick m n expr2, fvs, escs)
-coreToStgExpr (Case (Var id) _bndr _ty [(DEFAULT,[],expr)])
- | Just (TickBox m n) <- isTickBoxOp_maybe id = do
- (expr2, fvs, escs) <- coreToStgExpr expr
- return (StgTick m n expr2, fvs, escs)
+coreToStgExpr (Tick (ProfNote cc tick push) expr)
+ = do (expr2, fvs, escs) <- coreToStgExpr expr
+ return (StgSCC cc tick push expr2, fvs, escs)
-coreToStgExpr (Note _ expr)
- = coreToStgExpr expr
+coreToStgExpr (Tick Breakpoint{} _expr)
+ = panic "coreToStgExpr: breakpoint should not happen"
coreToStgExpr (Cast expr _)
= coreToStgExpr expr
@@ -1108,15 +1107,16 @@ filterStgBinders bndrs = filter isId bndrs
\begin{code}
- -- Ignore all notes except SCC
myCollectBinders :: Expr Var -> ([Var], Expr Var)
myCollectBinders expr
= go [] expr
where
go bs (Lam b e) = go (b:bs) e
- go bs e@(Note (SCC _) _) = (reverse bs, e)
+ go bs e@(Tick t e')
+ | tickishIsCode t = (reverse bs, e)
+ | otherwise = go bs e'
+ -- Ignore only non-code source annotations
go bs (Cast e _) = go bs e
- go bs (Note _ e) = go bs e
go bs e = (reverse bs, e)
myCollectArgs :: CoreExpr -> (Id, [CoreArg])
@@ -1127,9 +1127,8 @@ myCollectArgs expr
where
go (Var v) as = (v, as)
go (App f a) as = go f (a:as)
- go (Note (SCC _) _) _ = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
+ go (Tick _ _) _ = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
go (Cast e _) as = go e as
- go (Note _ e) as = go e as
go (Lam b e) as
| isTyVar b = go e as -- Note [Collect args]
go _ _ = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs
index 945d6c96d6..98b2de1444 100644
--- a/compiler/stgSyn/StgLint.lhs
+++ b/compiler/stgSyn/StgLint.lhs
@@ -191,7 +191,7 @@ lintStgExpr (StgLetNoEscape _ _ binds body) = do
addInScopeVars binders $
lintStgExpr body
-lintStgExpr (StgSCC _ expr) = lintStgExpr expr
+lintStgExpr (StgSCC _ _ _ expr) = lintStgExpr expr
lintStgExpr (StgCase scrut _ _ bndr _ alts_type alts) = runMaybeT $ do
_ <- MaybeT $ lintStgExpr scrut
diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index d332a4e279..c6a6762a15 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -374,7 +374,9 @@ Finally for @scc@ expressions we introduce a new STG construct.
\begin{code}
| StgSCC
CostCentre -- label of SCC expression
- (GenStgExpr bndr occ) -- scc expression
+ !Bool -- bump the entry count?
+ !Bool -- push the cost centre?
+ (GenStgExpr bndr occ) -- scc expression
\end{code}
%************************************************************************
@@ -761,9 +763,12 @@ pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
char ']']))))
2 (ppr expr)]
-pprStgExpr (StgSCC cc expr)
- = sep [ hsep [ptext (sLit "_scc_"), ppr cc],
- pprStgExpr expr ]
+pprStgExpr (StgSCC cc tick push expr)
+ = sep [ hsep [scc, ppr cc], pprStgExpr expr ]
+ where
+ scc | tick && push = ptext (sLit "_scc_")
+ | tick = ptext (sLit "_tick_")
+ | otherwise = ptext (sLit "_push_")
pprStgExpr (StgTick m n expr)
= sep [ hsep [ptext (sLit "_tick_"), pprModule m,text (show n)],