#include "HsVersions.h"
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 302
+#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 )
import HsSyn
import RdrHsSyn
-import RnHsSyn ( RenamedFixitySig )
+import RnHsSyn ( RenamedFixitySig, RenamedDeprecation )
import BasicTypes ( Version )
import SrcLoc ( noSrcLoc )
import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
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 )
-- 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
-- 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}
, 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)]
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,
-- Each is 'gated' by the names that must be available before
-- this instance decl is needed.
- iRules :: Bag GatedDecl
+ iRules :: Bag GatedDecl,
-- Ditto transformation rules
+
+ iDeprecs :: DeprecationEnv
}
type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
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
-- 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
-- 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 }
+ 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,
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}
-- 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) ->
+ = 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}
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}