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

15 files changed, 128 insertions, 11 deletions

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"