X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=156a04e0a6b8c8eaf17e95daef08d3b735f64404;hp=f23ff5831e83d45139e9cb56dd6bdf57d5a1f377;hb=75736ff2a36d165eed7c216b3fd510d525094b79;hpb=30ced40470d0bb2a14a8eb25dd77ca99edd88a5a diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index f23ff58..156a04e 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -117,8 +117,6 @@ import RdrName import Name import NameEnv import NameSet -import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, - extendOccEnv ) import Module import InstEnv ( InstEnv, Instance ) import FamInstEnv ( FamInstEnv, FamInst ) @@ -139,7 +137,7 @@ import Packages hiding ( Version(..) ) import DynFlags ( DynFlags(..), isOneShot, HscTarget (..), dopt, DynFlag(..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) -import BasicTypes ( IPName, Fixity, defaultFixity, WarningTxt(..) ) +import BasicTypes ( IPName, defaultFixity, WarningTxt(..) ) import OptimizationFuel ( OptFuelState ) import IfaceSyn import FiniteMap ( FiniteMap ) @@ -148,7 +146,7 @@ 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 ) @@ -327,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 @@ -359,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 @@ -980,9 +990,7 @@ data ModGuts mg_insts :: ![Instance], -- ^ Class instances declared in this module mg_fam_insts :: ![FamInst], -- ^ Family instances declared in this module mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains - -- rules declared in this module. After the core - -- pipeline starts, it is changed to contain all - -- known rules for those things imported + -- See Note [Overall plumbing for rules] in Rules.lhs mg_binds :: ![CoreBind], -- ^ Bindings for this module mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module mg_warns :: !Warnings, -- ^ Warnings declared in the module @@ -1129,7 +1137,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 @@ -1988,7 +1996,6 @@ on just the OccName easily in a Core pass. \begin{code} -- | Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'. --- All of this information is always tidy, even in ModGuts. data VectInfo = VectInfo { vectInfoVar :: VarEnv (Var , Var ), -- ^ @(f, f_v)@ keyed on @f@