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

32 files changed, 351 insertions, 177 deletions

diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs
index 2a44ccc9a3..688728ae48 100644
--- a/compiler/coreSyn/CoreFVs.hs
+++ b/compiler/coreSyn/CoreFVs.hs
@@ -24,7 +24,7 @@ module CoreFVs (
         idUnfoldingVars, idFreeVars, idRuleAndUnfoldingVars,
         idRuleVars, idRuleRhsVars, stableUnfoldingVars,
         ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,
-        ruleLhsOrphNames, ruleLhsFreeIds,
+        ruleLhsOrphNames, ruleLhsFreeIds, exprsOrphNames,
         vectsFreeVars,
 
         -- * Core syntax tree annotation with free variables
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 989cb7f7bf..f681ea53ac 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -1871,6 +1871,7 @@ withoutAnnots pass guts = do
       withoutFlag corem =
         liftIO =<< runCoreM <$> fmap removeFlag getHscEnv <*> getRuleBase <*>
                                 getUniqueSupplyM <*> getModule <*>
+                                getVisibleOrphanMods <*>
                                 getPrintUnqualified <*> pure corem
   -- Nuke existing ticks in module.
   -- TODO: Ticks in unfoldings. Maybe change unfolding so it removes
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 98400c42a3..c641d88f65 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -67,9 +67,13 @@ module CoreSyn (
         -- ** Operations on annotations
         deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
 
+        -- * Orphanhood
+        IsOrphan(..), isOrphan, notOrphan,
+
         -- * Core rule data types
         CoreRule(..), RuleBase,
         RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
+        RuleEnv(..), mkRuleEnv, emptyRuleEnv,
 
         -- ** Operations on 'CoreRule's
         ruleArity, ruleName, ruleIdName, ruleActivation,
@@ -88,7 +92,7 @@ import Var
 import Type
 import Coercion
 import Name
-import NameEnv( NameEnv )
+import NameEnv( NameEnv, emptyNameEnv )
 import Literal
 import DataCon
 import Module
@@ -99,6 +103,7 @@ import FastString
 import Outputable
 import Util
 import SrcLoc     ( RealSrcSpan, containsSpan )
+import Binary
 
 import Data.Data hiding (TyCon)
 import Data.Int
@@ -693,6 +698,84 @@ tickishContains t1 t2
 {-
 ************************************************************************
 *                                                                      *
+                Orphans
+*                                                                      *
+************************************************************************
+-}
+
+-- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
+-- witnessing the instance's non-orphanhood.
+-- See Note [Orphans]
+data IsOrphan
+  = IsOrphan
+  | NotOrphan OccName -- The OccName 'n' witnesses the instance's non-orphanhood
+                      -- In that case, the instance is fingerprinted as part
+                      -- of the definition of 'n's definition
+    deriving (Data, Typeable)
+
+-- | Returns true if 'IsOrphan' is orphan.
+isOrphan :: IsOrphan -> Bool
+isOrphan IsOrphan = True
+isOrphan _ = False
+
+-- | Returns true if 'IsOrphan' is not an orphan.
+notOrphan :: IsOrphan -> Bool
+notOrphan NotOrphan{} = True
+notOrphan _ = False
+
+instance Binary IsOrphan where
+    put_ bh IsOrphan = putByte bh 0
+    put_ bh (NotOrphan n) = do
+        putByte bh 1
+        put_ bh n
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IsOrphan
+            _ -> do
+                n <- get bh
+                return $ NotOrphan n
+
+{-
+Note [Orphans]
+~~~~~~~~~~~~~~
+Class instances, rules, and family instances are divided into orphans
+and non-orphans.  Roughly speaking, an instance/rule is an orphan if
+its left hand side mentions nothing defined in this module.  Orphan-hood
+has two major consequences
+
+ * A module that contains orphans is called an "orphan module".  If
+   the module being compiled depends (transitively) on an oprhan
+   module M, then M.hi is read in regardless of whether M is oherwise
+   needed. This is to ensure that we don't miss any instance decls in
+   M.  But it's painful, because it means we need to keep track of all
+   the orphan modules below us.
+
+ * A non-orphan is not finger-printed separately.  Instead, for
+   fingerprinting purposes it is treated as part of the entity it
+   mentions on the LHS.  For example
+      data T = T1 | T2
+      instance Eq T where ....
+   The instance (Eq T) is incorprated as part of T's fingerprint.
+
+   In constrast, orphans are all fingerprinted together in the
+   mi_orph_hash field of the ModIface.
+
+   See MkIface.addFingerprints.
+
+Orphan-hood is computed
+  * For class instances:
+      when we make a ClsInst
+    (because it is needed during instance lookup)
+
+  * For rules and family instances:
+       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)
+                     or IfaceFamInst (MkIface.instanceToIfaceInst)
+-}
+
+{-
+************************************************************************
+*                                                                      *
 \subsection{Transformation rules}
 *                                                                      *
 ************************************************************************
@@ -706,6 +789,20 @@ type RuleBase = NameEnv [CoreRule]
         -- The rules are unordered;
         -- we sort out any overlaps on lookup
 
+-- | A full rule environment which we can apply rules from.  Like a 'RuleBase',
+-- but it also includes the set of visible orphans we use to filter out orphan
+-- rules which are not visible (even though we can see them...)
+data RuleEnv
+    = RuleEnv { re_base          :: RuleBase
+              , re_visible_orphs :: ModuleSet
+              }
+
+mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
+mkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)
+
+emptyRuleEnv :: RuleEnv
+emptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet
+
 -- | A 'CoreRule' is:
 --
 -- * \"Local\" if the function it is a rule for is defined in the
@@ -738,17 +835,26 @@ data CoreRule
                                 --   @False@ <=> generated at the users behest
                                 --   Main effect: reporting of orphan-hood
 
+        ru_origin :: !Module,    -- ^ 'Module' the rule was defined in, used
+                                -- to test if we should see an orphan rule.
+
+        ru_orphan :: !IsOrphan,
+                                -- ^ Whether or not the rule is an orphan.
+
         ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
                                 -- defined in the same module as the rule
                                 -- and is not an implicit 'Id' (like a record selector,
-                                -- class operation, or data constructor)
-
-                -- NB: ru_local is *not* used to decide orphan-hood
-                --      c.g. MkIface.coreRuleToIfaceRule
+                                -- class operation, or data constructor).  This
+                                -- is different from 'ru_orphan', where a rule
+                                -- can avoid being an orphan if *any* Name in
+                                -- LHS of the rule was defined in the same
+                                -- module as the rule.
     }
 
   -- | Built-in rules are used for constant folding
   -- and suchlike.  They have no free variables.
