[commit: ghc] wip/tdammers/T11735: Performance improvements based on Trac #11735 and #14683. (e6472a2)
git at git.haskell.org
git at git.haskell.org
Tue Feb 6 15:54:37 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/tdammers/T11735
Link : http://ghc.haskell.org/trac/ghc/changeset/e6472a2787a3a1c7c465f142dc6d60da6a54b9d6/ghc
>---------------------------------------------------------------
commit e6472a2787a3a1c7c465f142dc6d60da6a54b9d6
Author: Tobias Dammers <tdammers at gmail.com>
Date: Tue Jan 30 17:04:47 2018 +0100
Performance improvements based on Trac #11735 and #14683.
Summary:
This includes:
- Refactoring coercionKind / coercionKindRole
- Caching role in NthCo constructor and mkNthCo
- Discard reflexive casts during Simplify
- Additional SCC's to hunt down performance bottlenecks in Coercion,
CoreTidy, and Simplify
Reviewers: goldfire, bgamari
Subscribers: rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4385
>---------------------------------------------------------------
e6472a2787a3a1c7c465f142dc6d60da6a54b9d6
compiler/main/TidyPgm.hs | 61 +++++++++++++++++++++++++++++++++---------------
1 file changed, 42 insertions(+), 19 deletions(-)
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index ce8ac53..c1bc57f 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -337,58 +337,80 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
= Err.withTiming (pure dflags)
(text "CoreTidy"<+>brackets (ppr mod))
(const ()) $
- do { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags
- ; expose_all = gopt Opt_ExposeAllUnfoldings dflags
- ; print_unqual = mkPrintUnqualified dflags rdr_env
+ do { let { omit_prags =
+ {-#SCC "omit_prags" #-}
+ gopt Opt_OmitInterfacePragmas dflags
+ ; expose_all =
+ {-#SCC "expose_all" #-}
+ gopt Opt_ExposeAllUnfoldings dflags
+ ; print_unqual =
+ {-#SCC "print_unqual" #-}
+ mkPrintUnqualified dflags rdr_env
}
- ; let { type_env = typeEnvFromEntities [] tcs fam_insts
+ ; let { type_env = {-#SCC "type_env" #-}
+ typeEnvFromEntities [] tcs fam_insts
; implicit_binds
- = concatMap getClassImplicitBinds (typeEnvClasses type_env) ++
+ = {-#SCC "implicit_binds" #-}
+ concatMap getClassImplicitBinds (typeEnvClasses type_env) ++
concatMap getTyConImplicitBinds (typeEnvTyCons type_env)
}
; (unfold_env, tidy_occ_env)
- <- chooseExternalIds hsc_env mod omit_prags expose_all
+ <- {-# SCC "chooseExternalIds" #-}
+ chooseExternalIds hsc_env mod omit_prags expose_all
binds implicit_binds imp_rules (vectInfoVar vect_info)
; let { (trimmed_binds, trimmed_rules)
- = findExternalRules omit_prags binds imp_rules unfold_env }
+ = {-#SCC "findExternalRules" #-}
+ findExternalRules omit_prags binds imp_rules unfold_env }
; (tidy_env, tidy_binds)
- <- tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds
+ <- {-#SCC "tidyTopBinds" #-}
+ tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds
- ; let { final_ids = [ id | id <- bindersOfBinds tidy_binds,
+ ; let { final_ids = {-#SCC "final_ids" #-}
+ [ id | id <- bindersOfBinds tidy_binds,
isExternalName (idName id)]
- ; type_env1 = extendTypeEnvWithIds type_env final_ids
+ ; type_env1 = {-#SCC "type_env1" #-}
+ extendTypeEnvWithIds type_env final_ids
- ; tidy_cls_insts = map (tidyClsInstDFun (tidyVarOcc tidy_env)) cls_insts
+ ; tidy_cls_insts = {-#SCC "tidy_cls_insts" #-}
+ map (tidyClsInstDFun (tidyVarOcc tidy_env)) cls_insts
-- A DFunId will have a binding in tidy_binds, and so will now be in
-- tidy_type_env, replete with IdInfo. Its name will be unchanged since
-- it was born, but we want Global, IdInfo-rich (or not) DFunId in the
-- tidy_cls_insts. Similarly the Ids inside a PatSyn.
- ; tidy_rules = tidyRules tidy_env trimmed_rules
+ ; tidy_rules = {-#SCC "tidy_rules" #-}
+ tidyRules tidy_env trimmed_rules
-- You might worry that the tidy_env contains IdInfo-rich stuff
-- and indeed it does, but if omit_prags is on, ext_rules is
-- empty
- ; tidy_vect_info = tidyVectInfo tidy_env vect_info
+ ; tidy_vect_info = {-#SCC "tidy_vect_info" #-}
+ tidyVectInfo tidy_env vect_info
-- Tidy the Ids inside each PatSyn, very similarly to DFunIds
-- and then override the PatSyns in the type_env with the new tidy ones
-- This is really the only reason we keep mg_patsyns at all; otherwise
-- they could just stay in type_env
- ; tidy_patsyns = map (tidyPatSynIds (tidyVarOcc tidy_env)) patsyns
- ; type_env2 = extendTypeEnvWithPatSyns tidy_patsyns type_env1
+ ; tidy_patsyns = {-#SCC "tidy_patsyns" #-}
+ map (tidyPatSynIds (tidyVarOcc tidy_env)) patsyns
+ ; type_env2 = {-#SCC "type_env2" #-}
+ extendTypeEnvWithPatSyns tidy_patsyns type_env1
- ; tidy_type_env = tidyTypeEnv omit_prags type_env2
+ ; tidy_type_env = {-#SCC "tidy_type_env" #-}
+ tidyTypeEnv omit_prags type_env2
}
-- See Note [Grand plan for static forms] in StaticPtrTable.
; (spt_entries, tidy_binds') <-
+ {-#SCC "sptCreateStaticBinds" #-}
sptCreateStaticBinds hsc_env mod tidy_binds
- ; let { spt_init_code = sptModuleInitCode mod spt_entries
+ ; let { spt_init_code = {-#SCC "spt_init_code" #-}
+ sptModuleInitCode mod spt_entries
; add_spt_init_code =
+ {-#SCC "add_spt_init_code" #-}
case hscTarget dflags of
-- If we are compiling for the interpreter we will insert
-- any necessary SPT entries dynamically
@@ -411,7 +433,8 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
}
- ; endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules
+ ; {-#SCC "endPassIO" #-}
+ endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules
-- If the endPass didn't print the rules, but ddump-rules is
-- on, print now
@@ -421,7 +444,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
(pprRulesForUser dflags tidy_rules)
-- Print one-line size info
- ; let cs = coreBindsStats tidy_binds
+ ; let cs = {-#SCC "coreBindStats" #-} coreBindsStats tidy_binds
; when (dopt Opt_D_dump_core_stats dflags)
(putLogMsg dflags NoReason SevDump noSrcSpan
(defaultDumpStyle dflags)
More information about the ghc-commits
mailing list