BuiltInSyntax(..),
-- ** Creating 'Name's
- mkInternalName, mkSystemName,
+ mkInternalName, mkSystemName, mkDerivedInternalName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
mkTickBoxOpName,
NamedThing(..),
getSrcLoc, getSrcSpan, getOccString,
- pprInfixName, pprPrefixName,
+ pprInfixName, pprPrefixName, pprModulePrefix,
+ getNameDepth, setNameDepth,
-- Re-export the OccName stuff
module OccName
) where
+#include "Typeable.h"
+
import {-# SOURCE #-} TypeRep( TyThing )
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}
%************************************************************************
-- (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
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
+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
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
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}
%************************************************************************
get bh = do
i <- get bh
- return $! (ud_symtab (getUserData bh) ! i)
+ return $! (ud_symtab (getUserData bh) ! fromIntegral (i::Word32))
\end{code}
%************************************************************************
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
+ | 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
- | NameQual modname <- qual_name = ppr modname <> dot <> ppr_occ_name occ
- -- see HscTypes.mkPrintUnqualified and Outputable.QualifyName:
- | NameNotInScope1 <- qual_name = ppr mod <> dot <> ppr_occ_name occ
- | NameNotInScope2 <- qual_name = ppr (modulePackageId mod) <> char ':' <>
- ppr (moduleName mod) <> dot <> ppr_occ_name occ
- | otherwise = ppr_occ_name occ
- where qual_name = qualName sty mod 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
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;
projects / ghc-hetmet.git / blobdiff