diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2017-02-03 16:27:51 -0500 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2017-02-03 22:09:54 -0500 |
commit | b59c2de7abe3cd4e046f11c3536ba8e7137c4f84 (patch) | |
tree | bb5f339698701b122f9ca378f763fb4b914e724f | |
parent | 122c655927185131186814064f30a041cc361630 (diff) | |
download | haskell-wip/T11179.tar.gz |
Do not drop dead code in the desugarerwip/T11179
so that GHC plugins have a chance of doing something with them first.
See #11179 and #10823.
-rw-r--r-- | compiler/coreSyn/CoreSubst.hs | 2 | ||||
-rw-r--r-- | compiler/deSugar/Desugar.hs | 3 | ||||
-rw-r--r-- | compiler/simplCore/OccurAnal.hs | 20 | ||||
-rw-r--r-- | compiler/simplCore/SimplCore.hs | 2 |
4 files changed, 21 insertions, 6 deletions
diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 9d69493d9e..7efb58d5b1 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -906,7 +906,7 @@ simpleOptPgm dflags this_mod binds rules vects ; return (reverse binds', substRulesForImportedIds subst' rules, substVects subst' vects) } where - occ_anald_binds = occurAnalysePgm this_mod (\_ -> False) {- No rules active -} + occ_anald_binds = occurAnalysePgm this_mod False (\_ -> False) {- No rules active -} rules vects emptyVarEnv binds (subst', binds') = foldl do_one (emptySubst, []) occ_anald_binds diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 1cd7979128..4936ece1aa 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -355,8 +355,7 @@ deSugar hsc_env #endif ; (ds_binds, ds_rules_for_imps, ds_vects) <- simpleOptPgm dflags mod final_pgm rules_for_imps vects0 - -- The simpleOptPgm gets rid of type - -- bindings plus any stupid dead code + -- The simpleOptPgm gets rid of type bindings ; endPassIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index b02ddc9540..52fa9d112c 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -56,10 +56,11 @@ Here's the externally-callable interface: -} occurAnalysePgm :: Module -- Used only in debug output + -> Bool -> (Activation -> Bool) -> [CoreRule] -> [CoreVect] -> VarSet -> CoreProgram -> CoreProgram -occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds +occurAnalysePgm this_mod remove_dead active_rule imp_rules vects vectVars binds | isEmptyDetails final_usage = occ_anald_binds @@ -81,11 +82,16 @@ occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds initial_uds = addManyOccsSet emptyDetails (rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects `unionVarSet` - vectVars) + vectVars `unionVarSet` + keepAliveVars) -- The RULES and VECTORISE declarations keep things alive! (For VECTORISE declarations, -- we only get them *until* the vectoriser runs. Afterwards, these dependencies are -- reflected in 'vectors' — see Note [Vectorisation declarations and occurrences].) + -- Note [Do not delete dead code in the desugarer] + keepAliveVars | remove_dead = emptyVarSet + | otherwise = mkVarSet $ concatMap bindersOf binds + -- Note [Preventing loops due to imported functions rules] imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv [ mapVarEnv (const maps_to) (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule) @@ -2709,3 +2715,13 @@ andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) | arity1 == arity2 = info andTailCallInfo _ _ = NoTailCallInfo + +-- Note [Do not delete dead code in the desugarer] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- GHC plugins rightly want to access code that is maybe not exported and thus +-- “dead” from GHC's point of view. So we must not eliminate dead code before +-- the first time a user plugin had a chance to run. +-- +-- The desugarer runs the occurrence analyser; in that run we will add +-- all binders to the “body” of the module, thus preventing them from being +-- deleted or marked as dead. diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 23faac861a..b7253a96ac 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -703,7 +703,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) InitialPhase -> (mg_vect_decls guts, vectVars) _ -> ([], vectVars) ; tagged_binds = {-# SCC "OccAnal" #-} - occurAnalysePgm this_mod active_rule rules + occurAnalysePgm this_mod True active_rule rules maybeVects maybeVectVars binds } ; Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis" |