import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
pprBagOfErrors, ErrMsg, WarnMsg, Message
)
-import RdrName ( RdrName, dummyRdrVarName, rdrNameOcc,
+import RdrName ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
RdrNameEnv, emptyRdrEnv, extendRdrEnv,
lookupRdrEnv, addListToRdrEnv, rdrEnvToList, rdrEnvElts
)
import Name ( Name, OccName, NamedThing(..), getSrcLoc,
isLocallyDefinedName, nameModule, nameOccName,
- decode, mkLocalName, mkUnboundName,
+ decode, mkLocalName, mkUnboundName, mkKnownKeyGlobal,
NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList
)
-import Module ( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
- mkModuleHiMaps, moduleName, mkSearchPath
- )
+import Module ( Module, ModuleName, WhereFrom, moduleName )
import NameSet
-import CmdLineOpts ( opt_D_dump_rn_trace, opt_HiMap )
-import PrelInfo ( builtinNames )
+import CmdLineOpts ( DynFlags, dopt_D_dump_rn_trace )
+import PrelInfo ( wiredInNames, knownKeyRdrNames )
import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
import Unique ( Unique )
-import FiniteMap ( FiniteMap, emptyFM, bagToFM )
+import FiniteMap ( FiniteMap, emptyFM, listToFM, plusFM )
import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
import UniqSupply
import Outputable
+import CmFind ( Finder )
infixr 9 `thenRn`, `thenRn_`
\end{code}
(\ err -> return (Left err))
traceRn :: SDoc -> RnM d ()
-traceRn msg | opt_D_dump_rn_trace = putDocRn msg
- | otherwise = returnRn ()
+traceRn msg
+ = doptsRn dopt_D_dump_rn_trace `thenRn` \b ->
+ if b then putDocRn msg else returnRn ()
putDocRn :: SDoc -> RnM d ()
putDocRn msg = ioToRnM (printErrs msg) `thenRn_`
type RnMG r = RnM () r -- Getting global names etc
-- Common part
-data RnDown = RnDown {
- rn_mod :: Module,
- rn_loc :: SrcLoc,
- rn_ns :: IORef RnNameSupply,
- rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg),
- rn_ifaces :: IORef Ifaces,
- rn_hi_maps :: (SearchPath, -- For error messages
- ModuleHiMap, -- for .hi files
- ModuleHiMap) -- for .hi-boot files
- }
+data RnDown
+ = RnDown {
+ 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_errs :: IORef (Bag WarnMsg, Bag ErrMsg),
+ rn_ns :: IORef NameSupply,
+ rn_ifaces :: IORef Ifaces
+ }
-- For renaming source code
data SDown = SDown {
rn_mode :: RnMode,
- rn_genv :: GlobalRdrEnv,
- -- Global envt; the fixity component gets extended
- -- with local fixity decls
+ rn_genv :: GlobalRdrEnv, -- Global envt
rn_lenv :: LocalRdrEnv, -- Local name envt
-- Does *not* include global name envt; may shadow it
= case lookupNameEnv env name of
Just (FixitySig _ fix _) -> fix
Nothing -> defaultFixity
-
---------------------------------
-type DeprecationEnv = NameEnv DeprecTxt
\end{code}
\begin{code}
---------------------------------
-type RnNameSupply
- = ( UniqSupply
-
- , FiniteMap (ModuleName, OccName) Name
- -- Ensures that one (module,occname) pair gets one unique
- , FiniteMap OccName Name
- -- Ensures that one implicit parameter name gets one unique
- )
-
-
---------------------------------
-type Avails = [AvailInfo]
-
type ExportAvails = (FiniteMap ModuleName Avails,
-- Used to figure out "module M" export specifiers
-- Includes avails only from *unqualified* imports
-- (see 1.4 Report Section 5.1.1)
AvailEnv) -- Used to figure out all other export specifiers.
-
-
-data GenAvailInfo name = Avail name -- An ordinary identifier
- | AvailTC name -- The name of the type or class
- [name] -- The available pieces of type/class.
- -- NB: If the type or class is itself
- -- to be in scope, it must be in this list.
- -- Thus, typically: AvailTC Eq [Eq, ==, /=]
- deriving( Eq )
- -- Equality used when deciding if the interface has changed
-
-type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it
-type AvailInfo = GenAvailInfo Name
-type RdrAvailInfo = GenAvailInfo OccName
\end{code}
%===================================================
[(name,Version)] -- List guaranteed non-empty
deriving( Eq )
-- 'Specifically' doesn't let you say "I imported f but none of the fixities in
- -- the module. If you use anything in the module you get its fixity and rule version
+ -- the module". If you use anything in the module you get its fixity and rule version
-- So if the fixities or rules change, you'll recompile, even if you don't use either.
-- This is easy to implement, and it's safer: you might not have used the rules last
-- time round, but if someone has added a new rule you might need it this time
type RdrNamePragma = () -- Fudge for now
-------------------
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{The renamer state}
+%* *
+%************************************************************************
+
+\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.
-- dependencies (direct or not) of the imported module.
iDecls :: DeclsMap, -- A single, global map of Names to decls
-
- iDeferred :: NameSet, -- data (not newtype) TyCons that have been slurped,
- -- but none of their constructors have.
- -- If this is still the case right at the end
-- we can get away with importing them abstractly
- iFixes :: FixityEnv,
- -- A single, global map of Names to fixities
- -- See comments with RnIfaces.lookupFixity
-
- 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)],
- -- 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.
-
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.
iRules :: IfaceRules,
-- Similar to instance decls, only for rules
- iDeprecs :: DeprecationEnv
- }
+ -- 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,
-type IfaceInsts = Bag GatedDecl
-type IfaceRules = Bag GatedDecl
+ -- EPHEMERAL FIELDS
+ -- These fields persist during the compilation of a single module only
-type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
+ 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)]
+ -- 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,
-- 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
-
-type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
- -- A DeclsMap contains a binding for each Name in the declaration
- -- including the constructors of a type decl etc.
- -- The Bool is True just for the 'main' Name.
\end{code}
%************************************************************************
\begin{code}
-initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
- -> RnMG r
- -> IO (r, Bag ErrMsg, Bag WarnMsg)
+initRn :: DynFlags -> Finder -> GlobalSymbolTable
+ -> PersistentRenamerState
+ -> Module -> SrcLoc
-initRn mod us dirs loc do_rn = do
+initRn dflags finder gst prs mod loc do_rn = do
himaps <- mkModuleHiMaps dirs
- names_var <- newIORef (us, builtins, emptyFM)
+ names_var <- newIORef (prsNS pcs)
errs_var <- newIORef (emptyBag,emptyBag)
- iface_var <- newIORef emptyIfaces
+ iface_var <- newIORef (initIfaces prs)
let
- rn_down = RnDown { rn_loc = loc, rn_ns = names_var,
- rn_errs = errs_var,
- rn_hi_maps = himaps,
+ 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,
- rn_mod = mod }
+ }
-- do the business
res <- do_rn rn_down ()
return (res, errs, warns)
+initIfaces :: PersistentRenamerState -> Ifaces
+initIfaces prs
+ = Ifaces { iDecls = prsDecls prs,
+ iInsts = prsInsts prs,
+ iRules = prsRules rules,
+
+ 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,
+ -- and we don't want thereby to try to suck it in!
+ iVSlurp = []
+ }
+
+
initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
initRnMS rn_env fixity_env mode thing_inside rn_down g_down
= let
= initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
setModuleRn mod thing_inside
-emptyIfaces :: Ifaces
-emptyIfaces = Ifaces { iImpModInfo = emptyFM,
- iDecls = emptyNameEnv,
- iDeferred = emptyNameSet,
- iFixes = emptyNameEnv,
- 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,
- -- and we don't want thereby to try to suck it in!
- iVSlurp = [],
- iInsts = emptyBag,
- iRules = emptyBag,
- iDeprecs = emptyNameEnv
- }
-
builtins :: FiniteMap (ModuleName,OccName) Name
-builtins =
- bagToFM (
- mapBag (\ name -> ((moduleName (nameModule name), nameOccName name), name))
- builtinNames)
+builtins = listToFM wired_in `plusFM` listToFM known_key
+ where
+ wired_in = [ ((moduleName (nameModule name), nameOccName name), name)
+ | name <- wiredInNames ]
+
+ known_key = [ ((rdrNameModule rdr_name, rdrNameOcc rdr_name), mkKnownKeyGlobal rdr_name uniq)
+ | (rdr_name, uniq) <- knownKeyRdrNames ]
\end{code}
@renameSourceCode@ is used to rename stuff ``out-of-line'';
Sole examples: derived definitions,
which are only generated in the type checker.
-The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
+The @NameSupply@ includes a @UniqueSupply@, so if you call it more than
once you must either split it, or install a fresh unique supply.
\begin{code}
-renameSourceCode :: Module
+renameSourceCode :: DynFlags
+ -> Module
-> RnNameSupply
-> RnMS r
-> r
-renameSourceCode mod name_supply m
+renameSourceCode dflags mod name_supply m
= unsafePerformIO (
-- It's not really unsafe! When renaming source code we
-- only do any I/O if we need to read in a fixity declaration;
-- and that doesn't happen in pragmas etc
- mkModuleHiMaps (mkSearchPath opt_HiMap) >>= \ himaps ->
newIORef name_supply >>= \ names_var ->
newIORef (emptyBag,emptyBag) >>= \ errs_var ->
let
- rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
- rn_errs = errs_var, rn_hi_maps = himaps,
+ rn_down = RnDown { rn_dflags = dflags,
+ rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
+ rn_errs = errs_var,
rn_mod = mod,
rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required
}
checkErrsRn (RnDown {rn_errs = errs_var}) l_down
= 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)
\end{code}
%=====================
\begin{code}
-getNameSupplyRn :: RnM d RnNameSupply
+getNameSupplyRn :: RnM d NameSupply
getNameSupplyRn rn_down l_down
= readIORef (rn_ns rn_down)
-setNameSupplyRn :: RnNameSupply -> RnM d ()
+setNameSupplyRn :: NameSupply -> RnM d ()
setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
= writeIORef names_var names'
setIfacesRn :: Ifaces -> RnM d ()
setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
= writeIORef iface_var ifaces
-
-getHiMaps :: RnM d (SearchPath, ModuleHiMap, ModuleHiMap)
-getHiMaps (RnDown {rn_hi_maps = himaps}) _
- = return himaps
-\end{code}
\end{code}
projects / ghc-hetmet.git / blobdiff