projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Added listSplitUniqSupply to ./compiler/basicTypes/UniqSupply.lhs
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
Name.lhs
diff --git
a/compiler/basicTypes/Name.lhs
b/compiler/basicTypes/Name.lhs
index
feda0b1
..
af9f280
100644
(file)
--- a/
compiler/basicTypes/Name.lhs
+++ b/
compiler/basicTypes/Name.lhs
@@
-15,6
+15,7
@@
module Name (
mkInternalName, mkSystemName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
mkInternalName, mkSystemName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
+ mkTickBoxOpName,
mkExternalName, mkWiredInName,
nameUnique, setNameUnique,
mkExternalName, mkWiredInName,
nameUnique, setNameUnique,
@@
-22,7
+23,7
@@
module Name (
tidyNameOcc,
hashName, localiseName,
tidyNameOcc,
hashName, localiseName,
- nameSrcLoc,
+ nameSrcLoc, nameSrcSpan,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
@@
-31,7
+32,7
@@
module Name (
-- Class NamedThing and overloaded friends
NamedThing(..),
-- Class NamedThing and overloaded friends
NamedThing(..),
- getSrcLoc, getOccString
+ getSrcLoc, getSrcSpan, getOccString
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
@@
-65,7
+66,7
@@
data Name = Name {
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
n_uniq :: Int#, -- UNPACK doesn't work, recursive type
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
n_uniq :: Int#, -- UNPACK doesn't work, recursive type
- n_loc :: !SrcLoc -- Definition site
+ n_loc :: !SrcSpan -- Definition site
}
-- NOTE: we make the n_loc field strict to eliminate some potential
}
-- NOTE: we make the n_loc field strict to eliminate some potential
@@
-126,10
+127,12
@@
nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
+nameSrcSpan :: Name -> SrcSpan
nameUnique name = mkUniqueGrimily (I# (n_uniq name))
nameOccName name = n_occ name
nameUnique name = mkUniqueGrimily (I# (n_uniq name))
nameOccName name = n_occ name
-nameSrcLoc name = n_loc name
+nameSrcLoc name = srcSpanStart (n_loc name)
+nameSrcSpan name = n_loc name
\end{code}
\begin{code}
\end{code}
\begin{code}
@@
-182,7
+185,7
@@
isSystemName other = False
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-mkInternalName :: Unique -> OccName -> SrcLoc -> Name
+mkInternalName :: Unique -> OccName -> SrcSpan -> Name
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
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
@@
-193,7
+196,7
@@
mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
-mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name
+mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName uniq mod occ loc
= Name { n_uniq = getKey# uniq, n_sort = External mod,
n_occ = occ, n_loc = loc }
mkExternalName uniq mod occ loc
= Name { n_uniq = getKey# uniq, n_sort = External mod,
n_occ = occ, n_loc = loc }
@@
-203,11
+206,11
@@
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax
mkWiredInName mod occ uniq thing built_in
= Name { n_uniq = getKey# uniq,
n_sort = WiredIn mod thing built_in,
mkWiredInName mod occ uniq thing built_in
= Name { n_uniq = getKey# uniq,
n_sort = WiredIn mod thing built_in,
- n_occ = occ, n_loc = wiredInSrcLoc }
+ n_occ = occ, n_loc = wiredInSrcSpan }
mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System,
mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System,
- n_occ = occ, n_loc = noSrcLoc }
+ n_occ = occ, n_loc = noSrcSpan }
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
@@
-218,14
+221,19
@@
mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall
mkFCallName uniq str = Name { n_uniq = getKey# uniq, n_sort = Internal,
mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall
mkFCallName uniq str = Name { n_uniq = getKey# uniq, n_sort = Internal,
- n_occ = mkVarOcc str, n_loc = noSrcLoc }
+ n_occ = mkVarOcc str, n_loc = noSrcSpan }
+
+mkTickBoxOpName :: Unique -> String -> Name
+mkTickBoxOpName uniq str
+ = Name { n_uniq = getKey# uniq, n_sort = Internal,
+ n_occ = mkVarOcc str, n_loc = noSrcSpan }
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
= Name { n_uniq = getKey# uniq,
n_sort = Internal,
n_occ = occ,
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
= Name { n_uniq = getKey# uniq,
n_sort = Internal,
n_occ = occ,
- n_loc = noSrcLoc }
+ n_loc = noSrcSpan }
\end{code}
\begin{code}
\end{code}
\begin{code}
@@
-254,8
+262,11
@@
localiseName n = n { n_sort = Internal }
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-hashName :: Name -> Int
-hashName name = getKey (nameUnique name)
+hashName :: Name -> Int -- ToDo: should really be Word
+hashName name = getKey (nameUnique name) + 1
+ -- The +1 avoids keys with lots of zeros in the ls bits, which
+ -- interacts badly with the cheap and cheerful multiplication in
+ -- hashExpr
\end{code}
\end{code}
@@
-397,9
+408,11
@@
class NamedThing a where
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
+getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String
getSrcLoc = nameSrcLoc . getName
getOccString :: NamedThing a => a -> String
getSrcLoc = nameSrcLoc . getName
+getSrcSpan = nameSrcSpan . getName
getOccString = occNameString . getOccName
\end{code}
getOccString = occNameString . getOccName
\end{code}