import HsSyn
import RdrHsSyn
import RnHsSyn ( RenamedFixitySig )
+import HscTypes ( Finder,
+ AvailEnv, lookupTypeEnv,
+ OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
+ WhetherHasOrphans, ImportVersion,
+ PersistentRenamerState(..), IsBootInterface, Avails,
+ DeclsMap, IfaceInsts, IfaceRules,
+ HomeSymbolTable, PackageSymbolTable,
+ PersistentCompilerState(..), GlobalRdrEnv,
+ HomeIfaceTable, PackageIfaceTable,
+ RdrAvailInfo, ModIface )
import BasicTypes ( Version, defaultFixity )
import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
pprBagOfErrors, ErrMsg, WarnMsg, Message
NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv,
extendNameEnvList
)
-import Module ( Module, ModuleName, WhereFrom, moduleName )
+import Module ( Module, ModuleName, lookupModuleEnvByName )
import NameSet
-import CmdLineOpts ( DynFlags, dopt_D_dump_rn_trace )
-import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
+import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
+import SrcLoc ( SrcLoc, generatedSrcLoc )
import Unique ( Unique )
-import FiniteMap ( FiniteMap, emptyFM, listToFM, plusFM )
-import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
+import FiniteMap ( FiniteMap, emptyFM )
+import Bag ( Bag, emptyBag, isEmptyBag, snocBag )
import UniqSupply
import Outputable
-import CmFind ( Finder )
import PrelNames ( mkUnboundName )
-import HscTypes ( GlobalSymbolTable, OrigNameEnv, AvailEnv,
- WhetherHasOrphans, ImportVersion, ExportItem,
- PersistentRenamerState(..), IsBootInterface, Avails,
- DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv )
+import Maybes ( maybeToBool, seqMaybe, orElse )
infixr 9 `thenRn`, `thenRn_`
\end{code}
traceRn :: SDoc -> RnM d ()
traceRn msg
- = doptsRn dopt_D_dump_rn_trace `thenRn` \b ->
+ = doptRn Opt_D_dump_rn_trace `thenRn` \b ->
if b then putDocRn msg else returnRn ()
putDocRn :: SDoc -> RnM d ()
-- Common part
data RnDown
= RnDown {
- rn_mod :: Module, -- This module
- rn_loc :: SrcLoc, -- Current locn
+ rn_mod :: Module, -- This module
+ rn_loc :: SrcLoc, -- Current locn
rn_finder :: Finder,
rn_dflags :: DynFlags,
- rn_gst :: GlobalSymbolTable, -- Both home modules and packages,
- -- at the moment we started compiling
- -- this module
+
+ rn_hit :: HomeIfaceTable,
+ rn_done :: Name -> Bool, -- Tells what things (both in the
+ -- home package and other packages)
+ -- were already available (i.e. in
+ -- the relevant SymbolTable) before
+ -- compiling this module
rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg),
- rn_ns :: IORef (UniqSupply, OrigNameEnv),
+
+ -- The second and third components are a flattened-out OrigNameEnv
+ rn_ns :: IORef (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv),
rn_ifaces :: IORef Ifaces
}
-- We still need the unsullied global name env so that
-- we can look up record field names
- rn_fixenv :: FixityEnv -- Local fixities
+ rn_fixenv :: LocalFixityEnv -- Local fixities
-- The global fixities are held in the
-- rn_ifaces field. Why? See the comments
- -- with RnIfaces.lookupFixity
+ -- with RnIfaces.lookupLocalFixity
}
data RnMode = SourceMode -- Renaming source code
\begin{code}
--------------------------------
-type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes
- -- These only get reported on lookup,
- -- not on construction
-type LocalRdrEnv = RdrNameEnv Name
-
---------------------------------
-type FixityEnv = NameEnv RenamedFixitySig
+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
-- fixity declaration
-lookupFixity :: FixityEnv -> Name -> Fixity
-lookupFixity env name
+lookupLocalFixity :: LocalFixityEnv -> Name -> Fixity
+lookupLocalFixity env name
= case lookupNameEnv env name of
Just (FixitySig _ fix _) -> fix
Nothing -> defaultFixity
%===================================================
\begin{code}
+type ExportItem = (ModuleName, [RdrAvailInfo])
data ParsedIface
= ParsedIface {
pi_vers :: Version, -- Module version number
pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
pi_usages :: [ImportVersion OccName], -- Usages
- pi_exports :: [ExportItem], -- Exports
+ pi_exports :: (Version, [ExportItem]), -- Exports
pi_insts :: [RdrNameInstDecl], -- Local instance declarations
pi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions
- pi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, with their version
+ pi_fixity :: [RdrNameFixitySig], -- Local fixity declarations,
pi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version
pi_deprecs :: [RdrNameDeprecation] -- Deprecations
}
-
-
-type RdrNamePragma = () -- Fudge for now
--------------------
-
\end{code}
%************************************************************************
\begin{code}
data Ifaces = Ifaces {
-
- -- PERSISTENT FIELDS
- iImpModInfo :: ImportedModuleInfo,
- -- Modules this one depends on: that is, the union
- -- of the modules its *direct* imports depend on.
- -- NB: The direct imports have .hi files that enumerate *all* the
- -- dependencies (direct or not) of the imported module.
-
- iDecls :: DeclsMap, -- A single, global map of Names to decls
- -- we can get away with importing them abstractly
-
- iInsts :: IfaceInsts,
+ -- PERSISTENT FIELDS
+ iPIT :: PackageIfaceTable,
+ -- The ModuleIFaces for modules in other packages
+ -- whose interfaces we have opened
+ -- The declarations in these interface files are held in
+ -- iDecls, iInsts, iRules (below), not in the mi_decls fields
+ -- of the iPIT. What _is_ in the iPIT is:
+ -- * The Module
+ -- * Version info
+ -- * Its exports
+ -- * Fixities
+ -- * Deprecations
+ -- The iPIT field is initialised from the compiler's persistent
+ -- package symbol table, and the renamer incrementally adds
+ -- to it.
+
+ iDecls :: DeclsMap,
+ -- A single, global map of Names to unslurped decls
+
+ iInsts :: IfaceInsts,
-- The as-yet un-slurped instance decls; this bag is depleted when we
-- slurp an instance decl so that we don't slurp the same one twice.
-- Each is 'gated' by the names that must be available before
-- this instance decl is needed.
- iRules :: IfaceRules,
+ iRules :: IfaceRules,
-- Similar to instance decls, only for rules
- -- SEMI-EPHEMERAL FIELDS
- -- iFixes and iDeprecs are accumulated here while one module
- -- is compiled, but are transferred to the package symbol table
- -- at the end. We don't add them to the table as we encounter them
- -- because doing so would require us to have a mutable symbol table
- -- which is yukky.
-
- iFixes :: FixityEnv, -- A single, global map of Names to fixities
- -- See comments with RnIfaces.lookupFixity
- iDeprecs :: DeprecationEnv,
-
- -- EPHEMERAL FIELDS
- -- These fields persist during the compilation of a single module only
+ -- EPHEMERAL FIELDS
+ -- These fields persist during the compilation of a single module only
+ iImpModInfo :: ImportedModuleInfo,
+ -- Modules this one depends on: that is, the union
+ -- of the modules its *direct* imports depend on.
+ -- NB: The direct imports have .hi files that enumerate *all* the
+ -- dependencies (direct or not) of the imported module.
- iSlurp :: NameSet,
+ 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.
- iVSlurp :: [(Name,Version)]
+ iVSlurp :: [Name]
-- All the (a) non-wired-in (b) "big" (c) non-locally-defined
-- 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.
- }
-
-type ImportedModuleInfo
- = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface,
- Maybe (Module, Version, Version, Version, WhereFrom, Avails))
- -- The three Versions are module version, fixity version, rules version
-
- -- Suppose the domain element is module 'A'
- --
- -- The first Bool is True if A contains
- -- 'orphan' rules or instance decls
-
- -- The second Bool is true if the interface file actually
- -- read was an .hi-boot file
-
- -- Nothing => A's interface not yet read, but this module has
- -- imported a module, B, that itself depends on A
- --
- -- Just xx => A's interface has been read. The Module in
- -- the Just has the correct Dll flag
-
- -- This set is used to decide whether to look for
- -- A.hi or A.hi-boot when importing A.f.
- -- Basically, we look for A.hi if A is in the map, and A.hi-boot
- -- otherwise
+ -- 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, IsLoaded)
+type IsLoaded = Bool
\end{code}
%************************************************************************
\begin{code}
-initRn :: DynFlags -> Finder -> GlobalSymbolTable
- -> PersistentRenamerState
- -> Module -> SrcLoc
+initRn :: DynFlags
+ -> Finder
+ -> HomeIfaceTable
+ -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> Module
+ -> SrcLoc
-> RnMG t
- -> IO (t, (Bag WarnMsg, Bag ErrMsg))
-
-initRn dflags finder gst prs mod loc do_rn
- = do uniqs <- mkSplitUniqSupply 'r'
- names_var <- newIORef (uniqs, prsOrig prs)
- errs_var <- newIORef (emptyBag,emptyBag)
- iface_var <- newIORef (initIfaces prs)
- let rn_down = RnDown { rn_mod = mod,
- rn_loc = loc,
-
- rn_finder = finder,
- rn_dflags = dflags,
- rn_gst = gst,
-
- rn_ns = names_var,
- rn_errs = errs_var,
- rn_ifaces = iface_var,
- }
-
- -- do the business
- res <- do_rn rn_down ()
-
- -- grab errors and return
- (warns, errs) <- readIORef errs_var
-
- return (res, (warns, errs))
-
-
-initIfaces :: PersistentRenamerState -> Ifaces
-initIfaces prs
- = Ifaces { iDecls = prsDecls prs,
+ -> IO (t, (Bag WarnMsg, Bag ErrMsg), PersistentCompilerState)
+
+initRn dflags finder hit hst pcs mod loc do_rn
+ = do
+ let prs = pcs_PRS pcs
+ let pst = pcs_PST pcs
+
+ uniqs <- mkSplitUniqSupply 'r'
+ names_var <- newIORef (uniqs, origNames (prsOrig prs),
+ origIParam (prsOrig prs))
+ errs_var <- newIORef (emptyBag,emptyBag)
+ iface_var <- newIORef (initIfaces pcs)
+ let rn_down = RnDown { rn_mod = mod,
+ rn_loc = loc,
+
+ rn_finder = finder,
+ rn_dflags = dflags,
+ rn_hit = hit,
+ rn_done = is_done hst pst,
+
+ rn_ns = names_var,
+ rn_errs = errs_var,
+ rn_ifaces = iface_var,
+ }
+
+ -- do the business
+ res <- do_rn rn_down ()
+
+ -- Grab state and record it
+ (warns, errs) <- readIORef errs_var
+ new_ifaces <- readIORef iface_var
+ (_, new_origN, new_origIP) <- readIORef names_var
+ let new_orig = Orig { origNames = new_origN, origIParam = new_origIP }
+ let new_prs = prs { prsOrig = new_orig,
+ 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 (res, (warns, errs), new_pcs)
+
+is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool
+-- Returns True iff the name is in either symbol table
+is_done hst pst n = maybeToBool (lookupTypeEnv pst n `seqMaybe` lookupTypeEnv hst n)
+
+lookupIface :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> ModIface
+lookupIface hit pit mod = lookupModuleEnvByName hit mod `orElse`
+ lookupModuleEnvByName pit mod `orElse`
+ pprPanic "lookupIface" (ppr mod)
+
+initIfaces :: PersistentCompilerState -> Ifaces
+initIfaces (PCS { pcs_PIT = pit, pcs_PRS = prs })
+ = Ifaces { iPIT = pit,
+ iDecls = prsDecls prs,
iInsts = prsInsts prs,
iRules = prsRules prs,
- iFixes = emptyNameEnv,
- iDeprecs = emptyNameEnv,
-
iImpModInfo = emptyFM,
- --iDeferred = emptyNameSet,
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,
}
-initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
+initRnMS :: GlobalRdrEnv -> LocalFixityEnv -> RnMode -> RnMS r -> RnM d r
initRnMS rn_env fixity_env mode thing_inside rn_down g_down
= let
s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv,
-- only do any I/O if we need to read in a fixity declaration;
-- and that doesn't happen in pragmas etc
- mkSplitUniqSupply 'r' >>= \ new_us ->
- newIORef (new_us, prsOrig prs) >>= \ names_var ->
- newIORef (emptyBag,emptyBag) >>= \ errs_var ->
+ mkSplitUniqSupply 'r' >>= \ new_us ->
+ newIORef (new_us, origNames (prsOrig prs),
+ origIParam (prsOrig prs)) >>= \ names_var ->
+ newIORef (emptyBag,emptyBag) >>= \ errs_var ->
let
rn_down = RnDown { rn_dflags = dflags,
- rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
+ rn_loc = generatedSrcLoc, rn_ns = names_var,
rn_errs = errs_var,
rn_mod = mod,
- rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required
+ rn_done = bogus "rn_done", rn_hit = bogus "rn_hit",
+ rn_ifaces = bogus "rn_ifaces", rn_finder = bogus "rn_finder"
}
s_down = SDown { rn_mode = InterfaceMode,
-- So that we can refer to PrelBase.True etc
where
display errs = pprBagOfErrors errs
+bogus s = panic ("rnameSourceCode: " ++ s) -- Used for unused record fields
+
{-# INLINE thenRn #-}
{-# INLINE thenRn_ #-}
{-# INLINE returnRn #-}
= readIORef errs_var >>= \ (warns,errs) ->
return (isEmptyBag errs)
-doptsRn :: (DynFlags -> Bool) -> RnM d Bool
-doptsRn dopt (RnDown { rn_dflags = dflags}) l_down
- = return (dopt dflags)
+doptRn :: DynFlag -> RnM d Bool
+doptRn dflag (RnDown { rn_dflags = dflags}) l_down
+ = return (dopt dflag dflags)
+
+getDOptsRn :: RnM d DynFlags
+getDOptsRn (RnDown { rn_dflags = dflags}) l_down
+ = return dflags
\end{code}
%================
-\subsubsection{ Source location}
+\subsubsection{Source location}
%=====================
\begin{code}
\end{code}
%================
-\subsubsection{ Name supply}
+\subsubsection{The finder and home symbol table}
%=====================
\begin{code}
-getNameSupplyRn :: RnM d (UniqSupply, OrigNameEnv)
+getFinderRn :: RnM d Finder
+getFinderRn down l_down = return (rn_finder down)
+
+getHomeIfaceTableRn :: RnM d HomeIfaceTable
+getHomeIfaceTableRn down l_down = return (rn_hit down)
+
+checkAlreadyAvailable :: Name -> RnM d Bool
+checkAlreadyAvailable name down l_down = return (rn_done down name)
+\end{code}
+
+%================
+\subsubsection{Name supply}
+%=====================
+
+\begin{code}
+getNameSupplyRn :: RnM d (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv)
getNameSupplyRn rn_down l_down
= readIORef (rn_ns rn_down)
-setNameSupplyRn :: (UniqSupply, OrigNameEnv) -> RnM d ()
+setNameSupplyRn :: (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv) -> RnM d ()
setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
= writeIORef names_var names'
getUniqRn :: RnM d Unique
getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, {-cache,-} ipcache) ->
+ = readIORef names_var >>= \ (us, cache, ipcache) ->
let
(us1,us') = splitUniqSupply us
in
- writeIORef names_var (us', {-cache,-} ipcache) >>
+ writeIORef names_var (us', cache, ipcache) >>
return (uniqFromSupply us1)
\end{code}
%=====================
\begin{code}
-getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
-getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
- = return (global_env, local_env)
-
getLocalNameEnv :: RnMS LocalRdrEnv
getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
= return local_env
setLocalNameEnv local_env' m rn_down l_down
= m rn_down (l_down {rn_lenv = local_env'})
-getFixityEnv :: RnMS FixityEnv
+getFixityEnv :: RnMS LocalFixityEnv
getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
= return fixity_env
projects / ghc-hetmet.git / blobdiff