+ ppr PprDebug (Global u m (Left n) _ _ _) = ppBesides [pp_mod PprDebug m, pp_name PprDebug n, ppStr "{-", pprUnique u, ppStr "-}"]
+ ppr PprDebug (Global u m (Right n) _ _ _) = ppBesides [pp_mod PprDebug m, pp_name2 PprDebug n, ppStr "{-", pprUnique u, ppStr "-}"]
+
+ ppr PprForUser (Global u m (Left n) _ _ [] ) = ppBeside (pp_mod PprForUser m) (pp_name PprForUser n)
+ ppr PprForUser (Global u m (Right n) _ _ [] ) = ppBeside (pp_mod PprForUser m) (pp_name2 PprForUser n)
+ ppr PprForUser (Global u m (Left _) _ _ occs) = ppr PprForUser (head occs)
+
+-- LATER:?
+-- ppr PprShowAll (Global u m n prov exp occs) = pp_all (Qual m n) prov exp occs
+
+ ppr sty (Global u m (Left n) _ _ _) = ppBeside (pp_mod sty m) (pp_name sty n)
+ ppr sty (Global u m (Right n) _ _ _) = ppBeside (pp_mod sty m) (pp_name2 sty n)
+
+pp_all orig prov exp occs
+ = ppBesides [ppr PprShowAll orig, ppr PprShowAll occs, pp_prov prov, pp_exp exp]
+
+pp_exp NotExported = ppNil
+pp_exp ExportAll = ppPStr SLIT("/EXP(..)")
+pp_exp ExportAbs = ppPStr SLIT("/EXP")
+
+pp_prov Implicit = ppPStr SLIT("/IMPLICIT")
+pp_prov Primitive = ppPStr SLIT("/PRIMITIVE")
+pp_prov (WiredIn _) = ppPStr SLIT("/WIREDIN")
+pp_prov _ = ppNil
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[ExportFlag-datatype]{The @ExportFlag@ datatype}
+%* *
+%************************************************************************
+
+The export flag @ExportAll@ means `export all there is', so there are
+times when it is attached to a class or data type which has no
+ops/constructors (if the class/type was imported abstractly). In
+fact, @ExportAll@ is attached to everything except to classes/types
+which are being {\em exported} abstractly, regardless of how they were
+imported.
+
+\begin{code}
+data ExportFlag
+ = ExportAll -- export with all constructors/methods
+ | ExportAbs -- export abstractly (tycons/classes only)
+ | NotExported
+
+exportFlagOn NotExported = False
+exportFlagOn _ = True
+
+-- Be very wary about using "isExported"; perhaps you
+-- really mean "externallyVisibleId"?
+
+isExported a = exportFlagOn (getExportFlag a)
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Overloaded functions related to Names}
+%* *
+%************************************************************************
+
+\begin{code}
+class NamedThing a where
+ getName :: a -> Name
+\end{code}
+
+\begin{code}
+origName :: NamedThing a => String -> a -> OrigName
+moduleOf :: OrigName -> Module
+nameOf :: OrigName -> FAST_STRING
+
+getOccName :: NamedThing a => a -> RdrName
+getLocalName :: NamedThing a => a -> FAST_STRING
+getExportFlag :: NamedThing a => a -> ExportFlag
+getSrcLoc :: NamedThing a => a -> SrcLoc
+getImpLocs :: NamedThing a => a -> [SrcLoc]
+isLocallyDefined :: NamedThing a => a -> Bool
+
+origName str n = nameOrigName str (getName n)
+
+moduleOf (OrigName m n) = m
+nameOf (OrigName m n) = n
+
+getLocalName n
+ = case (getName n) of
+ Local _ n _ _ -> n
+ Global _ m (Left n) _ _ _ -> n
+ Global _ m (Right n) _ _ _ -> let str = _CONCAT_ (glue n) in
+ -- pprTrace "getLocalName:" (ppPStr str) $
+ str
+
+getOccName = nameOccName . getName
+getExportFlag = nameExportFlag . getName
+getSrcLoc = nameSrcLoc . getName
+getImpLocs = nameImpLocs . getName
+isLocallyDefined = isLocallyDefinedName . getName
+\end{code}
+
+\begin{code}
+{-# SPECIALIZE getLocalName
+ :: Name -> FAST_STRING
+ , OrigName -> FAST_STRING
+ , RdrName -> FAST_STRING
+ , RnName -> FAST_STRING
+ #-}
+{-# SPECIALIZE isLocallyDefined
+ :: Name -> Bool
+ , RnName -> Bool
+ #-}
+{-# SPECIALIZE origName
+ :: String -> Name -> OrigName
+ , String -> RdrName -> OrigName
+ , String -> RnName -> OrigName
+ #-}
+\end{code}
+
+These functions test strings to see if they fit the lexical categories
+defined in the Haskell report. Normally applied as in e.g. @isCon
+(getLocalName foo)@.
+
+\begin{code}
+isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym,
+ isLexVarId, isLexVarSym, isLexSpecialSym :: FAST_STRING -> Bool
+
+isLexCon cs = isLexConId cs || isLexConSym cs
+isLexVar cs = isLexVarId cs || isLexVarSym cs
+
+isLexId cs = isLexConId cs || isLexVarId cs
+isLexSym cs = isLexConSym cs || isLexVarSym cs
+
+-------------
+
+isLexConId cs
+ | _NULL_ cs = False
+ | otherwise = isUpper c || isUpperISO c
+ where
+ c = _HEAD_ cs
+
+isLexVarId cs
+ | _NULL_ cs = False
+ | otherwise = isLower c || isLowerISO c
+ where
+ c = _HEAD_ cs
+
+isLexConSym cs
+ | _NULL_ cs = False
+ | otherwise = c == ':'
+-- || c == '(' -- (), (,), (,,), ...
+ || cs == SLIT("->")
+-- || cs == SLIT("[]")
+ where
+ c = _HEAD_ cs
+
+isLexVarSym cs
+ | _NULL_ cs = False
+ | otherwise = isSymbolASCII c
+ || isSymbolISO c
+-- || c == '(' -- (), (,), (,,), ...
+-- || cs == SLIT("[]")
+ where
+ c = _HEAD_ cs
+
+isLexSpecialSym cs
+ | _NULL_ cs = False
+ | otherwise = c == '(' -- (), (,), (,,), ...
+ || cs == SLIT("[]")
+ where
+ c = _HEAD_ cs
+
+-------------
+isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
+isUpperISO c = 0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
+isLowerISO c = 0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
+\end{code}
+
+And one ``higher-level'' interface to those:
+
+\begin{code}
+isSymLexeme :: NamedThing a => a -> Bool
+
+isSymLexeme v
+ = let str = getLocalName v in isLexSym str
+
+-- print `vars`, (op) correctly
+pprSym, pprNonSym :: (NamedThing name, Outputable name) => PprStyle -> name -> Pretty
+
+pprSym sty var
+ = let
+ str = getLocalName var
+ in
+ if isLexSym str && not (isLexSpecialSym str)
+ then ppr sty var
+ else ppBesides [ppChar '`', ppr sty var, ppChar '`']
+
+pprNonSym sty var
+ = if isSymLexeme var
+ then ppParens (ppr sty var)
+ else ppr sty var