mkTopName, mkIPName,
mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
- nameUnique, setNameUnique, setNameProvenance, getNameProvenance,
- setNameImportReason, tidyTopName,
- nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule,
+ nameUnique, setNameUnique, setLocalNameSort,
+ tidyTopName,
+ nameOccName, nameModule, setNameOcc, nameRdrName, setNameModuleAndLoc,
toRdrName, hashName,
isUserExportedName, isUserImportedName, isUserImportedExplicitlyName,
lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv,
- -- Provenance
- Provenance(..), ImportReason(..), pprProvenance,
- ExportFlag(..), PrintUnqualified,
- pprNameProvenance, hasBetterProv,
-
-- Class NamedThing and overloaded friends
NamedThing(..),
getSrcLoc, isLocallyDefined, getOccString, toRdrName
\begin{code}
data Name = Name {
n_sort :: NameSort, -- What sort of name it is
- n_uniq :: Unique,
n_occ :: OccName, -- Its occurrence name
- n_prov :: Provenance -- How it was made
+ n_uniq :: Unique,
+ n_loc :: SrcLoc -- Definition site
}
data NameSort
- = Local
- | Global Module
+ = Global Module -- (a) TyCon, Class, their derived Ids, dfun Id
+ -- (b) imported Id
+
+ | Exported -- An exported Ids defined in the module being compiled
+
+ | Local -- A user-defined, but non-exported Id or TyVar,
+ -- defined in the module being compiled
+
+ | System -- A system-defined Id or TyVar. Typically the
+ -- OccName is very uninformative (like 's')
\end{code}
-Things with a @Global@ name are given C static labels, so they finally
-appear in the .o file's symbol table. They appear in the symbol table
-in the form M.n. If originally-local things have this property they
-must be made @Global@ first.
+Notes about the NameSorts:
+
+1. An Exported Id is changed to Global right at the
+ end in the tidyCore pass, so that an importer sees a Global
+ Similarly, Local Ids that are visible to an importer (e.g. when
+ optimisation is on) are changed to Globals.
+
+2. Things with a @Global@ name are given C static labels, so they finally
+ appear in the .o file's symbol table. They appear in the symbol table
+ in the form M.n. If originally-local things have this property they
+ must be made @Global@ first.
+
+3. A System Name differs in the following ways:
+ a) has unique attached when printing dumps
+ b) unifier eliminates sys tyvars in favour of user provs where possible
+
+ Before anything gets printed in interface files or output code, it's
+ fed through a 'tidy' processor, which zaps the OccNames to have
+ unique names; and converts all sys-locals to user locals
+ If any desugarer sys-locals have survived that far, they get changed to
+ "ds1", "ds2", etc.
+
+\begin{code}
+nameUnique :: Name -> Unique
+nameOccName :: Name -> OccName
+nameModule :: Name -> Module
+nameSrcLoc :: Name -> SrcLoc
+
+nameUnique name = n_uniq name
+nameOccName name = n_occ name
+nameSrcLoc name = n_loc name
+nameModule (Name { n_sort = Global mod }) = mod
+nameModule name = pprPanic "nameModule" (ppr name)
+\end{code}
+
+\begin{code}
+isLocallyDefinedName :: Name -> Bool
+isUserExportedName :: Name -> Bool
+isLocalName :: Name -> Bool -- Not globala
+isGlobalName :: Name -> Bool
+isSystemName :: Name -> Bool
+isExternallyVisibleName :: Name -> Bool
+
+isGlobalName (Name {n_sort = Global _}) = True
+isGlobalName other = False
+
+isLocalName name = not (isGlobalName name)
+
+isLocallyDefinedName name = isLocalName name
+
+-- 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).
+isExternallyVisibleName name = isGlobalName name
+
+isUserExportedName (Name { n_sort = Exported }) = True
+isUserExportedName other = False
+
+isSystemName (Name {n_sort = System}) = True
+isSystemName other = False
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Making names}
+%* *
+%************************************************************************
\begin{code}
mkLocalName :: Unique -> OccName -> SrcLoc -> Name
-mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ,
- n_prov = LocalDef loc NotExported }
+mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, n_loc = loc }
-- NB: You might worry that after lots of huffing and
-- puffing we might end up with two local names with distinct
-- uniques, but the same OccName. Indeed we can, but that's ok
-- file. This is useful when trying to decide which of two type
-- variables should 'win' when unifying them.
-- NB: this is only for non-top-level names, so we use ImplicitImport
-mkImportedLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ,
- n_prov = NonLocalDef ImplicitImport True }
+ --
+ -- Oct 00: now that Names lack Provenances, mkImportedLocalName doesn't make
+ -- sense any more, so it's just the same as mkLocalName
+mkImportedLocalName uniq occ loc = mkLocalName uniq occ loc
-mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
+mkGlobalName :: Unique -> Module -> OccName -> SrcLoc -> Name
mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod,
- n_occ = occ, n_prov = prov }
+ n_occ = occ, n_loc = loc }
mkKnownKeyGlobal :: RdrName -> Unique -> Name
mkKnownKeyGlobal rdr_name uniq
= mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name))
(rdrNameOcc rdr_name)
- systemProvenance
+ builtinSrcLoc
mkWiredInName :: Module -> OccName -> Unique -> Name
-mkWiredInName mod occ uniq = mkGlobalName uniq mod occ systemProvenance
+mkWiredInName mod occ uniq = mkGlobalName uniq mod occ builtinSrcLoc
mkSysLocalName :: Unique -> UserFS -> Name
-mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local,
- n_occ = mkVarOcc fs, n_prov = systemProvenance }
+mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = System,
+ n_occ = mkVarOcc fs, n_loc = noSrcLoc }
mkCCallName :: Unique -> EncodedString -> Name
-- The encoded string completely describes the ccall
mkCCallName uniq str = Name { n_uniq = uniq, n_sort = Local,
n_occ = mkCCallOcc str,
- n_prov = NonLocalDef ImplicitImport True }
+ n_prov = noSrcLoc }
mkTopName :: Unique -> Module -> FAST_STRING -> Name
-- Make a top-level name; make it Global if top-level
-- We have to make sure that the name is globally unique
-- and we don't have tidyCore to help us. So we append
-- the unique. Hack! Hack!
+ -- (Used only by the STG lambda lifter.)
mkTopName uniq mod fs
= Name { n_uniq = uniq,
n_sort = mk_top_sort mod,
n_occ = mkVarOcc (_PK_ ((_UNPK_ fs) ++ show uniq)),
- n_prov = LocalDef noSrcLoc NotExported }
+ n_loc = noSrcLoc }
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
-- This is used by the tidy-up pass
setNameOcc name occ = name {n_occ = occ}
-setNameModule :: Name -> Module -> Name
-setNameModule name mod = name {n_sort = set (n_sort name)}
+setNameModuleAndLoc :: Name -> Module -> SrcLoc -> Name
+setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc}
where
- set (Global _) = Global mod
+ set (Global _) = Global mod
+
+setLocalNameSort :: Name -> Bool -> Name
+ -- Set the name's sort to Local or Exported, depending on the boolean
+setLocalNameSort name is_exported = name { n_sort = if is_exported then Exported
+ else Local }
\end{code}
%************************************************************************
%* *
-\subsection{Setting provenance and visibility
+\subsection{Tidying a name}
%* *
%************************************************************************
tidyTopName is applied to top-level names in the final program
-For top-level things, it globalises Local names
- (if all top-level things should be visible)
- and localises non-exported Global names
- (if only exported things should be visible)
+For top-level things,
+ it globalises Local names
+ (if all top-level things should be visible)
+ and localises non-exported Global names
+ (if only exported things should be visible)
In all cases except an exported global, it gives it a new occurrence name.
(env', occ') = tidyOccName env (n_occ name)
name' = Name { n_uniq = n_uniq name, n_sort = mk_top_sort mod,
- n_occ = occ', n_prov = LocalDef noSrcLoc NotExported }
+ n_occ = occ', n_loc = n_loc name }
mk_top_sort mod | all_toplev_ids_visible = Global mod
| otherwise = Local
\end{code}
-\begin{code}
-setNameProvenance :: Name -> Provenance -> Name
- -- setNameProvenance used to only change the provenance of
- -- Implicit-provenance things, but that gives bad error messages
- -- for names defined twice in the same module, so I changed it to
- -- set the provenance of *any* global (SLPJ Jun 97)
-setNameProvenance name prov = name {n_prov = prov}
-
-getNameProvenance :: Name -> Provenance
-getNameProvenance name = n_prov name
-
-setNameImportReason :: Name -> ImportReason -> Name
-setNameImportReason name reason
- = name { n_prov = new_prov }
- where
- -- It's important that we don't do the pattern matching
- -- in the top-level clause, else we get a black hole in
- -- the renamer. Rather a yukky constraint. There's only
- -- one call, in RnNames
- old_prov = n_prov name
- new_prov = case old_prov of
- NonLocalDef _ omit -> NonLocalDef reason omit
- other -> old_prov
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Provenance and export info}
-%* *
-%************************************************************************
-
-\begin{code}
-data Provenance
- = LocalDef -- Defined locally
- SrcLoc -- Defn site
- ExportFlag -- Whether it's exported
-
- | NonLocalDef -- Defined non-locally
- ImportReason
- PrintUnqualified
-
- | SystemProv -- Either (a) a system-generated local with
- -- a v short name OccName
- -- or (b) a known-key global which should have a proper
- -- provenance attached by the renamer
-\end{code}
-
-Sys-provs are only used internally. When the compiler generates (say)
-a fresh desguar variable it always calls it "ds", and of course it gets
-a fresh unique. But when printing -ddump-xx dumps, we must print it with
-its unique, because there'll be a lot of "ds" variables.
-
-Names with SystemProv differ in the following ways:
- a) locals have unique attached when printing dumps
- b) unifier eliminates sys tyvars in favour of user provs where possible
- c) renamer replaces SystemProv with a better one
-
-Before anything gets printed in interface files or output code, it's
-fed through a 'tidy' processor, which zaps the OccNames to have
-unique names; and converts all sys-locals to user locals
-If any desugarer sys-locals have survived that far, they get changed to
-"ds1", "ds2", etc.
-
-\begin{code}
-data ImportReason
- = UserImport Module SrcLoc Bool -- Imported from module M on line L
- -- Note the M may well not be the defining module
- -- for this thing!
- -- The Bool is true iff the thing was named *explicitly* in the import spec,
- -- rather than being imported as part of a group; e.g.
- -- import B
- -- import C( T(..) )
- -- Here, everything imported by B, and the constructors of T
- -- are not named explicitly; only T is named explicitly.
- -- This info is used when warning of unused names.
-
- | ImplicitImport -- Imported implicitly for some other reason
-
-
-type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is
- -- in scope in this module, so print it
- -- unqualified in error messages
-
-data ExportFlag = Exported | NotExported
-\end{code}
-
-Something is "Exported" if it may be mentioned by another module without
-warning. The crucial thing about Exported things is that they must
-never be dropped as dead code, even if they aren't used in this module.
-Furthermore, being Exported means that we can't see all call sites of the thing.
-
-Exported things include:
-
- - explicitly exported Ids, including data constructors,
- class method selectors
-
- - dfuns from instance decls
-
-Being Exported is *not* the same as finally appearing in the .o file's
-symbol table. For example, a local Id may be mentioned in an Exported
-Id's unfolding in the interface file, in which case the local Id goes
-out too.
-
-
-\begin{code}
-systemProvenance :: Provenance
-systemProvenance = SystemProv
-
--- pprNameProvenance is used in error messages to say where a name came from
-pprNameProvenance :: Name -> SDoc
-pprNameProvenance name = pprProvenance (getNameProvenance name)
-
-pprProvenance :: Provenance -> SDoc
-pprProvenance SystemProv = ptext SLIT("System")
-pprProvenance (LocalDef loc _) = ptext SLIT("defined at") <+> ppr loc
-pprProvenance (NonLocalDef ImplicitImport _)
- = ptext SLIT("implicitly imported")
-pprProvenance (NonLocalDef (UserImport mod loc _) _)
- = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
-\end{code}
-
%************************************************************************
%* *
%************************************************************************
\begin{code}
-nameUnique :: Name -> Unique
-nameOccName :: Name -> OccName
-nameModule :: Name -> Module
-nameSrcLoc :: Name -> SrcLoc
-isLocallyDefinedName :: Name -> Bool
-isUserExportedName :: Name -> Bool
-isLocalName :: Name -> Bool
-isGlobalName :: Name -> Bool
-isExternallyVisibleName :: Name -> Bool
-
-
-
hashName :: Name -> Int
hashName name = iBox (u2i (nameUnique name))
-nameUnique name = n_uniq name
-nameOccName name = n_occ name
-
-nameModule name =
- case n_sort name of
- Local -> pprPanic "nameModule" (ppr name)
- x -> nameSortModule x
-
-nameSortModule (Global mod) = mod
nameRdrName :: Name -> RdrName
-- Makes a qualified name for top-level (Global) names, whether locally defined or not
-- and an unqualified name just for Locals
-nameRdrName (Name { n_sort = Local, n_occ = occ }) = mkRdrUnqual occ
-nameRdrName (Name { n_sort = sort, n_occ = occ }) = mkRdrQual (moduleName (nameSortModule sort)) occ
+nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrQual (moduleName mod) occ
+nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ
ifaceNameRdrName :: Name -> RdrName
-- Makes a qualified naem for imported things,
ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n)
| otherwise = mkRdrQual (moduleName (nameModule n)) (nameOccName n)
-isUserExportedName (Name { n_prov = LocalDef _ Exported }) = True
-isUserExportedName other = False
-
-isUserImportedExplicitlyName (Name { n_prov = NonLocalDef (UserImport _ _ explicit) _ }) = explicit
-isUserImportedExplicitlyName other = False
-
-isUserImportedName (Name { n_prov = NonLocalDef (UserImport _ _ _) _ }) = True
-isUserImportedName other = False
-
-maybeUserImportedFrom (Name { n_prov = NonLocalDef (UserImport m _ _) _ }) = Just m
-maybeUserImportedFrom other = Nothing
-
isDllName :: Name -> Bool
-- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static &&
- not (isLocallyDefinedName nm) &&
--- isLocallyDefinedName test is needed because nameModule won't work on local names
- not (isLocalModule (nameModule nm))
-
-nameSrcLoc name = provSrcLoc (n_prov name)
+ not (isLocallyDefinedName nm) && -- isLocallyDefinedName test needed 'cos
+ not (isLocalModule (nameModule nm)) -- nameModule won't work on local names
-provSrcLoc (LocalDef loc _) = loc
-provSrcLoc (NonLocalDef (UserImport _ loc _) _) = loc
-provSrcLoc other = noSrcLoc
-
-isLocallyDefinedName (Name {n_sort = Local}) = True -- Local (might have SystemProv)
-isLocallyDefinedName (Name {n_prov = LocalDef _ _}) = True -- Global, but defined here
-isLocallyDefinedName other = False -- Other
-isLocalName (Name {n_sort = Local}) = True
-isLocalName _ = False
-
-isGlobalName (Name {n_sort = Local}) = False
-isGlobalName other = True
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
--- 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).
-isExternallyVisibleName name = isGlobalName name
-
-hasBetterProv :: Name -> Name -> Bool
--- Choose
--- a local thing over an imported thing
--- a user-imported thing over a non-user-imported thing
--- an explicitly-imported thing over an implicitly imported thing
-hasBetterProv n1 n2
- = case (n_prov n1, n_prov n2) of
- (LocalDef _ _, _ ) -> True
- (NonLocalDef (UserImport _ _ True) _, _ ) -> True
- (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
- other -> False
-
-isSystemName (Name {n_prov = SystemProv}) = True
-isSystemName other = False
\end{code}
module SrcLoc (
SrcLoc, -- Abstract
- mkSrcLoc,
- noSrcLoc, isNoSrcLoc, -- "I'm sorry, I haven't a clue"
+ mkSrcLoc, isGoodSrcLoc,
+ noSrcLoc, -- "I'm sorry, I haven't a clue"
- mkIfaceSrcLoc, -- Unknown place in an interface
- -- (this one can die eventually ToDo)
-
- mkBuiltinSrcLoc, -- Something wired into the compiler
-
- mkGeneratedSrcLoc, -- Code generated within the compiler
+ importedSrcLoc, -- Unknown place in an interface
+ builtinSrcLoc, -- Something wired into the compiler
+ generatedSrcLoc, -- Code generated within the compiler
incSrcLine, replaceSrcLine,
this is the obvious stuff:
\begin{code}
data SrcLoc
- = NoSrcLoc
-
- | SrcLoc FAST_STRING -- A precise location (file name)
+ = SrcLoc FAST_STRING -- A precise location (file name)
FastInt
| UnhelpfulSrcLoc FAST_STRING -- Just a general indication
+
+ | NoSrcLoc
\end{code}
Note that an entity might be imported via more than one route, and
Things to make 'em:
\begin{code}
-noSrcLoc = NoSrcLoc
-mkSrcLoc x y = SrcLoc x (iUnbox y)
-
-mkIfaceSrcLoc = UnhelpfulSrcLoc SLIT("<an interface file>")
-mkBuiltinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
-mkGeneratedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
+mkSrcLoc x y = SrcLoc x (iUnbox y)
+noSrcLoc = NoSrcLoc
+importedSrcLoc = UnhelpfulSrcLoc SLIT("<imported>")
+builtinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
+generatedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
-isNoSrcLoc NoSrcLoc = True
-isNoSrcLoc other = False
+isGoodSrcLoc (SrcLoc _ _) = True
+isGoodSrcLoc other = False
srcLocFile :: SrcLoc -> FAST_STRING
srcLocFile (SrcLoc fname _) = fname
-- so emacs can find the file
ppr (UnhelpfulSrcLoc s) = ptext s
-
- ppr NoSrcLoc = text "<NoSrcLoc>"
\end{code}
context | opt_PprStyle_Debug = vcat (reverse cxts) $$ cxt1
| otherwise = cxt1
- mk_msg msg
- | isNoSrcLoc loc = (loc, hang context 4 msg)
- | otherwise = addErrLocHdrLine loc context msg
+ mk_msg msg = addErrLocHdrLine loc context msg
addLoc :: LintLocInfo -> LintM a -> LintM a
addLoc extra_loc m loc scope errs warns
import Module ( Module, moduleUserString )
import Name ( mkGlobalName, nameModule, nameOccName, getOccString,
mkForeignExportOcc, isLocalName,
- NamedThing(..), Provenance(..), ExportFlag(..)
+ NamedThing(..),
)
import Type ( unUsgTy, repType,
splitTyConApp_maybe, splitFunTys, splitForAllTys,
| otherwise = nameModule name
occ = mkForeignExportOcc (nameOccName name)
- prov = LocalDef src_loc Exported
- helper_name = mkGlobalName uniq mod occ prov
+ helper_name = mkGlobalName uniq mod occ src_loc
the_app = getFun_wrapper (return_io_wrapper (mkVarApps (Var i) (tvs ++ fe_args)))
the_body = mkLams (tvs ++ wrapper_args) the_app
\section[HscTypes]{Types for the per-module compiler}
\begin{code}
-module HscTypes ( TyThing(..), GlobalSymbolTable, OrigNameEnv, AvailEnv,
- WhetherHasOrphans, ImportVersion, ExportItem,
- PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
- IfaceInsts, IfaceRules, DeprecationEnv, ModDetails(..),
- InstEnv, lookupTypeEnv )
-where
+module HscTypes (
+ ModDetails(..), GlobalSymbolTable,
+
+ TyThing(..), lookupTypeEnv,
+
+ WhetherHasOrphans, ImportVersion, ExportItem,
+ PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
+ IfaceInsts, IfaceRules, DeprecationEnv, OrigNameEnv, AvailEnv,
+
+ InstEnv,
+
+ -- Provenance
+ Provenance(..), ImportReason(..), PrintUnqualified,
+ pprProvenance, hasBetterProv
+
+ ) where
#include "HsVersions.h"
= ModDetails {
moduleId :: Module,
moduleExports :: Avails, -- What it exports
+ mdVersion :: VersionInfo,
moduleEnv :: GlobalRdrEnv, -- Its top level environment
fixityEnv :: NameEnv Fixity,
Simple lookups in the symbol table.
\begin{code}
-lookupFixityEnv :: SymbolTable -> Name -> Fixity
+lookupFixityEnv :: SymbolTable -> Name -> Maybe Fixity
-- Returns defaultFixity if there isn't an explicit fixity
lookupFixityEnv tbl name
= case lookupModuleEnv tbl (nameModule name) of
- Nothing -> defaultFixity
- Just details -> case lookupNameEnv (fixityEnv details) name of
- Just fixity -> fixity
- Nothing -> defaultFixity
+ Nothing -> Nothing
+ Just details -> lookupNameEnv (fixityEnv details) name
\end{code}
but they are mostly elaborated elsewhere
\begin{code}
-type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation
+data VersionInfo
+ = VersionInfo {
+ modVers :: Version,
+ fixVers :: Version,
+ ruleVers :: Version,
+ declVers :: NameEnv Version
+ }
-type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes
- -- These only get reported on lookup,
- -- not on construction
+type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
-- '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
-
\end{code}
prsInsts :: IfaceInsts,
prsRules :: IfaceRules
}
+\end{code}
+
+The OrigNameEnv makes sure that there is just one Unique assigned for
+each original name; i.e. (module-name, occ-name) pair. The Name is
+always stored as a Global, and has the SrcLoc of its binding location.
+Actually that's not quite right. When we first encounter the original
+name, we might not be at its binding site (e.g. we are reading an
+interface file); so we give it 'noSrcLoc' then. Later, when we find
+its binding site, we fix it up.
+
+Exactly the same is true of the Module stored in the Name. When we first
+encounter the occurrence, we may not know the details of the module, so
+we just store junk. Then when we find the binding site, we fix it up.
+\begin{code}
data OrigNameEnv
- = Orig { origNames :: FiniteMap (Module,OccName) Name, -- Ensures that one original name gets one unique
- origIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique
+ = Orig { origNames :: FiniteMap (ModuleName,OccName) Name, -- Ensures that one original name gets one unique
+ origIParam :: FiniteMap OccName Name -- Ensures that one implicit parameter name gets one unique
}
+\end{code}
-type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
- -- A DeclsMap contains a binding for each Name in the declaration
- -- including the constructors of a type decl etc.
- -- The Bool is True just for the 'main' Name.
+
+A DeclsMap contains a binding for each Name in the declaration
+including the constructors of a type decl etc. The Bool is True just
+for the 'main' Name.
+
+\begin{code}
+type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameHsDecl))
type IfaceInsts = Bag GatedDecl
type IfaceRules = Bag GatedDecl
\end{code}
+%************************************************************************
+%* *
+\subsection{Provenance and export info}
+%* *
+%************************************************************************
+
+The GlobalRdrEnv gives maps RdrNames to Names. There is a separate
+one for each module, corresponding to that module's top-level scope.
+
+\begin{code}
+type GlobalRdrEnv = RdrNameEnv [(Name,Provenance)] -- The list is because there may be name clashes
+ -- These only get reported on lookup,
+ -- not on construction
+\end{code}
+
+The "provenance" of something says how it came to be in scope.
+
+\begin{code}
+data Provenance
+ = LocalDef -- Defined locally
+
+ | NonLocalDef -- Defined non-locally
+ ImportReason
+ PrintUnqualified
+
+data ImportReason
+ = UserImport Module SrcLoc Bool -- Imported from module M on line L
+ -- Note the M may well not be the defining module
+ -- for this thing!
+ -- The Bool is true iff the thing was named *explicitly* in the import spec,
+ -- rather than being imported as part of a group; e.g.
+ -- import B
+ -- import C( T(..) )
+ -- Here, everything imported by B, and the constructors of T
+ -- are not named explicitly; only T is named explicitly.
+ -- This info is used when warning of unused names.
+
+ | ImplicitImport -- Imported implicitly for some other reason
+
+
+type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is
+ -- in scope in this module, so print it
+ -- unqualified in error messages
+\end{code}
+
+\begin{code}
+hasBetterProv :: Provenance -> Provenance -> Bool
+-- Choose
+-- a local thing over an imported thing
+-- a user-imported thing over a non-user-imported thing
+-- an explicitly-imported thing over an implicitly imported thing
+hasBetterProv LocalDef _ = True
+hasBetterProv (NonLocalDef (UserImport _ _ True) _) _ = True
+hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport _) = True
+hasBetterProv _ _ = False
+
+pprNameProvenance :: Name -> Provenance -> SDoc
+pprProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
+pprProvenance name (NonLocalDef why _) = sep [ppr_reason why,
+ nest 2 (parens (ppr_defn (nameSrcLoc name)))]
+
+ppr_reason ImplicitImport = ptext SLIT("implicitly imported")
+ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
+
+ppr_defn loc | isGoodSrcLoc loc = ptext SLIT("at") <+> ppr loc
+ | otherwise = empty
+\end{code}
\begin{code}
-type RenameResult = ( Module -- This module
+type RenameResult = ( PersistentCompilerState,
+ , Module -- This module
, RenamedHsModule -- Renamed module
, Maybe ParsedIface -- The existing interface file, if any
, ParsedIface -- The new interface
- , RnNameSupply -- Final env; for renaming derivings
- , FixityEnv -- The fixity environment; for derivings
, [Module]) -- Imported modules
-renameModule :: PersistentCompilerState -> GlobalSymbolTable
+renameModule :: PersistentCompilerState -> HomeSymbolTable
-> RdrNameHsModule -> IO (Maybe RenameResult)
-renameModule pcs gst this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
+renameModule old_pcs hst this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
= -- Initialise the renamer monad
do {
- ((maybe_rn_stuff, dump_action), msgs)
- <- initRn dflags finder gst prs
- (mkThisModule mod_name)
- (mkSearchPath opt_HiMap) loc
- (rename this_mod) ;
+ ((maybe_rn_stuff, dump_action), msgs, new_pcs)
+ <- initRn dflags finder old_pcs hst loc (rename this_mod) ;
-- Check for warnings
printErrorsAndWarnings msgs ;
-- Return results
if not (isEmptyBag rn_errs_bag) then
- do { ghcExit 1 ; return Nothing }
+ return (old_pcs, Nothing)
else
- return maybe_rn_stuff
+ return (new_pcs, maybe_rn_stuff)
}
\end{code}
`thenRn_` returnRn acc
| otherwise -> returnRn acc ;
- Just (name:_) ->
+ Just ((name,_):_) ->
-- Check for duplicate fixity decl
case lookupNameEnv acc name of {
, case parent_avail of { AvailTC _ _ -> True; other -> False }
]
- defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
- defined_but_not_used =
- nameSetToList (defined_names `minusNameSet` really_used_names)
+ defined_names, defined_but_not_used :: [(Name,Provenance)]
+ defined_names = concat (rdrEnvElts gbl_env)
+ defined_but_not_used = filter not_used defined_names
+ not_used name = not (name `elemNameSet` really_used_names)
-- Filter out the ones only defined implicitly
- bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
- bad_imp_names = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n,
- not (module_unused n)]
+ bad_locals :: [Name]
+ bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
+
+ bad_imp_names :: [(Name,Provenance)]
+ bad_imp_names = [(n,p) | (n,p@(UserImport mod _ True) <- defined_but_not_used,
+ not (module_unused mod)]
deprec_used deprec_env = [ (n,txt)
| n <- nameSetToList mentioned_names,
not (maybeToBool (lookupFM minimal_imports m)),
moduleName m /= pRELUDE_Name]
- module_unused :: Name -> Bool
- -- Name is imported from a module that's completely unused,
- -- so don't report stuff about the name (the module covers it)
- module_unused n = expectJust "module_unused" (maybeUserImportedFrom n)
- `elem` unused_imp_mods
- -- module_unused is only called if it's user-imported
+ module_unused :: Module -> Bool
+ module_unused mod = mod `elem` unused_imp_mods
+
in
warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
mkRdrUnqual, qualifyRdrName
)
import HsTypes ( hsTyVarName, hsTyVarNames, replaceTyVarName )
-
+import HscTypes ( pprNameProvenance )
import RnMonad
import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
ImportReason(..), getSrcLoc,
mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
mkIPName, hasBetterProv, isLocallyDefined,
nameOccName, setNameModule, nameModule,
- setNameProvenance, getNameProvenance, pprNameProvenance,
extendNameEnv_C, plusNameEnv_C, nameEnvElts
)
import NameSet
\begin{code}
implicitImportProvenance = NonLocalDef ImplicitImport False
-newTopBinder :: Module -> OccName -> RnM d Name
-newTopBinder mod occ
+newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
+newTopBinder mod rdr_name loc
= -- First check the cache
traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_`
getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
let
+ occ = rdrNameOcc rdr_name
key = (moduleName mod, occ)
in
case lookupFM cache key of
- -- A hit in the cache! We are at the binding site of the name, which is
- -- the time we know all about the Name's host Module (in particular, which
- -- package it comes from), so update the Module in the name.
- -- But otherwise *leave the Provenance alone*:
- --
- -- * For imported names, the Provenance may already be correct.
- -- e.g. We imported Prelude.hi, and set the provenance of PrelShow.Show
- -- to 'UserImport from Prelude'. Note that we havn't yet opened PrelShow.hi
- -- Later we find we really need PrelShow.Show, so we open PrelShow.hi, and
- -- that's when we find the binding occurrence of Show.
- --
- -- * For locally defined names, we do a setProvenance on the Name
- -- right after newTopBinder, and then use updateProveances to finally
- -- set the provenances in the cache correctly.
- --
- -- NB: for wired-in names it's important not to
- -- forget that they are wired in even when compiling that module
- -- (else we spit out redundant defns into the interface file)
+ -- A hit in the cache! We are at the binding site of the name, and
+ -- this is the moment when we know all about
+ -- a) the Name's host Module (in particular, which
+ -- package it comes from)
+ -- b) its defining SrcLoc
+ -- So we update this info
Just name -> let
- new_name = setNameModule name mod
+ new_name = setNameModuleAndLoc name mod loc
new_cache = addToFM cache key new_name
in
setNameSupplyRn (us, new_cache, ipcache) `thenRn_`
Nothing -> let
(us', us1) = splitUniqSupply us
uniq = uniqFromSupply us1
- new_name = mkGlobalName uniq mod occ implicitImportProvenance
+ new_name = mkGlobalName uniq mod occ loc
new_cache = addToFM cache key new_name
in
setNameSupplyRn (us', new_cache, ipcache) `thenRn_`
newGlobalName :: ModuleName -> OccName -> RnM d Name
-- Used for *occurrences*. We make a place-holder Name, really just
-- to agree on its unique, which gets overwritten when we read in
- -- the binding occurence later (newImportedBinder)
- -- The place-holder Name doesn't have the right Provenance, and its
+ -- the binding occurence later (newTopBinder)
+ -- The place-holder Name doesn't have the right SrcLoc, and its
-- Module won't have the right Package either.
--
-- (We have to pass a ModuleName, not a Module, because we may be
(us', us1) = splitUniqSupply us
uniq = uniqFromSupply us1
mod = mkVanillaModule mod_name
- name = mkGlobalName uniq mod occ implicitImportProvenance
+ name = mkGlobalName uniq mod occ noSrcLoc
new_cache = addToFM cache key name
-
newIPName rdr_name
= getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
case lookupFM ipcache key of
name = mkIPName uniq key
new_ipcache = addToFM ipcache key name
where key = (rdrNameOcc rdr_name)
-
-updateProvenances :: [Name] -> RnM d ()
--- Update the provenances of everything that is in scope.
--- We must be careful not to disturb the Module package info
--- already in the cache. Why not? Consider
--- module A module M( f )
--- import M( f ) import N( f)
--- import N
--- So f is defined in N, and M re-exports it.
--- When processing module A:
--- 1. We read M.hi first, and make a vanilla name N.f
--- (without reading N.hi). The package info says <THIS>
--- for lack of anything better.
--- 2. Now we read N, which update the cache to record
--- the correct package for N.f.
--- 3. Finally we update provenances (once we've read all imports).
--- Step 3 must not destroy package info recorded in Step 2.
-
-updateProvenances names
- = getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
- setNameSupplyRn (us, foldr update cache names, ipcache)
- where
- update name cache = addToFM_C update_prov cache key name
- where
- key = (moduleName (nameModule name), nameOccName name)
-
- update_prov name_in_cache name_with_prov
- = setNameProvenance name_in_cache (getNameProvenance name_with_prov)
\end{code}
%*********************************************************
getGlobalNameEnv `thenRn` \ global_env ->
case lookupRdrEnv global_env rdr_name of
- Just [name] -> returnRn name
- Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
- returnRn name
+ Just [(name,_)] -> returnRn name
+ Just stuff@(_:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
+ returnRn name
Nothing -> -- Not found when processing source code; so fail
failWithRn (mkUnboundName rdr_name)
(unknownNameErr rdr_name)
\begin{code}
lookupSysBinder rdr_name
= ASSERT( isUnqual rdr_name )
- getModuleRn `thenRn` \ mod ->
- newTopBinder mod (rdrNameOcc rdr_name) `thenRn` \ name ->
- getModeRn `thenRn` \ mode ->
- case mode of
- SourceMode -> getSrcLocRn `thenRn` \ loc ->
- returnRn (setNameProvenance name (LocalDef loc Exported))
- InterfaceMode -> returnRn name
+ getModuleRn `thenRn` \ mod ->
+ getSrcLocRn `thenRn` \ loc ->
+ newTopBinder mod rdr_name loc
\end{code}
-@unQualInScope@ returns a function that takes a @Name@ and tells whether
-its unqualified name is in scope. This is put as a boolean flag in
-the @Name@'s provenance to guide whether or not to print the name qualified
-in error messages.
-
-\begin{code}
-unQualInScope :: GlobalRdrEnv -> Name -> Bool
-unQualInScope env
- = lookup
- where
- lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
- Just [name'] -> name == name'
- other -> False
-\end{code}
%*********************************************************
%************************************************************************
%* *
-\subsection{Envt utility functions}
+\subsection{GlobalRdrEnv}
%* *
%************************************************************************
-\subsubsection{NameEnv}% ================
-
\begin{code}
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
-addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
+addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> (Name,Provenance) -> GlobalRdrEnv
addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
-combine_globals :: [Name] -- Old
- -> [Name] -- New
- -> [Name]
+combine_globals :: [(Name,Provenance)] -- Old
+ -> [(Name,Provenance)] -- New
+ -> [(Name,Provenance)]
combine_globals ns_old ns_new -- ns_new is often short
= foldr add ns_old ns_new
where
- add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates
+ add n ns | any (is_duplicate n) ns_old = map (choose n) ns -- Eliminate duplicates
| otherwise = n:ns
- where
- choose m | n==m && n `hasBetterProv` m = n
- | otherwise = m
+ choose n m | n `beats` m = n
+ | otherwise = m
+
+ (n,pn) `beats` (m,pm) = n==m && pn `hasBetterProv` pm
-is_duplicate :: Name -> Name -> Bool
-is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
- | otherwise = n1 == n2
+ is_duplicate :: Provenance -> (Name,Provenance) -> Bool
+ is_duplicate (n1,LocalDef _) (n2,LocalDef _) = False
+ is_duplicate _ _ = n1 == n2
\end{code}
We treat two bindings of a locally-defined name as a duplicate,
and error for that, {\em not} eliminate a duplicate.
On the other hand, if you import the same name from two different
-import statements, we {\em d}* want to eliminate the duplicate, not report
+import statements, we {\em do} want to eliminate the duplicate, not report
an error.
If a module imports itself then there might be a local defn and an imported
will still have different provenances.
+@unQualInScope@ returns a function that takes a @Name@ and tells whether
+its unqualified name is in scope. This is put as a boolean flag in
+the @Name@'s provenance to guide whether or not to print the name qualified
+in error messages.
+
+\begin{code}
+unQualInScope :: GlobalRdrEnv -> Name -> Bool
+unQualInScope env
+ = lookup
+ where
+ lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
+ Just [(name',_)] -> name == name'
+ other -> False
+\end{code}
+
-\subsubsection{AvailInfo}% ================
+%************************************************************************
+%* *
+\subsection{Avails}
+%* *
+%************************************************************************
\begin{code}
plusAvail (Avail n1) (Avail n2) = Avail n1
\end{code}
-
-
%************************************************************************
%* *
\subsection{Free variable manipulation}
%* *
%************************************************************************
-
-
\begin{code}
warnUnusedModules :: [Module] -> RnM d ()
warnUnusedModules mods
parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
quotes (pprModuleName m))]
-warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
+warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
warnUnusedImports names
| not opt_WarnUnusedImports
= returnRn () -- Don't force names unless necessary
| otherwise
- = warnUnusedBinds (const True) names
+ = warnUnusedBinds names
+warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
warnUnusedLocalBinds ns
| not opt_WarnUnusedBinds = returnRn ()
- | otherwise = warnUnusedBinds (const True) ns
+ | otherwise = warnUnusedBinds [(n,LocalDef) | n<-ns]
warnUnusedMatches names
- | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
+ | opt_WarnUnusedMatches = warnUnusedGroup [(n,LocalDef) | n<-ns]
| otherwise = returnRn ()
-------------------------
-warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
-warnUnusedBinds warn_when_local names
- = mapRn_ (warnUnusedGroup warn_when_local) groups
+warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
+warnUnusedBinds names
+ = mapRn_ warnUnusedGroup groups
where
-- Group by provenance
groups = equivClasses cmp names
- name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
+ (_,prov1) `cmp` (_,prov2) = prov1 `cmp_prov` prov2
cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
-------------------------
--- NOTE: the function passed to warnUnusedGroup is
--- now always (const True) so we should be able to
--- simplify the code slightly. I'm leaving it there
--- for now just in case I havn't realised why it was there.
--- Looks highly bogus to me. SLPJ Dec 99
-
-warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
-warnUnusedGroup emit_warning names
- | null filtered_names = returnRn ()
- | not (emit_warning is_local) = returnRn ()
+warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
+warnUnusedGroup names
+ | null filtered_names = returnRn ()
+ | not is_local = returnRn ()
| otherwise
= pushSrcLocRn def_loc $
addWarnRn $
sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
where
filtered_names = filter reportable names
- name1 = head filtered_names
+ (name1, prov1) = head filtered_names
(is_local, def_loc, msg)
- = case getNameProvenance name1 of
- LocalDef loc _ -> (True, loc, text "Defined but not used")
- NonLocalDef (UserImport mod loc _) _ ->
- (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
- text "but not used")
- other -> (False, getSrcLoc name1, text "Strangely defined but not used")
-
- reportable name = case occNameUserString (nameOccName name) of
- ('_' : _) -> False
- zz_other -> True
+ = case prov1 of
+ LocalDef loc _ -> (True, loc, text "Defined but not used")
+
+ NonLocalDef (UserImport mod loc _) _
+ -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
+
+ reportable (name,_) = case occNameUserString (nameOccName name) of
+ ('_' : _) -> False
+ zz_other -> True
-- Haskell 98 encourages compilers to suppress warnings about
-- unused names in a pattern if they start with "_".
\end{code}
\begin{code}
-addNameClashErrRn rdr_name (name1:names)
+addNameClashErrRn rdr_name (np1:nps)
= addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
where
- msg1 = ptext SLIT("either") <+> mk_ref name1
- msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
- mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
+ msg1 = ptext SLIT("either") <+> mk_ref np1
+ msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
+ mk_ref (name,prov) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
= hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
mod_map = iImpModInfo ifaces
mod_info = lookupFM mod_map mod_name
- hi_boot_file = case from of {
- ImportByUser -> False ; -- Not hi-boot
- ImportByUserSource -> True ; -- hi-boot
- ImportBySystem ->
- case mod_info of
- Just (_, is_boot, _) -> is_boot
-
- Nothing -> False
- -- We're importing a module we know absolutely
- -- nothing about, so we assume it's from
- -- another package, where we aren't doing
- -- dependency tracking. So it won't be a hi-boot file.
- }
+ hi_boot_file
+ = case (from, mod_info) of
+ (ImportByUser, _) -> False -- Not hi-boot
+ (ImportByUserSource, _) -> True -- hi-boot
+ (ImportBySystem, Just (_, is_boot, _)) -> is_boot --
+ (ImportBySystem, Nothing) -> False
+ -- We're importing a module we know absolutely
+ -- nothing about, so we assume it's from
+ -- another package, where we aren't doing
+ -- dependency tracking. So it won't be a hi-boot file.
+
redundant_source_import
= case (from, mod_info) of
(ImportByUserSource, Just (_,False,_)) -> True
- other -> False
+ other -> False
in
-- CHECK WHETHER WE HAVE IT ALREADY
case mod_info of {
- Just (_, _, Just _)
+ Just (_, _, True)
-> -- We're read it already so don't re-read it
returnRn (ifaces, Nothing) ;
(warnRedundantSourceImport mod_name) `thenRn_`
-- READ THE MODULE IN
- findAndReadIface doc_str mod_name hi_boot_file `thenRn` \ read_result ->
+ findAndReadIface doc_str mod_name hi_boot_file `thenRn` \ read_resultb ->
case read_result of {
Left err -> -- Not found, so add an empty export env to the Ifaces map
-- so that we don't look again
let
- mod = mkVanillaModule mod_name
- new_mod_map = addToFM mod_map mod_name (False, False, Just (mod, 0, 0, 0, from, []))
+ new_mod_map = addToFM mod_map mod_name (False, False, True)
new_ifaces = ifaces { iImpModInfo = new_mod_map }
in
setIfacesRn new_ifaces `thenRn_`
returnRn (new_ifaces, Just err) ;
-- Found and parsed!
- Right iface ->
+ Right (mod, iface) ->
-- LOAD IT INTO Ifaces
-- If we do loadExport first the wrong info gets into the cache (unless we
-- explicitly tag each export which seems a bit of a bore)
- getModuleRn `thenRn` \ this_mod ->
- let
- mod = pi_mod iface
- in
+
-- Sanity check. If we're system-importing a module we know nothing at all
-- about, it should be from a different package to this one
WARN( not (maybeToBool mod_info) &&
case from of { ImportBySystem -> True; other -> False } &&
isLocalModule mod,
ppr mod )
- foldlRn (loadDecl mod) (iDecls ifaces) (pi_decls iface) `thenRn` \ new_decls ->
+
+ 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) emptyDeprecEnv (pi_deprecs iface) `thenRn` \ deprec_env ->
foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
- loadRules mod (iRules ifaces) (pi_rules iface) `thenRn` \ new_rules ->
- loadFixDecls mod_name (iFixes ifaces) (pi_fixity iface) `thenRn` \ new_fixities ->
- foldlRn (loadDeprec mod) (iDeprecs ifaces) (pi_deprecs iface) `thenRn` \ new_deprecs ->
- mapRn (loadExport this_mod) (pi_exports iface) `thenRn` \ avails_s ->
+ loadExports (pi_exports iface) `thenRn` \ avails ->
let
+ version = VersionInfo { modVers = pi_vers iface,
+ fixVers = fix_vers,
+ ruleVers = rule_vers,
+ declVers = decl_vers }
+
-- For an explicit user import, add to mod_map info about
-- the things the imported module depends on, extracted
-- from its usage info.
mod_map1 = case from of
ImportByUser -> addModDeps mod (pi_usages iface) mod_map
other -> mod_map
+ mod_map2 = addToFM mod_map1 mod_name (pi_orphan iface, hi_boot_file, True)
- -- Now add info about this module
- mod_map2 = addToFM mod_map1 mod_name mod_details
- cts = (pi_mod iface, pi_vers iface,
- fst (pi_fixity iface), fst (pi_rules iface),
- from, concat avails_s)
- mod_details = (pi_orphan iface, hi_boot_file, Just cts)
+ -- Now add info about this module to the PST
+ new_pst = extendModuleEnv pst mod mod_detils
+ mod_details = ModDetails { mdModule = mod, mvVersion = version,
+ mdExports = avails,
+ mdFixEnv = fix_env, mdDeprecEnv = deprec_env }
- new_ifaces = ifaces { iImpModInfo = mod_map2,
+ new_ifaces = ifaces { iPST = new_pst,
iDecls = new_decls,
- iFixes = new_fixities,
iInsts = new_insts,
iRules = new_rules,
- iDeprecs = new_deprecs }
+ iImpModInfo = mod_map2 }
in
setIfacesRn new_ifaces `thenRn_`
returnRn (new_ifaces, Nothing)
-- import decls in the interface file
-----------------------------------------------------
-addModDeps :: Module -> [ImportVersion a]
+addModDeps :: Module -> PackageSymbolTable -> [ImportVersion a]
-> ImportedModuleInfo -> ImportedModuleInfo
-- (addModDeps M ivs deps)
-- We are importing module M, and M.hi contains 'import' decls given by ivs
-- 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
- | isLocalModule mod = [ (imp_mod, (has_orphans, is_boot, Nothing))
+ | isLocalModule mod = [ (imp_mod, (has_orphans, is_boot, False))
| (imp_mod, has_orphans, is_boot, _) <- new_deps
]
- | otherwise = [ (imp_mod, (True, False, Nothing))
+ | otherwise = [ (imp_mod, (True, False, False))
| (imp_mod, has_orphans, _, _) <- new_deps,
has_orphans
]
add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
- combine old@(_, old_is_boot, cts) new
- | maybeToBool cts || not old_is_boot = old -- Keep the old info if it's already loaded
+ combine old@(_, old_is_boot, old_is_loaded) new
+ | old_is_loaded || not old_is_boot = old -- Keep the old info if it's already loaded
-- or if it's a non-boot pending load
- | otherwise = new -- Otherwise pick new info
+ | otherwise = new -- Otherwise pick new info
-----------------------------------------------------
-- Loading the export list
-----------------------------------------------------
+loadExports :: [ExportItem] -> RnM d Avails
+loadExports items
+ = getModuleRn `thenRn` \ this_mod ->
+ mapRn (loadExport this_mod) items `thenRn` \ avails_s ->
+ returnRn (concat avails_s)
+
+
loadExport :: Module -> ExportItem -> RnM d [AvailInfo]
loadExport this_mod (mod, entities)
| mod == moduleName this_mod = returnRn []
-- Loading type/class/value decls
-----------------------------------------------------
+loadDecls :: Module
+ -> DeclsMap
+ -> [(Version, RdrNameHsDecl)]
+ -> RnM d (NameEnv Version, DeclsMap)
+loadDecls mod decls_map decls
+ = foldlRn (loadDecl mod) (emptyNameEnv, decls_map) decls
+
loadDecl :: Module
- -> DeclsMap
+ -> (NameEnv Version, DeclsMap)
-> (Version, RdrNameHsDecl)
- -> RnM d DeclsMap
-
-loadDecl mod decls_map (version, decl)
+ -> RnM d (NameEnv Version, DeclsMap)
+loadDecl mod (version_map, decls_map) (version, decl)
= getDeclBinders new_name decl `thenRn` \ maybe_avail ->
case maybe_avail of {
- Nothing -> returnRn decls_map; -- No bindings
- Just avail ->
+ Nothing -> returnRn (version_map, decls_map); -- No bindings
+ Just avail ->
getDeclSysBinders new_name decl `thenRn` \ sys_bndrs ->
let
main_name = availName avail
new_decls_map = foldl add_decl decls_map
- [ (name, (version, full_avail, name==main_name, (mod, decl')))
+ [ (name, (full_avail, name==main_name, (mod, decl')))
| name <- availNames full_avail]
add_decl decls_map (name, stuff)
= WARN( name `elemNameEnv` decls_map, ppr name )
extendNameEnv decls_map name stuff
+
+ new_version_map = extendNameEnv version_map main_name version
in
- returnRn new_decls_map
+ returnRn (new_version_map, new_decls_map)
}
where
-- newTopBinder puts into the cache the binder with the
-- There maybe occurrences that don't have the correct Module, but
-- by the typechecker will propagate the binding definition to all
-- the occurrences, so that doesn't matter
- new_name rdr_name loc = newTopBinder mod (rdrNameOcc rdr_name)
+ new_name rdr_name loc = newTopBinder mod rdr_name loc
{-
If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
-- Loading fixity decls
-----------------------------------------------------
-loadFixDecls mod_name fixity_env (version, decls)
- | null decls = returnRn fixity_env
+loadFixDecls mod_name (version, decls)
+ | null decls = returnRn (version, emptyNameEnv)
| otherwise
= mapRn (loadFixDecl mod_name) decls `thenRn` \ to_add ->
- returnRn (extendNameEnvList fixity_env to_add)
+ returnRn (version, mkNameEnv to_add)
loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
= newGlobalName mod_name (rdrNameOcc rdr_name) `thenRn` \ name ->
loadRules :: Module -> IfaceRules
-> (Version, [RdrNameRuleDecl])
- -> RnM d IfaceRules
+ -> RnM d (Version, IfaceRules)
loadRules mod rule_bag (version, rules)
| null rules || opt_IgnoreIfacePragmas
- = returnRn rule_bag
+ = returnRn (version, rule_bag)
| otherwise
= setModuleRn mod $
mapRn (loadRule mod) rules `thenRn` \ new_rules ->
- returnRn (rule_bag `unionBags` listToBag new_rules)
+ returnRn (version, rule_bag `unionBags` listToBag new_rules)
loadRule :: Module -> RdrNameRuleDecl -> RnM d GatedDecl
-- "Gate" the rule simply by whether the rule variable is
| HereItIs (Module, RdrNameHsDecl)
importDecl name
- = getSlurped `thenRn` \ already_slurped ->
- if name `elemNameSet` already_slurped then
- returnRn AlreadySlurped -- Already dealt with
+ = getIfacesRn `thenRn` \ ifaces ->
+ getHomeSymbolTableRn `thenRn` \ hst ->
+ if name `elemNameSet` iSlurp ifaces
+ || inTypeEnv (iPST ifaces) name
+ || inTypeEnv hst name
+ then -- Already dealt with
+ returnRn AlreadySlurped
else if isLocallyDefined name then -- Don't bring in decls from
-- the renamed module's own interface file
where
doc = ptext SLIT("need home module for wired in thing") <+> ppr name
-
-{- I don't think this is necessary any more; SLPJ May 00
- load_home name
- | name `elemNameSet` source_binders = returnRn ()
- -- When compiling the prelude, a wired-in thing may
- -- be defined in this module, in which case we don't
- -- want to load its home module!
- -- Using 'isLocallyDefined' doesn't work because some of
- -- the free variables returned are simply 'listTyCon_Name',
- -- with a system provenance. We could look them up every time
- -- but that seems a waste.
- | otherwise = loadHomeInterface doc name `thenRn_`
- returnRn ()
--}
-
getNonWiredInDecl :: Name -> RnMG ImportDeclResult
getNonWiredInDecl needed_name
= traceRn doc_str `thenRn_`
lookupFixityRn name
| isLocallyDefined name
= getFixityEnv `thenRn` \ local_fix_env ->
- returnRn (lookupFixity local_fix_env name)
+ returnRn (lookupLocalFixity local_fix_env name)
| otherwise -- Imported
-- For imported names, we have to get their fixities by doing a loadHomeInterface,
-- 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.
= loadHomeInterface doc name `thenRn` \ ifaces ->
- returnRn (lookupFixity (iFixes ifaces) name)
+ getHomeSymbolTableRn `thenRn` \ hst ->
+ returnRn (lookupFixityEnv hst name `orElse`
+ lookupFixityEnv (iPST ifaces) name) `orElse`
+ defaultFixity)
where
doc = ptext SLIT("Checking fixity for") <+> ppr name
\end{code}
findAndReadIface :: SDoc -> ModuleName
-> IsBootInterface -- True <=> Look for a .hi-boot file
-- False <=> Look for .hi file
- -> RnM d (Either Message ParsedIface)
+ -> RnM d (Either Message (Module, ParsedIface))
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
-- one for 'normal' ones, the other for .hi-boot files,
-- hence the need to signal which kind we're interested.
- getFinderRn `thenRn` \ finder ->
- ioToRn (finder mod_name) `thenRn` \ maybe_module ->
+ getFinderRn `thenRn` \ finder ->
+ ioToRn (findModule finder mod_name) `thenRn` \ maybe_module ->
+
case maybe_module of
- -- Found the file
- Just fpath -> traceRn (ptext SLIT("...reading from") <+> text fpath) `thenRn_`
- readIface mod_name fpath
+ Just mod | hi_boot_file, Just fpath <- moduleHiBootFile mod
+ -> readIface mod fpath
+ | not hi_boot_file, Just fpath <- moduleHiFile mod
+ -> readIface mod fpath
-- Can't find it
- Nothing -> traceRn (ptext SLIT("...not found")) `thenRn_`
- returnRn (Left (noIfaceErr mod_name hi_boot_file search_path))
+ other -> traceRn (ptext SLIT("...not found")) `thenRn_`
+ returnRn (Left (noIfaceErr finder mod_name hi_boot_file))
where
trace_msg = sep [hsep [ptext SLIT("Reading"),
@readIface@ tries just the one file.
\begin{code}
-readIface :: ModuleName -> String -> RnM d (Either Message ParsedIface)
+readIface :: Module -> String -> RnM d (Either Message (Module, ParsedIface))
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
readIface wanted_mod file_path
- = ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
+ = traceRn (ptext SLIT("...reading from") <+> text file_path) `thenRn_`
+ ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
case read_result of
Right contents ->
case parseIface contents
glasgow_exts = 1#,
loc = mkSrcLoc (mkFastString file_path) 1 } of
POk _ (PIface iface) ->
- warnCheckRn (read_mod == wanted_mod)
+ warnCheckRn (moduleName wanted_mod == read_mod)
(hiModuleNameMismatchWarn wanted_mod read_mod) `thenRn_`
- returnRn (Right iface)
+ returnRn (Right (mod, iface))
where
read_mod = moduleName (pi_mod iface)
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
<+> quotes (pprModuleName mod_name)
-hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
+hiModuleNameMismatchWarn :: Module -> ModuleName -> Message
hiModuleNameMismatchWarn requested_mod read_mod =
hsep [ ptext SLIT("Something is amiss; requested module name")
- , pprModuleName requested_mod
+ , ppr requested_mod
, ptext SLIT("differs from name found in the interface file")
, pprModuleName read_mod
]
-- We still need the unsullied global name env so that
-- we can look up record field names
- rn_fixenv :: FixityEnv -- Local fixities
+ rn_fixenv :: LocalFixityEnv -- Local fixities
-- The global fixities are held in the
-- rn_ifaces field. Why? See the comments
- -- with RnIfaces.lookupFixity
+ -- with RnIfaces.lookupLocalFixity
}
data RnMode = SourceMode -- Renaming source code
\begin{code}
--------------------------------
-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
-
---------------------------------
-type FixityEnv = NameEnv RenamedFixitySig
+type LocalRdrEnv = RdrNameEnv Name
+type LocalFixityEnv = 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
+lookupLocalFixity :: FixityEnv -> Name -> Fixity
+lookupLocalFixity env name
= case lookupNameEnv env name of
Just (FixitySig _ fix _) -> fix
Nothing -> defaultFixity
-- Subset of the previous field.
}
-type ImportedModuleInfo
- = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
-
- -- Suppose the domain element is module 'A'
- --
- -- The first Bool is True if A contains
- -- 'orphan' rules or instance decls
-
- -- The second Bool is true if the interface file actually
- -- read was an .hi-boot file
-
- -- Nothing => A's interface not yet read, but this module has
- -- imported a module, B, that itself depends on A
- --
- -- Just xx => A's interface has been read. The Module in
- -- the Just has the correct Dll flag
-
- -- This set is used to decide whether to look for
- -- A.hi or A.hi-boot when importing A.f.
- -- Basically, we look for A.hi if A is in the map, and A.hi-boot
- -- otherwise
+type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface, IsLoaded)
+type IsLoaded = True
\end{code}
-> PersistentCompilerState
-> Module -> SrcLoc
-> RnMG t
- -> IO (t, (Bag WarnMsg, Bag ErrMsg))
+ -> IO (t, PersistentCompilerState, (Bag WarnMsg, Bag ErrMsg))
initRn dflags finder hst pcs mod loc do_rn
- = do uniqs <- mkSplitUniqSupply 'r'
- names_var <- newIORef (uniqs, prsOrig prs)
- errs_var <- newIORef (emptyBag,emptyBag)
- iface_var <- newIORef (initIfaces pcs)
- let rn_down = RnDown { rn_mod = mod,
- rn_loc = loc,
-
- rn_finder = finder,
- rn_dflags = dflags,
- rn_hst = hst,
-
- rn_ns = names_var,
- rn_errs = errs_var,
- rn_ifaces = iface_var,
- }
-
- -- do the business
- res <- do_rn rn_down ()
-
- -- grab errors and return
- (warns, errs) <- readIORef errs_var
-
- return (res, (warns, errs))
+ = do
+ let prs = pcsPRS pcs
+ uniqs <- mkSplitUniqSupply 'r'
+ names_var <- newIORef (uniqs, prsOrig prs)
+ errs_var <- newIORef (emptyBag,emptyBag)
+ iface_var <- newIORef (initIfaces pcs)
+ let rn_down = RnDown { rn_mod = mod,
+ rn_loc = loc,
+
+ rn_finder = finder,
+ rn_dflags = dflags,
+ rn_hst = hst,
+
+ rn_ns = names_var,
+ rn_errs = errs_var,
+ rn_ifaces = iface_var,
+ }
+
+ -- do the business
+ res <- do_rn rn_down ()
+
+ -- Grab state and record it
+ (warns, errs) <- readIORef errs_var
+ new_ifaces <- readIORef iface_var
+ (_, new_orig) <- readIORef names_var
+
+ let new_prs = prs { prsOrig = new_orig,
+ prsDecls = iDecls new_ifaces,
+ prsInsts = iInsts new_ifaces,
+ prsRules = iRules new_ifaces }
+ let new_pcs = pcs { pcsPST = iPST new_ifaces,
+ pcsPRS = new_prs }
+
+ return (res, new_pcs, (warns, errs))
initIfaces :: PersistentCompilerState -> Ifaces
\end{code}
%================
-\subsubsection{The finder}
+\subsubsection{The finder and home symbol table}
%=====================
\begin{code}
getFinderRn :: RnM d Finder
getFinderRn down l_down = return (rn_finder down)
+
+getHomeSymbolTableRn :: RnM d HomeSymbolTable
+getHomeSymbolTableRn down l_down = return (rn_hst down)
\end{code}
%================
%=====================
\begin{code}
-getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
-getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
- = return (global_env, local_env)
-
getLocalNameEnv :: RnMS LocalRdrEnv
getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
= return local_env
setLocalNameEnv local_env' m rn_down l_down
= m rn_down (l_down {rn_lenv = local_env'})
-getFixityEnv :: RnMS FixityEnv
+getFixityEnv :: RnMS LocalFixityEnv
getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
= return fixity_env
import Module ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
import NameSet
import Name ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
- setNameProvenance,
- nameOccName, getSrcLoc, pprProvenance, getNameProvenance,
- nameEnvElts
+ setLocalNameSort, nameOccName, nameEnvElts
)
import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual, isUnqual )
import OccName ( setOccNameSpace, dataName )
returnRn Nothing
else
- -- RECORD BETTER PROVENANCES IN THE CACHE
- -- The names in the envirnoment have better provenances (e.g. imported on line x)
- -- than the names in the name cache. We update the latter now, so that we
- -- we start renaming declarations we'll get the good names
- -- The isQual is because the qualified name is always in scope
- updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList gbl_env,
- isQual rdr_name]) `thenRn_`
-
-- PROCESS EXPORT LISTS
exportsFromAvail this_mod exports all_avails gbl_env `thenRn` \ export_avails ->
filterImports imp_mod_name import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
+ let
+ mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
+ (is_unqual name))
+ in
+
qualifyImports imp_mod_name
(not qual_only) -- Maybe want unqualified names
as_mod hides
- (improveAvails imp_mod iloc explicits
- is_unqual filtered_avails)
-
-
-improveAvails imp_mod iloc explicits is_unqual avails
- -- We 'improve' the provenance by setting
- -- (a) the import-reason field, so that the Name says how it came into scope
- -- including whether it's explicitly imported
- -- (b) the print-unqualified field
- = map improve_avail avails
- where
- improve_avail (Avail n) = Avail (improve n)
- improve_avail (AvailTC n ns) = AvailTC (improve n) (map improve ns)
-
- improve name = setNameProvenance name
- (NonLocalDef (UserImport imp_mod iloc (is_explicit name))
- (is_unqual name))
- is_explicit name = name `elemNameSet` explicits
+ mk_provenance
+ filtered_avails
\end{code}
-- Build the environment
qualifyImports mod_name
- True -- Want unqualified names
- Nothing -- no 'as M'
- [] -- Hide nothing
+ True -- Want unqualified names
+ Nothing -- no 'as M'
+ [] -- Hide nothing
+ (\n -> LocalDef) -- Provenance is local
avails
-
where
mod = mkThisModule mod_name
-getLocalDeclBinders :: Module -> (Name -> ExportFlag)
+getLocalDeclBinders :: Module
+ -> (Name -> Bool) -- Is-exported predicate
-> RdrNameHsDecl -> RnMG Avails
getLocalDeclBinders mod rec_exp_fn (ValD binds)
= mapRn do_one (bagToList (collectTopBinders binds))
Just avail -> returnRn [avail]
newLocalName mod rec_exp_fn rdr_name loc
- = check_unqual rdr_name loc `thenRn_`
- newTopBinder mod (rdrNameOcc rdr_name) `thenRn` \ name ->
- returnRn (setNameProvenance name (LocalDef loc (rec_exp_fn name)))
+ = check_unqual rdr_name loc `thenRn_`
+ newTopBinder mod rdr_name loc `thenRn` \ name ->
+ returnRn (setLocalNameSort name (rec_exp_fn name))
where
-- There should never be a qualified name in a binding position (except in instance decls)
-- The parser doesn't check this because the same parser parses instance decls
-> Bool -- True <=> want unqualified import
-> Maybe ModuleName -- Optional "as M" part
-> [AvailInfo] -- What's to be hidden
+ -> (Name -> Provenance)
-> Avails -- Whats imported and how
-> RnMG (GlobalRdrEnv, ExportAvails)
-qualifyImports this_mod unqual_imp as_mod hides avails
+qualifyImports this_mod unqual_imp as_mod hides mk_provenance avails
=
-- Make the name environment. We're talking about a
-- single module here, so there must be no name clashes.
| unqual_imp = env2
| otherwise = env1
where
- env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) name
- env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) name
+ env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) (name,prov)
+ env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov)
occ = nameOccName name
+ prov = mk_provenance name
del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
where
where
rdr_name = ieName ie
maybe_in_scope = lookupFM global_name_env rdr_name
- Just (name:dup_names) = maybe_in_scope
+ Just ((name,_):dup_names) = maybe_in_scope
maybe_avail = lookupUFM entity_avail_env name
Just avail = maybe_avail
maybe_export_avail = filterAvail ie avail
dupDeclErr (n:ns)
= vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
- nest 4 (vcat (map pp sorted_ns))]
+ nest 4 (vcat (map ppr sorted_locs))]
where
- sorted_ns = sortLt occ'ed_before (n:ns)
-
- occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
-
- pp n = pprProvenance (getNameProvenance n)
+ sorted_locs = sortLt occ'ed_before (map nameSrcLoc (n:ns))
+ occ'ed_before a b = LT == compare a b
dupExportWarn occ_name ie1 ie2
= hsep [quotes (ppr occ_name),
)
import IdInfo ( StrictnessInfo(..), ArityInfo, atLeastArity, setOccInfo, vanillaIdInfo )
import Maybes ( maybeToBool, catMaybes )
-import Name ( isLocalName, setNameUnique )
+import Name ( setNameUnique )
import Demand ( Demand, isStrict, wwLazy, wwLazy )
import SimplMonad
import Type ( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType, repType,
tcGetUnique `thenNF_Tc` \ uniq ->
returnNF_Tc (mkGlobalName uniq mod
(mkDFunOcc dfun_string inst_uniq)
- (LocalDef loc Exported))
+ loc)
where
-- Any string that is somewhat unique will do
dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
= tcGetUnique `thenNF_Tc` \ uniq ->
returnNF_Tc (mkGlobalName uniq (nameModule op_name)
(mkDefaultMethodOcc (getOccName op_name))
- (LocalDef loc Exported))
+ loc)
\end{code}
import VarEnv
import VarSet
-import Name ( Name, Provenance(..), ExportFlag(..),
- mkGlobalName, mkKindOccFS, tcName,
- )
+import Name ( Name, mkGlobalName, mkKindOccFS, tcName )
import OccName ( mkOccFS, tcName )
import TyCon ( TyCon, KindCon,
mkFunTyCon, mkKindCon, mkSuperKindCon,
import Class ( Class )
-- others
-import SrcLoc ( mkBuiltinSrcLoc )
+import SrcLoc ( builtinSrcLoc )
import PrelNames ( pREL_GHC, kindConKey, boxityConKey, boxedConKey,
unboxedConKey, typeConKey, anyBoxConKey, funTyConName
)
\begin{code}
-mk_kind_name key str = mkGlobalName key pREL_GHC (mkKindOccFS tcName str)
- (LocalDef mkBuiltinSrcLoc NotExported)
+mk_kind_name key str = mkGlobalName key pREL_GHC (mkKindOccFS tcName str) builtinSrcLoc
-- mk_kind_name is a bit of a hack
-- The LocalDef means that we print the name without
-- a qualifier, which is what we want for these kinds.
projects / ghc-hetmet.git / commitdiff