projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
FIX #1465, error messages could sometimes say things like "A.T doesn't match A.T"
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
Name.lhs
diff --git
a/compiler/basicTypes/Name.lhs
b/compiler/basicTypes/Name.lhs
index
feda0b1
..
488dbca
100644
(file)
--- a/
compiler/basicTypes/Name.lhs
+++ b/
compiler/basicTypes/Name.lhs
@@
-5,6
+5,13
@@
\section[Name]{@Name@: to transmit name info from renamer to typechecker}
\begin{code}
\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,
module Name (
-- Re-export the OccName stuff
module OccName,
@@
-15,6
+22,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
+30,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
+39,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
+73,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
+134,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
+192,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
+203,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
+213,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
+228,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
+269,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}
@@
-349,9
+367,13
@@
pprExternal sty uniq mod occ is_wired is_builtin
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ
-- never qualify builtin syntax
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ
-- never qualify builtin syntax
- | 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
+ | 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
| otherwise = ppr_occ_name occ
+ where qual_name = qualName sty mod occ
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
@@
-397,9
+419,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}