\section[Name]{@Name@: to transmit name info from renamer to typechecker}
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module Name (
-- Re-export the OccName stuff
module OccName,
getSrcLoc, getSrcSpan, getOccString
) where
-#include "HsVersions.h"
-
import {-# SOURCE #-} TypeRep( TyThing )
import OccName
import Module
import SrcLoc
-import UniqFM
import Unique
import Maybes
import Binary
-import FastMutInt
import FastTypes
import FastString
import Outputable
-import Data.IORef
import Data.Array
\end{code}
isWiredInName :: Name -> Bool
isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
-isWiredInName other = False
+isWiredInName _ = False
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
-wiredInNameTyThing_maybe other = Nothing
+wiredInNameTyThing_maybe _ = Nothing
+isBuiltInSyntax :: Name -> Bool
isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
-isBuiltInSyntax other = False
+isBuiltInSyntax _ = False
isExternalName (Name {n_sort = External _}) = True
isExternalName (Name {n_sort = WiredIn _ _ _}) = True
-isExternalName other = False
+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 name = Nothing
+nameModule_maybe _ = Nothing
nameIsLocalOrFrom from name
| isExternalName name = from == nameModule name
isTyConName name = isTcOcc (nameOccName name)
isSystemName (Name {n_sort = System}) = True
-isSystemName other = False
+isSystemName _ = False
\end{code}
%************************************************************************
\begin{code}
+cmpName :: Name -> Name -> Ordering
cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
\end{code}
\begin{code}
instance Binary Name where
- put_ bh name = do
- case getUserData bh of {
- UserData { ud_symtab_map = symtab_map_ref,
- ud_symtab_next = symtab_next } -> do
- symtab_map <- readIORef symtab_map_ref
- case lookupUFM symtab_map name of
- Just (off,_) -> put_ bh off
- Nothing -> do
- off <- readFastMutInt symtab_next
- writeFastMutInt symtab_next (off+1)
- writeIORef symtab_map_ref
- $! addToUFM symtab_map name (off,name)
- put_ bh off
- }
+ put_ bh name =
+ case getUserData bh of
+ UserData{ ud_put_name = put_name } -> put_name bh name
get bh = do
i <- get bh
instance OutputableBndr Name where
pprBndr _ name = pprName name
-pprName name@(Name {n_sort = sort, n_uniq = u, 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
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
-- 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,
+ <> braces (hsep [if is_wired then ptext (sLit "(w)") else empty,
pprNameSpaceBrief (occNameSpace occ),
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ
| otherwise = ppr_occ_name occ
where qual_name = qualName sty mod 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),
| 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
-- is unlikely to be informative (like 's'),
-- so print the unique
+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))
-- Prints (if mod information is available) "Defined at <loc>" or
pprNameLoc name
| isGoodSrcSpan loc = pprDefnLoc loc
| isInternalName name || isSystemName name
- = ptext SLIT("<no location info>")
- | otherwise = ptext SLIT("Defined in ") <> ppr (nameModule name)
+ = ptext (sLit "<no location info>")
+ | otherwise = ptext (sLit "Defined in ") <> ppr (nameModule name)
where loc = nameSrcSpan name
\end{code}
projects / ghc-hetmet.git / blobdiff