X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnMonad.lhs;h=6a6acbb343936011dc008ece537d583aa3132a4d;hb=4297c94eed6d8610549b6d4375e88ed942dc3234;hp=ff541af5cdc3e06e4de71563494c15a8458f8ef6;hpb=376b25a5f43f5358cd4112cdced77c4b931d2b0f;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index ff541af..6a6acbb 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -38,11 +38,11 @@ import RdrHsSyn import RnHsSyn ( RenamedFixitySig ) import HscTypes ( AvailEnv, lookupType, NameSupply(..), - WhetherHasOrphans, ImportVersion, - PersistentRenamerState(..), IsBootInterface, Avails, + ImportedModuleInfo, WhetherHasOrphans, ImportVersion, + PersistentRenamerState(..), Avails, DeclsMap, IfaceInsts, IfaceRules, HomeSymbolTable, TyThing, - PersistentCompilerState(..), GlobalRdrEnv, + PersistentCompilerState(..), GlobalRdrEnv, LocalRdrEnv, HomeIfaceTable, PackageIfaceTable, RdrAvailInfo ) import BasicTypes ( Version, defaultFixity ) @@ -58,13 +58,13 @@ import Name ( Name, OccName, NamedThing(..), nameOccName, decode, mkLocalName, mkKnownKeyGlobal ) -import Name ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList ) +import NameEnv ( NameEnv, lookupNameEnv, emptyNameEnv, extendNameEnvList ) import Module ( Module, ModuleName, ModuleSet, emptyModuleSet ) import NameSet import CmdLineOpts ( DynFlags, DynFlag(..), dopt ) import SrcLoc ( SrcLoc, generatedSrcLoc, noSrcLoc ) import Unique ( Unique ) -import FiniteMap ( FiniteMap, emptyFM ) +import FiniteMap ( FiniteMap ) import Bag ( Bag, emptyBag, isEmptyBag, snocBag ) import UniqSupply import Outputable @@ -93,14 +93,10 @@ ioToRnM_no_fail io rn_down g_down (\ err -> panic "ioToRnM_no_fail: the I/O operation failed!") traceRn :: SDoc -> RnM d () -traceRn msg - = doptRn Opt_D_dump_rn_trace `thenRn` \b -> - if b then putDocRn msg else returnRn () +traceRn msg = ifOptRn Opt_D_dump_rn_trace (putDocRn msg) traceHiDiffsRn :: SDoc -> RnM d () -traceHiDiffsRn msg - = doptRn Opt_D_dump_hi_diffs `thenRn` \b -> - if b then putDocRn msg else returnRn () +traceHiDiffsRn msg = ifOptRn Opt_D_dump_hi_diffs (putDocRn msg) putDocRn :: SDoc -> RnM d () putDocRn msg = ioToRnM (printErrs alwaysQualify msg) `thenRn_` @@ -166,8 +162,12 @@ data SDown = SDown { -- with RnIfaces.lookupLocalFixity } -data RnMode = SourceMode -- Renaming source code - | InterfaceMode -- Renaming interface declarations. +data RnMode = SourceMode -- Renaming source code + | InterfaceMode -- Renaming interface declarations. + | CmdLineMode -- Renaming a command-line expression + +isInterfaceMode InterfaceMode = True +isInterfaceMode _ = False \end{code} %=================================================== @@ -176,7 +176,6 @@ data RnMode = SourceMode -- Renaming source code \begin{code} -------------------------------- -type LocalRdrEnv = RdrNameEnv Name type LocalFixityEnv = NameEnv RenamedFixitySig -- We keep the whole fixity sig so that we -- can report line-number info when there is a duplicate @@ -251,6 +250,11 @@ data Ifaces = Ifaces { -- package symbol table, and the renamer incrementally adds -- to it. + iImpModInfo :: ImportedModuleInfo, + -- Modules that we know something about, because they are mentioned + -- in interface files, BUT which we have not loaded yet. + -- No module is both in here and in the PIT + iDecls :: DeclsMap, -- A single, global map of Names to unslurped decls @@ -265,14 +269,15 @@ data Ifaces = Ifaces { -- EPHEMERAL FIELDS -- These fields persist during the compilation of a single module only - iImpModInfo :: ImportedModuleInfo, - -- Modules that we know something about, because they are mentioned - -- in interface files, BUT which we have not loaded yet. - -- No module is both in here and in the PIT - iSlurp :: NameSet, -- All the names (whether "big" or "small", whether wired-in or not, -- whether locally defined or not) that have been slurped in so far. + -- + -- It's used for two things: + -- a) To record what we've already slurped, so + -- we can no-op if we try to slurp it again + -- b) As the 'gates' for importing rules. We import a rule + -- if all its LHS free vars have been slurped iVSlurp :: (ModuleSet, NameSet) -- The Names are all the (a) non-wired-in @@ -282,16 +287,13 @@ data Ifaces = Ifaces { -- names that have been slurped in so far, with their versions. -- This is used to generate the "usage" information for this module. -- Subset of the previous field. + -- -- The module set is the non-home-package modules from which we have -- slurped at least one name. -- It's worth keeping separately, because there's no very easy -- way to distinguish the "big" names from the "non-big" ones. -- But this is a decision we might want to revisit. } - -type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface) - -- Contains info ONLY about modules that - -- have not yet been loaded into the iPIT \end{code} @@ -324,7 +326,7 @@ initRn dflags hit hst pcs mod do_rn iInsts = prsInsts prs, iRules = prsRules prs, - iImpModInfo = emptyFM, + iImpModInfo = prsImpMods prs, iSlurp = unitNameSet (mkUnboundName dummyRdrVarName), -- Pretend that the dummy unbound name has already been -- slurped. This is what's returned for an out-of-scope name, @@ -353,30 +355,31 @@ initRn dflags hit hst pcs mod do_rn (warns, errs) <- readIORef errs_var new_ifaces <- readIORef iface_var new_orig <- readIORef names_var - let new_prs = prs { prsOrig = new_orig, - prsDecls = iDecls new_ifaces, - prsInsts = iInsts new_ifaces, - prsRules = iRules new_ifaces } + let new_prs = prs { prsOrig = new_orig, + prsImpMods = iImpModInfo new_ifaces, + prsDecls = iDecls new_ifaces, + prsInsts = iInsts new_ifaces, + prsRules = iRules new_ifaces } let new_pcs = pcs { pcs_PIT = iPIT new_ifaces, pcs_PRS = new_prs } return (new_pcs, (warns, errs), res) -initRnMS :: GlobalRdrEnv -> LocalFixityEnv -> RnMode +initRnMS :: GlobalRdrEnv -> LocalRdrEnv -> LocalFixityEnv -> RnMode -> RnMS a -> RnM d a -initRnMS rn_env fixity_env mode thing_inside rn_down g_down +initRnMS rn_env local_env fixity_env mode thing_inside rn_down g_down -- The fixity_env appears in both the rn_fixenv field -- and in the HIT. See comments with RnHiFiles.lookupFixityRn = let - s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, + s_down = SDown { rn_genv = rn_env, rn_lenv = local_env, rn_fixenv = fixity_env, rn_mode = mode } in thing_inside rn_down s_down initIfaceRnMS :: Module -> RnMS r -> RnM d r initIfaceRnMS mod thing_inside - = initRnMS emptyRdrEnv emptyLocalFixityEnv InterfaceMode $ + = initRnMS emptyRdrEnv emptyRdrEnv emptyLocalFixityEnv InterfaceMode $ setModuleRn mod thing_inside \end{code} @@ -568,6 +571,11 @@ doptRn :: DynFlag -> RnM d Bool doptRn dflag (RnDown { rn_dflags = dflags}) l_down = return (dopt dflag dflags) +ifOptRn :: DynFlag -> RnM d a -> RnM d () +ifOptRn dflag thing_inside down@(RnDown { rn_dflags = dflags}) l_down + | dopt dflag dflags = thing_inside down l_down >> return () + | otherwise = return () + getDOptsRn :: RnM d DynFlags getDOptsRn (RnDown { rn_dflags = dflags}) l_down = return dflags