-- The Name type
Name, -- Abstract
- mkLocalName, mkSysLocalName, mkTopName,
- mkDerivedName, mkGlobalName,
+ mkLocalName, mkImportedLocalName, mkSysLocalName,
+ mkTopName,
+ mkDerivedName, mkGlobalName, mkKnownKeyGlobal,
mkWiredInIdName, mkWiredInTyConName,
maybeWiredInIdName, maybeWiredInTyConName,
isWiredInName,
tidyTopName,
nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule,
- isExportedName, nameSrcLoc,
+ isUserExportedName, nameSrcLoc,
isLocallyDefinedName,
isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
-
+
-- Provenance
Provenance(..), ImportReason(..), pprProvenance,
ExportFlag(..), PrintUnqualified,
- pprNameProvenance, systemProvenance,
+ pprNameProvenance, systemProvenance, hasBetterProv,
-- Class NamedThing and overloaded friends
NamedThing(..),
- isExported,
getSrcLoc, isLocallyDefined, getOccString
) where
import {-# SOURCE #-} TyCon ( TyCon, setTyConName )
import OccName -- All of it
-import Module
-import RdrName ( RdrName, mkRdrQual, mkRdrUnqual )
+import Module ( Module, moduleName, pprModule, mkVanillaModule )
+import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
+mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name
+ -- Just the same as mkLocalName, except the provenance is different
+ -- Reason: this flags the name as one that came in from an interface 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 }
+
+
mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod,
n_occ = occ, n_prov = prov }
+mkKnownKeyGlobal :: (RdrName, Unique) -> Name
+mkKnownKeyGlobal (rdr_name, uniq)
+ = mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name))
+ (rdrNameOcc rdr_name)
+ systemProvenance
+
mkSysLocalName :: Unique -> FAST_STRING -> Name
mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local,
n_occ = mkSrcVarOcc fs, n_prov = SystemProv }
\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)
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
isLocallyDefinedName :: Name -> Bool
-isExportedName :: Name -> Bool
+isUserExportedName :: Name -> Bool
isWiredInName :: Name -> Bool
isLocalName :: Name -> Bool
isGlobalName :: Name -> Bool
nameRdrName :: Name -> RdrName
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
-isExportedName (Name { n_prov = LocalDef _ Exported }) = True
-isExportedName other = False
+isUserExportedName (Name { n_prov = LocalDef _ Exported }) = True
+isUserExportedName other = False
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
-- does not mean visible at the source level (that's isExported).
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
+
isSystemName (Name {n_prov = SystemProv}) = True
isSystemName other = False
\end{code}
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
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
-isExported = isExportedName . getName
getSrcLoc = nameSrcLoc . getName
isLocallyDefined = isLocallyDefinedName . getName
getOccString x = occNameString (getOccName x)
projects / ghc-hetmet.git / blobdiff