Filter orphan rules based on imports, fixes #10294 and #10420.

Summary:
If we have an orphan rule in our database, don't apply it
unless the defining module is transitively imported by the
module we are processing.  We do this by defining a new RuleEnv
data type which includes both the RuleBase as well as the set
of visible orphan modules, and threading this through the
relevant environments (CoreReader, RuleCheckEnv and ScEnv).

This is analogous to the instances fix we applied in #2182
4c834fdddf4d44d12039da4d6a2c63a660975b95, but done for RULES.
An important knock-on effect is that we can remove some buggy
code in LoadInterface which tried to avoid loading interfaces
that were loaded by plugins (which sometimes caused instances
and rules to NEVER become visible).

One note about tests: I renamed the old plugins07 test to T10420
and replaced plugins07 with a test to ensure that a plugin
import did not cause new rules to be loaded in.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin, goldfire

Subscribers: bgamari, thomie

Differential Revision: https://phabricator.haskell.org/D950

GHC Trac Issues: #10420

1 files changed, 29 insertions, 9 deletions

diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index 3601253e41..cb71e3a3f3 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -29,9 +29,11 @@ module Rules (
 #include "HsVersions.h"
 
 import CoreSyn          -- All of it
+import Module           ( Module, ModuleSet, elemModuleSet )
 import CoreSubst
 import OccurAnal        ( occurAnalyseExpr )
-import CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars )
+import CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars
+                        , rulesFreeVars, exprsOrphNames )
 import CoreUtils        ( exprType, eqExpr, mkTick, mkTicks,
                           stripTicksTopT, stripTicksTopE )
 import PprCore          ( pprRules )
@@ -43,7 +45,8 @@ import Id
 import IdInfo           ( SpecInfo( SpecInfo ) )
 import VarEnv
 import VarSet
-import Name             ( Name, NamedThing(..) )
+import Name             ( Name, NamedThing(..), nameIsLocalOrFrom, nameOccName )
+import NameSet
 import NameEnv
 import Unify            ( ruleMatchTyX, MatchEnv(..) )
 import BasicTypes       ( Activation, CompilerPhase, isActive )
@@ -158,16 +161,28 @@ might have a specialisation
 where pi' :: Lift Int# is the specialised version of pi.
 -}
 
-mkRule :: Bool -> Bool -> RuleName -> Activation
+mkRule :: Module -> Bool -> Bool -> RuleName -> Activation
        -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
 -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
 -- compiled. See also 'CoreSyn.CoreRule'
-mkRule is_auto is_local name act fn bndrs args rhs
+mkRule this_mod is_auto is_local name act fn bndrs args rhs
   = Rule { ru_name = name, ru_fn = fn, ru_act = act,
            ru_bndrs = bndrs, ru_args = args,
            ru_rhs = occurAnalyseExpr rhs,
            ru_rough = roughTopNames args,
+           ru_origin = this_mod,
+           ru_orphan = orph,
            ru_auto = is_auto, ru_local = is_local }
+  where
+        -- Compute orphanhood.  See Note [Orphans] in InstEnv
+        -- A rule is an orphan only if none of the variables
+        -- mentioned on its left-hand side are locally defined
+    lhs_names = nameSetElems (extendNameSet (exprsOrphNames args) fn)
+        -- TODO: copied from ruleLhsOrphNames
+
+    orph = case filter (nameIsLocalOrFrom this_mod) lhs_names of
+                        (n : _) -> NotOrphan (nameOccName n)
+                        []      -> IsOrphan
 
 --------------
 roughTopNames :: [CoreExpr] -> [Maybe Name]
@@ -277,13 +292,18 @@ addIdSpecialisations id rules
 rulesOfBinds :: [CoreBind] -> [CoreRule]
 rulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds
 
-getRules :: RuleBase -> Id -> [CoreRule]
+getRules :: RuleEnv -> Id -> [CoreRule]
 -- See Note [Where rules are found]
-getRules rule_base fn
-  = idCoreRules fn ++ imp_rules
+getRules (RuleEnv { re_base = rule_base, re_visible_orphs = orphs }) fn
+  = idCoreRules fn ++ filter (ruleIsVisible orphs) imp_rules
   where
     imp_rules = lookupNameEnv rule_base (idName fn) `orElse` []
 
+ruleIsVisible :: ModuleSet -> CoreRule -> Bool
+ruleIsVisible _ BuiltinRule{} = True
+ruleIsVisible vis_orphs Rule { ru_orphan = orph, ru_origin = origin }
+    = notOrphan orph || origin `elemModuleSet` vis_orphs
+
 {-
 Note [Where rules are found]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1041,7 +1061,7 @@ is so important.
 -- string for the purposes of error reporting
 ruleCheckProgram :: CompilerPhase               -- ^ Rule activation test
                  -> String                      -- ^ Rule pattern
-                 -> RuleBase                    -- ^ Database of rules
+                 -> RuleEnv                     -- ^ Database of rules
                  -> CoreProgram                 -- ^ Bindings to check in
                  -> SDoc                        -- ^ Resulting check message
 ruleCheckProgram phase rule_pat rule_base binds
@@ -1065,7 +1085,7 @@ data RuleCheckEnv = RuleCheckEnv {
     rc_is_active :: Activation -> Bool,
     rc_id_unf  :: IdUnfoldingFun,
     rc_pattern :: String,
-    rc_rule_base :: RuleBase
+    rc_rule_base :: RuleEnv
 }
 
 ruleCheckBind :: RuleCheckEnv -> CoreBind -> Bag SDoc