summaryrefslogtreecommitdiff
path: root/ghc/compiler/rename
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/rename')
-rw-r--r--ghc/compiler/rename/Rename.lhs63
-rw-r--r--ghc/compiler/rename/RnEnv.lhs2
-rw-r--r--ghc/compiler/rename/RnHiFiles.lhs44
-rw-r--r--ghc/compiler/rename/RnIfaces.lhs37
-rw-r--r--ghc/compiler/rename/RnMonad.lhs16
-rw-r--r--ghc/compiler/rename/RnSource.lhs2
6 files changed, 84 insertions, 80 deletions
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 88beb68220..c3a1e3209a 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -36,7 +36,8 @@ import Module ( Module, ModuleName, WhereFrom(..),
moduleNameUserString, moduleName,
mkModuleInThisPackage, mkModuleName, moduleEnvElts
)
-import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
+import Name ( Name, NamedThing(..), getSrcLoc,
+ nameIsLocalOrFrom,
nameOccName, nameModule,
mkNameEnv, nameEnvElts, extendNameEnv
)
@@ -65,7 +66,7 @@ import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
VersionInfo(..), ImportVersion, IfaceDecls(..),
GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo,
Provenance(..), ImportReason(..), initialVersionInfo,
- Deprecations(..), lookupDeprec, lookupTable
+ Deprecations(..), lookupDeprec, lookupIface
)
import List ( partition, nub )
\end{code}
@@ -159,11 +160,9 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
else
-- GENERATE THE VERSION/USAGE INFO
- mkImportInfo mod_name imports `thenRn` \ my_usages ->
+ mkImportInfo mod_name imports `thenRn` \ my_usages ->
- -- RETURN THE RENAMED MODULE
- getNameSupplyRn `thenRn` \ name_supply ->
- getIfacesRn `thenRn` \ ifaces ->
+ -- BUILD THE MODULE INTERFACE
let
-- We record fixities even for things that aren't exported,
-- so that we can change into the context of this moodule easily
@@ -171,23 +170,23 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
| FixitySig name fixity loc <- nameEnvElts local_fixity_env
]
-
-- Sort the exports to make them easier to compare for versions
my_exports = groupAvails this_module export_avails
+ final_decls = rn_local_decls ++ rn_imp_decls
+ is_orphan = any (isOrphanDecl this_module) rn_local_decls
+
mod_iface = ModIface { mi_module = this_module,
mi_version = initialVersionInfo,
+ mi_usages = my_usages,
mi_boot = False,
- mi_orphan = any isOrphanDecl rn_local_decls,
+ mi_orphan = is_orphan,
mi_exports = my_exports,
mi_globals = gbl_env,
- mi_usages = my_usages,
mi_fixities = fixities,
mi_deprecs = my_deprecs,
mi_decls = panic "mi_decls"
}
-
- final_decls = rn_local_decls ++ rn_imp_decls
in
-- REPORT UNUSED NAMES, AND DEBUG DUMP
@@ -253,20 +252,21 @@ implicitFVs mod_name decls
\end{code}
\begin{code}
-isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
- = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
+isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
+ = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
+ (extractHsTyNames (removeContext inst_ty)))
-- The 'removeContext' is because of
-- instance Foo a => Baz T where ...
-- The decl is an orphan if Baz and T are both not locally defined,
-- even if Foo *is* locally defined
-isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
+isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
= check lhs
where
-- At the moment we just check for common LHS forms
-- Expand as necessary. Getting it wrong just means
-- more orphans than necessary
- check (HsVar v) = not (isLocallyDefined v)
+ check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
check (HsApp f a) = check f && check a
check (HsLit _) = False
check (HsOverLit _) = False
@@ -278,7 +278,7 @@ isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
check other = True -- Safe fall through
-isOrphanDecl other = False
+isOrphanDecl _ _ = False
\end{code}
@@ -540,12 +540,14 @@ reportUnusedNames my_mod_iface imports avail_env
= warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
warnUnusedImports bad_imp_names `thenRn_`
- printMinimalImports my_mod_iface minimal_imports `thenRn_`
- warnDeprecations my_mod_iface really_used_names `thenRn_`
+ printMinimalImports this_mod minimal_imports `thenRn_`
+ warnDeprecations this_mod my_deprecs really_used_names `thenRn_`
returnRn ()
where
+ this_mod = mi_module my_mod_iface
gbl_env = mi_globals my_mod_iface
+ my_deprecs = mi_deprecs my_mod_iface
-- Now, a use of C implies a use of T,
-- if C was brought into scope by T(..) or T(C)
@@ -638,7 +640,7 @@ reportUnusedNames my_mod_iface imports avail_env
module_unused mod = moduleName mod `elem` unused_imp_mods
-warnDeprecations my_mod_iface used_names
+warnDeprecations this_mod my_deprecs used_names
= doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
if not warn_drs then returnRn () else
@@ -653,15 +655,16 @@ warnDeprecations my_mod_iface used_names
mapRn_ warnDeprec deprecs
where
- my_deprecs = mi_deprecs my_mod_iface
- lookup_deprec hit pit n
- | isLocallyDefined n = lookupDeprec my_deprecs n
- | otherwise = case lookupTable hit pit n of
- Just iface -> lookupDeprec (mi_deprecs iface) n
- Nothing -> pprPanic "warnDeprecations:" (ppr n)
+ lookup_deprec hit pit n
+ | nameIsLocalOrFrom this_mod n
+ = lookupDeprec my_deprecs n
+ | otherwise
+ = case lookupIface hit pit this_mod n of
+ Just iface -> lookupDeprec (mi_deprecs iface) n
+ Nothing -> pprPanic "warnDeprecations:" (ppr n)
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
-printMinimalImports my_mod_iface imps
+printMinimalImports this_mod imps
= doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
if not dump_minimal then returnRn () else
@@ -671,8 +674,7 @@ printMinimalImports my_mod_iface imps
}) `thenRn_`
returnRn ()
where
- filename = moduleNameUserString (moduleName (mi_module my_mod_iface))
- ++ ".imports"
+ filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
ppr_mod_ie (mod_name, ies)
| mod_name == pRELUDE_Name
= empty
@@ -706,7 +708,7 @@ rnDump :: [RenamedHsDecl] -- Renamed imported decls
rnDump imp_decls local_decls
= doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
- doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
+ doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
getIfacesRn `thenRn` \ ifaces ->
ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
@@ -735,12 +737,11 @@ getRnStats imported_decls ifaces
n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
-- This is really only right for a one-shot compile
- decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
+ decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces)
-- Data, newtype, and class decls are in the decls_fm
-- under multiple names; the tycon/class, and each
-- constructor/class op too.
-- The 'True' selects just the 'main' decl
- not (isLocallyDefined (availName avail))
]
(cd_rd, dd_rd, nd_rd, sd_rd, vd_rd) = countTyClDecls decls_read
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 023e10c523..97f505e673 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -663,7 +663,7 @@ groupAvails this_mod avails
]
where
groupFM :: FiniteMap FastString Avails
- -- Deliberatey use the FastString so we
+ -- Deliberately use the FastString so we
-- get a canonical ordering
groupFM = foldl add emptyFM avails
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 2fa3bdd22c..ca381a37ba 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -21,7 +21,7 @@ import CmdLineOpts ( DynFlag(..), opt_IgnoreIfacePragmas )
import HscTypes ( ModuleLocation(..),
ModIface(..), emptyModIface,
VersionInfo(..),
- lookupTableByModName,
+ lookupIfaceByModName,
ImportVersion, WhetherHasOrphans, IsBootInterface,
DeclsMap, GatedDecl, IfaceInsts, IfaceRules,
AvailInfo, GenAvailInfo(..), Avails, Deprecations(..)
@@ -40,7 +40,7 @@ import RnMonad
import ParseIface ( parseIface, IfaceStuff(..) )
import Name ( Name {-instance NamedThing-}, nameOccName,
- nameModule, isLocallyDefined,
+ nameModule, isLocalName, nameIsLocalOrFrom,
NamedThing(..),
mkNameEnv, extendNameEnv
)
@@ -76,7 +76,8 @@ import Monad ( when )
\begin{code}
loadHomeInterface :: SDoc -> Name -> RnM d ModIface
loadHomeInterface doc_str name
- = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
+ = ASSERT2( not (isLocalName name), ppr name <+> parens doc_str )
+ loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
loadOrphanModules :: [ModuleName] -> RnM d ()
loadOrphanModules mods
@@ -110,7 +111,7 @@ tryLoadInterface doc_str mod_name from
getIfacesRn `thenRn` \ ifaces@(Ifaces { iPIT = pit }) ->
-- CHECK WHETHER WE HAVE IT ALREADY
- case lookupTableByModName hit pit mod_name of {
+ case lookupIfaceByModName hit pit mod_name of {
Just iface -> returnRn (iface, Nothing) ; -- Already loaded
Nothing ->
@@ -191,7 +192,7 @@ tryLoadInterface doc_str mod_name from
ImportByUser -> addModDeps mod is_loaded (pi_usages iface) mod_map
other -> mod_map
mod_map2 = delFromFM mod_map1 mod_name
- is_loaded m = maybeToBool (lookupTableByModName hit pit m)
+ is_loaded m = maybeToBool (lookupIfaceByModName hit pit m)
-- Now add info about this module to the PIT
has_orphans = pi_orphan iface
@@ -553,16 +554,32 @@ readIface tr file_path
%* *
%*********************************************************
-This has to be in RnIfaces (or RnHiFiles) because it calls loadHomeInterface
+@lookupFixityRn@ has to be in RnIfaces (or RnHiFiles) because
+it calls @loadHomeInterface@.
+
+lookupFixity is a bit strange.
+
+* Nested local fixity decls are put in the local fixity env, which we
+ find with getFixtyEnv
+
+* Imported fixities are found in the HIT or PIT
+
+* Top-level fixity decls in this module may be for Names that are
+ either Global (constructors, class operations)
+ or Local/Exported (everything else)
+ (See notes with RnNames.getLocalDeclBinders for why we have this split.)
+ We put them all in the local fixity environment
\begin{code}
lookupFixityRn :: Name -> RnMS Fixity
lookupFixityRn name
- | isLocallyDefined name
- = getFixityEnv `thenRn` \ local_fix_env ->
- returnRn (lookupLocalFixity local_fix_env name)
+ = getModuleRn `thenRn` \ this_mod ->
+ if nameIsLocalOrFrom this_mod name
+ then -- It's defined in this module
+ getFixityEnv `thenRn` \ local_fix_env ->
+ returnRn (lookupLocalFixity local_fix_env name)
- | otherwise -- Imported
+ else -- It's imported
-- For imported names, we have to get their fixities by doing a loadHomeInterface,
-- and consulting the Ifaces that comes back from that, because the interface
-- file for the Name might not have been loaded yet. Why not? Suppose you import module A,
@@ -570,11 +587,10 @@ lookupFixityRn name
-- right away (after all, it's possible that nothing from B will be used).
-- When we come across a use of 'f', we need to know its fixity, and it's then,
-- and only then, that we load B.hi. That is what's happening here.
- = getHomeIfaceTableRn `thenRn` \ hit ->
- loadHomeInterface doc name `thenRn` \ iface ->
- returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
+ loadHomeInterface doc name `thenRn` \ iface ->
+ returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
where
- doc = ptext SLIT("Checking fixity for") <+> ppr name
+ doc = ptext SLIT("Checking fixity for") <+> ppr name
\end{code}
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 81c9ab9980..8d371ceac9 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -36,7 +36,7 @@ import Id ( idType )
import Type ( namesOfType )
import TyCon ( isSynTyCon, getSynTyConDefn )
import Name ( Name {-instance NamedThing-}, nameOccName,
- nameModule, isLocallyDefined, nameUnique,
+ nameModule, isLocalName, nameUnique,
NamedThing(..),
elemNameEnv
)
@@ -458,15 +458,14 @@ getSlurped
recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = (imp_mods, imp_names) })
avail
- = let
- new_slurped_names = addAvailToNameSet slurped_names avail
- new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names name)
- | otherwise = (extendModuleSet imp_mods mod, imp_names)
- where
- mod = nameModule name
- name = availName avail
- in
+ = ASSERT2( not (isLocalName (availName avail)), pprAvail avail )
ifaces { iSlurp = new_slurped_names, iVSlurp = new_vslurp }
+ where
+ main_name = availName avail
+ mod = nameModule main_name
+ new_slurped_names = addAvailToNameSet slurped_names avail
+ new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
+ | otherwise = (extendModuleSet imp_mods mod, imp_names)
recordLocalSlurps local_avails
= getIfacesRn `thenRn` \ ifaces ->
@@ -647,7 +646,7 @@ data ImportDeclResult
importDecl name
= -- Check if it was loaded before beginning this module
- if isLocallyDefined name then
+ if isLocalName name then
returnRn AlreadySlurped
else
checkAlreadyAvailable name `thenRn` \ done ->
@@ -661,13 +660,6 @@ importDecl name
returnRn AlreadySlurped
else
- -- Don't slurp in decls from this module's own interface file
- -- (Indeed, this shouldn't happen.)
- if isLocallyDefined name then
- addWarnRn (importDeclWarn name) `thenRn_`
- returnRn AlreadySlurped
- else
-
-- When we find a wired-in name we must load its home
-- module so that we find any instance decls lurking therein
if name `elemNameEnv` wiredInThingEnv then
@@ -798,9 +790,8 @@ recompileRequired iface_path source_unchanged iface
returnRn outOfDate
else
- -- CHECK WHETHER WE HAVE AN OLD IFACE
-- Source code unchanged and no errors yet... carry on
- checkList [checkModUsage u | u <- mi_usages iface]
+ checkList [checkModUsage u | u <- mi_usages iface]
checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
checkList [] = returnRn upToDate
@@ -915,12 +906,4 @@ getDeclErr name
= vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
ptext SLIT("from module") <+> quotes (ppr (nameModule name))
]
-
-importDeclWarn name
- = sep [ptext SLIT(
- "Compiler tried to import decl from interface file with same name as module."),
- ptext SLIT(
- "(possible cause: module name clashes with interface file already in scope.)")
- ] $$
- hsep [ptext SLIT("name:"), quotes (ppr name)]
\end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 74101b781c..12f40893c2 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -53,7 +53,7 @@ import RdrName ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
addListToRdrEnv, rdrEnvToList, rdrEnvElts
)
import Name ( Name, OccName, NamedThing(..), getSrcLoc,
- isLocallyDefinedName, nameOccName,
+ nameOccName,
decode, mkLocalName, mkKnownKeyGlobal,
NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv,
extendNameEnvList
@@ -68,7 +68,7 @@ import Bag ( Bag, emptyBag, isEmptyBag, snocBag )
import UniqSupply
import Outputable
import PrelNames ( mkUnboundName )
-import Maybes ( maybeToBool, seqMaybe )
+import Maybes ( maybeToBool )
import ErrUtils ( printErrorsAndWarnings )
infixr 9 `thenRn`, `thenRn_`
@@ -145,7 +145,7 @@ data RnDown
data SDown = SDown {
rn_mode :: RnMode,
- rn_genv :: GlobalRdrEnv, -- Global envt
+ rn_genv :: GlobalRdrEnv, -- Top level environment
rn_lenv :: LocalRdrEnv, -- Local name envt
-- Does *not* include global name envt; may shadow it
@@ -155,9 +155,10 @@ data SDown = SDown {
-- We still need the unsullied global name env so that
-- we can look up record field names
- rn_fixenv :: LocalFixityEnv -- Local fixities
+ rn_fixenv :: LocalFixityEnv -- Local fixities (for non-top-level
+ -- declarations)
-- The global fixities are held in the
- -- rn_ifaces field. Why? See the comments
+ -- HIT or PIT. Why? See the comments
-- with RnIfaces.lookupLocalFixity
}
@@ -360,9 +361,12 @@ initRn dflags hit hst pcs mod do_rn
is_done :: HomeSymbolTable -> PackageTypeEnv -> Name -> Bool
-- Returns True iff the name is in either symbol table
+-- The name is a Global, so it has a Module
is_done hst pte n = maybeToBool (lookupType hst pte n)
initRnMS rn_env fixity_env mode thing_inside rn_down g_down
+ -- The fixity_env appears in both the rn_fixenv field
+ -- and in the HIT. See comments with RnHiFiles.lookupFixityRn
= let
s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv,
rn_fixenv = fixity_env, rn_mode = mode }
@@ -373,7 +377,6 @@ initIfaceRnMS :: Module -> RnMS r -> RnM d r
initIfaceRnMS mod thing_inside
= initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
setModuleRn mod thing_inside
-
\end{code}
@renameSourceCode@ is used to rename stuff ``out-of-line'';
@@ -588,6 +591,7 @@ getHomeIfaceTableRn :: RnM d HomeIfaceTable
getHomeIfaceTableRn down l_down = return (rn_hit down)
checkAlreadyAvailable :: Name -> RnM d Bool
+ -- Name is a Global name
checkAlreadyAvailable name down l_down = return (rn_done down name)
\end{code}
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 693c6000fb..09979d448f 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -109,7 +109,7 @@ rnDecl (TyClD tycl_decl)
rnDecl (InstD inst)
= rnInstDecl inst `thenRn` \ new_inst ->
rnInstBinds inst new_inst `thenRn` \ (new_inst', fvs) ->
- returnRn (InstD new_inst, fvs `plusFV` instDeclFVs new_inst')
+ returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
rnDecl (RuleD rule)
| isIfaceRuleDecl rule
View Lorry Controller Status