#include "HsVersions.h"
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 405
+import IOExts ( fixIO )
+#elif 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
import RdrHsSyn
-import RnHsSyn ( RenamedFixitySig )
+import RnHsSyn ( RenamedFixitySig, RenamedDeprecation )
import BasicTypes ( Version )
import SrcLoc ( noSrcLoc )
import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
)
import Name ( Name, OccName, NamedThing(..),
isLocallyDefinedName, nameModule, nameOccName,
- decode, mkLocalName
+ decode, mkLocalName, mkUnboundName
)
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,
- rn_hi_maps :: (ModuleHiMap, -- for .hi files
+ rn_hi_maps :: (SearchPath, -- For error messages
+ ModuleHiMap, -- for .hi files
ModuleHiMap) -- for .hi-boot files
}
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
- -- rn_ifaces field
+ -- The global fixities are held in the
+ -- rn_ifaces field. Why? See the comments
+ -- with RnIfaces.lookupFixity
}
data RnMode = SourceMode -- Renaming source code
| InterfaceMode -- Renaming interface declarations.
\end{code}
-===================================================
- ENVIRONMENTS
-===================================================
+%===================================================
+\subsubsection{ ENVIRONMENTS}
+%===================================================
\begin{code}
--------------------------------
addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
addToNameEnv :: NameEnv a -> Name -> a -> NameEnv a
plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
+plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
lookupNameEnv :: NameEnv a -> Name -> Maybe a
delFromNameEnv :: NameEnv a -> Name -> NameEnv a
elemNameEnv :: Name -> NameEnv a -> Bool
+unitNameEnv :: Name -> a -> NameEnv a
emptyNameEnv = emptyUFM
nameEnvElts = eltsUFM
addToNameEnv_C = addToUFM_C
addToNameEnv = addToUFM
plusNameEnv = plusUFM
+plusNameEnv_C = plusUFM_C
extendNameEnv = addListToUFM
lookupNameEnv = lookupUFM
delFromNameEnv = delFromUFM
elemNameEnv = elemUFM
+unitNameEnv = unitUFM
--------------------------------
type FixityEnv = NameEnv RenamedFixitySig
-- We keep the whole fixity sig so that we
-- can report line-number info when there is a duplicate
-- fixity declaration
+
+--------------------------------
+type DeprecationEnv = NameEnv DeprecTxt
\end{code}
\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,
, 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
)
--------------------------------
-data ExportEnv = ExportEnv Avails Fixities
+data ExportEnv = ExportEnv Avails Fixities [ModuleName]
+ -- The list of modules is the modules exported
+ -- with 'module M' in the export list
+
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
+ 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, ==, /=]
-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 AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it
type AvailInfo = GenAvailInfo Name
type RdrAvailInfo = GenAvailInfo OccName
\end{code}
-===================================================
- INTERFACE FILE STUFF
-===================================================
+%===================================================
+\subsubsection{ INTERFACE FILE STUFF}
+%===================================================
\begin{code}
type ExportItem = (ModuleName, [RdrAvailInfo])
type VersionInfo name = [ImportVersion name]
-type ImportVersion name = (ModuleName, Version, WhetherHasOrphans, WhatsImported name)
+type ImportVersion name = (ModuleName, Version,
+ WhetherHasOrphans, IsBootInterface, WhatsImported name)
type WhetherHasOrphans = Bool
-- An "orphan" is
-- * a transformation rule in a module other than the one defining
-- the function in the head of the rule.
+type IsBootInterface = Bool
+
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",
data ParsedIface
= ParsedIface {
- pi_mod :: Version, -- Module version number
+ pi_mod :: Module, -- Complete with package info
+ pi_vers :: Version, -- Module version number
pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
pi_usages :: [ImportVersion OccName], -- Usages
pi_exports :: [ExportItem], -- Exports
pi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions
pi_insts :: [RdrNameInstDecl], -- Local instance declarations
- pi_rules :: [RdrNameRuleDecl] -- Rules
+ pi_rules :: [RdrNameRuleDecl], -- Rules
+ pi_deprecs :: [RdrNameDeprecation] -- Deprecations
}
-type InterfaceDetails = (WhetherHasOrphans,
- VersionInfo Name, -- Version information for what this module imports
- ExportEnv) -- What modules this one depends on
+data InterfaceDetails
+ = InterfaceDetails WhetherHasOrphans
+ (VersionInfo Name) -- Version information for what this module imports
+ ExportEnv -- What modules this one depends on
+ [Deprecation Name]
-- needed by Main to fish out the fixities assoc list.
getIfaceFixities :: InterfaceDetails -> Fixities
-getIfaceFixities (_, _, ExportEnv _ fs) = fs
+getIfaceFixities (InterfaceDetails _ _ (ExportEnv _ fs _) _) = fs
type RdrNamePragma = () -- Fudge for now
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
+ -- 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.
+ 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
- iRules :: Bag GatedDecl
- -- Ditto transformation rules
+ iDeprecs :: DeprecationEnv
}
type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
type ImportedModuleInfo
- = FiniteMap ModuleName (Version, Bool, Maybe (Module, Bool, Avails))
+ = FiniteMap ModuleName (Version, WhetherHasOrphans, IsBootInterface,
+ Maybe (Module, WhereFrom, Avails))
-- Suppose the domain element is module 'A'
--
-- The first Bool is True if A contains
initRn mod us dirs loc do_rn = do
himaps <- mkModuleHiMaps dirs
- names_var <- newIORef (us, emptyFM, builtins)
+ names_var <- newIORef (us, emptyFM, builtins, emptyFM)
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,
-- and we don't want thereby to try to suck it in!
iVSlurp = [],
iInsts = emptyBag,
- iRules = emptyBag
+ iRules = emptyBag,
+ iDeprecs = emptyNameEnv
}
--- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
--- during compiler debugging.
-mkUnboundName :: RdrName -> Name
-mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
-
-isUnboundName :: Name -> Bool
-isUnboundName name = getUnique name == unboundKey
-
builtins :: FiniteMap (ModuleName,OccName) Name
builtins =
bagToFM (
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_mod = mod_name }
- s_down = SDown { rn_mode = InterfaceMode, -- So that we can refer to PrelBase.True etc
+ rn_errs = errs_var, rn_hi_maps = himaps,
+ rn_mod = mod_name,
+ rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required
+ }
+ 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
mapRn :: (a -> RnM d b) -> [a] -> RnM d [b]
mapRn_ :: (a -> RnM d b) -> [a] -> RnM d ()
mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
+flatMapRn :: (a -> RnM d [b]) -> [a] -> RnM d [b]
sequenceRn :: [RnM d a] -> RnM d [a]
foldlRn :: (b -> a -> RnM d b) -> b -> [a] -> RnM d b
mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
case maybe_r of
Nothing -> returnRn rs
Just r -> returnRn (r:rs)
+
+flatMapRn f [] = returnRn []
+flatMapRn f (x:xs) = f x `thenRn` \ r ->
+ flatMapRn f xs `thenRn` \ rs ->
+ returnRn (r ++ rs)
\end{code}
%************************************************************************
-================ 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) ->
+ = readIORef names_var >>= \ (us, mapInst, cache, ipcache) ->
let
uniq = case lookupFM mapInst key of
Just x -> x+1
Nothing -> 0
mapInst' = addToFM mapInst key uniq
in
- writeIORef names_var (us, mapInst', cache) >>
+ writeIORef names_var (us, mapInst', cache, ipcache) >>
return uniq
getUniqRn :: RnM d Unique
getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, mapInst, cache) ->
+ = readIORef names_var >>= \ (us, mapInst, cache, ipcache) ->
let
(us1,us') = splitUniqSupply us
in
- writeIORef names_var (us', mapInst, cache) >>
+ writeIORef names_var (us', mapInst, cache, ipcache) >>
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
setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
= writeIORef iface_var ifaces
-getHiMaps :: RnM d (ModuleHiMap, ModuleHiMap)
+getHiMaps :: RnM d (SearchPath, ModuleHiMap, ModuleHiMap)
getHiMaps (RnDown {rn_hi_maps = himaps}) _
= return himaps
\end{code}
+\end{code}