+  -- A built-in rule is always visible (there is no such thing as
+  -- an orphan built-in rule.)
   | BuiltinRule {
         ru_name  :: RuleName,   -- ^ As above
         ru_fn    :: Name,       -- ^ As above
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 2e84560f9e..e3a31b9caa 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -356,6 +356,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
 
         ; rhs' <- dsLExpr rhs
         ; dflags <- getDynFlags
+        ; this_mod <- getModule
 
         ; (bndrs'', lhs'', rhs'') <- unfold_coerce bndrs' lhs' rhs'
 
@@ -371,7 +372,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
                 -- because they don't show up in the bindings until just before code gen
               fn_name   = idName fn_id
               final_rhs = simpleOptExpr rhs''    -- De-crap it
-              rule      = mkRule False {- Not auto -} is_local
+              rule      = mkRule this_mod False {- Not auto -} is_local
                                  (snd $ unLoc name) act fn_name final_bndrs args
                                  final_rhs
 
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index fac5eb7d0a..ab3dfb90e1 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -444,6 +444,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
            Right (rule_bndrs, _fn, args) -> do
 
        { dflags <- getDynFlags
+       ; this_mod <- getModule
        ; let fn_unf    = realIdUnfolding poly_id
              unf_fvs   = stableUnfoldingVars fn_unf `orElse` emptyVarSet
              in_scope  = mkInScopeSet (unf_fvs `unionVarSet` exprsFreeVars args)
@@ -451,7 +452,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
              spec_id   = mkLocalId spec_name spec_ty
                             `setInlinePragma` inl_prag
                             `setIdUnfolding`  spec_unf
-             rule =  mkRule False {- Not auto -} is_local_id
+             rule =  mkRule this_mod False {- Not auto -} is_local_id
                         (mkFastString ("SPEC " ++ showPpr dflags poly_name))
                         rule_act poly_name
                         rule_bndrs args
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 60feb04a4f..2a8943ca11 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -458,11 +458,7 @@ loadInterface doc_str mod from
 
         ; updateEps_  $ \ eps ->
            if elemModuleEnv mod (eps_PIT eps) then eps else
-              case from of  -- See Note [Care with plugin imports]
-                ImportByPlugin -> eps {
-                  eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
-                  eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls}
-                _              -> eps {
+                eps {
                   eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
                   eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
                   eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
@@ -526,27 +522,6 @@ badSourceImport mod
        2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
           <+> quotes (ppr (modulePackageKey mod)))
 
-{-
-Note [Care with plugin imports]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When dynamically loading a plugin (via loadPluginInterface) we
-populate the same External Package State (EPS), even though plugin
-modules are to link with the compiler itself, and not with the
-compiled program.  That's fine: mostly the EPS is just a cache for
-the interace files on disk.
-
-But it's NOT ok for the RULES or instance environment.  We do not want
-to fire a RULE from the plugin on the code we are compiling, otherwise
-the code we are compiling will have a reference to a RHS of the rule
-that exists only in the compiler!  This actually happened to Daniel,
-via a RULE arising from a specialisation of (^) in the plugin.
-
-Solution: when loading plugins, do not extend the rule and instance
-environments.  We are only interested in the type environment, so that
-we can check that the plugin exports a function with the type that the
-compiler expects.
--}
-
 -----------------------------------------------------
 --      Loading type/class/value decls
 -- We pass the full Module name here, replete with
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index c1a9d2523f..970031327c 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -69,7 +69,6 @@ import Demand
 import Coercion( tidyCo )
 import Annotations
 import CoreSyn
-import CoreFVs
 import Class
 import Kind
 import TyCon
@@ -271,7 +270,7 @@ mkIface_ hsc_env maybe_old_fingerprint
 
         fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
         warns       = src_warns
-        iface_rules = map (coreRuleToIfaceRule this_mod) rules
+        iface_rules = map coreRuleToIfaceRule rules
         iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
         iface_fam_insts = map famInstToIfaceFamInst fam_insts
         iface_vect_info = flattenVectInfo vect_info
@@ -1929,15 +1928,15 @@ toIfUnfolding _ _
   = Nothing
 
 --------------------------
-coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
-coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
+coreRuleToIfaceRule :: CoreRule -> IfaceRule
+coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
   = pprTrace "toHsRule: builtin" (ppr fn) $
     bogusIfaceRule fn
 
-coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn,
-                                     ru_act = act, ru_bndrs = bndrs,
-                                     ru_args = args, ru_rhs = rhs,
-                                     ru_auto = auto })
+coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
+                            ru_act = act, ru_bndrs = bndrs,
+                            ru_args = args, ru_rhs = rhs,
+                            ru_orphan = orph, ru_auto = auto })
   = IfaceRule { ifRuleName  = name, ifActivation = act,
                 ifRuleBndrs = map toIfaceBndr bndrs,
                 ifRuleHead  = fn,
@@ -1954,15 +1953,6 @@ coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn,
     do_arg (Coercion co) = IfaceCo   (toIfaceCoercion co)
     do_arg arg           = toIfaceExpr arg
 
-        -- 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 (ruleLhsOrphNames rule)
-
-    orph = case filter (nameIsLocalOrFrom mod) lhs_names of
-                        (n : _) -> NotOrphan (nameOccName n)
-                        []      -> IsOrphan
-
 bogusIfaceRule :: Name -> IfaceRule
 bogusIfaceRule id_name
   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 7d6d1a6aa7..4f80fc9c4e 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -625,7 +625,7 @@ tcIfaceRules ignore_prags if_rules
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
                         ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
-                        ifRuleAuto = auto })
+                        ifRuleAuto = auto, ifRuleOrph = orph })
   = do  { ~(bndrs', args', rhs') <-
                 -- Typecheck the payload lazily, in the hope it'll never be looked at
                 forkM (ptext (sLit "Rule") <+> ftext name) $
@@ -634,10 +634,13 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
                    ; rhs'  <- tcIfaceExpr rhs
                    ; return (bndrs', args', rhs') }
         ; let mb_tcs = map ifTopFreeName args
+        ; this_mod <- getIfModule
         ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,
                           ru_bndrs = bndrs', ru_args = args',
                           ru_rhs = occurAnalyseExpr rhs',
                           ru_rough = mb_tcs,
+                          ru_origin = this_mod,
+                          ru_orphan = orph,
                           ru_auto = auto,
                           ru_local = False }) } -- An imported RULE is never for a local Id
                                                 -- or, even if it is (module loop, perhaps)
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index dec41bb4f7..fc69fdc681 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -27,6 +27,7 @@ module CoreMonad (
     -- ** Reading from the monad
     getHscEnv, getRuleBase, getModule,
     getDynFlags, getOrigNameCache, getPackageFamInstEnv,
+    getVisibleOrphanMods,
     getPrintUnqualified,
 
     -- ** Writing to the monad
@@ -518,6 +519,7 @@ data CoreReader = CoreReader {
         cr_hsc_env :: HscEnv,
         cr_rule_base :: RuleBase,
         cr_module :: Module,
+        cr_visible_orphan_mods :: !ModuleSet,
         cr_print_unqual :: PrintUnqualified,
 #ifdef GHCI
         cr_globals :: (MVar PersistentLinkerState, Bool)
@@ -595,10 +597,11 @@ runCoreM :: HscEnv
          -> RuleBase
          -> UniqSupply
          -> Module
+         -> ModuleSet
          -> PrintUnqualified
          -> CoreM a
          -> IO (a, SimplCount)
-runCoreM hsc_env rule_base us mod print_unqual m = do
+runCoreM hsc_env rule_base us mod orph_imps print_unqual m = do
         glbls <- saveLinkerGlobals
         liftM extract $ runIOEnv (reader glbls) $ unCoreM m state
   where
@@ -606,6 +609,7 @@ runCoreM hsc_env rule_base us mod print_unqual m = do
             cr_hsc_env = hsc_env,
             cr_rule_base = rule_base,
             cr_module = mod,
+            cr_visible_orphan_mods = orph_imps,
             cr_globals = glbls,
             cr_print_unqual = print_unqual
         }
@@ -668,6 +672,9 @@ getHscEnv = read cr_hsc_env
 getRuleBase :: CoreM RuleBase
 getRuleBase = read cr_rule_base
 
+getVisibleOrphanMods :: CoreM ModuleSet
+getVisibleOrphanMods = read cr_visible_orphan_mods
+
 getPrintUnqualified :: CoreM PrintUnqualified
 getPrintUnqualified = read cr_print_unqual
 
diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs
index d83ab89bd6..88ca00f6a0 100644
--- a/compiler/simplCore/SimplCore.hs
+++ b/compiler/simplCore/SimplCore.hs
@@ -14,7 +14,7 @@ import DynFlags
 import CoreSyn
 import HscTypes
 import CSE              ( cseProgram )
-import Rules            ( emptyRuleBase, mkRuleBase, unionRuleBase,
+import Rules            ( mkRuleBase, unionRuleBase,
                           extendRuleBaseList, ruleCheckProgram, addSpecInfo, )
 import PprCore          ( pprCoreBindings, pprCoreExpr )
 import OccurAnal        ( occurAnalysePgm, occurAnalyseExpr )
@@ -47,6 +47,7 @@ import Vectorise        ( vectorise )
 import FastString
 import SrcLoc
 import Util
+import Module
 
 import Maybes
 import UniqSupply       ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
@@ -72,8 +73,10 @@ core2core hsc_env guts
        -- make sure all plugins are loaded
 
        ; let builtin_passes = getCoreToDo dflags
+             orph_mods = mkModuleSet (mg_module guts : dep_orphs (mg_deps guts))
        ;
-       ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base us mod print_unqual $
+       ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base us mod
+                                    orph_mods print_unqual $
                            do { all_passes <- addPluginPasses builtin_passes
                               ; runCorePasses all_passes guts }
 
@@ -411,9 +414,11 @@ ruleCheckPass :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts
 ruleCheckPass current_phase pat guts = do
     rb <- getRuleBase
     dflags <- getDynFlags
+    vis_orphs <- getVisibleOrphanMods
     liftIO $ Err.showPass dflags "RuleCheck"
     liftIO $ log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle
-                 (ruleCheckProgram current_phase pat rb (mg_binds guts))
+                 (ruleCheckProgram current_phase pat
+                    (RuleEnv rb vis_orphs) (mg_binds guts))
     return guts
 
 
@@ -490,8 +495,9 @@ simplifyExpr dflags expr
 
         ; let sz = exprSize expr
 
-        ; (expr', counts) <- initSmpl dflags emptyRuleBase emptyFamInstEnvs us sz $
-                                 simplExprGently (simplEnvForGHCi dflags) expr
+        ; (expr', counts) <- initSmpl dflags emptyRuleEnv
+                               emptyFamInstEnvs us sz
+                               (simplExprGently (simplEnvForGHCi dflags) expr)
 
         ; Err.dumpIfSet dflags (dopt Opt_D_dump_simpl_stats dflags)
                   "Simplifier statistics" (pprSimplCount counts)
@@ -551,6 +557,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
               hsc_env us hpt_rule_base
               guts@(ModGuts { mg_module = this_mod
                             , mg_rdr_env = rdr_env
+                            , mg_deps = deps
                             , mg_binds = binds, mg_rules = rules
                             , mg_fam_inst_env = fam_inst_env })
   = do { (termination_msg, it_count, counts_out, guts')
@@ -639,10 +646,12 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
            eps <- hscEPS hsc_env ;
            let  { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps)
                 ; rule_base2 = extendRuleBaseList rule_base1 rules
-                ; fam_envs = (eps_fam_inst_env eps, fam_inst_env) } ;
+                ; fam_envs = (eps_fam_inst_env eps, fam_inst_env)
+                ; vis_orphs = this_mod : dep_orphs deps } ;
 
                 -- Simplify the program
-           ((binds1, rules1), counts1) <- initSmpl dflags rule_base2 fam_envs us1 sz $
+           ((binds1, rules1), counts1) <-
+             initSmpl dflags (mkRuleEnv rule_base2 vis_orphs) fam_envs us1 sz $
                do { env1 <- {-# SCC "SimplTopBinds" #-}
                             simplTopBinds simpl_env tagged_binds
 
diff --git a/compiler/simplCore/SimplMonad.hs b/compiler/simplCore/SimplMonad.hs
index bd60a7942c..c8503a7f3f 100644
--- a/compiler/simplCore/SimplMonad.hs
+++ b/compiler/simplCore/SimplMonad.hs
@@ -22,7 +22,7 @@ module SimplMonad (
 import Id               ( Id, mkSysLocal )
 import Type             ( Type )
 import FamInstEnv       ( FamInstEnv )
-import CoreSyn          ( RuleBase )
+import CoreSyn          ( RuleEnv(..) )
 import UniqSupply
 import DynFlags
 import CoreMonad
@@ -55,10 +55,10 @@ newtype SimplM result
 data SimplTopEnv
   = STE { st_flags     :: DynFlags
         , st_max_ticks :: IntWithInf  -- Max #ticks in this simplifier run
-        , st_rules     :: RuleBase
+        , st_rules     :: RuleEnv
         , st_fams      :: (FamInstEnv, FamInstEnv) }
 
-initSmpl :: DynFlags -> RuleBase -> (FamInstEnv, FamInstEnv)
+initSmpl :: DynFlags -> RuleEnv -> (FamInstEnv, FamInstEnv)
          -> UniqSupply          -- No init count; set to 0
          -> Int                 -- Size of the bindings, used to limit
                                 -- the number of ticks we allow
@@ -168,7 +168,7 @@ instance MonadIO SimplM where
       x <- m
       return (x, us, sc)
 
-getSimplRules :: SimplM RuleBase
+getSimplRules :: SimplM RuleEnv
 getSimplRules = SM (\st_env us sc -> return (st_rules st_env, us, sc))
 
 getFamEnvs :: SimplM (FamInstEnv, FamInstEnv)
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
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 7a4b4028c4..a8c6f060ab 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -58,6 +58,7 @@ import MonadUtils
 import Control.Monad    ( zipWithM )
 import Data.List
 import PrelNames        ( specTyConName )
+import Module
 
 -- See Note [Forcing specialisation]
 #ifndef GHCI
@@ -686,9 +687,11 @@ specConstrProgram guts
       dflags <- getDynFlags
       us     <- getUniqueSupplyM
       annos  <- getFirstAnnotations deserializeWithData guts
+      this_mod <- getModule
       let binds' = reverse $ fst $ initUs us $ do
                     -- Note [Top-level recursive groups]
-                    (env, binds) <- goEnv (initScEnv dflags annos) (mg_binds guts)
+                    (env, binds) <- goEnv (initScEnv dflags this_mod annos)
+                                          (mg_binds guts)
                         -- binds is identical to (mg_binds guts), except that the
                         -- binders on the LHS have been replaced by extendBndr
                         --   (SPJ this seems like overkill; I don't think the binders
@@ -760,6 +763,7 @@ leave it for now.
 -}
 
 data ScEnv = SCE { sc_dflags    :: DynFlags,
+                   sc_module    :: !Module,
                    sc_size      :: Maybe Int,   -- Size threshold
                    sc_count     :: Maybe Int,   -- Max # of specialisations for any one fn
                                                 -- See Note [Avoiding exponential blowup]
@@ -811,9 +815,10 @@ instance Outputable Value where
    ppr LambdaVal         = ptext (sLit "<Lambda>")
 
 ---------------------
-initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv
-initScEnv dflags anns
+initScEnv :: DynFlags -> Module -> UniqFM SpecConstrAnnotation -> ScEnv
+initScEnv dflags this_mod anns
   = SCE { sc_dflags      = dflags,
+          sc_module      = this_mod,
           sc_size        = specConstrThreshold dflags,
           sc_count       = specConstrCount     dflags,
           sc_recursive   = specConstrRecursive dflags,
@@ -1650,7 +1655,8 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
               body_ty    = exprType spec_body
               rule_rhs   = mkVarApps (Var spec_id) spec_call_args
               inline_act = idInlineActivation fn
-              rule       = mkRule True {- Auto -} True {- Local -}
+              this_mod   = sc_module spec_env
+              rule       = mkRule this_mod True {- Auto -} True {- Local -}
                                   rule_name inline_act fn_name qvars pats rule_rhs
                            -- See Note [Transfer activation]
         ; return (spec_usg, OS call_pat rule spec_id spec_rhs) }
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs
index 61633f9834..5c29c28449 100644
--- a/compiler/specialise/Specialise.hs
+++ b/compiler/specialise/Specialise.hs
@@ -13,7 +13,7 @@ import Id
 import TcType hiding( substTy, extendTvSubstList )
 import Type   hiding( substTy, extendTvSubstList )
 import Coercion( Coercion )
-import Module( Module )
+import Module( Module, HasModule(..) )
 import CoreMonad
 import qualified CoreSubst
 import CoreUnfold
@@ -578,7 +578,7 @@ specProgram guts@(ModGuts { mg_module = this_mod
   = do { dflags <- getDynFlags
 
              -- Specialise the bindings of this module
-       ; (binds', uds) <- runSpecM dflags (go binds)
+       ; (binds', uds) <- runSpecM dflags this_mod (go binds)
 
              -- Specialise imported functions
        ; hpt_rules <- getRuleBase
@@ -652,10 +652,11 @@ specImport dflags this_mod done rb fn calls_for_fn
              -- more rules as we go along
        ; hsc_env <- getHscEnv
        ; eps <- liftIO $ hscEPS hsc_env
+       ; vis_orphs <- getVisibleOrphanMods
        ; let full_rb = unionRuleBase rb (eps_rule_base eps)
-             rules_for_fn = getRules full_rb fn
+             rules_for_fn = getRules (RuleEnv full_rb vis_orphs) fn
 
-       ; (rules1, spec_pairs, uds) <- runSpecM dflags $
+       ; (rules1, spec_pairs, uds) <- runSpecM dflags this_mod $
               specCalls (Just this_mod) emptySpecEnv rules_for_fn calls_for_fn fn rhs
        ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs]
              -- After the rules kick in we may get recursion, but
@@ -1187,6 +1188,7 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs
 
            ; spec_f <- newSpecIdSM fn spec_id_ty
            ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body)
+           ; this_mod <- getModule
            ; let
                 -- The rule to put in the function's specialisation is:
                 --      forall b, d1',d2'.  f t1 b t3 d1' d2' = f1 b
@@ -1202,7 +1204,10 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs
                             -- otherwise uniques end up there, making builds
                             -- less deterministic (See #4012 comment:61 ff)
 
-                spec_env_rule = mkRule True {- Auto generated -} is_local
+                spec_env_rule = mkRule
+                                  this_mod
+                                  True {- Auto generated -}
+                                  is_local
                                   rule_name
                                   inl_act       -- Note [Auto-specialisation and RULES]
                                   (idName fn)
@@ -1955,6 +1960,7 @@ newtype SpecM a = SpecM (State SpecState a)
 
 data SpecState = SpecState {
                      spec_uniq_supply :: UniqSupply,
+                     spec_module :: Module,
                      spec_dflags :: DynFlags
                  }
 
@@ -1989,11 +1995,15 @@ instance MonadUnique SpecM where
 instance HasDynFlags SpecM where
     getDynFlags = SpecM $ liftM spec_dflags get
 
-runSpecM :: DynFlags -> SpecM a -> CoreM a
-runSpecM dflags (SpecM spec)
+instance HasModule SpecM where
+    getModule = SpecM $ liftM spec_module get
+
+runSpecM :: DynFlags -> Module -> SpecM a -> CoreM a
+runSpecM dflags this_mod (SpecM spec)
     = do us <- getUniqueSupplyM
          let initialState = SpecState {
                                 spec_uniq_supply = us,
+                                spec_module = this_mod,
                                 spec_dflags = dflags
                             }
          return $ evalState spec initialState
diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs
index 6151f20599..f810850d4b 100644
--- a/compiler/types/InstEnv.hs
+++ b/compiler/types/InstEnv.hs
@@ -29,6 +29,7 @@ module InstEnv (
 
 #include "HsVersions.h"
 
+import CoreSyn (IsOrphan(..), isOrphan, notOrphan)
 import Module
 import Class
 import Var
@@ -44,7 +45,6 @@ import BasicTypes
 import UniqFM
 import Util
 import Id
-import Binary
 import FastString
 import Data.Data        ( Data, Typeable )
 import Data.Maybe       ( isJust, isNothing )
@@ -274,82 +274,6 @@ instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
 instanceCantMatch _             _             =  False  -- Safe
 
 {-
-************************************************************************
-*                                                                      *
-                Orphans
-*                                                                      *
-************************************************************************
--}
-
--- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
--- witnessing the instance's non-orphanhood.
--- See Note [Orphans]
-data IsOrphan
-  = IsOrphan
-  | NotOrphan OccName  -- The OccName 'n' witnesses the instance's non-orphanhood
-                       -- In that case, the instance is fingerprinted as part
-                       -- of the definition of 'n's definition
-    deriving (Data, Typeable)
-
--- | Returns true if 'IsOrphan' is orphan.
-isOrphan :: IsOrphan -> Bool
-isOrphan IsOrphan = True
-isOrphan _ = False
-
--- | Returns true if 'IsOrphan' is not an orphan.
-notOrphan :: IsOrphan -> Bool
-notOrphan NotOrphan{} = True
-notOrphan _ = False
-
-instance Binary IsOrphan where
-    put_ bh IsOrphan = putByte bh 0
-    put_ bh (NotOrphan n) = do
-        putByte bh 1
-        put_ bh n
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return IsOrphan
-            _ -> do
-                n <- get bh
-                return $ NotOrphan n
-
-{-
-Note [Orphans]
-~~~~~~~~~~~~~~
-Class instances, rules, and family instances are divided into orphans
-and non-orphans.  Roughly speaking, an instance/rule is an orphan if
-its left hand side mentions nothing defined in this module.  Orphan-hood
-has two major consequences
-
- * A module that contains orphans is called an "orphan module".  If
-   the module being compiled depends (transitively) on an oprhan
-   module M, then M.hi is read in regardless of whether M is oherwise
-   needed. This is to ensure that we don't miss any instance decls in
-   M.  But it's painful, because it means we need to keep track of all
-   the orphan modules below us.
-
- * A non-orphan is not finger-printed separately.  Instead, for
-   fingerprinting purposes it is treated as part of the entity it
-   mentions on the LHS.  For example
-      data T = T1 | T2
-      instance Eq T where ....
-   The instance (Eq T) is incorprated as part of T's fingerprint.
-
-   In constrast, orphans are all fingerprinted together in the
-   mi_orph_hash field of the ModIface.
-
-   See MkIface.addFingerprints.
-
-Orphan-hood is computed
-  * For class instances:
-      when we make a ClsInst
-    (because it is needed during instance lookup)
-
-  * For rules and family instances:
-       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)
-                     or IfaceFamInst (MkIface.instanceToIfaceInst)
-
 Note [When exactly is an instance decl an orphan?]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   (see MkIface.instanceToIfaceInst, which implements this)
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 21c5709c45..10b1bfe699 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -1202,7 +1202,11 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
 /tests/plugins/simple-plugin/pkg.plugins02/
 /tests/plugins/simple-plugin/pkg.plugins03/
 /tests/plugins/simple-plugin/setup
+/tests/plugins/rule-defining-plugin/pkg.T10420/
 /tests/plugins/rule-defining-plugin/pkg.plugins07/
+/tests/plugins/annotation-plugin/pkg.T10294/
+/tests/plugins/annotation-plugin/pkg.T10294a/
+/tests/plugins/T10420
 /tests/polykinds/Freeman
 /tests/polykinds/MonoidsFD
 /tests/polykinds/MonoidsTF
diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile
index aac3b1257d..42a4d1af0a 100644
--- a/testsuite/tests/plugins/Makefile
+++ b/testsuite/tests/plugins/Makefile
@@ -2,12 +2,25 @@ TOP=../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
 
-.PHONY: plugins01 plugins07
-
+.PHONY: plugins01
 plugins01:
 	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -package simple-plugin
 	./plugins01
 
+.PHONY: plugins07
 plugins07:
-	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -package rule-defining-plugin
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -package rule-defining-plugin -fplugin=RuleDefiningPlugin
 	./plugins07
+
+.PHONY: T10420
+T10420:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O T10420.hs -package-db rule-defining-plugin/pkg.T10420/local.package.conf -package rule-defining-plugin
+	./T10420
+
+.PHONY: T10294
+T10294:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -c -v0 T10294.hs -package-db annotation-plugin/pkg.T10294/local.package.conf -package annotation-plugin -fplugin=SayAnnNames
+
+.PHONY: T10294a
+T10294a:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -c -v0 T10294a.hs -package-db annotation-plugin/pkg.T10294a/local.package.conf -package annotation-plugin -fplugin=SayAnnNames
diff --git a/testsuite/tests/plugins/T10294.hs b/testsuite/tests/plugins/T10294.hs
new file mode 100644
index 0000000000..ff1dd57400
--- /dev/null
+++ b/testsuite/tests/plugins/T10294.hs
@@ -0,0 +1,7 @@
+module T10294 where
+
+import SayAnnNames
+
+{-# ANN foo SomeAnn #-}
+foo :: ()
+foo = ()
diff --git a/testsuite/tests/plugins/T10294.stderr b/testsuite/tests/plugins/T10294.stderr
new file mode 100644
index 0000000000..4b3737a028
--- /dev/null
+++ b/testsuite/tests/plugins/T10294.stderr
@@ -0,0 +1 @@
+Annotated binding found: foo
diff --git a/testsuite/tests/plugins/T10294a.hs b/testsuite/tests/plugins/T10294a.hs
new file mode 100644
index 0000000000..ba5942be72
--- /dev/null
+++ b/testsuite/tests/plugins/T10294a.hs
@@ -0,0 +1,7 @@
+module T10294a where
+
+import SayAnnNames
+import Data.Data
+
+baz :: Constr
+baz = toConstr SomeAnn
diff --git a/testsuite/tests/plugins/T10420.hs b/testsuite/tests/plugins/T10420.hs
new file mode 100644
index 0000000000..7b863445ec
--- /dev/null
+++ b/testsuite/tests/plugins/T10420.hs
@@ -0,0 +1,10 @@
+module Main where
+
+import T10420a
+
+import RuleDefiningPlugin
+
+{-# NOINLINE x #-}
+x = "foo"
+
+main = putStrLn (show x)
diff --git a/testsuite/tests/plugins/T10420.stdout b/testsuite/tests/plugins/T10420.stdout
new file mode 100644
index 0000000000..d27268d74f
--- /dev/null
+++ b/testsuite/tests/plugins/T10420.stdout
@@ -0,0 +1 @@
+SHOWED
diff --git a/testsuite/tests/plugins/Plugins07a.hs b/testsuite/tests/plugins/T10420a.hs
index 7453a31dea..da4d3b51a0 100644
--- a/testsuite/tests/plugins/Plugins07a.hs
+++ b/testsuite/tests/plugins/T10420a.hs
@@ -1,2 +1,2 @@
 {-# OPTIONS_GHC -fplugin RuleDefiningPlugin #-}
-module Plugins07a where
+module T10420a where
diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index e39c049dfa..62e69239b4 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -40,7 +40,24 @@ test('plugins06',
 
 test('plugins07',
      [pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.plugins07'),
-      clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.plugins07'),
-      expect_broken(10420)],
+      clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.plugins07')],
      run_command,
      ['$MAKE -s --no-print-directory plugins07'])
+
+test('T10420',
+     [pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T10420'),
+      clean_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin clean.T10420')],
+     run_command,
+     ['$MAKE -s --no-print-directory T10420'])
+
+test('T10294',
+     [pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294'),
+      clean_cmd('$MAKE -s --no-print-directory -C annotation-plugin clean.T10294')],
+     run_command,
+     ['$MAKE -s --no-print-directory T10294'])
+
+test('T10294a',
+     [pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294a'),
+      clean_cmd('$MAKE -s --no-print-directory -C annotation-plugin clean.T10294a')],
+     run_command,
+     ['$MAKE -s --no-print-directory T10294a'])
diff --git a/testsuite/tests/plugins/annotation-plugin/LICENSE b/testsuite/tests/plugins/annotation-plugin/LICENSE
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/plugins/annotation-plugin/LICENSE
diff --git a/testsuite/tests/plugins/annotation-plugin/Makefile b/testsuite/tests/plugins/annotation-plugin/Makefile
new file mode 100644
index 0000000000..7d957d0e95
--- /dev/null
+++ b/testsuite/tests/plugins/annotation-plugin/Makefile
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+	rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise,HERE))
+
+package.%:
+	$(MAKE) clean.$*
+	mkdir pkg.$*
+	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+	"$(GHC_PKG)" init pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+	pkg.$*/setup build     --distdir pkg.$*/dist -v0
+	pkg.$*/setup install   --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
new file mode 100644
index 0000000000..883ba3ada6
--- /dev/null
+++ b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module SayAnnNames (plugin, SomeAnn(..)) where
+import GhcPlugins
+import Control.Monad (unless)
+import Data.Data
+
+data SomeAnn = SomeAnn deriving (Data, Typeable)
+
+plugin :: Plugin
+plugin = defaultPlugin {
+  installCoreToDos = install
+  }
+
+install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+install _ todo = do
+  reinitializeGlobals
+  return (CoreDoPluginPass "Say name" pass : todo)
+
+pass :: ModGuts -> CoreM ModGuts
+pass g = do
+          dflags <- getDynFlags
+          mapM_ (printAnn dflags g) (mg_binds g) >> return g
+  where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind
+        printAnn dflags guts bndr@(NonRec b _) = do
+          anns <- annotationsOn guts b :: CoreM [SomeAnn]
+          unless (null anns) $ putMsgS $
+            "Annotated binding found: " ++  showSDoc dflags (ppr b)
+          return bndr
+        printAnn _ _ bndr = return bndr
+
+annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]
+annotationsOn guts bndr = do
+  anns <- getAnnotations deserializeWithData guts
+  return $ lookupWithDefaultUFM anns [] (varUnique bndr)
diff --git a/testsuite/tests/plugins/annotation-plugin/Setup.hs b/testsuite/tests/plugins/annotation-plugin/Setup.hs
new file mode 100644
index 0000000000..9a994af677
--- /dev/null
+++ b/testsuite/tests/plugins/annotation-plugin/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal b/testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal
new file mode 100644
index 0000000000..e83c0aa617
--- /dev/null
+++ b/testsuite/tests/plugins/annotation-plugin/annotation-plugin.cabal
@@ -0,0 +1,11 @@
+name:                annotation-plugin
+version:             0.1.0.0
+license-file:        LICENSE
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     SayAnnNames
+  other-extensions:    DeriveDataTypeable
+  build-depends:       base >=4.8 && <4.9, ghc
+  default-language:    Haskell2010
diff --git a/testsuite/tests/plugins/plugins07.hs b/testsuite/tests/plugins/plugins07.hs
index 78762a3fd1..ddc2c53322 100644
--- a/testsuite/tests/plugins/plugins07.hs
+++ b/testsuite/tests/plugins/plugins07.hs
@@ -1,9 +1,5 @@
 module Main where
 
-import Plugins07a
-
-import RuleDefiningPlugin
-
 {-# NOINLINE x #-}
 x = "foo"
 
diff --git a/testsuite/tests/plugins/plugins07.stdout b/testsuite/tests/plugins/plugins07.stdout
index d27268d74f..810c96eeeb 100644
--- a/testsuite/tests/plugins/plugins07.stdout
+++ b/testsuite/tests/plugins/plugins07.stdout
@@ -1 +1 @@
-SHOWED
+"foo"
diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr
index 4cb138537b..5bdd0076ce 100644
--- a/testsuite/tests/simplCore/should_compile/T8848.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8848.stderr
@@ -59,18 +59,18 @@ Rule fired: SPEC $c*> @ 'Z
 Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: Class op $p1Applicative
-Rule fired: Class op fmap
+Rule fired: Class op <$
 Rule fired: Class op <*>
-Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape ('S 'Z))
 Rule fired: Class op $p1Applicative
-Rule fired: Class op fmap
+Rule fired: Class op <$
 Rule fired: Class op <*>
 Rule fired: SPEC $fApplicativeShape @ 'Z
 Rule fired: Class op $p1Applicative
-Rule fired: Class op <$
+Rule fired: Class op fmap
 Rule fired: Class op <*>
+Rule fired: SPEC/T8848 liftA2 _ _ _ @ (Shape ('S 'Z))
 Rule fired: Class op $p1Applicative
-Rule fired: Class op <$
+Rule fired: Class op fmap
 Rule fired: Class op <*>
 Rule fired: SPEC $fFunctorShape @ 'Z
 Rule fired: Class op fmap