%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 19921998
%
\section[Name]{@Name@: to transmit name info from renamer to typechecker}
\begin{code}
module Name (
Name,
BuiltInSyntax(..),
mkInternalName, mkSystemName, mkDerivedInternalName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
mkTickBoxOpName,
mkExternalName, mkWiredInName,
nameUnique, setNameUnique,
nameOccName, nameModule, nameModule_maybe,
tidyNameOcc,
hashName, localiseName,
nameSrcLoc, nameSrcSpan, pprNameLoc,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isDataConName,
isValName, isVarName,
isWiredInName, isBuiltInSyntax,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom,
NamedThing(..),
getSrcLoc, getSrcSpan, getOccString,
pprInfixName, pprPrefixName, pprModulePrefix,
module OccName
) where
#include "Typeable.h"
import TypeRep( TyThing )
import OccName
import Module
import SrcLoc
import Unique
import Util
import Maybes
import Binary
import StaticFlags
import FastTypes
import FastString
import Outputable
import Data.Array
import Data.Data
import Data.Word ( Word32 )
\end{code}
%************************************************************************
%* *
\subsection[Namedatatype]{The @Name@ datatype, and name construction}
%* *
%************************************************************************
\begin{code}
data Name = Name {
n_sort :: NameSort,
n_occ :: !OccName,
n_uniq :: FastInt,
n_loc :: !SrcSpan
}
data NameSort
= External Module
| WiredIn Module TyThing BuiltInSyntax
| Internal
| System
data BuiltInSyntax = BuiltInSyntax | UserSyntax
\end{code}
Notes about the NameSorts:
1. Initially, toplevel Ids (including locallydefined ones) get External names,
and all other local Ids get Internal names
2. Things with a External 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 originallylocal things have this property they
must be made @External@ first.
3. In the tidycore phase, a External that is not visible to an importer
is changed to Internal, and a Internal that is visible is changed to External
4. 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 syslocals to user locals
If any desugarer syslocals have survived that far, they get changed to
"ds1", "ds2", etc.
Builtin syntax => It's a syntactic form, not "in scope" (e.g. [])
Wiredin thing => The thing (Id, TyCon) is fully known to the compiler,
not read from an interface file.
E.g. Bool, True, Int, Float, and many others
All builtin syntax is for wiredin things.
\begin{code}
nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameSrcSpan :: Name -> SrcSpan
nameUnique name = mkUniqueGrimily (iBox (n_uniq name))
nameOccName name = n_occ name
nameSrcLoc name = srcSpanStart (n_loc name)
nameSrcSpan name = n_loc name
\end{code}
%************************************************************************
%* *
\subsection{Predicates on names}
%* *
%************************************************************************
\begin{code}
nameIsLocalOrFrom :: Module -> Name -> Bool
isInternalName :: Name -> Bool
isExternalName :: Name -> Bool
isSystemName :: Name -> Bool
isWiredInName :: Name -> Bool
isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
isWiredInName _ = False
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
wiredInNameTyThing_maybe _ = Nothing
isBuiltInSyntax :: Name -> Bool
isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
isBuiltInSyntax _ = False
isExternalName (Name {n_sort = External _}) = True
isExternalName (Name {n_sort = WiredIn _ _ _}) = True
isExternalName _ = False
isInternalName name = not (isExternalName name)
nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
nameModule_maybe :: Name -> Maybe Module
nameModule_maybe (Name { n_sort = External mod}) = Just mod
nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
nameModule_maybe _ = Nothing
nameIsLocalOrFrom from name
| isExternalName name = from == nameModule name
| otherwise = True
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
isTyConName :: Name -> Bool
isTyConName name = isTcOcc (nameOccName name)
isDataConName :: Name -> Bool
isDataConName name = isDataOcc (nameOccName name)
isValName :: Name -> Bool
isValName name = isValOcc (nameOccName name)
isVarName :: Name -> Bool
isVarName = isVarOcc . nameOccName
isSystemName (Name {n_sort = System}) = True
isSystemName _ = False
\end{code}
%************************************************************************
%* *
\subsection{Making names}
%* *
%************************************************************************
\begin{code}
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
= Name { n_uniq = getKeyFastInt uniq, n_sort = Internal
, n_occ = derive_occ occ, n_loc = loc }
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName uniq mod occ loc
= Name { n_uniq = getKeyFastInt uniq, n_sort = External mod,
n_occ = occ, n_loc = loc }
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName mod occ uniq thing built_in
= Name { n_uniq = getKeyFastInt uniq,
n_sort = WiredIn mod thing built_in,
n_occ = occ, n_loc = wiredInSrcSpan }
mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKeyFastInt uniq, n_sort = System,
n_occ = occ, n_loc = noSrcSpan }
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
mkSysTvName :: Unique -> FastString -> Name
mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
mkFCallName :: Unique -> String -> Name
mkFCallName uniq str = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal,
n_occ = mkVarOcc str, n_loc = noSrcSpan }
mkTickBoxOpName :: Unique -> String -> Name
mkTickBoxOpName uniq str
= Name { n_uniq = getKeyFastInt uniq, n_sort = Internal,
n_occ = mkVarOcc str, n_loc = noSrcSpan }
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
= Name { n_uniq = getKeyFastInt uniq,
n_sort = Internal,
n_occ = occ,
n_loc = noSrcSpan }
\end{code}
\begin{code}
setNameUnique :: Name -> Unique -> Name
setNameUnique name uniq = name {n_uniq = getKeyFastInt uniq}
tidyNameOcc :: Name -> OccName -> Name
tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
tidyNameOcc name occ = name { n_occ = occ }
localiseName :: Name -> Name
localiseName n = n { n_sort = Internal }
\end{code}
%************************************************************************
%* *
\subsection{Hashing and comparison}
%* *
%************************************************************************
\begin{code}
hashName :: Name -> Int
hashName name = getKey (nameUnique name) + 1
cmpName :: Name -> Name -> Ordering
cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
\end{code}
%************************************************************************
%* *
\subsection[Nameinstances]{Instance declarations}
%* *
%************************************************************************
\begin{code}
instance Eq Name where
a == b = case (a `compare` b) of { EQ -> True; _ -> 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 -> False; EQ -> True; GT -> True }
a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
compare a b = cmpName a b
instance Uniquable Name where
getUnique = nameUnique
instance NamedThing Name where
getName n = n
INSTANCE_TYPEABLE0(Name,nameTc,"Name")
instance Data Name where
toConstr _ = abstractConstr "Name"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Name"
\end{code}
%************************************************************************
%* *
\subsection{Binary}
%* *
%************************************************************************
\begin{code}
instance Binary Name where
put_ bh name =
case getUserData bh of
UserData{ ud_put_name = put_name } -> put_name bh name
get bh = do
i <- get bh
return $! (ud_symtab (getUserData bh) ! fromIntegral (i::Word32))
\end{code}
%************************************************************************
%* *
\subsection{Pretty printing}
%* *
%************************************************************************
\begin{code}
instance Outputable Name where
ppr name = pprName name
instance OutputableBndr Name where
pprBndr _ name = pprName name
pprName :: Name -> SDoc
pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
= getPprStyle $ \ sty ->
case sort of
WiredIn mod _ builtin -> pprExternal sty uniq mod occ True builtin
External mod -> pprExternal sty uniq mod occ False UserSyntax
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
where uniq = mkUniqueGrimily (iBox u)
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ is_wired is_builtin
| codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
| debugStyle sty = ppr mod <> dot <> ppr_occ_name occ
<> braces (hsep [if is_wired then ptext (sLit "(w)") else empty,
pprNameSpaceBrief (occNameSpace occ),
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ
| otherwise = pprModulePrefix sty mod occ <> ppr_occ_name occ
pprInternal :: PprStyle -> Unique -> OccName -> SDoc
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
| debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
pprUnique uniq])
| dumpStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
| otherwise = ppr_occ_name occ
pprSystem :: PprStyle -> Unique -> OccName -> SDoc
pprSystem sty uniq occ
| codeStyle sty = pprUnique uniq
| debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
<> braces (pprNameSpaceBrief (occNameSpace occ))
| otherwise = ppr_occ_name occ <> ppr_underscore_unique uniq
pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
pprModulePrefix sty mod occ
| opt_SuppressModulePrefixes = empty
| otherwise
= case qualName sty mod occ of
NameQual modname -> ppr modname <> dot
NameNotInScope1 -> ppr mod <> dot
NameNotInScope2 -> ppr (modulePackageId mod) <> colon
<> ppr (moduleName mod) <> dot
_otherwise -> empty
ppr_underscore_unique :: Unique -> SDoc
ppr_underscore_unique uniq
| opt_SuppressUniques = empty
| otherwise = char '_' <> pprUnique uniq
ppr_occ_name :: OccName -> SDoc
ppr_occ_name occ = ftext (occNameFS occ)
ppr_z_occ_name :: OccName -> SDoc
ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
pprNameLoc :: Name -> SDoc
pprNameLoc name
| isGoodSrcSpan loc = pprDefnLoc loc
| isInternalName name || isSystemName name
= ptext (sLit "<no location info>")
| otherwise = ptext (sLit "Defined in ") <> ppr (nameModule name)
where loc = nameSrcSpan name
\end{code}
%************************************************************************
%* *
\subsection{Overloaded functions related to Names}
%* *
%************************************************************************
\begin{code}
class NamedThing a where
getOccName :: a -> OccName
getName :: a -> Name
getOccName n = nameOccName (getName n)
\end{code}
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String
getSrcLoc = nameSrcLoc . getName
getSrcSpan = nameSrcSpan . getName
getOccString = occNameString . getOccName
pprInfixName, pprPrefixName :: (Outputable a, NamedThing a) => a -> SDoc
pprInfixName n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)
pprPrefixName n = pprPrefixVar (isSymOcc (getOccName n)) (ppr n)
\end{code}