-- The Name type
Name, -- Abstract
- mkLocalName, mkImportedLocalName, mkSysLocalName,
- mkTopName,
- mkDerivedName, mkGlobalName,
+ mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
+ mkTopName, mkIPName,
+ mkDerivedName, mkGlobalName, mkKnownKeyGlobal,
mkWiredInIdName, mkWiredInTyConName,
+ mkUnboundName, isUnboundName,
+
maybeWiredInIdName, maybeWiredInTyConName,
- isWiredInName,
+ isWiredInName, hashName,
nameUnique, setNameUnique, setNameProvenance, getNameProvenance, setNameImportReason,
tidyTopName,
- nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule,
+ nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule, toRdrName,
- isExportedName, nameSrcLoc,
- isLocallyDefinedName,
+ isUserExportedName, isUserImportedName, isUserImportedExplicitlyName,
+ maybeUserImportedFrom,
+ nameSrcLoc, isLocallyDefinedName, isDllName,
isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
+ -- Environment
+ NameEnv,
+ emptyNameEnv, unitNameEnv, nameEnvElts,
+ addToNameEnv_C, addToNameEnv, addListToNameEnv,
+ plusNameEnv, plusNameEnv_C, extendNameEnv,
+ lookupNameEnv, delFromNameEnv, elemNameEnv,
+
-- Provenance
Provenance(..), ImportReason(..), pprProvenance,
ExportFlag(..), PrintUnqualified,
- pprNameProvenance, systemProvenance, hasBetterProv,
+ pprNameProvenance, hasBetterProv,
-- Class NamedThing and overloaded friends
NamedThing(..),
- isExported,
- getSrcLoc, isLocallyDefined, getOccString
+ getSrcLoc, isLocallyDefined, getOccString, toRdrName
) where
#include "HsVersions.h"
import {-# SOURCE #-} TyCon ( TyCon, setTyConName )
import OccName -- All of it
-import Module
-import RdrName ( RdrName, mkRdrQual, mkRdrUnqual )
-import CmdLineOpts ( opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
+import Module ( Module, moduleName, pprModule, mkVanillaModule, isLocalModule )
+import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
+import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
-import Unique ( pprUnique, Unique, Uniquable(..) )
+import Unique ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i )
+import UniqFM
import Outputable
import GlaExts
\end{code}
n_occ = occ, n_prov = prov }
-mkSysLocalName :: Unique -> FAST_STRING -> Name
+mkKnownKeyGlobal :: (RdrName, Unique) -> Name
+mkKnownKeyGlobal (rdr_name, uniq)
+ = mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name))
+ (rdrNameOcc rdr_name)
+ systemProvenance
+
+mkSysLocalName :: Unique -> UserFS -> Name
mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local,
- n_occ = mkSrcVarOcc fs, n_prov = SystemProv }
+ n_occ = mkSrcVarOcc fs, n_prov = systemProvenance }
+
+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 }
mkTopName :: Unique -> Module -> FAST_STRING -> Name
-- Make a top-level name; make it Global if top-level
n_occ = mkSrcVarOcc (_PK_ ((_UNPK_ fs) ++ show uniq)),
n_prov = LocalDef noSrcLoc NotExported }
+mkIPName :: Unique -> OccName -> Name
+mkIPName uniq occ
+ = Name { n_uniq = uniq,
+ n_sort = Local,
+ n_occ = occ,
+ -- ZZ is this an appropriate provinence?
+ n_prov = SystemProv }
+
------------------------- Wired in names -------------------------
mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name
mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)}
+-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
+-- during compiler debugging.
+mkUnboundName :: RdrName -> Name
+mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
+
+isUnboundName :: Name -> Bool
+isUnboundName name = name `hasKey` unboundKey
+\end{code}
+
+\begin{code}
-- When we renumber/rename things, we need to be
-- able to change a Name's Unique to match the cached
-- one in the thing it's the name of. If you know what I mean.
\begin{code}
tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name)
tidyTopName mod env name
- | isExported name = (env, name) -- Don't fiddle with an exported name
- -- It should be in the TidyOccEnv already
- | otherwise = (env', name')
+ = (env', name')
where
(env', occ') = tidyOccName env (n_occ name)
opt_EnsureSplittableC -- Splitting requires visiblilty
\end{code}
+
\begin{code}
setNameProvenance :: Name -> Provenance -> Name
-- setNameProvenance used to only change the provenance of
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
isLocallyDefinedName :: Name -> Bool
-isExportedName :: Name -> Bool
+isUserExportedName :: Name -> Bool
isWiredInName :: Name -> Bool
isLocalName :: Name -> Bool
isGlobalName :: Name -> Bool
+hashName :: Name -> Int
+hashName name = IBOX( u2i (nameUnique name) )
+
nameUnique name = n_uniq name
nameOccName name = n_occ name
nameSortModule (WiredInTyCon 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 (nameSortModule sort) occ
+nameRdrName (Name { n_sort = sort, n_occ = occ }) = mkRdrQual (moduleName (nameSortModule sort)) occ
+
+ifaceNameRdrName :: Name -> RdrName
+-- Makes a qualified naem for imported things,
+-- and an unqualified one for local 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
-isExportedName (Name { n_prov = LocalDef _ Exported }) = True
-isExportedName 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) &&
+ not (isLocalModule (nameModule nm))
nameSrcLoc name = provSrcLoc (n_prov name)
provSrcLoc (LocalDef loc _) = loc
provSrcLoc (NonLocalDef (UserImport _ loc _) _) = loc
-provSrcLoc SystemProv = noSrcLoc
+provSrcLoc other = noSrcLoc
isLocallyDefinedName (Name {n_sort = Local}) = True -- Local (might have SystemProv)
isLocallyDefinedName (Name {n_prov = LocalDef _ _}) = True -- Global, but defined here
isExternallyVisibleName name = isGlobalName name
hasBetterProv :: Name -> Name -> Bool
-hasBetterProv name1 name2
- = case n_prov name1 of
- LocalDef _ _ -> True
- SystemProv -> False
- NonLocalDef _ _ -> case n_prov name2 of
- LocalDef _ _ -> False
- other -> True
+-- 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
a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
instance Ord Name where
- a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
- a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
+ a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
+ a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
compare a b = cmpName a b
%************************************************************************
%* *
+\subsection{Name environment}
+%* *
+%************************************************************************
+
+\begin{code}
+type NameEnv a = UniqFM a -- Domain is Name
+
+emptyNameEnv :: NameEnv a
+nameEnvElts :: NameEnv a -> [a]
+addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
+addToNameEnv :: NameEnv a -> Name -> a -> NameEnv a
+addListToNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
+plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
+plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
+extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
+lookupNameEnv :: NameEnv a -> Name -> Maybe a
+delFromNameEnv :: NameEnv a -> Name -> NameEnv a
+elemNameEnv :: Name -> NameEnv a -> Bool
+unitNameEnv :: Name -> a -> NameEnv a
+
+emptyNameEnv = emptyUFM
+nameEnvElts = eltsUFM
+addToNameEnv_C = addToUFM_C
+addToNameEnv = addToUFM
+addListToNameEnv = addListToUFM
+plusNameEnv = plusUFM
+plusNameEnv_C = plusUFM_C
+extendNameEnv = addListToUFM
+lookupNameEnv = lookupUFM
+delFromNameEnv = delFromUFM
+elemNameEnv = elemUFM
+unitNameEnv = unitUFM
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Pretty printing}
%* *
%************************************************************************
pp_mod_dot sty
= case prov of
- SystemProv -> pp_qual mod pp_sep user_sty
+ SystemProv -> pp_qual mod user_sty
-- Hack alert! Omit the qualifier on SystemProv things in user style
-- I claim such SystemProv things will also be WiredIn things.
-- We can't get the omit flag right
-- and hope that leaving it out isn't too consfusing.
-- (e.g. if the programmer hides Bool and redefines it. If so, use -dppr-debug.)
- LocalDef _ _ -> pp_qual mod dot (user_sty || iface_sty)
+ LocalDef _ _ -> pp_qual mod (user_sty || iface_sty)
NonLocalDef (UserImport imp_mod _ _) omit
- | user_sty -> pp_qual imp_mod pp_sep omit
- | otherwise -> pp_qual mod pp_sep False
- NonLocalDef ImplicitImport omit -> pp_qual mod pp_sep (user_sty && omit)
+ | user_sty -> pp_qual imp_mod omit
+ | otherwise -> pp_qual mod False
+ NonLocalDef ImplicitImport omit -> pp_qual mod (user_sty && omit)
where
user_sty = userStyle sty
iface_sty = ifaceStyle sty
- pp_qual mod sep omit_qual
+ pp_qual mod omit_qual
| omit_qual = empty
- | otherwise = pprModule mod <> sep
+ | otherwise = pprModule mod <> dot
- pp_sep | bootFlavour (moduleIfaceFlavour mod) = text "!" -- M!t indicates a name imported
- -- from a .hi-boot interface
- | otherwise = dot -- Vanilla case
-
pp_global_debug sty uniq prov
| debugStyle sty = hcat [text "{-", pprUnique uniq, prov_p prov, text "-}"]
| otherwise = empty
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
isLocallyDefined :: NamedThing a => a -> Bool
-isExported :: NamedThing a => a -> Bool
getOccString :: NamedThing a => a -> String
+toRdrName :: NamedThing a => a -> RdrName
-isExported = isExportedName . getName
getSrcLoc = nameSrcLoc . getName
isLocallyDefined = isLocallyDefinedName . getName
getOccString x = occNameString (getOccName x)
+toRdrName = ifaceNameRdrName . getName
\end{code}
\begin{code}
projects / ghc-hetmet.git / blobdiff