-- The Name type
Name, -- Abstract
- mkInternalName, mkSystemName, mkFCallName,
- mkIPName,
- mkExternalName, mkKnownKeyExternalName, mkWiredInName,
+ BuiltInSyntax(..),
+ mkInternalName, mkSystemName,
+ mkSystemNameEncoded, mkSysTvName,
+ mkFCallName, mkIPName,
+ mkExternalName, mkWiredInName,
nameUnique, setNameUnique,
- nameOccName, nameModule, nameModule_maybe,
- setNameOcc, nameRdrName, setNameModuleAndLoc,
- toRdrName, hashName,
- externaliseName, localiseName,
+ nameOccName, nameModule, nameModule_maybe, nameModuleName,
+ setNameOcc,
+ hashName, localiseName,
- nameSrcLoc,
+ nameSrcLoc, nameParent, nameParent_maybe,
isSystemName, isInternalName, isExternalName,
- isTyVarName, isDllName,
+ isTyVarName, isDllName, isWiredInName, isBuiltInSyntax,
+ wiredInNameTyThing_maybe,
nameIsLocalOrFrom, isHomePackageName,
-- Class NamedThing and overloaded friends
NamedThing(..),
- getSrcLoc, getOccString, toRdrName
+ getSrcLoc, getOccString
) where
#include "HsVersions.h"
+import {-# SOURCE #-} TypeRep( TyThing )
+
import OccName -- All of it
-import Module ( Module, moduleName, mkVanillaModule, isHomeModule )
-import RdrName ( RdrName, mkRdrOrig, mkRdrUnqual, rdrNameOcc, rdrNameModule )
+import Module ( Module, ModuleName, moduleName, isHomeModule )
import CmdLineOpts ( opt_Static )
-import SrcLoc ( builtinSrcLoc, noSrcLoc, SrcLoc )
+import SrcLoc ( noSrcLoc, wiredInSrcLoc, SrcLoc )
import Unique ( Unique, Uniquable(..), getKey, pprUnique )
-import FastTypes
-import Binary
+import Maybes ( orElse )
import Outputable
\end{code}
-- the SrcLoc in a Name all that often.
data NameSort
- = External Module -- (a) TyCon, Class, their derived Ids, dfun Id
- -- (b) Imported Id
- -- (c) Top-level Id in the original source, even if
- -- locally defined
+ = 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
+
+ | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
+ -- A variant of External, for wired-in things
| Internal -- A user-defined Id or TyVar
-- defined in the module being compiled
| 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"
+-- as such.
\end{code}
Notes about the NameSorts:
If any desugarer sys-locals have survived that far, they get changed to
"ds1", "ds2", etc.
+Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])
+
+Wired-in 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 built-in syntax is for wired-in things.
+
\begin{code}
nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
nameModule :: Name -> Module
+nameModuleName :: Name -> ModuleName
nameSrcLoc :: Name -> SrcLoc
nameUnique name = n_uniq name
nameOccName name = n_occ name
nameSrcLoc name = n_loc name
-
-nameModule (Name { n_sort = External mod }) = mod
-nameModule name = pprPanic "nameModule" (ppr name)
-
-nameModule_maybe (Name { n_sort = External mod }) = Just mod
-nameModule_maybe name = Nothing
\end{code}
\begin{code}
isExternalName :: Name -> Bool
isSystemName :: Name -> Bool
isHomePackageName :: Name -> Bool
+isWiredInName :: Name -> Bool
-isExternalName (Name {n_sort = External _}) = True
-isExternalName other = False
+isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
+isWiredInName other = False
+
+wiredInNameTyThing_maybe :: Name -> Maybe TyThing
+wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing _}) = Just thing
+wiredInNameTyThing_maybe other = Nothing
+
+isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
+isBuiltInSyntax other = False
+
+isExternalName (Name {n_sort = External _ _}) = True
+isExternalName (Name {n_sort = WiredIn _ _ _ _}) = True
+isExternalName other = False
isInternalName name = not (isExternalName name)
-nameIsLocalOrFrom from (Name {n_sort = External mod}) = mod == from
-nameIsLocalOrFrom from other = True
+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
-isHomePackageName (Name {n_sort = External mod}) = isHomeModule mod
-isHomePackageName other = True -- Internal and system names
+nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
+nameModuleName name = moduleName (nameModule name)
+
+nameModule_maybe (Name { n_sort = External mod _}) = Just mod
+nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
+nameModule_maybe name = Nothing
+
+nameIsLocalOrFrom from name
+ | isExternalName name = from == nameModule name
+ | otherwise = True
+
+isHomePackageName name
+ | isExternalName name = isHomeModule (nameModule name)
+ | otherwise = True -- Internal and system names
isDllName :: Name -> Bool -- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static && not (isHomePackageName nm)
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
-mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name
-mkExternalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = External mod,
- n_occ = occ, n_loc = loc }
-
-mkKnownKeyExternalName :: RdrName -> Unique -> Name
-mkKnownKeyExternalName rdr_name uniq
- = mkExternalName uniq (mkVanillaModule (rdrNameModule rdr_name))
- (rdrNameOcc rdr_name)
- builtinSrcLoc
+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,
+ n_occ = occ, n_loc = loc }
-mkWiredInName :: Module -> OccName -> Unique -> Name
-mkWiredInName mod occ uniq = mkExternalName uniq mod occ builtinSrcLoc
+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 }
-mkSystemName :: Unique -> EncodedFS -> Name
+mkSystemName :: Unique -> UserFS -> Name
mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System,
- n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+ n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+
+-- Use this version when the string is already encoded. Avoids duplicating
+-- the string each time a new name is created.
+mkSystemNameEncoded :: Unique -> EncodedFS -> Name
+mkSystemNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System,
+ n_occ = mkSysOccFS varName fs,
+ n_loc = noSrcLoc }
+
+mkSysTvName :: Unique -> EncodedFS -> Name
+mkSysTvName uniq fs = Name { n_uniq = uniq, n_sort = System,
+ n_occ = mkSysOccFS tvName fs,
+ n_loc = noSrcLoc }
mkFCallName :: Unique -> EncodedString -> Name
-- The encoded string completely describes the ccall
setNameOcc :: Name -> OccName -> Name
setNameOcc name occ = name {n_occ = occ}
-externaliseName :: Name -> Module -> Name
-externaliseName n mod = n { n_sort = External mod }
-
localiseName :: Name -> Name
localiseName n = n { n_sort = Internal }
-
-setNameModuleAndLoc :: Name -> Module -> SrcLoc -> Name
-setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc}
- where
- set (External _) = External mod
\end{code}
\begin{code}
hashName :: Name -> Int
-hashName name = iBox (getKey (nameUnique name))
-
-
-nameRdrName :: Name -> RdrName
--- Makes a qualified name for top-level (External) names,
--- whether locally defined or not and an unqualified name just for Internals
-nameRdrName (Name { n_occ = occ, n_sort = External mod }) = mkRdrOrig (moduleName mod) occ
-nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ
+hashName name = getKey (nameUnique name)
\end{code}
getName n = n
\end{code}
-%************************************************************************
-%* *
-\subsection{Binary output}
-%* *
-%************************************************************************
-
-\begin{code}
-instance Binary Name where
- -- we must print these as RdrNames, because that's how they will be read in
- put_ bh Name {n_sort = sort, n_uniq = uniq, n_occ = occ} =
- case sort of
- External mod
- | this_mod == mod -> put_ bh (mkRdrUnqual occ)
- | otherwise -> put_ bh (mkRdrOrig (moduleName mod) occ)
- where (this_mod,_,_,_) = getUserData bh
- _ -> do
- put_ bh (mkRdrUnqual occ)
-
- get bh = error "can't Binary.get a Name"
-\end{code}
%************************************************************************
%* *
-- When printing interfaces, all Internals have been given nice print-names
ppr name = pprName name
-pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+instance OutputableBndr Name where
+ pprBndr _ name = pprName name
+
+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
= getPprStyle $ \ sty ->
case sort of
- External mod -> pprExternal sty name uniq mod occ
- System -> pprSystem sty uniq occ
- Internal -> pprInternal sty uniq occ
-
-pprExternal sty name uniq mod occ
- | codeStyle sty = ppr (moduleName mod) <> char '_' <> pprOccName occ
-
- | debugStyle sty = ppr (moduleName mod) <> dot <> pprOccName occ <>
- text "{-" <> pprUnique uniq <> text "-}"
-
- | unqualStyle sty name = pprOccName occ
- | otherwise = ppr (moduleName mod) <> dot <> pprOccName occ
+ 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
+
+pprExternal sty uniq mod occ is_wired is_builtin
+ | codeStyle sty = ppr mod_name <> char '_' <> pprOccName 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 = sep [ppr mod_name <> dot <> pprOccName occ,
+ hsep [text "{-"
+ , if is_wired then ptext SLIT("(w)") else empty
+ , pprUnique uniq
+-- (overkill) , case mb_p of
+-- Nothing -> empty
+-- Just n -> brackets (ppr n)
+ , text "-}"]]
+ | BuiltInSyntax <- is_builtin = pprOccName occ
+ -- never qualify builtin syntax
+ | unqualStyle sty mod_name occ = pprOccName occ
+ | otherwise = ppr mod_name <> dot <> pprOccName occ
+ where
+ mod_name = moduleName mod
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
- | debugStyle sty = pprOccName occ <>
- text "{-" <> pprUnique uniq <> text "-}"
+ | debugStyle sty = pprOccName occ <> text "{-" <> pprUnique uniq <> text "-}"
| otherwise = pprOccName occ -- User style
-- Like Internal, except that we only omit the unique in Iface style
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
getOccString :: NamedThing a => a -> String
-toRdrName :: NamedThing a => a -> RdrName
getSrcLoc = nameSrcLoc . getName
getOccString = occNameString . getOccName
-toRdrName = nameRdrName . getName
\end{code}
projects / ghc-hetmet.git / blobdiff