[commit: ghc] wip/T11179: Do not drop dead code in the desugarer (b59c2de)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T11179
Link       : http://ghc.haskell.org/trac/ghc/changeset/b59c2de7abe3cd4e046f11c3536ba8e7137c4f84/ghc

>---------------------------------------------------------------

commit b59c2de7abe3cd4e046f11c3536ba8e7137c4f84
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Feb 3 16:27:51 2017 -0500

    Do not drop dead code in the desugarer
    
    so that GHC plugins have a chance of doing something with them first.
    See #11179 and #10823.


>---------------------------------------------------------------

b59c2de7abe3cd4e046f11c3536ba8e7137c4f84
 compiler/coreSyn/CoreSubst.hs   |  2 +-
 compiler/deSugar/Desugar.hs     |  3 +--
 compiler/simplCore/OccurAnal.hs | 20 ++++++++++++++++++--
 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 9d69493..7efb58d 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 1cd7979..4936ece 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 b02ddc9..52fa9d1 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 23faac8..b7253a9 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"