X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FFamInst.lhs;h=8855fdcbe94e4513c2e8cebe17367f484efc43a6;hp=45de3f03924d5ea3ffb0ed76d5aa42986820b3a1;hb=e95ee1f718c6915c478005aad8af81705357d6ab;hpb=1e50fd4185479a62e02d987bdfcb1c62712859ca diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 45de3f0..8855fdc 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -2,25 +2,25 @@ The @FamInst@ type: family instance heads \begin{code} module FamInst ( - checkFamInstConsistency, tcExtendLocalFamInstEnv + checkFamInstConsistency, tcExtendLocalFamInstEnv, tcGetFamInstEnvs ) where import HscTypes import FamInstEnv import TcMType -import TcType import TcRnMonad import TyCon import Name import Module import SrcLoc import Outputable -import LazyUniqFM -import FiniteMap +import UniqFM import FastString import Maybes import Control.Monad +import Data.Map (Map) +import qualified Data.Map as Map \end{code} @@ -71,10 +71,10 @@ instance Ord ModulePair where -- Sets of module pairs -- -type ModulePairSet = FiniteMap ModulePair () +type ModulePairSet = Map ModulePair () listToSet :: [ModulePair] -> ModulePairSet -listToSet l = listToFM (zip l (repeat ())) +listToSet l = Map.fromList (zip l (repeat ())) checkFamInstConsistency :: [Module] -> [Module] -> TcM () checkFamInstConsistency famInstMods directlyImpMods @@ -102,7 +102,7 @@ checkFamInstConsistency famInstMods directlyImpMods -- instances of okPairs are consistent ; criticalPairs = listToSet $ allPairs famInstMods -- all pairs that we need to consider - ; toCheckPairs = keysFM $ criticalPairs `minusFM` okPairs + ; toCheckPairs = Map.keys $ criticalPairs `Map.difference` okPairs -- the difference gives us the pairs we need to check now } @@ -197,4 +197,17 @@ addFamInstLoc famInst thing_inside = setSrcSpan (mkSrcSpan loc loc) thing_inside where loc = getSrcLoc famInst +\end{code} + +\begin{code} + +tcGetFamInstEnvs :: TcM (FamInstEnv, FamInstEnv) +-- Gets both the external-package inst-env +-- and the home-pkg inst env (includes module being compiled) +tcGetFamInstEnvs + = do { eps <- getEps; env <- getGblEnv + ; return (eps_fam_inst_env eps, tcg_fam_inst_env env) + } + + \end{code}