\begin{code}
module RnMonad(
module RnMonad,
+
+ module RdrName, -- Re-exports
+ module Name, -- from these two
+
Module,
FiniteMap,
Bag,
- Name,
RdrNameHsDecl,
RdrNameInstDecl,
Version,
import HsSyn
import RdrHsSyn
import RnHsSyn ( RenamedFixitySig, RenamedDeprecation )
-import BasicTypes ( Version )
+import BasicTypes ( Version, defaultFixity )
import SrcLoc ( noSrcLoc )
import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
pprBagOfErrors, ErrMsg, WarnMsg, Message
)
-import Name ( Name, OccName, NamedThing(..),
+import RdrName ( RdrName, dummyRdrVarName, rdrNameOcc,
+ RdrNameEnv, emptyRdrEnv, extendRdrEnv,
+ lookupRdrEnv, addListToRdrEnv, rdrEnvToList, rdrEnvElts
+ )
+import Name ( Name, OccName, NamedThing(..), getSrcLoc,
isLocallyDefinedName, nameModule, nameOccName,
- decode, mkLocalName
+ decode, mkLocalName, mkUnboundName,
+ NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList
)
import Module ( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
- mkModuleHiMaps, moduleName, mkVanillaModule, mkSearchPath
+ mkModuleHiMaps, moduleName, mkSearchPath
)
import NameSet
-import RdrName ( RdrName, dummyRdrVarName, rdrNameOcc )
import CmdLineOpts ( opt_D_dump_rn_trace, opt_HiMap )
import PrelInfo ( builtinNames )
-import TysWiredIn ( boolTyCon )
import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
import Unique ( Unique, getUnique, unboundKey )
-import UniqFM ( UniqFM )
import FiniteMap ( FiniteMap, emptyFM, bagToFM, lookupFM, addToFM, addListToFM,
addListToFM_C, addToFM_C, eltsFM, fmToList
)
import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
-import Maybes ( mapMaybe )
-import UniqSet
-import UniqFM
import UniqSupply
-import Util
import Outputable
infixr 9 `thenRn`, `thenRn_`
-- Common part
data RnDown = RnDown {
- rn_mod :: ModuleName,
+ rn_mod :: Module,
rn_loc :: SrcLoc,
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
}
\begin{code}
--------------------------------
-type RdrNameEnv a = FiniteMap RdrName a
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
-emptyRdrEnv :: RdrNameEnv a
-lookupRdrEnv :: RdrNameEnv a -> RdrName -> Maybe a
-addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
-extendRdrEnv :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
-
-emptyRdrEnv = emptyFM
-lookupRdrEnv = lookupFM
-addListToRdrEnv = addListToFM
-rdrEnvElts = eltsFM
-extendRdrEnv = addToFM
-rdrEnvToList = fmToList
-
---------------------------------
-type NameEnv a = UniqFM a -- Domain is Name
-
-emptyNameEnv :: NameEnv a
-nameEnvElts :: NameEnv a -> [a]
-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
-extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
-lookupNameEnv :: NameEnv a -> Name -> Maybe a
-delFromNameEnv :: NameEnv a -> Name -> NameEnv a
-elemNameEnv :: Name -> NameEnv a -> Bool
-
-emptyNameEnv = emptyUFM
-nameEnvElts = eltsUFM
-addToNameEnv_C = addToUFM_C
-addToNameEnv = addToUFM
-plusNameEnv = plusUFM
-extendNameEnv = addListToUFM
-lookupNameEnv = lookupUFM
-delFromNameEnv = delFromUFM
-elemNameEnv = elemUFM
-
--------------------------------
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
+lookupFixity :: FixityEnv -> Name -> Fixity
+lookupFixity env name
+ = case lookupNameEnv env name of
+ Just (FixitySig _ fix _) -> fix
+ Nothing -> defaultFixity
+
--------------------------------
-type DeprecationEnv = NameEnv RenamedDeprecation
+type DeprecationEnv = NameEnv DeprecTxt
\end{code}
\begin{code}
type RnNameSupply
= ( UniqSupply
- , FiniteMap String Int
- -- This is used as a name supply for dictionary functions
- -- 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
- -- 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,
- -- hence less recompilation
-
, FiniteMap (ModuleName, OccName) Name
-- Ensures that one (module,occname) pair gets one unique
, FiniteMap OccName Name
--------------------------------
-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)
- 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
-- 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}
\begin{code}
type ExportItem = (ModuleName, [RdrAvailInfo])
-type VersionInfo name = [ImportVersion name]
-type ImportVersion name = (ModuleName, Version, WhetherHasOrphans, WhatsImported name)
+type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
+
+type ModVersionInfo = (Version, -- Version of the whole module
+ Version, -- Version number for all fixity decls together
+ Version) -- ...ditto all rules together
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.
-data WhatsImported name = Everything
- | Specifically [LocalVersion name] -- List guaranteed non-empty
+type IsBootInterface = Bool
- -- ("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",
- -- not the list of LocalVersions.
+data WhatsImported name = NothingAtAll -- The module is below us in the
+ -- hierarchy, but we import nothing
+ | Everything Version -- The module version
-type LocalVersion name = (name, Version)
+ | Specifically Version -- Module version
+ Version -- Fixity version
+ Version -- Rules version
+ [(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
+ -- 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
+
+ -- 'Everything' means there was a "module M" in
+ -- this module's export list, so we just have to go by M's version,
+ -- not the list of (name,version) pairs
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_decls :: [(Version, RdrNameHsDecl)], -- Local definitions
+ pi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, with their version
+ pi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version
pi_deprecs :: [RdrNameDeprecation] -- Deprecations
}
-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 (InterfaceDetails _ _ (ExportEnv _ fs _) _) = fs
-
type RdrNamePragma = () -- Fudge for now
-------------------
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
+ 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,
-- This is used to generate the "usage" information for this module.
-- Subset of the previous field.
- iInsts :: Bag GatedDecl,
+ 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 :: Bag GatedDecl,
- -- Ditto transformation rules
+ iRules :: IfaceRules,
+ -- Similar to instance decls, only for rules
iDeprecs :: DeprecationEnv
}
+type IfaceInsts = Bag GatedDecl
+type IfaceRules = Bag GatedDecl
+
type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
type ImportedModuleInfo
- = FiniteMap ModuleName (Version, Bool, Maybe (Module, Bool, Avails))
+ = 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
%************************************************************************
\begin{code}
-initRn :: ModuleName -> UniqSupply -> SearchPath -> SrcLoc
+initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
-> RnMG r
-> IO (r, Bag ErrMsg, Bag WarnMsg)
initRn mod us dirs loc do_rn = do
himaps <- mkModuleHiMaps dirs
- names_var <- newIORef (us, emptyFM, builtins, emptyFM)
+ names_var <- newIORef (us, builtins, emptyFM)
errs_var <- newIORef (emptyBag,emptyBag)
iface_var <- newIORef emptyIfaces
let
initIfaceRnMS :: Module -> RnMS r -> RnM d r
initIfaceRnMS mod thing_inside
= initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
- setModuleRn (moduleName mod) thing_inside
+ 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
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 (
once you must either split it, or install a fresh unique supply.
\begin{code}
-renameSourceCode :: ModuleName
+renameSourceCode :: Module
-> RnNameSupply
-> RnMS r
-> r
-renameSourceCode mod_name name_supply m
+renameSourceCode 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;
let
rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
rn_errs = errs_var, rn_hi_maps = himaps,
- rn_mod = mod_name,
+ rn_mod = mod,
rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required
}
s_down = SDown { rn_mode = InterfaceMode,
setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
= writeIORef names_var names'
--- See comments with RnNameSupply above.
-newInstUniq :: String -> RnM d Int
-newInstUniq key (RnDown {rn_ns = names_var}) l_down
- = 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, ipcache) >>
- return uniq
-
getUniqRn :: RnM d Unique
getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, mapInst, cache, ipcache) ->
+ = readIORef names_var >>= \ (us, cache, ipcache) ->
let
(us1,us') = splitUniqSupply us
in
- writeIORef names_var (us', mapInst, cache, ipcache) >>
+ writeIORef names_var (us', cache, ipcache) >>
return (uniqFromSupply us1)
\end{code}
%=====================
\begin{code}
-getModuleRn :: RnM d ModuleName
-getModuleRn (RnDown {rn_mod = mod_name}) l_down
- = return mod_name
+getModuleRn :: RnM d Module
+getModuleRn (RnDown {rn_mod = mod}) l_down
+ = return mod
-setModuleRn :: ModuleName -> RnM d a -> RnM d a
+setModuleRn :: Module -> RnM d a -> RnM d a
setModuleRn new_mod enclosed_thing rn_down l_down
= enclosed_thing (rn_down {rn_mod = new_mod}) l_down
\end{code}
getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
= return local_env
+getGlobalNameEnv :: RnMS GlobalRdrEnv
+getGlobalNameEnv rn_down (SDown {rn_genv = global_env})
+ = return global_env
+
setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
setLocalNameEnv local_env' m rn_down l_down
= m rn_down (l_down {rn_lenv = local_env'})
extendFixityEnv fixes enclosed_scope
rn_down l_down@(SDown {rn_fixenv = fixity_env})
= let
- new_fixity_env = extendNameEnv fixity_env fixes
+ new_fixity_env = extendNameEnvList fixity_env fixes
in
enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
\end{code}
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}
-
-\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