X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=f88ef3584571c63ee60b535d8ba90d02099af97f;hb=762c24327f4a2f874fb8a4b2d6717d36aa6c5e02;hp=f424089594d30dc7f66f9386f58c3d098102283f;hpb=5c61fd637c1f3f47cddb523b33be95baa29716eb;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index f424089..f88ef35 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -129,7 +129,7 @@ import Id import Type import Annotations -import Class ( Class, classSelIds, classATs, classTyCon ) +import Class ( Class, classAllSelIds, classATs, classTyCon ) import TyCon import DataCon ( DataCon, dataConImplicitIds, dataConWrapId ) import PrelNames ( gHC_PRIM ) @@ -140,13 +140,12 @@ import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( IPName, defaultFixity, WarningTxt(..) ) import OptimizationFuel ( OptFuelState ) import IfaceSyn -import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) import Maybes ( orElse, expectJust, catMaybes ) import Outputable import BreakArray import SrcLoc ( SrcSpan, Located(..) ) -import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM ) +import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) import UniqSupply ( UniqSupply ) import FastString import StringBuffer ( StringBuffer ) @@ -162,6 +161,7 @@ import System.Time ( ClockTime ) import Data.IORef import Data.Array ( Array, array ) import Data.List +import Data.Map (Map) import Control.Monad ( mplus, guard, liftM, when ) import Exception \end{code} @@ -325,6 +325,12 @@ instance ExceptionMonad Ghc where Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s gblock (Ghc m) = Ghc $ \s -> gblock (m s) gunblock (Ghc m) = Ghc $ \s -> gunblock (m s) + gmask f = + Ghc $ \s -> gmask $ \io_restore -> + let + g_restore (Ghc m) = Ghc $ \s -> io_restore (m s) + in + unGhc (f g_restore) s instance WarnLogMonad Ghc where setWarnings warns = Ghc $ \(Session _ wref) -> writeIORef wref warns @@ -357,6 +363,12 @@ instance ExceptionMonad m => ExceptionMonad (GhcT m) where GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s gblock (GhcT m) = GhcT $ \s -> gblock (m s) gunblock (GhcT m) = GhcT $ \s -> gunblock (m s) + gmask f = + GhcT $ \s -> gmask $ \io_restore -> + let + g_restore (GhcT m) = GhcT $ \s -> io_restore (m s) + in + unGhcT (f g_restore) s instance MonadIO m => WarnLogMonad (GhcT m) where setWarnings warns = GhcT $ \(Session _ wref) -> liftIO $ writeIORef wref warns @@ -555,21 +567,10 @@ data HscEnv -- by limiting the number of transformations, -- we can use binary search to help find compiler bugs. - hsc_type_env_var :: Maybe (Module, IORef TypeEnv), + hsc_type_env_var :: Maybe (Module, IORef TypeEnv) -- ^ Used for one-shot compilation only, to initialise -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for -- 'TcRunTypes.TcGblEnv' - - hsc_global_rdr_env :: GlobalRdrEnv, - -- ^ A mapping from 'RdrName's that are in global scope during - -- the compilation of the current file to more detailed - -- information about those names. Not necessarily just the - -- names directly imported by the module being compiled! - - hsc_global_type_env :: TypeEnv - -- ^ Typing information about all those things in global scope. - -- Not necessarily just the things directly imported by the module - -- being compiled! } hscEPS :: HscEnv -> IO ExternalPackageState @@ -1125,7 +1126,7 @@ data InteractiveContext ic_toplev_scope :: [Module], -- ^ The context includes the "top-level" scope of -- these modules - ic_exports :: [Module], -- ^ The context includes just the exports of these + ic_exports :: [(Module, Maybe (ImportDecl RdrName))], -- ^ The context includes just the exported parts of these -- modules ic_rn_gbl_env :: GlobalRdrEnv, -- ^ The contexts' cached 'GlobalRdrEnv', built from @@ -1321,7 +1322,7 @@ implicitTyThings (AClass cl) -- are only the family decls; they have no implicit things map ATyCon (classATs cl) ++ -- superclass and operation selectors - map AnId (classSelIds cl) + map AnId (classAllSelIds cl) implicitTyThings (ADataCon dc) = -- For data cons add the worker and (possibly) wrapper @@ -1839,7 +1840,7 @@ data NameCache type OrigNameCache = ModuleEnv (OccEnv Name) -- | Module-local cache of implicit parameter 'OccName's given 'Name's -type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name) +type OrigIParamCache = Map (IPName OccName) (IPName Name) \end{code}