X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FFamInst.lhs;h=8855fdcbe94e4513c2e8cebe17367f484efc43a6;hb=14a496fd0b3aa821b69eb02736d5f41086576761;hp=b09f9a516da17b92c729e76708f9a9230f0286f1;hpb=c9959e41ee1d72aa0ca28d51580f1ad3c06f0e8b;p=ghc-hetmet.git diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index b09f9a5..8855fdc 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -2,13 +2,12 @@ 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 @@ -16,11 +15,12 @@ import Module import SrcLoc import Outputable import UniqFM -import FiniteMap 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}