Improve getNameToInstancesIndex
authorDouglas Wilson <douglas.wilson@gmail.com>
Mon, 12 Jun 2017 21:02:01 +0000 (17:02 -0400)
committerBen Gamari <ben@smart-cactus.org>
Mon, 12 Jun 2017 21:02:01 +0000 (17:02 -0400)
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

compiler/main/GHC.hs
compiler/typecheck/TcRnDriver.hs

index ec9e271..ce779ca 100644 (file)
@@ -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
index 4073fa1..35f767d 100644 (file)
@@ -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