summaryrefslogtreecommitdiff
path: root/compiler/specialise
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/specialise
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/specialise')
-rw-r--r--compiler/specialise/Rules.lhs19
-rw-r--r--compiler/specialise/SpecConstr.lhs14
-rw-r--r--compiler/specialise/Specialise.lhs16
3 files changed, 23 insertions, 26 deletions
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index a439f2ac27..ef29eb58eb 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -626,10 +626,6 @@ match :: RuleEnv
-- The Var case follows closely what happens in Unify.match
match renv subst (Var v1) e2 = match_var renv subst v1 e2
-match renv subst (Note _ e1) e2 = match renv subst e1 e2
-match renv subst e1 (Note _ e2) = match renv subst e1 e2
- -- Ignore notes in both template and thing to be matched
- -- See Note [Notes in RULE matching]
match renv subst e1 (Var v2) -- Note [Expanding variables]
| not (inRnEnvR rn_env v2) -- Note [Do not expand locally-bound variables]
@@ -885,13 +881,12 @@ the entire match.
Hence, (a) the guard (not (isLocallyBoundR v2))
(b) when we expand we nuke the renaming envt (nukeRnEnvR).
-Note [Notes in RULE matching]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Look through Notes in both template and expression being matched. In
-particular, we don't want to be confused by InlineMe notes. Maybe we
-should be more careful about profiling notes, but for now I'm just
-riding roughshod over them. cf Note [Notes in call patterns] in
-SpecConstr
+Note [Tick annotations in RULE matching]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We used to look through Notes in both template and expression being
+matched. This would be incorrect for ticks, which we cannot discard,
+so we do not look through Ticks at all. cf Note [Notes in call
+patterns] in SpecConstr
Note [Matching lets]
~~~~~~~~~~~~~~~~~~~~
@@ -1051,7 +1046,7 @@ ruleCheck _ (Lit _) = emptyBag
ruleCheck _ (Type _) = emptyBag
ruleCheck _ (Coercion _) = emptyBag
ruleCheck env (App f a) = ruleCheckApp env (App f a) []
-ruleCheck env (Note _ e) = ruleCheck env e
+ruleCheck env (Tick _ e) = ruleCheck env e
ruleCheck env (Cast e _) = ruleCheck env e
ruleCheck env (Let bd e) = ruleCheckBind env bd `unionBags` ruleCheck env e
ruleCheck env (Lam _ e) = ruleCheck env e
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 34cfc9c90b..0959425e8f 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -970,8 +970,8 @@ combineOccs xs ys = zipWithEqual "combineOccs" combineOcc xs ys
setScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage
-- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee
-- is a variable, and an interesting variable
-setScrutOcc env usg (Cast e _) occ = setScrutOcc env usg e occ
-setScrutOcc env usg (Note _ e) occ = setScrutOcc env usg e occ
+setScrutOcc env usg (Cast e _) occ = setScrutOcc env usg e occ
+setScrutOcc env usg (Tick _ e) occ = setScrutOcc env usg e occ
setScrutOcc env usg (Var v) occ
| Just RecArg <- lookupHowBound env v = usg { scu_occs = extendVarEnv (scu_occs usg) v occ }
| otherwise = usg
@@ -1003,8 +1003,8 @@ scExpr' env (Var v) = case scSubstId env v of
scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t))
scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c))
scExpr' _ e@(Lit {}) = return (nullUsage, e)
-scExpr' env (Note n e) = do (usg,e') <- scExpr env e
- return (usg, Note n e')
+scExpr' env (Tick t e) = do (usg,e') <- scExpr env e
+ return (usg, Tick t e')
scExpr' env (Cast e co) = do (usg, e') <- scExpr env e
return (usg, Cast e' (scSubstCo env co))
scExpr' env e@(App _ _) = scApp env (collectArgs e)
@@ -1583,7 +1583,7 @@ argToPat _env _in_scope _val_env arg@(Type {}) _arg_occ
argToPat _env _in_scope _val_env arg@(Coercion {}) _arg_occ
= return (False, arg)
-argToPat env in_scope val_env (Note _ arg) arg_occ
+argToPat env in_scope val_env (Tick _ arg) arg_occ
= argToPat env in_scope val_env arg arg_occ
-- Note [Notes in call patterns]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1765,9 +1765,9 @@ samePat (vs1, as1) (vs2, as2)
same (Type {}) (Type {}) = True -- Note [Ignore type differences]
same (Coercion {}) (Coercion {}) = True
- same (Note _ e1) e2 = same e1 e2 -- Ignore casts and notes
+ same (Tick _ e1) e2 = same e1 e2 -- Ignore casts and notes
same (Cast e1 _) e2 = same e1 e2
- same e1 (Note _ e2) = same e1 e2
+ same e1 (Tick _ e2) = same e1 e2
same e1 (Cast e2 _) = same e1 e2
same e1 e2 = WARN( bad e1 || bad e2, ppr e1 $$ ppr e2)
diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 68d023b52c..24f9d080db 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -716,9 +716,9 @@ specExpr _ (Lit lit) = return (Lit lit, emptyUDs)
specExpr subst (Cast e co) = do
(e', uds) <- specExpr subst e
return ((Cast e' (CoreSubst.substCo subst co)), uds)
-specExpr subst (Note note body) = do
+specExpr subst (Tick tickish body) = do
(body', uds) <- specExpr subst body
- return (Note (specNote subst note) body', uds)
+ return (Tick (specTickish subst tickish) body', uds)
---------------- Applications might generate a call instance --------------------
@@ -766,10 +766,12 @@ specExpr subst (Let bind body) = do
-- All done
return (foldr Let body' binds', uds)
--- Must apply the type substitution to coerceions
-specNote :: Subst -> Note -> Note
-specNote _ note = note
-
+specTickish :: Subst -> Tickish Id -> Tickish Id
+specTickish subst (Breakpoint ix ids)
+ = Breakpoint ix [ id' | id <- ids, Var id' <- [specVar subst id]]
+ -- drop vars from the list if they have a non-variable substitution.
+ -- should never happen, but it's harmless to drop them anyway.
+specTickish _ other_tickish = other_tickish
specCase :: Subst
-> CoreExpr -- Scrutinee, already done
@@ -1611,7 +1613,7 @@ interestingDict (Type _) = False
interestingDict (Coercion _) = False
interestingDict (App fn (Type _)) = interestingDict fn
interestingDict (App fn (Coercion _)) = interestingDict fn
-interestingDict (Note _ a) = interestingDict a
+interestingDict (Tick _ a) = interestingDict a
interestingDict (Cast e _) = interestingDict e
interestingDict _ = True
\end{code}