%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Name]{@Name@: to transmit name info from renamer to typechecker}
\begin{code}
-module Name (
- -- Re-export the OccName stuff
- module OccName,
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName': see "OccName#name_types"
+--
+-- * 'RdrName.RdrName': see "RdrName#name_types"
+--
+-- * 'Name.Name' is the type of names that have had their scoping and binding resolved. They
+-- have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have
+-- the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names
+-- also contain information about where they originated from, see "Name#name_sorts"
+--
+-- * 'Id.Id': see "Id#name_types"
+--
+-- * 'Var.Var': see "Var#name_types"
+--
+-- #name_sorts#
+-- Names are one of:
+--
+-- * External, if they name things declared in other modules. Some external
+-- Names are wired in, i.e. they name primitives defined in the compiler itself
+--
+-- * Internal, if they name things in the module being compiled. Some internal
+-- Names are system names, if they are names manufactured by the compiler
- -- The Name type
+module Name (
+ -- * The main types
Name, -- Abstract
- BuiltInSyntax(..),
- mkInternalName, mkSystemName,
+ BuiltInSyntax(..),
+
+ -- ** Creating 'Name's
+ mkInternalName, mkSystemName, mkDerivedInternalName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
+ mkTickBoxOpName,
mkExternalName, mkWiredInName,
+ -- ** Manipulating and deconstructing 'Name's
nameUnique, setNameUnique,
nameOccName, nameModule, nameModule_maybe,
tidyNameOcc,
hashName, localiseName,
- nameSrcLoc, nameParent, nameParent_maybe, isImplicitName,
+ nameSrcLoc, nameSrcSpan, pprNameLoc,
+ -- ** Predicates on 'Name's
isSystemName, isInternalName, isExternalName,
- isTyVarName, isWiredInName, isBuiltInSyntax,
+ isTyVarName, isTyConName, isDataConName,
+ isValName, isVarName,
+ isWiredInName, isBuiltInSyntax,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom,
-
- -- Class NamedThing and overloaded friends
+
+ -- * Class 'NamedThing' and overloaded friends
NamedThing(..),
- getSrcLoc, getOccString
+ getSrcLoc, getSrcSpan, getOccString,
+
+ pprInfixName, pprPrefixName, pprModulePrefix,
+ getNameDepth, setNameDepth,
+
+ -- Re-export the OccName stuff
+ module OccName
) where
-#include "HsVersions.h"
+#include "Typeable.h"
import {-# SOURCE #-} TypeRep( TyThing )
-import OccName -- All of it
-import Module ( Module, moduleFS )
-import SrcLoc ( noSrcLoc, wiredInSrcLoc, SrcLoc )
-import Unique ( Unique, Uniquable(..), getKey, pprUnique )
-import Maybes ( orElse, isJust )
-import FastString ( FastString, zEncodeFS )
+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}
%************************************************************************
%************************************************************************
\begin{code}
+-- | A unique, unambigious name for something, containing information about where
+-- that thing originated.
data Name = Name {
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
- n_uniq :: Unique,
- n_loc :: !SrcLoc -- Definition site
+ n_uniq :: FastInt, -- UNPACK doesn't work, recursive type
+--(note later when changing Int# -> FastInt: is that still true about UNPACK?)
+ n_loc :: !SrcSpan -- Definition site
}
-- NOTE: we make the n_loc field strict to eliminate some potential
-- (and real!) space leaks, due to the fact that we don't look at
-- the SrcLoc in a Name all that often.
+setNameDepth :: Int -> Name -> Name
+setNameDepth depth name = name { n_occ = setOccNameDepth depth (n_occ name) }
+
+getNameDepth :: Name -> Int
+getNameDepth name = getOccNameDepth $ n_occ name
+
data NameSort
- = External Module (Maybe Name)
- -- (Just parent) => this Name is a subordinate name of 'parent'
- -- e.g. data constructor of a data type, method of a class
- -- Nothing => not a subordinate
+ = External Module
- | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
+ | WiredIn Module TyThing BuiltInSyntax
-- A variant of External, for wired-in things
| Internal -- A user-defined Id or TyVar
| System -- A system-defined Id or TyVar. Typically the
-- OccName is very uninformative (like 's')
-data BuiltInSyntax = BuiltInSyntax | UserSyntax
--- BuiltInSyntax is for things like (:), [], tuples etc,
--- which have special syntactic forms. They aren't "in scope"
+-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples,
+-- which have special syntactic forms. They aren't in scope
-- as such.
+data BuiltInSyntax = BuiltInSyntax | UserSyntax
\end{code}
Notes about the NameSorts:
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
+nameSrcSpan :: Name -> SrcSpan
-nameUnique name = n_uniq name
+nameUnique name = mkUniqueGrimily (iBox (n_uniq name))
nameOccName name = n_occ name
-nameSrcLoc name = n_loc 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
isSystemName :: Name -> Bool
isWiredInName :: Name -> Bool
-isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
-isWiredInName other = False
+isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
+isWiredInName _ = False
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
-wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing _}) = Just thing
-wiredInNameTyThing_maybe other = Nothing
+wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
+wiredInNameTyThing_maybe _ = Nothing
-isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
-isBuiltInSyntax other = False
+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 other = False
+isExternalName (Name {n_sort = External _}) = True
+isExternalName (Name {n_sort = WiredIn _ _ _}) = True
+isExternalName _ = False
isInternalName name = not (isExternalName name)
-nameParent_maybe :: Name -> Maybe Name
-nameParent_maybe (Name {n_sort = External _ p}) = p
-nameParent_maybe (Name {n_sort = WiredIn _ p _ _}) = p
-nameParent_maybe other = Nothing
-
-nameParent :: Name -> Name
-nameParent name = case nameParent_maybe name of
- Just parent -> parent
- Nothing -> name
-
-isImplicitName :: Name -> Bool
--- An Implicit Name is one has a parent; that is, one whose definition
--- derives from the parent thing
-isImplicitName name = isJust (nameParent_maybe name)
-
nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
-nameModule_maybe (Name { n_sort = External mod _}) = Just mod
-nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
-nameModule_maybe name = Nothing
+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
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 other = False
+isSystemName _ = False
\end{code}
%************************************************************************
\begin{code}
-mkInternalName :: Unique -> OccName -> SrcLoc -> Name
-mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
+-- | Create a name which is (for now at least) local to the current module and hence
+-- does not need a 'Module' to disambiguate it from other 'Name's
+mkInternalName :: Unique -> OccName -> SrcSpan -> Name
+mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, 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
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
-mkExternalName :: Unique -> Module -> OccName -> Maybe Name -> SrcLoc -> Name
-mkExternalName uniq mod occ mb_parent loc
- = Name { n_uniq = uniq, n_sort = External mod mb_parent,
+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 }
+
+-- | Create a name which definitely originates in the given module
+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
- -> Maybe Name -> TyThing -> BuiltInSyntax -> Name
-mkWiredInName mod occ uniq mb_parent thing built_in
- = Name { n_uniq = uniq,
- n_sort = WiredIn mod mb_parent thing built_in,
- n_occ = occ, n_loc = wiredInSrcLoc }
+-- | Create a name which is actually defined by the compiler itself
+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 }
+-- | Create a name brought into being by the compiler
mkSystemName :: Unique -> OccName -> Name
-mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System,
- n_occ = occ, n_loc = noSrcLoc }
+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)
+mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
+-- | Make a name for a foreign call
mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall
-mkFCallName uniq str = Name { n_uniq = uniq, n_sort = Internal,
- n_occ = mkVarOcc str, n_loc = noSrcLoc }
+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 }
+
+-- | Make the name of an implicit parameter
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
- = Name { n_uniq = uniq,
+ = Name { n_uniq = getKeyFastInt uniq,
n_sort = Internal,
n_occ = occ,
- n_loc = noSrcLoc }
+ n_loc = noSrcSpan }
\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.
-setNameUnique name uniq = name {n_uniq = uniq}
+setNameUnique :: Name -> Unique -> Name
+setNameUnique name uniq = name {n_uniq = getKeyFastInt uniq}
tidyNameOcc :: Name -> OccName -> Name
-- We set the OccName of a Name when tidying
tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
tidyNameOcc name occ = name { n_occ = occ }
+-- | Make the 'Name' into an internal name, regardless of what it was to begin with
localiseName :: Name -> Name
localiseName n = n { n_sort = Internal }
\end{code}
-
%************************************************************************
%* *
-\subsection{Predicates and selectors}
+\subsection{Hashing and comparison}
%* *
%************************************************************************
\begin{code}
-hashName :: Name -> Int
-hashName name = getKey (nameUnique name)
+hashName :: Name -> Int -- ToDo: should really be Word
+hashName name = getKey (nameUnique name) + 1
+ -- The +1 avoids keys with lots of zeros in the ls bits, which
+ -- interacts badly with the cheap and cheerful multiplication in
+ -- hashExpr
+
+cmpName :: Name -> Name -> Ordering
+cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
\end{code}
-
%************************************************************************
%* *
\subsection[Name-instances]{Instance declarations}
%************************************************************************
\begin{code}
-cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
-\end{code}
-
-\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 NamedThing Name where
getName n = n
+
+INSTANCE_TYPEABLE0(Name,nameTc,"Name")
+
+instance Data Name where
+ -- don't traverse?
+ 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}
%************************************************************************
%* *
instance OutputableBndr Name where
pprBndr _ name = pprName name
-pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+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
+ 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_z_module mod <> char '_' <> ppr_z_occ_name occ
+ | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
-- In code style, always qualify
-- ToDo: maybe we could print all wired-in things unqualified
-- in code style, to reduce symbol table bloat?
- | 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
- -- never qualify builtin syntax
- | unqualStyle sty mod occ = ppr_occ_name occ
- | otherwise = ppr mod <> dot <> ppr_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 -- Never qualify builtin syntax
+ | 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 <> char '_' <> pprUnique uniq
+ | dumpStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
-- For debug dumps, we're not necessarily dumping
-- tidied code, so we need to print the uniques.
| otherwise = ppr_occ_name occ -- User style
-- Like Internal, except that we only omit the unique in Iface style
+pprSystem :: PprStyle -> Unique -> OccName -> SDoc
pprSystem sty uniq occ
| codeStyle sty = pprUnique uniq
- | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
+ | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
<> braces (pprNameSpaceBrief (occNameSpace occ))
- | otherwise = ppr_occ_name occ <> char '_' <> pprUnique uniq
+ | otherwise = ppr_occ_name occ <> ppr_underscore_unique uniq
-- If the tidy phase hasn't run, the OccName
-- is unlikely to be informative (like 's'),
-- so print the unique
+
+pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
+-- Print the "M." part of a name, based on whether it's in scope or not
+-- See Note [Printing original names] in HscTypes
+pprModulePrefix sty mod occ
+ | opt_SuppressModulePrefixes = empty
+
+ | otherwise
+ = case qualName sty mod occ of -- See Outputable.QualifyName:
+ NameQual modname -> ppr modname <> dot -- Name is in scope
+ NameNotInScope1 -> ppr mod <> dot -- Not in scope
+ NameNotInScope2 -> ppr (modulePackageId mod) <> colon -- Module not in
+ <> ppr (moduleName mod) <> dot -- scope eithber
+ _otherwise -> empty
+
+ppr_underscore_unique :: Unique -> SDoc
+-- Print an underscore separating the name from its unique
+-- But suppress it if we aren't printing the uniques anyway
+ppr_underscore_unique uniq
+ | opt_SuppressUniques = empty
+ | otherwise = char '_' <> pprUnique uniq
+
+ppr_occ_name :: OccName -> SDoc
ppr_occ_name occ = ftext (occNameFS occ)
-- Don't use pprOccName; instead, just print the string of the OccName;
-- we print the namespace in the debug stuff above
-- In code style, we Z-encode the strings. The results of Z-encoding each FastString are
-- cached behind the scenes in the FastString implementation.
+ppr_z_occ_name :: OccName -> SDoc
ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
-ppr_z_module mod = ftext (zEncodeFS (moduleFS mod))
+-- Prints (if mod information is available) "Defined at <loc>" or
+-- "Defined in <mod>" information for a Name.
+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}
%************************************************************************
%************************************************************************
\begin{code}
+-- | A class allowing convenient access to the 'Name' of various datatypes
class NamedThing a where
getOccName :: a -> OccName
getName :: a -> Name
\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
+-- See Outputable.pprPrefixVar, pprInfixVar;
+-- add parens or back-quotes as appropriate
+pprInfixName n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)
+pprPrefixName n = pprPrefixVar (isSymOcc (getOccName n)) (ppr n)
\end{code}
projects / ghc-hetmet.git / blobdiff