[commit: ghc] master: Amend TcPluginM interface (726ea08)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/726ea08a6e5899ccefe9b9bd65738141f257fc13/ghc

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

commit 726ea08a6e5899ccefe9b9bd65738141f257fc13
Author: Adam Gundry <adam at well-typed.com>
Date:   Thu Dec 18 08:04:20 2014 +0000

    Amend TcPluginM interface
    
    Summary:
    Expose some new functions in TcPluginM and remove one, in the light of
    experience writing plugins.  In particular, I've removed lookupRdrName
    because using it to import modules containing instances leads to subtle
    bugs; I've expanded on the lookupRdrNameInModuleForPlugins comments.
    
    Test Plan: validate
    
    Reviewers: simonpj, austin
    
    Reviewed By: austin
    
    Subscribers: goldfire, ezyang, carter, thomie, yav, gridaphobe
    
    Differential Revision: https://phabricator.haskell.org/D553
    
    Conflicts:
    	compiler/typecheck/TcSMonad.hs


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

726ea08a6e5899ccefe9b9bd65738141f257fc13
 compiler/main/DynamicLoading.hs | 14 ++++++++++----
 compiler/typecheck/TcPluginM.hs | 31 +++++++++++++++++++++++--------
 compiler/typecheck/TcSMonad.hs  |  9 ++++++---
 3 files changed, 39 insertions(+), 15 deletions(-)

diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index 95321cf..82081bf 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -184,14 +184,20 @@ lessUnsafeCoerce dflags context what = do
     return output
 
 
--- | Finds the 'Name' corresponding to the given 'RdrName' in the context of the 'ModuleName'. Returns @Nothing@ if no
--- such 'Name' could be found. Any other condition results in an exception:
+-- | Finds the 'Name' corresponding to the given 'RdrName' in the
+-- context of the 'ModuleName'. Returns @Nothing@ if no such 'Name'
+-- could be found. Any other condition results in an exception:
 --
 -- * If the module could not be found
 -- * If we could not determine the imports of the module
 --
--- Can only be used for lookuping up names while handling plugins.
--- This was introduced by 57d6798.
+-- Can only be used for looking up names while loading plugins (and is
+-- *not* suitable for use within plugins).  The interface file is
+-- loaded very partially: just enough that it can be used, without its
+-- rules and instances affecting (and being linked from!) the module
+-- being compiled.  This was introduced by 57d6798.
+--
+-- See Note [Care with plugin imports] in LoadIface.
 lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe Name)
 lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
     -- First find the package the module resides in by searching exposed packages and home modules
diff --git a/compiler/typecheck/TcPluginM.hs b/compiler/typecheck/TcPluginM.hs
index 9ba89cc..5acf1b8 100644
--- a/compiler/typecheck/TcPluginM.hs
+++ b/compiler/typecheck/TcPluginM.hs
@@ -10,8 +10,12 @@ module TcPluginM (
         tcPluginTrace,
         unsafeTcPluginTcM,
 
-        -- * Lookup
-        lookupRdrName,
+        -- * Finding Modules and Names
+        FindResult(..),
+        findImportedModule,
+        lookupOrig,
+
+        -- * Looking up Names in the typechecking environment
         tcLookupGlobal,
         tcLookupTyCon,
         tcLookupDataCon,
@@ -24,6 +28,7 @@ module TcPluginM (
         getEnvs,
         getInstEnvs,
         getFamInstEnvs,
+        matchFam,
 
         -- * Type variables
         newFlexiTyVar,
@@ -37,29 +42,32 @@ module TcPluginM (
 
 #ifdef GHCI
 import qualified TcRnMonad
+import qualified TcSMonad
 import qualified TcEnv
 import qualified TcMType
 import qualified Inst
 import qualified FamInst
+import qualified IfaceEnv
+import qualified Finder
 
 import FamInstEnv ( FamInstEnv )
 import TcRnMonad  ( TcGblEnv, TcLclEnv, Ct, TcPluginM
                   , unsafeTcPluginTcM, liftIO, traceTc )
 import TcMType    ( TcTyVar, TcType )
 import TcEnv      ( TcTyThing )
+import TcEvidence ( TcCoercion )
 
 import Module
 import Name
-import RdrName
 import TyCon
 import DataCon
 import Class
 import HscTypes
 import Outputable
 import Type
-import DynamicLoading
 import Id
 import InstEnv
+import FastString
 
 
 -- | Perform some IO, typically to interact with an external tool.
@@ -71,10 +79,14 @@ tcPluginTrace :: String -> SDoc -> TcPluginM ()
 tcPluginTrace a b = unsafeTcPluginTcM (traceTc a b)
 
 
-lookupRdrName :: ModuleName -> RdrName -> TcPluginM (Maybe Name)
-lookupRdrName mod rdr = do
-  hsc_env <- getTopEnv
-  tcPluginIO $ lookupRdrNameInModuleForPlugins hsc_env mod rdr
+findImportedModule :: ModuleName -> Maybe FastString -> TcPluginM FindResult
+findImportedModule mod_name mb_pkg = do
+    hsc_env <- getTopEnv
+    tcPluginIO $ Finder.findImportedModule hsc_env mod_name mb_pkg
+
+lookupOrig :: Module -> OccName -> TcPluginM Name
+lookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod
+
 
 tcLookupGlobal :: Name -> TcPluginM TyThing
 tcLookupGlobal = unsafeTcPluginTcM . TcEnv.tcLookupGlobal
@@ -107,6 +119,9 @@ getInstEnvs = unsafeTcPluginTcM Inst.tcGetInstEnvs
 getFamInstEnvs :: TcPluginM (FamInstEnv, FamInstEnv)
 getFamInstEnvs = unsafeTcPluginTcM FamInst.tcGetFamInstEnvs
 
+matchFam :: TyCon -> [Type] -> TcPluginM (Maybe (TcCoercion, TcType))
+matchFam tycon args = unsafeTcPluginTcM $ TcSMonad.matchFamTcM tycon args
+
 
 newFlexiTyVar :: Kind -> TcPluginM TcTyVar
 newFlexiTyVar = unsafeTcPluginTcM . TcMType.newFlexiTyVar
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index a0dda96..4c9ab2f 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -80,7 +80,7 @@ module TcSMonad (
 
     -- Misc
     getDefaultInfo, getDynFlags, getGlobalRdrEnvTcS,
-    matchFam,
+    matchFam, matchFamTcM,
     checkWellStagedDFun,
     pprEq                                    -- Smaller utils, re-exported from TcM
                                              -- TODO (DV): these are only really used in the
@@ -1739,9 +1739,12 @@ instDFunConstraints loc = mapM (newWantedEvVar loc)
 
 
 matchFam :: TyCon -> [Type] -> TcS (Maybe (TcCoercion, TcType))
+matchFam tycon args = wrapTcS $ matchFamTcM tycon args
+
+matchFamTcM :: TyCon -> [Type] -> TcM (Maybe (TcCoercion, TcType))
 -- Given (F tys) return (ty, co), where co :: F tys ~ ty
-matchFam tycon args
-  = do { fam_envs <- getFamInstEnvs
+matchFamTcM tycon args
+  = do { fam_envs <- FamInst.tcGetFamInstEnvs
        ; return $ fmap (first TcCoercion) $
          reduceTyFamApp_maybe fam_envs Nominal tycon args }