[commit: ghc] master: Improve getNameToInstancesIndex (f942f65)

[git at git.haskell.org]

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

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

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

commit f942f65a525dd972cd96e6ae42922b6a3ce4b2d0
Author: Douglas Wilson <douglas.wilson at gmail.com>
Date:   Mon Jun 12 17:02:01 2017 -0400

    Improve getNameToInstancesIndex
    
    Put it in a GhcMonad.
    Stop accidentally reversing the list of instances.
    Add a comment noting the code is mostly copied from tcRnGetInfo.
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: mpickering, rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3636


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

f942f65a525dd972cd96e6ae42922b6a3ce4b2d0
 compiler/main/GHC.hs             | 18 ++++++++++--------
 compiler/typecheck/TcRnDriver.hs |  8 ++++++++
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index ec9e271..ce779ca 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -1242,22 +1242,24 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
 -- | Retrieve all type and family instances in the environment, indexed
 -- by 'Name'. Each name's lists will contain every instance in which that name
 -- is mentioned in the instance head.
-getNameToInstancesIndex :: HscEnv
-  -> IO (Messages, Maybe (NameEnv ([ClsInst], [FamInst])))
-getNameToInstancesIndex hsc_env
-  = runTcInteractive hsc_env $
+getNameToInstancesIndex :: GhcMonad m
+  => m (Messages, Maybe (NameEnv ([ClsInst], [FamInst])))
+getNameToInstancesIndex = do
+  hsc_env <- getSession
+  liftIO $ runTcInteractive hsc_env $
     do { loadUnqualIfaces hsc_env (hsc_IC hsc_env)
        ; InstEnvs {ie_global, ie_local, ie_visible} <- tcGetInstEnvs
        ; (pkg_fie, home_fie) <- tcGetFamInstEnvs
-       -- We use flip mappend to maintain the order of instances,
-       -- and Data.Sequence.Seq to keep flip mappend fast
-       ; let cls_index = Map.fromListWith (flip mappend)
+       -- We use Data.Sequence.Seq because we are creating left associated
+       -- mappends.
+       -- cls_index and fam_index below are adapted from TcRnDriver.lookupInsts
+       ; let cls_index = Map.fromListWith mappend
                  [ (n, Seq.singleton ispec)
                  | ispec <- instEnvElts ie_local ++ instEnvElts ie_global
                  , instIsVisible ie_visible ispec
                  , n <- nameSetElemsStable $ orphNamesOfClsInst ispec
                  ]
-       ; let fam_index = Map.fromListWith (flip mappend)
+       ; let fam_index = Map.fromListWith mappend
                  [ (n, Seq.singleton fispec)
                  | fispec <- famInstEnvElts home_fie ++ famInstEnvElts pkg_fie
                  , n <- nameSetElemsStable $ orphNamesOfFamInst fispec
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 4073fa1..35f767d 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -2441,6 +2441,14 @@ tcRnGetInfo hsc_env name
        ; (cls_insts, fam_insts) <- lookupInsts thing
        ; return (thing, fixity, cls_insts, fam_insts) }
 
+
+-- Lookup all class and family instances for a type constructor.
+--
+-- This function filters all instances in the type environment, so there
+-- is a lot of duplicated work if it is called many times in the same
+-- type environment. If this becomes a problem, the NameEnv computed
+-- in GHC.getNameToInstancesIndex could be cached in TcM and both functions
+-- could be changed to consult that index.
 lookupInsts :: TyThing -> TcM ([ClsInst],[FamInst])
 lookupInsts (ATyCon tc)
   = do  { InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods } <- tcGetInstEnvs