Commit 88f315a1 authored by simonpj's avatar simonpj

[project @ 2000-10-31 08:08:38 by simonpj]

More tidying up; esp of isLocallyDefined
parent 156d9133
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.103 2000/10/30 11:18:14 sewardj Exp $
# $Id: Makefile,v 1.104 2000/10/31 08:08:38 simonpj Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -366,7 +366,9 @@ parser/Parser.hs : parser/Parser.y
#-----------------------------------------------------------------------------
# Linking
SRC_LD_OPTS += -no-link-chk -ldl
SRC_LD_OPTS += -no-link-chk
# REMOVED SLPJ
# -ldl
ifneq "$(GhcWithHscBuiltViaC)" "YES"
ifeq "$(GhcReportCompiles)" "YES"
......
......@@ -21,7 +21,7 @@ module Name (
toRdrName, hashName,
isUserExportedName,
nameSrcLoc, isLocallyDefinedName, isDllName,
nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom,
isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
isTyVarName,
......@@ -36,7 +36,8 @@ module Name (
-- Class NamedThing and overloaded friends
NamedThing(..),
getSrcLoc, isLocallyDefined, getOccString, toRdrName
getSrcLoc, isLocallyDefined, getOccString, toRdrName,
isFrom, isLocalOrFrom
) where
#include "HsVersions.h"
......@@ -121,7 +122,9 @@ nameModule_maybe name = Nothing
\end{code}
\begin{code}
isLocallyDefinedName :: Name -> Bool
nameIsLocallyDefined :: Name -> Bool
nameIsFrom :: Module -> Name -> Bool
nameIsLocalOrFrom :: Module -> Name -> Bool
isUserExportedName :: Name -> Bool
isLocalName :: Name -> Bool -- Not globals
isGlobalName :: Name -> Bool
......@@ -133,14 +136,23 @@ isGlobalName other = False
isLocalName name = not (isGlobalName name)
isLocallyDefinedName name = isLocalName name
nameIsLocallyDefined name = isLocalName name
nameIsLocalOrFrom from (Name {n_sort = Global mod}) = mod == from
nameIsLocalOrFrom from other = True
nameIsFrom from (Name {n_sort = Global mod}) = mod == from
nameIsFrom from other = pprPanic "nameIsFrom" (ppr other)
-- Global names are by definition those that are visible
-- outside the module, *as seen by the linker*. Externally visible
-- does not mean visible at the source level (that's isExported).
-- does not mean visible at the source level (that's isUserExported).
isExternallyVisibleName name = isGlobalName name
-- Constructors, selectors and suchlike Globals, and are all exported
-- Other Local things may or may not be exported
isUserExportedName (Name { n_sort = Exported }) = True
isUserExportedName (Name { n_sort = Global _ }) = True
isUserExportedName other = False
isSystemName (Name {n_sort = System}) = True
......@@ -354,7 +366,7 @@ ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n)
isDllName :: Name -> Bool
-- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static &&
not (isLocallyDefinedName nm) && -- isLocallyDefinedName test needed 'cos
not (nameIsLocallyDefined nm) && -- isLocallyDefinedName test needed 'cos
not (isModuleInThisPackage (nameModule nm)) -- nameModule won't work on local names
......@@ -494,11 +506,15 @@ getSrcLoc :: NamedThing a => a -> SrcLoc
isLocallyDefined :: NamedThing a => a -> Bool
getOccString :: NamedThing a => a -> String
toRdrName :: NamedThing a => a -> RdrName
isFrom :: NamedThing a => Module -> a -> Bool
isLocalOrFrom :: NamedThing a => Module -> a -> Bool
getSrcLoc = nameSrcLoc . getName
isLocallyDefined = isLocallyDefinedName . getName
isLocallyDefined = nameIsLocallyDefined . getName
getOccString = occNameString . getOccName
toRdrName = ifaceNameRdrName . getName
isFrom mod x = nameIsFrom mod (getName x)
isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
\end{code}
\begin{code}
......
......@@ -10,7 +10,7 @@ module HscTypes (
ModDetails(..), ModIface(..),
HomeSymbolTable, PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
lookupTable, lookupTableByModName,
lookupIface, lookupIfaceByModName,
emptyModIface,
IfaceDecls(..),
......@@ -47,8 +47,9 @@ module HscTypes (
import RdrName ( RdrNameEnv, emptyRdrEnv )
import Name ( Name, NameEnv, NamedThing,
emptyNameEnv, extendNameEnv,
lookupNameEnv, emptyNameEnv, getName, nameModule,
nameSrcLoc, nameEnvElts )
lookupNameEnv, emptyNameEnv, nameEnvElts,
isLocallyDefined, getName, nameModule,
nameSrcLoc )
import NameSet ( NameSet )
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
......@@ -200,16 +201,19 @@ emptyIfaceTable = emptyUFM
Simple lookups in the symbol table.
\begin{code}
lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a
-- We often have two Symbol- or IfaceTables, and want to do a lookup
lookupTable ht pt name
= lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod
lookupIface :: HomeIfaceTable -> PackageIfaceTable
-> Module -> Name -- The module is to use for locally-defined names
-> Maybe ModIface
-- We often have two IfaceTables, and want to do a lookup
lookupIface hit pit this_mod name
| isLocallyDefined name = lookupModuleEnv hit this_mod
| otherwise = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
where
mod = nameModule name
lookupTableByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
lookupIfaceByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
-- We often have two Symbol- or IfaceTables, and want to do a lookup
lookupTableByModName ht pt mod
lookupIfaceByModName ht pt mod
= lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
\end{code}
......@@ -260,7 +264,8 @@ extendTypeEnvList env things
\begin{code}
lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing
lookupType hst pte name
= case lookupModuleEnv hst (nameModule name) of
= ASSERT2( not (isLocallyDefined name), ppr name )
case lookupModuleEnv hst (nameModule name) of
Just details -> lookupNameEnv (md_types details) name
Nothing -> lookupNameEnv pte name
\end{code}
......
......@@ -128,9 +128,6 @@ completeIface :: Maybe ModIface -- The old interface, if we have it
-- NB: 'Nothing' means that even the usages havn't changed, so there's no
-- need to write a new interface file. But even if the usages have
-- changed, the module version may not have.
--
-- The IO in the type is solely for debug output
-- In particular, dumping a record of what has changed
completeIface maybe_old_iface new_iface mod_details
= addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls })
where
......@@ -628,14 +625,13 @@ pprIface iface
, vcat (map pprExport (mi_exports iface))
, vcat (map pprUsage (mi_usages iface))
, pprIfaceDecls (vers_decls version_info)
(mi_fixities iface)
(mi_decls iface)
, pprFixities (mi_fixities iface) (dcl_tycl decls)
, pprIfaceDecls (vers_decls version_info) decls
, pprDeprecs (mi_deprecs iface)
]
where
version_info = mi_version iface
decls = mi_decls iface
exp_vers = vers_exports version_info
rule_vers = vers_rules version_info
......@@ -696,27 +692,27 @@ pprUsage (m, has_orphans, is_boot, whats_imported)
\end{code}
\begin{code}
pprIfaceDecls version_map fixity_map decls
pprIfaceDecls version_map decls
= vcat [ vcat [ppr i <+> semi | i <- dcl_insts decls]
, vcat (map ppr_decl (dcl_tycl decls))
, pprRules (dcl_rules decls)
]
where
ppr_decl d = (ppr_vers d <+> ppr d <> semi) $$ ppr_fixes d
ppr_decl d = ppr_vers d <+> ppr d <> semi
-- Print the version for the decl
ppr_vers d = case lookupNameEnv version_map (tyClDeclName d) of
Nothing -> empty
Just v -> int v
-- Print fixities relevant to the decl
ppr_fixes d = vcat [ ppr fix <+> ppr n <> semi
| (n,_) <- tyClDeclNames d,
Just fix <- [lookupNameEnv fixity_map n]
]
\end{code}
\begin{code}
pprFixities fixity_map decls
= hsep [ ppr fix <+> ppr n
| d <- decls,
(n,_) <- tyClDeclNames d,
Just fix <- [lookupNameEnv fixity_map n]] <> semi
pprRules [] = empty
pprRules rules = hsep [ptext SLIT("{-## __R"), vcat (map ppr rules), ptext SLIT("##-}")]
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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}
......@@ -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}
......
......@@ -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
......
......@@ -42,7 +42,8 @@ import Class ( classTyVars, classBigSig, classSelIds, classTyCon, classTvsFds,
import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
import DataCon ( mkDataCon, notMarkedStrict )
import Id ( Id, idType, idName )
import Name ( Name, isLocallyDefined, NamedThing(..),
import Module ( Module )
import Name ( Name, NamedThing(..), isFrom,
NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv,
plusNameEnv, nameEnvElts )
import NameSet ( emptyNameSet )
......@@ -296,8 +297,8 @@ tcClassSig rec_env clas clas_tyvars fds dm_info
and superclass dictionary.
\begin{code}
mkImplicitClassBinds :: [Class] -> NF_TcM ([Id], TcMonoBinds)
mkImplicitClassBinds classes
mkImplicitClassBinds :: Module -> [Class] -> NF_TcM ([Id], TcMonoBinds)
mkImplicitClassBinds this_mod classes
= returnNF_Tc (concat cls_ids_s, andMonoBindList binds_s)
-- The selector binds are already in the selector Id's unfoldings
-- We don't return the data constructor etc from the class,
......@@ -308,8 +309,8 @@ mkImplicitClassBinds classes
mk_implicit clas = (sel_ids, binds)
where
sel_ids = classSelIds clas
binds | isLocallyDefined clas = idsToMonoBinds sel_ids
| otherwise = EmptyMonoBinds
binds | isFrom this_mod clas = idsToMonoBinds sel_ids
| otherwise = EmptyMonoBinds