#include "HsVersions.h"
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 302
import PrelIOBase ( fixIO ) -- Should be in GlaExts
+#else
+import IOBase ( fixIO )
+#endif
import IOExts ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
import HsSyn
decode, mkLocalName
)
import Module ( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
- mkModuleHiMaps, moduleName
+ mkModuleHiMaps, moduleName, mkVanillaModule, mkSearchPath
)
import NameSet
import RdrName ( RdrName, dummyRdrVarName, rdrNameOcc )
-import CmdLineOpts ( opt_D_dump_rn_trace, opt_IgnoreIfacePragmas )
+import CmdLineOpts ( opt_D_dump_rn_trace, opt_HiMap )
import PrelInfo ( builtinNames )
import TysWiredIn ( boolTyCon )
import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
%* *
%************************************************************************
-===================================================
- MONAD TYPES
-===================================================
+%===================================================
+\subsubsection{ MONAD TYPES}
+%===================================================
\begin{code}
type RnM d r = RnDown -> d -> IO r
data RnDown = RnDown {
rn_mod :: ModuleName,
rn_loc :: SrcLoc,
- rn_omit :: Name -> Bool, -- True <=> omit qualifier when printing
rn_ns :: IORef RnNameSupply,
rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg),
rn_ifaces :: IORef Ifaces,
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; the fixity component gets extended
+ -- with local fixity decls
rn_lenv :: LocalRdrEnv, -- Local name envt
- -- Does *not* includes global name envt; may shadow it
- -- Includes both ordinary variables and type variables;
- -- they are kept distinct because tyvar have a different
- -- occurrence contructor (Name.TvOcc)
- -- We still need the unsullied global name env so that
- -- we can look up record field names
+ -- Does *not* include global name envt; may shadow it
+ -- Includes both ordinary variables and type variables;
+ -- they are kept distinct because tyvar have a different
+ -- occurrence contructor (Name.TvOcc)
+ -- We still need the unsullied global name env so that
+ -- we can look up record field names
rn_fixenv :: FixityEnv -- Local fixities
-- The global ones are held in the
| InterfaceMode -- Renaming interface declarations.
\end{code}
-===================================================
- ENVIRONMENTS
-===================================================
+%===================================================
+\subsubsection{ ENVIRONMENTS}
+%===================================================
\begin{code}
--------------------------------
type RnNameSupply
= ( UniqSupply
- , FiniteMap (OccName, OccName) Int
+ , FiniteMap String Int
-- This is used as a name supply for dictionary functions
- -- From the inst decl we derive a (class, tycon) pair;
+ -- From the inst decl we derive a string, usually by glomming together
+ -- the class and tycon name -- but it doesn't matter exactly how;
-- this map then gives a unique int for each inst decl with that
- -- (class, tycon) pair. (In Haskell 98 there can only be one,
- -- but not so in more extended versions.)
+ -- string. (In Haskell 98 there can only be one,
+ -- but not so in more extended versions; also class CC type T
+ -- and class C type TT might both give the string CCT
--
-- We could just use one Int for all the instance decls, but this
-- way the uniques change less when you add an instance decl,
type Avails = [AvailInfo]
type Fixities = [(Name, Fixity)]
-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)
+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)
+
+ NameEnv AvailInfo) -- Used to figure out all other export specifiers.
+ -- Maps a Name to the AvailInfo that contains it
- NameEnv AvailInfo) -- Used to figure out all other export specifiers.
- -- Maps a Name to the AvailInfo that contains it
+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, ==, /=]
-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, ==, /=]
type AvailInfo = GenAvailInfo Name
type RdrAvailInfo = GenAvailInfo OccName
\end{code}
-===================================================
- INTERFACE FILE STUFF
-===================================================
+%===================================================
+\subsubsection{ INTERFACE FILE STUFF}
+%===================================================
\begin{code}
type ExportItem = (ModuleName, [RdrAvailInfo])
-- the function in the head of the rule.
data WhatsImported name = Everything
- | Specifically [LocalVersion name] -- List guaranteed non-empty
+ | Specifically [LocalVersion name] -- List guaranteed non-empty
-- ("M", hif, ver, Everything) means there was a "module M" in
-- this module's export list, so we just have to go by M's version, "ver",
}
type InterfaceDetails = (WhetherHasOrphans,
- VersionInfo Name, -- Version information for what this module imports
- ExportEnv) -- What modules this one depends on
+ VersionInfo Name, -- Version information for what this module imports
+ ExportEnv) -- What modules this one depends on
-- needed by Main to fish out the fixities assoc list.
data Ifaces = Ifaces {
iImpModInfo :: ImportedModuleInfo,
-- Modules this one depends on: that is, the union
- -- of the modules its direct imports depend on.
+ -- 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
iFixes :: FixityEnv, -- A single, global map of Names to fixities
- 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.
+ 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.
+ 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 :: Bag GatedDecl,
- -- 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.
+ -- 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 :: Bag GatedDecl
- -- Ditto transformation rules
+ -- Ditto transformation rules
}
type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
errs_var <- newIORef (emptyBag,emptyBag)
iface_var <- newIORef emptyIfaces
let
- rn_down = RnDown { rn_loc = loc, rn_omit = \n -> False, rn_ns = names_var,
+ rn_down = RnDown { rn_loc = loc, rn_ns = names_var,
rn_errs = errs_var,
rn_hi_maps = himaps,
rn_ifaces = iface_var,
builtinNames)
\end{code}
-@renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
-the main renamer. Sole examples: derived definitions, which are only generated
-in the type checker.
+@renameSourceCode@ is used to rename stuff ``out-of-line'';
+that is, not as part of the main renamer.
+Sole examples: derived definitions,
+which are only generated in the type checker.
The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
once you must either split it, or install a fresh unique supply.
-- 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_errs = errs_var, rn_hi_maps = himaps,
rn_mod = mod_name }
- s_down = SDown { rn_mode = InterfaceMode, -- So that we can refer to PrelBase.True etc
+ s_down = SDown { rn_mode = InterfaceMode,
+ -- So that we can refer to PrelBase.True etc
rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
rn_fixenv = emptyNameEnv }
in
%************************************************************************
-================ Errors and warnings =====================
+%================
+\subsubsection{ Errors and warnings}
+%=====================
\begin{code}
failWithRn :: a -> Message -> RnM d a
\end{code}
-================ Source location =====================
+%================
+\subsubsection{ Source location}
+%=====================
\begin{code}
pushSrcLocRn :: SrcLoc -> RnM d a -> RnM d a
= return (rn_loc down)
\end{code}
-================ Name supply =====================
+%================
+\subsubsection{ Name supply}
+%=====================
\begin{code}
getNameSupplyRn :: RnM d RnNameSupply
= writeIORef names_var names'
-- See comments with RnNameSupply above.
-newInstUniq :: (OccName, OccName) -> RnM d Int
+newInstUniq :: String -> RnM d Int
newInstUniq key (RnDown {rn_ns = names_var}) l_down
= readIORef names_var >>= \ (us, mapInst, cache) ->
let
return (uniqFromSupply us1)
\end{code}
-================ Module =====================
+%================
+\subsubsection{ Module}
+%=====================
\begin{code}
getModuleRn :: RnM d ModuleName
= enclosed_thing (rn_down {rn_mod = new_mod}) l_down
\end{code}
-\begin{code}
-setOmitQualFn :: (Name -> Bool) -> RnM d a -> RnM d a
-setOmitQualFn fn m g_down l_down = m (g_down { rn_omit = fn }) l_down
-
-getOmitQualFn :: RnM d (Name -> Bool)
-getOmitQualFn (RnDown {rn_omit = omit_fn}) l_down
- = return omit_fn
-\end{code}
%************************************************************************
%* *
%* *
%************************************************************************
-================ RnEnv =====================
+%================
+\subsubsection{ RnEnv}
+%=====================
\begin{code}
getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
\end{code}
-================ Mode =====================
+%================
+\subsubsection{ Mode}
+%=====================
\begin{code}
getModeRn :: RnMS RnMode
getHiMaps (RnDown {rn_hi_maps = himaps}) _
= return himaps
\end{code}
+
+\begin{code}
+lookupModuleRn :: ModuleName -> RnM d Module
+lookupModuleRn x =
+ getHiMaps `thenRn` \ (himap, _) ->
+ case lookupFM himap x of
+ Nothing -> returnRn (mkVanillaModule x)
+ Just (_,x) -> returnRn x
+
+\end{code}
projects / ghc-hetmet.git / blobdiff