projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
newtype fixes, coercions for non-recursive newtypes now optional
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
Name.lhs
diff --git
a/compiler/basicTypes/Name.lhs
b/compiler/basicTypes/Name.lhs
index
1e1fb31
..
25db761
100644
(file)
--- a/
compiler/basicTypes/Name.lhs
+++ b/
compiler/basicTypes/Name.lhs
@@
-24,7
+24,7
@@
module Name (
nameSrcLoc, nameParent, nameParent_maybe, isImplicitName,
isSystemName, isInternalName, isExternalName,
nameSrcLoc, nameParent, nameParent_maybe, isImplicitName,
isSystemName, isInternalName, isExternalName,
- isTyVarName, isWiredInName, isBuiltInSyntax,
+ isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom,
@@
-38,12
+38,15
@@
module Name (
import {-# SOURCE #-} TypeRep( TyThing )
import OccName -- All of it
import {-# SOURCE #-} TypeRep( TyThing )
import OccName -- All of it
-import Module ( Module, moduleFS )
+import Module ( Module )
import SrcLoc ( noSrcLoc, wiredInSrcLoc, SrcLoc )
import SrcLoc ( noSrcLoc, wiredInSrcLoc, SrcLoc )
-import Unique ( Unique, Uniquable(..), getKey, pprUnique )
+import Unique ( Unique, Uniquable(..), getKey, pprUnique,
+ mkUniqueGrimily, getKey# )
import Maybes ( orElse, isJust )
import FastString ( FastString, zEncodeFS )
import Outputable
import Maybes ( orElse, isJust )
import FastString ( FastString, zEncodeFS )
import Outputable
+
+import GLAEXTS ( Int#, Int(..) )
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-56,7
+59,7
@@
import Outputable
data Name = Name {
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
data Name = Name {
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
- n_uniq :: Unique,
+ n_uniq :: Int#, -- UNPACK doesn't work, recursive type
n_loc :: !SrcLoc -- Definition site
}
n_loc :: !SrcLoc -- Definition site
}
@@
-122,7
+125,7
@@
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
-nameUnique name = n_uniq name
+nameUnique name = mkUniqueGrimily (I# (n_uniq name))
nameOccName name = n_occ name
nameSrcLoc name = n_loc name
\end{code}
nameOccName name = n_occ name
nameSrcLoc name = n_loc name
\end{code}
@@
-177,6
+180,9
@@
nameIsLocalOrFrom from name
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
+isTyConName :: Name -> Bool
+isTyConName name = isTcOcc (nameOccName name)
+
isSystemName (Name {n_sort = System}) = True
isSystemName other = False
\end{code}
isSystemName (Name {n_sort = System}) = True
isSystemName other = False
\end{code}
@@
-190,7
+196,7
@@
isSystemName other = False
\begin{code}
mkInternalName :: Unique -> OccName -> SrcLoc -> Name
\begin{code}
mkInternalName :: Unique -> OccName -> SrcLoc -> Name
-mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
+mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
-- NB: You might worry that after lots of huffing and
-- puffing we might end up with two local names with distinct
-- uniques, but the same OccName. Indeed we can, but that's ok
-- NB: You might worry that after lots of huffing and
-- puffing we might end up with two local names with distinct
-- uniques, but the same OccName. Indeed we can, but that's ok
@@
-202,18
+208,18
@@
mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = o
mkExternalName :: Unique -> Module -> OccName -> Maybe Name -> SrcLoc -> Name
mkExternalName uniq mod occ mb_parent loc
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,
+ = Name { n_uniq = getKey# uniq, n_sort = External mod mb_parent,
n_occ = occ, n_loc = loc }
mkWiredInName :: Module -> OccName -> Unique
-> Maybe Name -> TyThing -> BuiltInSyntax -> Name
mkWiredInName mod occ uniq mb_parent thing built_in
n_occ = occ, n_loc = loc }
mkWiredInName :: Module -> OccName -> Unique
-> Maybe Name -> TyThing -> BuiltInSyntax -> Name
mkWiredInName mod occ uniq mb_parent thing built_in
- = Name { n_uniq = uniq,
+ = Name { n_uniq = getKey# uniq,
n_sort = WiredIn mod mb_parent thing built_in,
n_occ = occ, n_loc = wiredInSrcLoc }
mkSystemName :: Unique -> OccName -> Name
n_sort = WiredIn mod mb_parent thing built_in,
n_occ = occ, n_loc = wiredInSrcLoc }
mkSystemName :: Unique -> OccName -> Name
-mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System,
+mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System,
n_occ = occ, n_loc = noSrcLoc }
mkSystemVarName :: Unique -> FastString -> Name
n_occ = occ, n_loc = noSrcLoc }
mkSystemVarName :: Unique -> FastString -> Name
@@
-224,12
+230,12
@@
mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall
mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall
-mkFCallName uniq str = Name { n_uniq = uniq, n_sort = Internal,
+mkFCallName uniq str = Name { n_uniq = getKey# uniq, n_sort = Internal,
n_occ = mkVarOcc str, n_loc = noSrcLoc }
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
n_occ = mkVarOcc str, n_loc = noSrcLoc }
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
- = Name { n_uniq = uniq,
+ = Name { n_uniq = getKey# uniq,
n_sort = Internal,
n_occ = occ,
n_loc = noSrcLoc }
n_sort = Internal,
n_occ = occ,
n_loc = noSrcLoc }
@@
-239,7
+245,8
@@
mkIPName uniq occ
-- When we renumber/rename things, we need to be
-- able to change a Name's Unique to match the cached
-- one in the thing it's the name of. If you know what I mean.
-- When we renumber/rename things, we need to be
-- able to change a Name's Unique to match the cached
-- one in the thing it's the name of. If you know what I mean.
-setNameUnique name uniq = name {n_uniq = uniq}
+setNameUnique :: Name -> Unique -> Name
+setNameUnique name uniq = name {n_uniq = getKey# uniq}
tidyNameOcc :: Name -> OccName -> Name
-- We set the OccName of a Name when tidying
tidyNameOcc :: Name -> OccName -> Name
-- We set the OccName of a Name when tidying
@@
-272,7
+279,7
@@
hashName name = getKey (nameUnique name)
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
+cmpName n1 n2 = I# (n_uniq n1) `compare` I# (n_uniq n2)
\end{code}
\begin{code}
\end{code}
\begin{code}
@@
-308,27
+315,29
@@
instance Outputable Name where
instance OutputableBndr Name where
pprBndr _ name = pprName name
instance OutputableBndr Name where
pprBndr _ name = pprName name
-pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+pprName name@(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
External mod _ -> pprExternal sty uniq mod occ False UserSyntax
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
= getPprStyle $ \ sty ->
case sort of
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
+ where uniq = mkUniqueGrimily (I# u#)
pprExternal sty uniq mod occ is_wired is_builtin
pprExternal sty uniq mod occ is_wired is_builtin
- | codeStyle sty = ppr_z_module 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?
-- 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])
+ | 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
| BuiltInSyntax <- is_builtin = ppr_occ_name occ
-- never qualify builtin syntax
- | unqualStyle sty mod occ = ppr_occ_name occ
- | otherwise = ppr mod <> dot <> ppr_occ_name occ
+ | Just mod <- qualName sty mod occ = ppr mod <> dot <> ppr_occ_name occ
+ -- the PrintUnqualified tells us how to qualify this Name, if at all
+ | otherwise = ppr_occ_name occ
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
@@
-356,8
+365,6
@@
ppr_occ_name occ = ftext (occNameFS occ)
-- 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 occ = ftext (zEncodeFS (occNameFS occ))
-- 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 occ = ftext (zEncodeFS (occNameFS occ))
-ppr_z_module mod = ftext (zEncodeFS (moduleFS mod))
-
\end{code}
%************************************************************************
\end{code}
%************************************************************************