Commit f9120c20 authored by partain's avatar partain

[project @ 1996-04-07 15:41:24 by partain]

Sansom 1.3 changes through 960407
parent e5401e80
......@@ -59,9 +59,7 @@ NATIVEGEN_DIR=$(TOP_PWD)/$(CURRENT_DIR)/nativeGen
parser/U_constr.hs \
parser/U_binding.hs \
parser/U_pbinding.hs \
parser/U_coresyn.hs \
parser/U_entidt.hs \
parser/U_hpragma.hs \
parser/U_list.hs \
parser/U_literal.hs \
parser/U_maybe.hs \
......@@ -76,7 +74,6 @@ parser/U_ttype.hs
parser/UgenUtil.lhs \
parser/UgenAll.lhs \
reader/ReadPrefix.lhs \
reader/ReadPragmas.lhs \
\
reader/PrefixSyn.lhs \
reader/PrefixToHs.lhs \
......@@ -101,10 +98,8 @@ basicTypes/IdInfo.lhs \
basicTypes/IdUtils.lhs \
basicTypes/Literal.lhs \
basicTypes/Name.lhs \
basicTypes/NameTypes.lhs \
basicTypes/PprEnv.lhs \
basicTypes/PragmaInfo.lhs \
basicTypes/ProtoName.lhs \
basicTypes/SrcLoc.lhs \
basicTypes/UniqSupply.lhs \
basicTypes/Unique.lhs \
......@@ -121,18 +116,15 @@ specialise/SpecEnv.lhs
#define RENAMERSRCS_LHS \
rename/RnPass1.lhs \
rename/RnPass2.lhs \
rename/RnPass3.lhs \
rename/RnPass4.lhs \
rename/RnHsSyn.lhs \
rename/RnUtils.lhs \
rename/RnMonad12.lhs \
rename/RnMonad3.lhs \
rename/RnMonad4.lhs \
rename/RnBinds4.lhs \
rename/RnExpr4.lhs \
rename/Rename.lhs
rename/RnMonad.lhs \
rename/Rename.lhs \
rename/RnNames.lhs \
rename/RnSource.lhs \
rename/RnBinds.lhs \
rename/RnExpr.lhs \
rename/RnIfaces.lhs \
rename/RnUtils.lhs
#define TCSRCS_LHS \
typecheck/TcHsSyn.lhs \
......@@ -359,14 +351,15 @@ NOT_SO_BASICSRCS_LHS \
UTILSRCS_LHS \
MAIN_SRCS_LHS \
READERSRCS_LHS \
RENAMERSRCS_LHS \
TCSRCS_LHS \
RENAMERSRCS_LHS \
TCSRCS_LHS \
DSSRCS_LHS \
SIMPL_SRCS_LHS \
STG_SRCS_LHS \
BACKSRCS_LHS NATIVEGEN_SRCS_LHS
/*
\
*/
/* NB: all the ones that may be empty (e.g., NATIVEGEN_SRCS_LHS)
need to be on the last line.
......@@ -487,8 +480,6 @@ absCSyn/AbsCLoop.hi : absCSyn/AbsCLoop.lhi
$(GHC_UNLIT) absCSyn/AbsCLoop.lhi absCSyn/AbsCLoop.hi
basicTypes/IdLoop.hi : basicTypes/IdLoop.lhi
$(GHC_UNLIT) basicTypes/IdLoop.lhi basicTypes/IdLoop.hi
basicTypes/NameLoop.hi : basicTypes/NameLoop.lhi
$(GHC_UNLIT) basicTypes/NameLoop.lhi basicTypes/NameLoop.hi
codeGen/CgLoop1.hi : codeGen/CgLoop1.lhi
$(GHC_UNLIT) codeGen/CgLoop1.lhi codeGen/CgLoop1.hi
codeGen/CgLoop2.hi : codeGen/CgLoop2.lhi
......@@ -501,8 +492,6 @@ nativeGen/NcgLoop.hi : nativeGen/NcgLoop.lhi
$(GHC_UNLIT) nativeGen/NcgLoop.lhi nativeGen/NcgLoop.hi
prelude/PrelLoop.hi : prelude/PrelLoop.lhi
$(GHC_UNLIT) prelude/PrelLoop.lhi prelude/PrelLoop.hi
reader/RdrLoop.hi : reader/RdrLoop.lhi
$(GHC_UNLIT) reader/RdrLoop.lhi reader/RdrLoop.hi
rename/RnLoop.hi : rename/RnLoop.lhi
$(GHC_UNLIT) rename/RnLoop.lhi rename/RnLoop.hi
simplCore/SmplLoop.hi : simplCore/SmplLoop.lhi
......@@ -540,10 +529,8 @@ compile(basicTypes/IdInfo,lhs,-K2m)
compile(basicTypes/IdUtils,lhs,)
compile(basicTypes/Literal,lhs,)
compile(basicTypes/Name,lhs,)
compile(basicTypes/NameTypes,lhs,)
compile(basicTypes/PprEnv,lhs,)
compile(basicTypes/PragmaInfo,lhs,)
compile(basicTypes/ProtoName,lhs,)
compile(basicTypes/SrcLoc,lhs,)
compile(basicTypes/UniqSupply,lhs,)
compile(basicTypes/Unique,lhs,)
......@@ -626,21 +613,17 @@ compile(profiling/CostCentre,lhs,)
compile(reader/PrefixSyn,lhs,)
compile(reader/PrefixToHs,lhs,)
compile(reader/ReadPrefix,lhs,if_ghc(-fvia-C -I$(COMPINFO_DIR) -Iparser '-#include"hspincl.h"'))
compile(reader/ReadPragmas,lhs,)
compile(reader/RdrHsSyn,lhs,)
compile(rename/RnHsSyn,lhs,)
compile(rename/RnMonad,lhs,)
compile(rename/Rename,lhs,)
compile(rename/RnPass1,lhs,)
compile(rename/RnPass2,lhs,)
compile(rename/RnPass3,lhs,)
compile(rename/RnPass4,lhs,)
compile(rename/RnNames,lhs,)
compile(rename/RnSource,lhs,)
compile(rename/RnBinds,lhs,)
compile(rename/RnExpr,lhs,)
compile(rename/RnIfaces,lhs,)
compile(rename/RnUtils,lhs,)
compile(rename/RnHsSyn,lhs,)
compile(rename/RnBinds4,lhs,)
compile(rename/RnExpr4,lhs,)
compile(rename/RnMonad12,lhs,)
compile(rename/RnMonad3,lhs,)
compile(rename/RnMonad4,lhs,)
compile(simplCore/BinderInfo,lhs,)
compile(simplCore/ConFold,lhs,)
......@@ -772,9 +755,7 @@ CPP_DEFINES = $(D_DEBUG)
HSP_SRCS_C = parser/constr.c \
parser/binding.c \
parser/pbinding.c \
parser/coresyn.c \
parser/entidt.c \
parser/hpragma.c \
parser/hslexer.c \
parser/hsparser.tab.c \
parser/id.c \
......@@ -794,9 +775,7 @@ HSP_SRCS_C = parser/constr.c \
HSP_OBJS_O = parser/constr.o \
parser/binding.o \
parser/pbinding.o \
parser/coresyn.o \
parser/entidt.o \
parser/hpragma.o \
parser/hslexer.o \
parser/hsparser.tab.o \
parser/id.o \
......@@ -841,14 +820,12 @@ MakeDirectories(install, $(INSTLIBDIR_GHC))
InstallBinaryTarget(hsp,$(INSTLIBDIR_GHC))
#endif /* DoInstall... */
YaccRunWithExpectMsg(parser/hsparser,16,0)
YaccRunWithExpectMsg(parser/hsparser,14,0)
UgenTarget(parser/constr)
UgenTarget(parser/binding)
UgenTarget(parser/pbinding)
UgenTarget(parser/coresyn)
UgenTarget(parser/entidt)
UgenTarget(parser/hpragma)
UgenTarget(parser/list)
UgenTarget(parser/literal)
UgenTarget(parser/maybe)
......@@ -860,14 +837,12 @@ UgenTarget(parser/ttype)
UGENS_C = parser/constr.c \
parser/binding.c \
parser/pbinding.c \
parser/coresyn.c \
parser/entidt.c \
parser/literal.c \
parser/list.c \
parser/maybe.c \
parser/either.c \
parser/qid.c \
parser/hpragma.c \
parser/tree.c \
parser/ttype.c
......@@ -882,9 +857,7 @@ compile(parser/UgenUtil,lhs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_constr,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_binding,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_pbinding,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_coresyn,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_entidt,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_hpragma,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_list,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_literal,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
compile(parser/U_maybe,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
......
......@@ -40,6 +40,6 @@ instance Eq FieldLabel where
instance Outputable FieldLabel where
ppr sty (FieldLabel n _ _) = ppr sty n
instance NamedThing FieldLabel
-- ToDo: fill this in
instance NamedThing FieldLabel where
getName (FieldLabel n _ _) = n
\end{code}
This diff is collapsed.
......@@ -138,7 +138,7 @@ data IdInfo
-- ToDo: SrcLoc is in FullNames too (could rm?) but it
-- is needed here too for things like ConstMethodIds and the
-- like, which don't have full-names of their own Mind you,
-- perhaps the FullName for a constant method could give the
-- perhaps the Name for a constant method could give the
-- class/type involved?
\end{code}
......
......@@ -15,12 +15,11 @@ import CoreSyn
import CoreUnfold ( UnfoldingGuidance(..) )
import Id ( mkPreludeId )
import IdInfo -- quite a few things
import Name ( Name(..) )
import NameTypes ( mkPreludeCoreName )
import Name ( mkBuiltinName )
import PrelMods ( pRELUDE_BUILTIN )
import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str,
PrimOpInfo(..), PrimOpResultInfo(..)
)
PrimOpInfo(..), PrimOpResultInfo(..) )
import RnHsSyn ( RnName(..) )
import Type ( mkForAllTys, mkFunTys, applyTyCon )
import TysWiredIn ( boolTy )
import Unique ( mkPrimOpIdUnique )
......@@ -28,10 +27,10 @@ import Util ( panic )
\end{code}
\begin{code}
primOpNameInfo :: PrimOp -> (FAST_STRING, Name)
primOpNameInfo :: PrimOp -> (FAST_STRING, RnName)
primOpId :: PrimOp -> Id
primOpNameInfo op = (primOp_str op, WiredInVal (primOpId op))
primOpNameInfo op = (primOp_str op, WiredInId (primOpId op))
primOpId op
= case (primOpInfo op) of
......@@ -62,14 +61,12 @@ primOpId op
(length arg_tys) -- arity
where
mk_prim_Id prim_op mod name tyvar_tmpls arg_tys ty arity
= mkPreludeId
(mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op)))
(mkPreludeCoreName mod name)
ty
(noIdInfo
`addInfo` (mkArityInfo arity)
`addInfo_UF` (mkUnfolding EssentialUnfolding
(mk_prim_unfold prim_op tyvar_tmpls arg_tys)))
= mkPreludeId (mkBuiltinName key mod name) ty
(noIdInfo `addInfo` (mkArityInfo arity)
`addInfo_UF` (mkUnfolding EssentialUnfolding
(mk_prim_unfold prim_op tyvar_tmpls arg_tys)))
where
key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op))
\end{code}
......@@ -88,7 +85,7 @@ mk_prim_unfold prim_op tvs arg_tys
= panic "IdUtils.mk_prim_unfold"
{-
= let
(inst_env, tyvars, tyvar_tys) = instantiateTyVars tvs (map getItsUnique tvs)
(inst_env, tyvars, tyvar_tys) = instantiateTyVars tvs (map uniqueOf tvs)
inst_arg_tys = map (instantiateTauTy inst_env) arg_tys
vars = mkTemplateLocals inst_arg_tys
in
......
......@@ -7,139 +7,171 @@
#include "HsVersions.h"
module Name (
-- things for the Name NON-abstract type
Name(..),
isTyConName, isClassName, isClassOpName,
isUnboundName, invisibleName,
getTagFromClassOpName, getSynNameArity,
getNameShortName, getNameFullName
Module(..),
RdrName(..),
isUnqual,
isQual,
isConopRdr,
appendRdr,
rdrToOrig,
showRdr,
cmpRdr,
Name,
Provenance,
mkLocalName, isLocalName,
mkTopLevName, mkImportedName,
mkImplicitName, isImplicitName,
mkBuiltinName,
nameUnique,
nameOrigName,
nameOccName,
nameExportFlag,
nameSrcLoc,
isLocallyDefinedName,
isPreludeDefinedName
) where
import Ubiq{-uitous-}
import Ubiq
import NameLoop -- break Name/Id loop, Name/PprType/Id loop
import NameTypes
import Outputable ( ExportFlag(..) )
import CStrings ( identToC, cSEP )
import Outputable ( Outputable(..), ExportFlag(..), isConop )
import PprStyle ( PprStyle(..), codeStyle )
import Pretty
import PprStyle ( PprStyle(..) )
import PrelMods ( pRELUDE )
import SrcLoc ( mkBuiltinSrcLoc, mkUnknownSrcLoc )
import TyCon ( TyCon, synTyConArity )
import TyVar ( GenTyVar )
import Unique ( pprUnique, Unique )
import Util ( panic, panic#, pprPanic )
import Util ( thenCmp, _CMP_STRING_, panic )
\end{code}
%************************************************************************
%* *
\subsection[Name-datatype]{The @Name@ datatype}
\subsection[RdrName]{The @RdrName@ datatype; names read from files}
%* *
%************************************************************************
\begin{code}
data Name
= Short Unique -- Local ids and type variables
ShortName
-- Nano-prelude things; truly wired in.
-- Includes all type constructors and their associated data constructors
| WiredInTyCon TyCon
| WiredInVal Id
| TyConName Unique -- TyCons other than Prelude ones; need to
FullName -- separate these because we want to pin on
Arity -- their arity.
Bool -- False <=> `type',
-- True <=> `data' or `newtype'
[Name] -- List of user-visible data constructors;
-- NB: for `data' types only.
-- Used in checking import/export lists.
| ClassName Unique
FullName
[Name] -- List of class methods; used for checking
-- import/export lists.
| ValName Unique -- Top level id
FullName
| ClassOpName Unique
Name -- Name associated w/ the defined class
-- (can get unique and export info, etc., from this)
FAST_STRING -- The class operation
Int -- Unique tag within the class
-- Miscellaneous
| Unbound FAST_STRING -- Placeholder for a name which isn't in scope
-- Used only so that the renamer can carry on after
-- finding an unbound identifier.
-- The string is grabbed from the unbound name, for
-- debugging information only.
\end{code}
type Module = FAST_STRING
These @is..@ functions are used in the renamer to check that (eg) a tycon
is seen in a context which demands one.
data RdrName = Unqual FAST_STRING
| Qual Module FAST_STRING
\begin{code}
isTyConName, isClassName, isUnboundName :: Name -> Bool
isUnqual (Unqual _) = True
isUnqual (Qual _ _) = False
isTyConName (TyConName _ _ _ _ _) = True
isTyConName (WiredInTyCon _) = True
isTyConName other = False
isQual (Unqual _) = False
isQual (Qual _ _) = True
isClassName (ClassName _ _ _) = True
isClassName other = False
isConopRdr (Unqual n) = isConop n
isConopRdr (Qual m n) = isConop n
isUnboundName (Unbound _) = True
isUnboundName other = False
\end{code}
appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
@isClassOpName@ is a little cleverer: it checks to see whether the
class op comes from the correct class.
rdrToOrig (Unqual n) = (pRELUDE, n)
rdrToOrig (Qual m n) = (m, n)
\begin{code}
isClassOpName :: Name -- The name of the class expected for this op
-> Name -- The name of the thing which should be a class op
-> Bool
cmpRdr (Unqual n1) (Unqual n2) = _CMP_STRING_ n1 n2
cmpRdr (Unqual n1) (Qual m2 n2) = LT_
cmpRdr (Qual m1 n1) (Unqual n2) = GT_
cmpRdr (Qual m1 n1) (Qual m2 n2) = thenCmp (_CMP_STRING_ m1 m2) (_CMP_STRING_ n1 n2)
instance Eq RdrName where
a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
isClassOpName (ClassName uniq1 _ _) (ClassOpName _ (ClassName uniq2 _ _) _ _)
= uniq1 == uniq2
isClassOpName other_class other_op = False
instance Ord RdrName where
a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
instance Ord3 RdrName where
cmp = cmpRdr
instance NamedThing RdrName where
-- We're sorta faking it here
getName rdr_name
= Global u rdr_name prov ex [rdr_name]
where
u = panic "NamedThing.RdrName:Unique"
prov = panic "NamedThing.RdrName:Provenance"
ex = panic "NamedThing.RdrName:ExportFlag"
instance Outputable RdrName where
ppr sty (Unqual n) = pp_name sty n
ppr sty (Qual m n) = ppBeside (pp_mod sty m) (pp_name sty n)
pp_mod PprInterface m = ppNil
pp_mod PprForC m = ppBesides [identToC m, ppPStr cSEP]
pp_mod (PprForAsm False _) m = ppBesides [identToC m, ppPStr cSEP]
pp_mod (PprForAsm True _) m = ppBesides [ppPStr cSEP, identToC m, ppPStr cSEP]
pp_mod _ m = ppBesides [ppPStr m, ppChar '.']
pp_name sty n | codeStyle sty = identToC n
| otherwise = ppPStr n
showRdr sty rdr = ppShow 100 (ppr sty rdr)
\end{code}
A Name is ``invisible'' if the user has no business seeing it; e.g., a
data-constructor for an abstract data type (but whose constructors are
known because of a pragma).
%************************************************************************
%* *
\subsection[Name-datatype]{The @Name@ datatype}
%* *
%************************************************************************
\begin{code}
invisibleName :: Name -> Bool
data Name
= Local Unique
FAST_STRING
SrcLoc
| Global Unique
RdrName -- original name; Unqual => prelude
Provenance -- where it came from
ExportFlag -- is it exported?
[RdrName] -- ordered occurrence names (usually just one);
-- first may be *un*qual.
data Provenance
= LocalDef SrcLoc -- locally defined; give its source location
| Imported SrcLoc -- imported; give the *original* source location
-- [SrcLoc] -- any import source location(s)
invisibleName (TyConName _ n _ _ _) = invisibleFullName n
invisibleName (ClassName _ n _) = invisibleFullName n
invisibleName (ValName _ n) = invisibleFullName n
invisibleName _ = False
| Implicit
| Builtin
\end{code}
\begin{code}
getTagFromClassOpName :: Name -> Int
getTagFromClassOpName (ClassOpName _ _ _ tag) = tag
mkLocalName = Local
getSynNameArity :: Name -> Maybe Arity
getSynNameArity (TyConName _ _ arity False{-syn-} _) = Just arity
getSynNameArity (WiredInTyCon tycon) = synTyConArity tycon
getSynNameArity other_name = Nothing
mkTopLevName u orig locn exp occs = Global u orig (LocalDef locn) exp occs
mkImportedName u orig locn exp occs = Global u orig (Imported locn) exp occs
getNameShortName :: Name -> ShortName
getNameShortName (Short _ sn) = sn
mkImplicitName :: Unique -> RdrName -> Name
mkImplicitName u o = Global u o Implicit NotExported []
getNameFullName :: Name -> FullName
getNameFullName n = get_nm "getNameFullName" n
mkBuiltinName :: Unique -> Module -> FAST_STRING -> Name
mkBuiltinName u m n = Global u (Unqual n) Builtin NotExported []
-- ToDo: what about module ???
-- ToDo: exported when compiling builtin ???
isLocalName (Local _ _ _) = True
isLocalName _ = False
isImplicitName (Global _ _ Implicit _ _) = True
isImplicitName _ = False
isBuiltinName (Global _ _ Builtin _ _) = True
isBuiltinName _ = False
\end{code}
%************************************************************************
%* *
\subsection[Name-instances]{Instance declarations}
......@@ -149,17 +181,8 @@ getNameFullName n = get_nm "getNameFullName" n
\begin{code}
cmpName n1 n2 = c n1 n2
where
c (Short u1 _) (Short u2 _) = cmp u1 u2
c (WiredInTyCon tc1) (WiredInTyCon tc2) = cmp tc1 tc2
c (WiredInVal id1) (WiredInVal id2) = cmp id1 id2
c (TyConName u1 _ _ _ _) (TyConName u2 _ _ _ _) = cmp u1 u2
c (ClassName u1 _ _) (ClassName u2 _ _) = cmp u1 u2
c (ValName u1 _) (ValName u2 _) = cmp u1 u2
c (ClassOpName u1 _ _ _) (ClassOpName u2 _ _ _) = cmp u1 u2
c (Unbound a) (Unbound b) = panic# "Eq.Name.Unbound"
c (Local u1 _ _) (Local u2 _ _) = cmp u1 u2
c (Global u1 _ _ _ _) (Global u2 _ _ _ _) = cmp u1 u2
c other_1 other_2 -- the tags *must* be different
= let tag1 = tag_Name n1
......@@ -167,14 +190,8 @@ cmpName n1 n2 = c n1 n2
in
if tag1 _LT_ tag2 then LT_ else GT_
tag_Name (Short _ _) = (ILIT(1) :: FAST_INT)
tag_Name (WiredInTyCon _) = ILIT(2)
tag_Name (WiredInVal _) = ILIT(3)
tag_Name (TyConName _ _ _ _ _) = ILIT(7)
tag_Name (ClassName _ _ _) = ILIT(8)
tag_Name (ValName _ _) = ILIT(9)
tag_Name (ClassOpName _ _ _ _) = ILIT(10)
tag_Name (Unbound _) = ILIT(11)
tag_Name (Local _ _ _) = (ILIT(1) :: FAST_INT)
tag_Name (Global _ _ _ _ _) = ILIT(2)
\end{code}
\begin{code}
......@@ -190,106 +207,68 @@ instance Ord Name where
instance Ord3 Name where
cmp = cmpName
\end{code}
\begin{code}
instance Uniquable Name where
uniqueOf = nameUnique
instance NamedThing Name where
getExportFlag (Short _ _) = NotExported
getExportFlag (WiredInTyCon _) = NotExported -- compiler always know about these
getExportFlag (WiredInVal _) = NotExported
getExportFlag (ClassOpName _ c _ _) = getExportFlag c
getExportFlag other = getExportFlag (get_nm "getExportFlag" other)
isLocallyDefined (Short _ _) = True
isLocallyDefined (WiredInTyCon _) = False
isLocallyDefined (WiredInVal _) = False
isLocallyDefined (ClassOpName _ c _ _) = isLocallyDefined c
isLocallyDefined other = isLocallyDefined (get_nm "isLocallyDefined" other)
getOrigName (Short _ sn) = getOrigName sn
getOrigName (WiredInTyCon tc) = getOrigName tc
getOrigName (WiredInVal id) = getOrigName id
getOrigName (ClassOpName _ c op _) = (fst (getOrigName c), op)
getOrigName other = getOrigName (get_nm "getOrigName" other)
getOccurrenceName (Short _ sn) = getOccurrenceName sn
getOccurrenceName (WiredInTyCon tc) = getOccurrenceName tc
getOccurrenceName (WiredInVal id) = getOccurrenceName id
getOccurrenceName (ClassOpName _ _ op _) = op
getOccurrenceName (Unbound s) = s _APPEND_ SLIT("<unbound>")
getOccurrenceName other = getOccurrenceName (get_nm "getOccurrenceName" other)
getInformingModules thing = panic "getInformingModule:Name"
getSrcLoc (Short _ sn) = getSrcLoc sn
getSrcLoc (WiredInTyCon tc) = mkBuiltinSrcLoc
getSrcLoc (WiredInVal id) = mkBuiltinSrcLoc
getSrcLoc (ClassOpName _ c _ _) = getSrcLoc c
getSrcLoc (Unbound _) = mkUnknownSrcLoc
getSrcLoc other = getSrcLoc (get_nm "getSrcLoc" other)
getItsUnique (Short u _) = u
getItsUnique (WiredInTyCon t) = getItsUnique t
getItsUnique (WiredInVal i) = getItsUnique i
getItsUnique (TyConName u _ _ _ _) = u
getItsUnique (ClassName u _ _) = u
getItsUnique (ValName u _) = u
getItsUnique (ClassOpName u _ _ _) = u
fromPreludeCore (WiredInTyCon _) = True
fromPreludeCore (WiredInVal _) = True
fromPreludeCore (ClassOpName _ c _ _) = fromPreludeCore c
fromPreludeCore other = False
getName n = n
\end{code}
A useful utility; most emphatically not for export! (but see