Commit d2cca44e authored by simonpj's avatar simonpj
Browse files

[project @ 2000-10-23 16:39:11 by simonpj]

More renamer stuff
parent 0499865e
......@@ -56,7 +56,8 @@ module Module
, elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C
, delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
, lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
, rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv, lookupModuleEnvByName
, rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
, lookupModuleEnvByName, extendModuleEnv_C
) where
......@@ -266,6 +267,7 @@ emptyModuleEnv :: ModuleEnv a
mkModuleEnv :: [(Module, a)] -> ModuleEnv a
unitModuleEnv :: Module -> a -> ModuleEnv a
extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv_C :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
......@@ -284,6 +286,7 @@ foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
elemModuleEnv = elemUFM
extendModuleEnv = addToUFM
extendModuleEnv_C = addToUFM_C
extendModuleEnvList = addListToUFM
plusModuleEnv_C = plusUFM_C
delModuleEnvList = delListFromUFM
......
......@@ -8,7 +8,7 @@ module VarEnv (
VarEnv, IdEnv, TyVarEnv,
emptyVarEnv, unitVarEnv, mkVarEnv,
elemVarEnv, rngVarEnv,
extendVarEnv, extendVarEnvList,
extendVarEnv, extendVarEnv_C, extendVarEnvList,
plusVarEnv, plusVarEnv_C,
delVarEnvList, delVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
......@@ -127,6 +127,7 @@ mkVarEnv :: [(Var, a)] -> VarEnv a
zipVarEnv :: [Var] -> [a] -> VarEnv a
unitVarEnv :: Var -> a -> VarEnv a
extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
......@@ -148,6 +149,7 @@ foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
\begin{code}
elemVarEnv = elemUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
......
......@@ -21,6 +21,7 @@ import SrcLoc ( mkSrcLoc )
import Rename ( renameModule )
import PrelInfo ( wiredInThings )
import PrelRules ( builtinRules )
import MkIface ( writeIface )
import TcModule ( TcResults(..), typecheckModule )
import Desugar ( deSugar )
......@@ -254,7 +255,7 @@ initPersistentCompilerState :: PersistentCompilerState
initPersistentCompilerState
= PCS { pcs_PST = initPackageDetails,
pcs_insts = emptyInstEnv,
pcs_rules = emptyRuleEnv,
pcs_rules = initRules,
pcs_PRS = initPersistentRenamerState }
initPackageDetails :: PackageSymbolTable
......@@ -273,4 +274,11 @@ initOrigNames = grab knownKeyNames `plusFM` grab (map getName wiredInThings)
where
grab names = foldl add emptyFM names
add env name = addToFM env (moduleName (nameModule name), nameOccName name) name
initRules :: RuleEnv
initRules = foldl add emptyVarEnv builtinRules
where
add env (name,rule) = extendNameEnv_C add1 env name [rule]
add1 rules _ = rule : rules
\end{code}
......@@ -21,7 +21,7 @@ module HscTypes (
WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
IfaceInsts, IfaceRules, DeprecationEnv, GatedDecl,
IfaceInsts, IfaceRules, Deprecations(..), GatedDecl,
OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
AvailEnv, AvailInfo, GenAvailInfo(..),
PersistentCompilerState(..),
......@@ -113,13 +113,16 @@ data ModIface
mi_module :: Module, -- Complete with package info
mi_version :: VersionInfo, -- Module version number
mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
mi_usages :: [ImportVersion Name], -- Usages
mi_exports :: Avails, -- What it exports
mi_exports :: Avails, -- What it exports; kept sorted by (mod,occ),
-- to make version comparisons easier
mi_globals :: GlobalRdrEnv, -- Its top level environment
mi_fixities :: NameEnv Fixity, -- Fixities
mi_deprecs :: NameEnv DeprecTxt, -- Deprecations
mi_deprecs :: Deprecations, -- Deprecations
mi_decls :: [RenamedHsDecl] -- types, classes
-- inst decls, rules, iface sigs
......@@ -149,7 +152,7 @@ emptyModIface mod
= ModIface { mi_module = mod,
mi_exports = [],
mi_globals = emptyRdrEnv,
mi_deprecs = emptyNameEnv,
mi_deprecs = NoDeprecs
}
\end{code}
......@@ -258,13 +261,16 @@ data VersionInfo
-- the parent class/tycon changes
}
type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation
data Deprecations = NoDeprecs
| DeprecAll DeprecTxt -- Whole module deprecated
| DeprecSome (NameEnv DeprecTxt) -- Some things deprecated
-- Just "big" names
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
type DFunId = Id
type RuleEnv = IdEnv [CoreRule]
type RuleEnv = NameEnv [CoreRule]
emptyRuleEnv = emptyVarEnv
\end{code}
......@@ -468,16 +474,6 @@ instance Ord ImportReason where
= (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
{-
Moved here from Name.
pp_prov (LocalDef _ Exported) = char 'x'
pp_prov (LocalDef _ NotExported) = char 'l'
pp_prov (NonLocalDef ImplicitImport _) = char 'j'
pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I' -- Imported by name
pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i' -- Imported by ..
pp_prov SystemProv = char 's'
-}
data ImportReason
= UserImport Module SrcLoc Bool -- Imported from module M on line L
-- Note the M may well not be the defining module
......@@ -510,7 +506,7 @@ hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport
hasBetterProv _ _ = False
pprNameProvenance :: Name -> Provenance -> SDoc
pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why,
nest 2 (parens (ppr_defn (nameSrcLoc name)))]
......
......@@ -429,7 +429,8 @@ builtinRules
]
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) = unpackFoldrCString# "foobaz" c n
-- The rule is this:
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) = unpackFoldrCString# "foobaz" c n
match_append_lit_str [Type ty1,
Lit (MachStr s1),
......
......@@ -225,16 +225,16 @@ iface : '__interface' package mod_name
pi_mod = mkModule $3 $2, -- Module itself
pi_vers = $4, -- Module version
pi_orphan = $6,
pi_exports = $9, -- Exports
pi_exports = (fst $5, $9), -- Exports
pi_usages = $10, -- Usages
pi_fixity = (fst $5,$11), -- Fixies
pi_fixity = $11, -- Fixies
pi_insts = $12, -- Local instances
pi_decls = $13, -- Decls
pi_rules = (snd $5,fst $14), -- Rules
pi_deprecs = snd $14 -- Deprecations
} }
-- Versions for fixities and rules (optional)
-- Versions for exports and rules (optional)
sub_versions :: { (Version,Version) }
: '[' version version ']' { ($2,$3) }
| {- empty -} { (initialVersion, initialVersion) }
......
This diff is collapsed.
......@@ -16,7 +16,7 @@ import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
import HsTypes ( hsTyVarName, replaceTyVarName )
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
ImportReason(..), GlobalRdrEnv, AvailEnv,
AvailInfo, GenAvailInfo(..), RdrAvailInfo )
AvailInfo, Avails, GenAvailInfo(..), RdrAvailInfo )
import RnMonad
import Name ( Name, NamedThing(..),
getSrcLoc,
......@@ -582,16 +582,19 @@ availNames :: GenAvailInfo name -> [name]
availNames (Avail n) = [n]
availNames (AvailTC n ns) = ns
-------------------------------------
addSysAvails :: AvailInfo -> [Name] -> AvailInfo
addSysAvails avail [] = avail
addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
-------------------------------------
rdrAvailInfo :: AvailInfo -> RdrAvailInfo
-- Used when building the avails we are going to put in an interface file
-- We sort the components to reduce needless wobbling of interfaces
rdrAvailInfo (Avail n) = Avail (nameOccName n)
rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
-------------------------------------
filterAvail :: RdrNameIE -- Wanted
-> AvailInfo -- Available
-> Maybe AvailInfo -- Resulting available;
......@@ -627,6 +630,21 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
filterAvail ie avail = Nothing
-------------------------------------
sortAvails :: Avails -> Avails
sortAvails avails = sortLt lt avails
where
a1 `lt` a2 = mod1 < mod2 ||
(mod1 == mod2 && occ1 < occ2)
where
name1 = availName a1
name2 = availName a2
mod1 = nameModule name1
mod2 = nameModule name2
occ1 = nameOccName name1
occ2 = nameOccName name2
-------------------------------------
pprAvail :: AvailInfo -> SDoc
pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
[] -> empty
......@@ -678,7 +696,7 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
%************************************************************************
\begin{code}
warnUnusedModules :: [Module] -> RnM d ()
warnUnusedModules :: [ModuleName] -> RnM d ()
warnUnusedModules mods
= doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
if warn then mapRn_ (addWarnRn . unused_mod) mods
......@@ -687,7 +705,7 @@ warnUnusedModules mods
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
text "is imported, but nothing from it is used",
parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
quotes (ppr (moduleName m)))]
quotes (ppr m))]
warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
warnUnusedImports names
......
......@@ -11,8 +11,8 @@ module RnIfaces
getInterfaceExports,
getImportedInstDecls, getImportedRules,
lookupFixityRn, loadHomeInterface,
importDecl, ImportDeclResult(..), recordLocalSlurps, loadBuiltinRules,
mkImportExportInfo, getSlurped,
importDecl, ImportDeclResult(..), recordLocalSlurps,
mkImportInfo, getSlurped,
getDeclBinders, getDeclSysBinders,
removeContext -- removeContext probably belongs somewhere else
......@@ -47,8 +47,8 @@ import Name ( Name {-instance NamedThing-}, nameOccName,
import Module ( Module, ModuleEnv,
moduleName, isModuleInThisPackage,
ModuleName, WhereFrom(..),
extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName,
plusModuleEnv_C, lookupWithDefaultModuleEnv
emptyModuleEnv, extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName,
extendModuleEnv_C, lookupWithDefaultModuleEnv
)
import RdrName ( RdrName, rdrNameOcc )
import NameSet
......@@ -171,13 +171,13 @@ tryLoadInterface doc_str mod_name from
loadDecls mod (iDecls ifaces) (pi_decls iface) `thenRn` \ (decls_vers, new_decls) ->
loadRules mod (iRules ifaces) (pi_rules iface) `thenRn` \ (rule_vers, new_rules) ->
loadFixDecls mod_name (pi_fixity iface) `thenRn` \ (fix_vers, fix_env) ->
foldlRn (loadDeprec mod) emptyNameEnv (pi_deprecs iface) `thenRn` \ deprec_env ->
loadFixDecls mod_name (pi_fixity iface) `thenRn` \ fix_env ->
loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
loadExports (pi_exports iface) `thenRn` \ avails ->
loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
let
version = VersionInfo { vers_module = pi_vers iface,
fixVers = fix_vers,
vers_exports = export_vers,
vers_rules = rule_vers,
vers_decls = decls_vers }
......@@ -225,7 +225,7 @@ addModDeps mod new_deps mod_deps
-- Don't record dependencies when importing a module from another package
-- Except for its descendents which contain orphans,
-- and in that case, forget about the boot indicator
filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface, IsLoaded))]
filtered_new_deps
| isModuleInThisPackage mod
= [ (imp_mod, (has_orphans, is_boot, False))
......@@ -247,11 +247,11 @@ addModDeps mod new_deps mod_deps
-- Loading the export list
-----------------------------------------------------
loadExports :: [ExportItem] -> RnM d Avails
loadExports items
loadExports :: (Version, [ExportItem]) -> RnM d (Version, Avails)
loadExports (vers, items)
= getModuleRn `thenRn` \ this_mod ->
mapRn (loadExport this_mod) items `thenRn` \ avails_s ->
returnRn (concat avails_s)
returnRn (vers, concat avails_s)
loadExport :: Module -> ExportItem -> RnM d [AvailInfo]
......@@ -361,9 +361,9 @@ loadDecl mod (version_map, decls_map) (version, decl)
-- Loading fixity decls
-----------------------------------------------------
loadFixDecls mod_name (version, decls)
loadFixDecls mod_name decls
= mapRn (loadFixDecl mod_name) decls `thenRn` \ to_add ->
returnRn (version, mkNameEnv to_add)
returnRn (mkNameEnv to_add)
loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
= newGlobalName mod_name (rdrNameOcc rdr_name) `thenRn` \ name ->
......@@ -431,31 +431,20 @@ loadRule mod decl@(IfaceRule _ _ var _ _ src_loc)
= lookupOrigName var `thenRn` \ var_name ->
returnRn (unitNameSet var_name, (mod, RuleD decl))
loadBuiltinRules :: [(RdrName, CoreRule)] -> RnMG ()
loadBuiltinRules builtin_rules
= getIfacesRn `thenRn` \ ifaces ->
mapRn loadBuiltinRule builtin_rules `thenRn` \ rule_decls ->
setIfacesRn (ifaces { iRules = iRules ifaces `unionBags` listToBag rule_decls })
loadBuiltinRule (var, rule)
= lookupOrigName var `thenRn` \ var_name ->
returnRn (unitNameSet var_name, (nameModule var_name, RuleD (IfaceRuleOut var rule)))
-----------------------------------------------------
-- Loading Deprecations
-----------------------------------------------------
loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
loadDeprec mod deprec_env (Deprecation (IEModuleContents _) txt _)
= traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
-- SUP: TEMPORARY HACK, ignoring module deprecations for now
returnRn deprec_env
loadDeprec mod deprec_env (Deprecation ie txt _)
= setModuleRn mod $
mapRn lookupOrigName (ieNames ie) `thenRn` \ names ->
traceRn (text "loaded deprecation(s) for" <+> hcat (punctuate comma (map ppr names)) <> colon <+> ppr txt) `thenRn_`
loadDeprecs :: Module -> [RdrNameDeprecation] -> RnM d Deprecations
loadDeprecs m [] = returnRn NoDeprecs
loadDeprecs m [Deprecation (IEModuleContents _) txt _] = returnRn (DeprecAll txt)
loadDeprecs m deprecs = setModuleRn m $
foldlRn loadDeprec emptyNameEnv deprecs `thenRn` \ env ->
returnRn (DeprecSome env)
loadDeprec deprec_env (Deprecation ie txt _)
= mapRn lookupOrigName (ieNames ie) `thenRn` \ names ->
traceRn (text "Loaded deprecation(s) for" <+> hcat (punctuate comma (map ppr names)) <> colon <+> ppr txt) `thenRn_`
returnRn (extendNameEnvList deprec_env (zip names (repeat txt)))
\end{code}
......@@ -782,33 +771,32 @@ imports A. This line says that A imports B, but uses nothing in it.
So we'll get an early bale-out when compiling A if B's version changes.
\begin{code}
mkImportExportInfo :: ModuleName -- Name of this module
-> Avails -- Info about exports
-> [ImportDecl n] -- The import decls
-> RnMG ([ExportItem], -- Export info for iface file; sorted
[ImportVersion Name]) -- Import info for iface file; sorted
-- Both results are sorted into canonical order to
-- reduce needless wobbling of interface files
mkImportExportInfo this_mod export_avails exports
mkImportInfo :: ModuleName -- Name of this module
-> [ImportDecl n] -- The import decls
-> RnMG [ImportVersion Name]
mkImportInfo this_mod imports
= getIfacesRn `thenRn` \ ifaces ->
getHomeIfaceTableRn `thenRn` \ hit ->
let
import_all_mods :: [ModuleName]
-- Modules where we imported all the names
-- (apart from hiding some, perhaps)
import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports ]
import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports,
import_all imp_list ]
import_all (Just (False, _)) = False -- Imports are specified explicitly
import_all other = True -- Everything is imported
mod_map = iImpModInfo ifaces
imp_names = iVSlurp ifaces
pit = iPIT ifaces
-- mv_map groups together all the things imported from a particular module.
mv_map :: ModuleEnv [Name]
mv_map = foldr add_mv emptyFM imp_names
mv_map = foldr add_mv emptyModuleEnv imp_names
add_mv (name, version) mv_map = addItem mv_map (nameModule name) name
add_mv name mv_map = addItem mv_map (nameModule name) name
-- Build the result list by adding info for each module.
-- For (a) a library module, we don't record it at all unless it contains orphans
......@@ -847,10 +835,10 @@ mkImportExportInfo this_mod export_avails exports
= so_far
| is_lib_module -- Record the module version only
= go_for_it (Everything vers_module)
= go_for_it (Everything module_vers)
| otherwise
= go_for_it (mk_whats_imported mod vers_module)
= go_for_it whats_imported
where
go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far
......@@ -859,12 +847,14 @@ mkImportExportInfo this_mod export_avails exports
is_lib_module = not (isModuleInThisPackage mod)
version_info = mi_version mod_iface
version_env = vers_decls version_info
module_vers = vers_module version_info
whats_imported = Specifically mod_vers export_vers import_items
whats_imported = Specifically module_vers
export_vers import_items
(vers_rules version_info)
import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
let v = lookupNameEnv version_env `orElse`
let v = lookupNameEnv version_env n `orElse`
pprPanic "mk_whats_imported" (ppr n)
]
export_vers | moduleName mod `elem` import_all_mods
......@@ -873,22 +863,13 @@ mkImportExportInfo this_mod export_avails exports
= Nothing
import_info = foldFM mk_imp_info [] mod_map
-- Sort exports into groups by module
export_fm :: FiniteMap Module [RdrAvailInfo]
export_fm = foldr insert emptyFM export_avails
insert avail efm = addItem efm (nameModule (availName avail))
avail
export_info = fmToList export_fm
in
traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map))) `thenRn_`
returnRn (export_info, import_info)
returnRn import_info
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
addItem fm mod x = plusModuleEnv_C add_item fm mod [x]
addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
where
add_item xs _ = x:xs
\end{code}
......@@ -1044,7 +1025,7 @@ findAndReadIface doc_str mod_name hi_boot_file
ioToRnM (finder mod_name) `thenRn` \ maybe_found ->
case maybe_found of
Just (mod,locn)
Right (Just (mod,locn))
| hi_boot_file -> readIface mod (hi_file locn ++ "-hi-boot")
| otherwise -> readIface mod (hi_file locn)
......@@ -1129,7 +1110,7 @@ warnRedundantSourceImport mod_name
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
<+> quotes (ppr mod_name)
hiModuleNameMismatchWarn :: Module -> ModuleName -> Message
hiModuleNameMismatchWarn :: Module -> Module -> Message
hiModuleNameMismatchWarn requested_mod read_mod =
hsep [ ptext SLIT("Something is amiss; requested module name")
, ppr (moduleName requested_mod)
......
......@@ -201,11 +201,10 @@ data ParsedIface
pi_vers :: Version, -- Module version number
pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
pi_usages :: [ImportVersion OccName], -- Usages
pi_exports :: [ExportItem], -- Exports
pi_exports :: (Version, [ExportItem]), -- Exports
pi_insts :: [RdrNameInstDecl], -- Local instance declarations
pi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions
pi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations,
-- with their version
pi_fixity :: [RdrNameFixitySig], -- Local fixity declarations,
pi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version
pi_deprecs :: [RdrNameDeprecation] -- Deprecations
}
......@@ -290,7 +289,7 @@ initRn :: DynFlags
-> Module
-> SrcLoc
-> RnMG t
-> IO (t, PersistentCompilerState, (Bag WarnMsg, Bag ErrMsg))
-> IO (t, (Bag WarnMsg, Bag ErrMsg), PersistentCompilerState)
initRn dflags finder hit hst pcs mod loc do_rn
= do
......@@ -330,7 +329,7 @@ initRn dflags finder hit hst pcs mod loc do_rn
let new_pcs = pcs { pcs_PIT = iPIT new_ifaces,
pcs_PRS = new_prs }
return (res, new_pcs, (warns, errs))
return (res, (warns, errs), new_pcs)
is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool
-- Returns True iff the name is in either symbol table
......@@ -402,8 +401,8 @@ renameSourceCode dflags mod prs m
rn_loc = generatedSrcLoc, rn_ns = names_var,
rn_errs = errs_var,
rn_mod = mod,
rn_ifaces = panic "rnameSourceCode: rn_ifaces", -- Not required
rn_finder = panic "rnameSourceCode: rn_finder" -- Not required
rn_done = bogus "rn_done", rn_hit = bogus "rn_hit",
rn_ifaces = bogus "rn_ifaces", rn_finder = bogus "rn_finder"
}
s_down = SDown { rn_mode = InterfaceMode,
-- So that we can refer to PrelBase.True etc
......@@ -428,6 +427,8 @@ renameSourceCode dflags mod prs m
where
display errs = pprBagOfErrors errs
bogus s = panic ("rnameSourceCode: " ++ s) -- Used for unused record fields
{-# INLINE thenRn #-}
{-# INLINE thenRn_ #-}
{-# INLINE returnRn #-}
......
......@@ -19,8 +19,7 @@ import RdrHsSyn ( RdrNameIE, RdrNameImportDecl,
RdrNameHsModule, RdrNameHsDecl
)
import RnIfaces ( getInterfaceExports, getDeclBinders,
recordLocalSlurps, checkModUsage,
outOfDate, findAndReadIface )
recordLocalSlurps, findAndReadIface )
import RnEnv
import RnMonad
......@@ -59,16 +58,15 @@ getGlobalNames :: RdrNameHsModule
-> RnMG (Maybe (GlobalRdrEnv, -- Maps all in-scope things
GlobalRdrEnv, -- Maps just *local* things
Avails, -- The exported stuff
AvailEnv, -- Maps a name to its parent AvailInfo
AvailEnv -- Maps a name to its parent AvailInfo
-- Just for in-scope things only
Maybe ParsedIface -- The old interface file, if any
))
-- Nothing => no need to recompile
getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
= -- These two fix-loops are to get the right
-- provenance information into a Name
fixRn ( \ ~(Just (rec_gbl_env, _, rec_export_avails, _, _)) ->
fixRn ( \ ~(Just (rec_gbl_env, _, rec_export_avails, _)) ->
let
rec_unqual_fn :: Name -> Bool -- Is this chap in scope unqualified?
......@@ -132,19 +130,13 @@ getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
-- Found errors already, so exit now
returnRn Nothing
else
checkEarlyExit this_mod `thenRn` \ (up_to_date, old_iface) ->
if up_to_date then
-- Interface files are sufficiently unchanged
putDocRn (text "Compilation IS NOT required") `thenRn_`
returnRn Nothing
else
-- PROCESS EXPORT LISTS
exportsFromAvail this_mod exports all_avails gbl_env `thenRn` \ export_avails ->
-- ALL DONE
returnRn (Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface))
returnRn (Just (gbl_env, local_gbl_env, export_avails, global_avail_env))
)
where
all_imports = prel_imports ++ imports
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment