Commit 940524ae authored by Simon Marlow's avatar Simon Marlow

Store a SrcSpan instead of a SrcLoc inside a Name

This has been a long-standing ToDo.
parent 485b80f9
...@@ -154,7 +154,7 @@ mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty ...@@ -154,7 +154,7 @@ mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
-- UserLocal: an Id with a name the user might recognize... -- UserLocal: an Id with a name the user might recognize...
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
mkVanillaGlobal :: Name -> Type -> IdInfo -> Id mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
...@@ -175,7 +175,7 @@ mkWorkerId :: Unique -> Id -> Type -> Id ...@@ -175,7 +175,7 @@ mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId uniq unwrkr ty mkWorkerId uniq unwrkr ty
= mkLocalId wkr_name ty = mkLocalId wkr_name ty
where where
wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr) wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr)
-- "Template locals" typically used in unfoldings -- "Template locals" typically used in unfoldings
mkTemplateLocals :: [Type] -> [Id] mkTemplateLocals :: [Type] -> [Id]
......
...@@ -23,7 +23,7 @@ module Name ( ...@@ -23,7 +23,7 @@ module Name (
tidyNameOcc, tidyNameOcc,
hashName, localiseName, hashName, localiseName,
nameSrcLoc, nameSrcLoc, nameSrcSpan,
isSystemName, isInternalName, isExternalName, isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax, isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
...@@ -32,7 +32,7 @@ module Name ( ...@@ -32,7 +32,7 @@ module Name (
-- Class NamedThing and overloaded friends -- Class NamedThing and overloaded friends
NamedThing(..), NamedThing(..),
getSrcLoc, getOccString getSrcLoc, getSrcSpan, getOccString
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -66,7 +66,7 @@ data Name = Name { ...@@ -66,7 +66,7 @@ data Name = Name {
n_sort :: NameSort, -- What sort of name it is n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name n_occ :: !OccName, -- Its occurrence name
n_uniq :: Int#, -- UNPACK doesn't work, recursive type 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
...@@ -127,10 +127,12 @@ nameUnique :: Name -> Unique ...@@ -127,10 +127,12 @@ nameUnique :: Name -> Unique
nameOccName :: Name -> OccName nameOccName :: Name -> OccName
nameModule :: Name -> Module nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc nameSrcLoc :: Name -> SrcLoc
nameSrcSpan :: Name -> SrcSpan
nameUnique name = mkUniqueGrimily (I# (n_uniq name)) nameUnique name = mkUniqueGrimily (I# (n_uniq name))
nameOccName name = n_occ name nameOccName name = n_occ name
nameSrcLoc name = n_loc name nameSrcLoc name = srcSpanStart (n_loc name)
nameSrcSpan name = n_loc name
\end{code} \end{code}
\begin{code} \begin{code}
...@@ -183,7 +185,7 @@ isSystemName other = False ...@@ -183,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 } 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 -- NB: You might worry that after lots of huffing and
-- puffing we might end up with two local names with distinct -- puffing we might end up with two local names with distinct
...@@ -194,7 +196,7 @@ mkInternalName uniq occ loc = Name { n_uniq = getKey# uniq, n_sort = Internal, n ...@@ -194,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 -- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below) -- into the print name (see setNameVisibility below)
mkExternalName :: Unique -> Module -> OccName -> SrcLoc -> Name mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName uniq mod occ loc mkExternalName uniq mod occ loc
= Name { n_uniq = getKey# uniq, n_sort = External mod, = Name { n_uniq = getKey# uniq, n_sort = External mod,
n_occ = occ, n_loc = loc } n_occ = occ, n_loc = loc }
...@@ -204,11 +206,11 @@ mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax ...@@ -204,11 +206,11 @@ mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax
mkWiredInName mod occ uniq thing built_in mkWiredInName mod occ uniq thing built_in
= Name { n_uniq = getKey# uniq, = Name { n_uniq = getKey# uniq,
n_sort = WiredIn mod thing built_in, n_sort = WiredIn mod thing built_in,
n_occ = occ, n_loc = wiredInSrcLoc } n_occ = occ, n_loc = wiredInSrcSpan }
mkSystemName :: Unique -> OccName -> Name mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System, 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 :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs) mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
...@@ -219,19 +221,19 @@ mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) ...@@ -219,19 +221,19 @@ mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
mkFCallName :: Unique -> String -> Name mkFCallName :: Unique -> String -> Name
-- The encoded string completely describes the ccall -- The encoded string completely describes the ccall
mkFCallName uniq str = Name { n_uniq = getKey# uniq, n_sort = Internal, 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 :: Unique -> String -> Name
mkTickBoxOpName uniq str mkTickBoxOpName uniq str
= Name { n_uniq = getKey# uniq, n_sort = Internal, = Name { n_uniq = getKey# uniq, n_sort = Internal,
n_occ = mkVarOcc str, n_loc = noSrcLoc } n_occ = mkVarOcc str, n_loc = noSrcSpan }
mkIPName :: Unique -> OccName -> Name mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ mkIPName uniq occ
= Name { n_uniq = getKey# uniq, = Name { n_uniq = getKey# uniq,
n_sort = Internal, n_sort = Internal,
n_occ = occ, n_occ = occ,
n_loc = noSrcLoc } n_loc = noSrcSpan }
\end{code} \end{code}
\begin{code} \begin{code}
...@@ -406,9 +408,11 @@ class NamedThing a where ...@@ -406,9 +408,11 @@ class NamedThing a where
\begin{code} \begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc getSrcLoc :: NamedThing a => a -> SrcLoc
getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String getOccString :: NamedThing a => a -> String
getSrcLoc = nameSrcLoc . getName getSrcLoc = nameSrcLoc . getName
getSrcSpan = nameSrcSpan . getName
getOccString = occNameString . getOccName getOccString = occNameString . getOccName
\end{code} \end{code}
...@@ -11,7 +11,6 @@ module SrcLoc ( ...@@ -11,7 +11,6 @@ module SrcLoc (
advanceSrcLoc, advanceSrcLoc,
importedSrcLoc, -- Unknown place in an interface importedSrcLoc, -- Unknown place in an interface
wiredInSrcLoc, -- Something wired into the compiler
generatedSrcLoc, -- Code generated within the compiler generatedSrcLoc, -- Code generated within the compiler
interactiveSrcLoc, -- Code from an interactive session interactiveSrcLoc, -- Code from an interactive session
...@@ -22,6 +21,8 @@ module SrcLoc ( ...@@ -22,6 +21,8 @@ module SrcLoc (
SrcSpan, -- Abstract SrcSpan, -- Abstract
noSrcSpan, noSrcSpan,
wiredInSrcSpan, -- Something wired into the compiler
importedSrcSpan, -- Unknown place in an interface
mkGeneralSrcSpan, mkGeneralSrcSpan,
isGoodSrcSpan, isOneLineSpan, isGoodSrcSpan, isOneLineSpan,
mkSrcSpan, srcLocSpan, mkSrcSpan, srcLocSpan,
...@@ -60,7 +61,7 @@ data SrcLoc ...@@ -60,7 +61,7 @@ data SrcLoc
-- Don't ask me why lines start at 1 and columns start at -- Don't ask me why lines start at 1 and columns start at
-- zero. That's just the way it is, so there. --SDM -- zero. That's just the way it is, so there. --SDM
| ImportedLoc String -- Module name | ImportedLoc FastString -- Module name
| UnhelpfulLoc FastString -- Just a general indication | UnhelpfulLoc FastString -- Just a general indication
\end{code} \end{code}
...@@ -81,13 +82,12 @@ Things to make 'em: ...@@ -81,13 +82,12 @@ Things to make 'em:
mkSrcLoc x line col = SrcLoc x line col mkSrcLoc x line col = SrcLoc x line col
noSrcLoc = UnhelpfulLoc FSLIT("<no location info>") noSrcLoc = UnhelpfulLoc FSLIT("<no location info>")
generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>") generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>")
wiredInSrcLoc = UnhelpfulLoc FSLIT("<wired into compiler>")
interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>") interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
mkGeneralSrcLoc :: FastString -> SrcLoc mkGeneralSrcLoc :: FastString -> SrcLoc
mkGeneralSrcLoc = UnhelpfulLoc mkGeneralSrcLoc = UnhelpfulLoc
importedSrcLoc :: String -> SrcLoc importedSrcLoc :: FastString -> SrcLoc
importedSrcLoc mod_name = ImportedLoc mod_name importedSrcLoc mod_name = ImportedLoc mod_name
isGoodSrcLoc (SrcLoc _ _ _) = True isGoodSrcLoc (SrcLoc _ _ _) = True
...@@ -150,7 +150,7 @@ instance Outputable SrcLoc where ...@@ -150,7 +150,7 @@ instance Outputable SrcLoc where
hcat [text "{-# LINE ", int src_line, space, hcat [text "{-# LINE ", int src_line, space,
char '\"', ftext src_path, text " #-}"] char '\"', ftext src_path, text " #-}"]
ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> text mod ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod
ppr (UnhelpfulLoc s) = ftext s ppr (UnhelpfulLoc s) = ftext s
\end{code} \end{code}
...@@ -193,7 +193,7 @@ data SrcSpan ...@@ -193,7 +193,7 @@ data SrcSpan
srcSpanCol :: !Int srcSpanCol :: !Int
} }
| ImportedSpan String -- Module name | ImportedSpan FastString -- Module name
| UnhelpfulSpan FastString -- Just a general indication | UnhelpfulSpan FastString -- Just a general indication
-- also used to indicate an empty span -- also used to indicate an empty span
...@@ -206,7 +206,9 @@ instance Ord SrcSpan where ...@@ -206,7 +206,9 @@ instance Ord SrcSpan where
(srcSpanStart a `compare` srcSpanStart b) `thenCmp` (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
(srcSpanEnd a `compare` srcSpanEnd b) (srcSpanEnd a `compare` srcSpanEnd b)
noSrcSpan = UnhelpfulSpan FSLIT("<no location info>") noSrcSpan = UnhelpfulSpan FSLIT("<no location info>")
wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
importedSrcSpan = ImportedSpan
mkGeneralSrcSpan :: FastString -> SrcSpan mkGeneralSrcSpan :: FastString -> SrcSpan
mkGeneralSrcSpan = UnhelpfulSpan mkGeneralSrcSpan = UnhelpfulSpan
...@@ -306,11 +308,11 @@ combineSrcSpans start end ...@@ -306,11 +308,11 @@ combineSrcSpans start end
col2 = srcSpanEndCol end col2 = srcSpanEndCol end
file = srcSpanFile start file = srcSpanFile start
pprDefnLoc :: SrcLoc -> SDoc pprDefnLoc :: SrcSpan -> SDoc
-- "defined at ..." or "imported from ..." -- "defined at ..." or "imported from ..."
pprDefnLoc loc pprDefnLoc loc
| isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
| otherwise = ppr loc | otherwise = ppr loc
instance Outputable SrcSpan where instance Outputable SrcSpan where
ppr span ppr span
...@@ -347,7 +349,7 @@ pprUserSpan (SrcSpanPoint src_path line col) ...@@ -347,7 +349,7 @@ pprUserSpan (SrcSpanPoint src_path line col)
char ':', int col char ':', int col
] ]
pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> text mod pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod
pprUserSpan (UnhelpfulSpan s) = ftext s pprUserSpan (UnhelpfulSpan s) = ftext s
\end{code} \end{code}
......
...@@ -350,7 +350,7 @@ maybeExternaliseId dflags id ...@@ -350,7 +350,7 @@ maybeExternaliseId dflags id
name = idName id name = idName id
uniq = nameUnique name uniq = nameUnique name
new_occ = mkLocalOcc uniq (nameOccName name) new_occ = mkLocalOcc uniq (nameOccName name)
loc = nameSrcLoc name loc = nameSrcSpan name
-- We want to conjure up a name that can't clash with any -- We want to conjure up a name that can't clash with any
-- existing name. So we generate -- existing name. So we generate
-- Mod_$L243foo -- Mod_$L243foo
......
...@@ -176,7 +176,7 @@ tidyIdBndr env@(tidy_env, var_env) id ...@@ -176,7 +176,7 @@ tidyIdBndr env@(tidy_env, var_env) id
-- which should save some space. -- which should save some space.
-- But note that tidyLetBndr puts some of it back. -- But note that tidyLetBndr puts some of it back.
ty' = tidyType env (idType id) ty' = tidyType env (idType id)
id' = mkUserLocal occ' (idUnique id) ty' noSrcLoc id' = mkUserLocal occ' (idUnique id) ty' noSrcSpan
`setIdInfo` vanillaIdInfo `setIdInfo` vanillaIdInfo
var_env' = extendVarEnv var_env id id' var_env' = extendVarEnv var_env id id'
in in
......
...@@ -734,7 +734,7 @@ dataConInstPat arg_fun fss uniqs con inst_tys ...@@ -734,7 +734,7 @@ dataConInstPat arg_fun fss uniqs con inst_tys
co_kind = substTy subst (mkPredTy eq_pred) co_kind = substTy subst (mkPredTy eq_pred)
-- make value vars, instantiating types -- make value vars, instantiating types
mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrcLoc mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrcSpan
id_bndrs = zipWith3 mk_id_var id_uniqs id_fss arg_tys id_bndrs = zipWith3 mk_id_var id_uniqs id_fss arg_tys
exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr]) exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
......
...@@ -378,7 +378,7 @@ make_row_vars used_lits (_, EqnInfo { eqn_pats = pats}) ...@@ -378,7 +378,7 @@ make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
hash_x = mkInternalName unboundKey {- doesn't matter much -} hash_x = mkInternalName unboundKey {- doesn't matter much -}
(mkVarOccFS FSLIT("#x")) (mkVarOccFS FSLIT("#x"))
noSrcLoc noSrcSpan
make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat] make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats}) make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
......
...@@ -948,7 +948,7 @@ mkTickBox ix vars e = do ...@@ -948,7 +948,7 @@ mkTickBox ix vars e = do
| otherwise = mkBreakPointOpId uq mod ix | otherwise = mkBreakPointOpId uq mod ix
uq2 <- newUnique uq2 <- newUnique
let occName = mkVarOcc "tick" let occName = mkVarOcc "tick"
let name = mkInternalName uq2 occName noSrcLoc -- use mkSysLocal? let name = mkInternalName uq2 occName noSrcSpan -- use mkSysLocal?
let var = Id.mkLocalId name realWorldStatePrimTy let var = Id.mkLocalId name realWorldStatePrimTy
scrut <- scrut <-
if opt_Hpc if opt_Hpc
......
...@@ -203,7 +203,7 @@ newGrimName cms userName = do ...@@ -203,7 +203,7 @@ newGrimName cms userName = do
us <- mkSplitUniqSupply 'b' us <- mkSplitUniqSupply 'b'
let unique = uniqFromSupply us let unique = uniqFromSupply us
occname = mkOccName varName userName occname = mkOccName varName userName
name = mkInternalName unique occname noSrcLoc name = mkInternalName unique occname noSrcSpan
return name return name
skolemSubst subst = subst `setTvSubstEnv` skolemSubst subst = subst `setTvSubstEnv`
......
...@@ -81,7 +81,7 @@ listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo] ...@@ -81,7 +81,7 @@ listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
listTags unqual modInfo = listTags unqual modInfo =
[ tagInfo unqual name loc [ tagInfo unqual name loc
| name <- GHC.modInfoExports modInfo | name <- GHC.modInfoExports modInfo
, let loc = nameSrcLoc name , let loc = srcSpanStart (nameSrcSpan name)
, isGoodSrcLoc loc , isGoodSrcLoc loc
] ]
......
...@@ -1556,7 +1556,7 @@ breakSwitch session args@(arg1:rest) ...@@ -1556,7 +1556,7 @@ breakSwitch session args@(arg1:rest)
io $ putStrLn "Perhaps no modules are loaded for debugging?" io $ putStrLn "Perhaps no modules are loaded for debugging?"
| otherwise = do -- try parsing it as an identifier | otherwise = do -- try parsing it as an identifier
wantNameFromInterpretedModule noCanDo arg1 $ \name -> do wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
let loc = GHC.nameSrcLoc name let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc if GHC.isGoodSrcLoc loc
then findBreakAndSet (GHC.nameModule name) $ then findBreakAndSet (GHC.nameModule name) $
findBreakByCoord (Just (GHC.srcLocFile loc)) findBreakByCoord (Just (GHC.srcLocFile loc))
...@@ -1678,7 +1678,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do ...@@ -1678,7 +1678,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
listModuleLine mod (read arg2) listModuleLine mod (read arg2)
list2 [arg] = do list2 [arg] = do
wantNameFromInterpretedModule noCanDo arg $ \name -> do wantNameFromInterpretedModule noCanDo arg $ \name -> do
let loc = GHC.nameSrcLoc name let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc if GHC.isGoodSrcLoc loc
then do then do
tickArray <- getTickArray (GHC.nameModule name) tickArray <- getTickArray (GHC.nameModule name)
......
...@@ -573,7 +573,7 @@ thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName ...@@ -573,7 +573,7 @@ thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
-- --
-- The strict applications ensure that any buried exceptions get forced -- The strict applications ensure that any buried exceptions get forced
thRdrName ctxt_ns occ (TH.NameG th_ns pkg mod) = (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! (mk_occ (mk_ghc_ns th_ns) occ) thRdrName ctxt_ns occ (TH.NameG th_ns pkg mod) = (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! (mk_occ (mk_ghc_ns th_ns) occ)
thRdrName ctxt_ns occ (TH.NameL uniq) = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrcLoc) thRdrName ctxt_ns occ (TH.NameL uniq) = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrcSpan)
thRdrName ctxt_ns occ (TH.NameQ mod) = (mkRdrQual $! (mk_mod mod)) $! (mk_occ ctxt_ns occ) thRdrName ctxt_ns occ (TH.NameQ mod) = (mkRdrQual $! (mk_mod mod)) $! (mk_occ ctxt_ns occ)
thRdrName ctxt_ns occ (TH.NameU uniq) = mkRdrUnqual $! (mk_uniq_occ ctxt_ns occ uniq) thRdrName ctxt_ns occ (TH.NameU uniq) = mkRdrUnqual $! (mk_uniq_occ ctxt_ns occ uniq)
thRdrName ctxt_ns occ TH.NameS thRdrName ctxt_ns occ TH.NameS
......
...@@ -216,7 +216,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) = ...@@ -216,7 +216,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) =
let let
us = nsUniqs nc us = nsUniqs nc
uniq = uniqFromSupply us uniq = uniqFromSupply us
name = mkExternalName uniq mod occ noSrcLoc name = mkExternalName uniq mod occ noSrcSpan
new_cache = extendNameCache cache mod occ name new_cache = extendNameCache cache mod occ name
in in
case splitUniqSupply us of { (us',_) -> case splitUniqSupply us of { (us',_) ->
......
...@@ -46,7 +46,7 @@ import Outputable ...@@ -46,7 +46,7 @@ import Outputable
%********************************************************* %*********************************************************
\begin{code} \begin{code}
newGlobalBinder :: Module -> OccName -> SrcLoc -> TcRnIf a b Name newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
-- Used for source code and interface files, to make the -- Used for source code and interface files, to make the
-- Name for a thing, given its Module and OccName -- Name for a thing, given its Module and OccName
-- --
...@@ -66,7 +66,7 @@ newGlobalBinder mod occ loc ...@@ -66,7 +66,7 @@ newGlobalBinder mod occ loc
allocateGlobalBinder allocateGlobalBinder
:: NameCache :: NameCache
-> Module -> OccName -> SrcLoc -> Module -> OccName -> SrcSpan
-> (NameCache, Name) -> (NameCache, Name)
allocateGlobalBinder name_supply mod occ loc allocateGlobalBinder name_supply mod occ loc
= case lookupOrigNameCache (nsNames name_supply) mod occ of = case lookupOrigNameCache (nsNames name_supply) mod occ of
...@@ -114,7 +114,7 @@ newImplicitBinder :: Name -- Base name ...@@ -114,7 +114,7 @@ newImplicitBinder :: Name -- Base name
newImplicitBinder base_name mk_sys_occ newImplicitBinder base_name mk_sys_occ
= newGlobalBinder (nameModule base_name) = newGlobalBinder (nameModule base_name)
(mk_sys_occ (nameOccName base_name)) (mk_sys_occ (nameOccName base_name))
(nameSrcLoc base_name) (nameSrcSpan base_name)
ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo] ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames exports = do ifaceExportNames exports = do
...@@ -155,7 +155,7 @@ lookupOrig mod occ ...@@ -155,7 +155,7 @@ lookupOrig mod occ
let let
us = nsUniqs name_cache us = nsUniqs name_cache
uniq = uniqFromSupply us uniq = uniqFromSupply us
name = mkExternalName uniq mod occ noSrcLoc name = mkExternalName uniq mod occ noSrcSpan
new_cache = extendNameCache (nsNames name_cache) mod occ name new_cache = extendNameCache (nsNames name_cache) mod occ name
in in
case splitUniqSupply us of { (us',_) -> do case splitUniqSupply us of { (us',_) -> do
...@@ -292,11 +292,11 @@ lookupIfaceTop occ ...@@ -292,11 +292,11 @@ lookupIfaceTop occ
newIfaceName :: OccName -> IfL Name newIfaceName :: OccName -> IfL Name
newIfaceName occ newIfaceName occ
= do { uniq <- newUnique = do { uniq <- newUnique
; return $! mkInternalName uniq occ noSrcLoc } ; return $! mkInternalName uniq occ noSrcSpan }
newIfaceNames :: [OccName] -> IfL [Name] newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames occs newIfaceNames occs
= do { uniqs <- newUniqueSupply = do { uniqs <- newUniqueSupply
; return [ mkInternalName uniq occ noSrcLoc ; return [ mkInternalName uniq occ noSrcSpan
| (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] } | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
\end{code} \end{code}
...@@ -367,8 +367,7 @@ loadDecl ignore_prags mod (_version, decl) ...@@ -367,8 +367,7 @@ loadDecl ignore_prags mod (_version, decl)
-- * location -- * location
-- imported name, to fix the module correctly in the cache -- imported name, to fix the module correctly in the cache
mk_new_bndr mod occ mk_new_bndr mod occ
= newGlobalBinder mod occ = newGlobalBinder mod occ (importedSrcSpan (moduleNameFS (moduleName mod)))
(importedSrcLoc (showSDoc (ppr (moduleName mod))))
-- ToDo: qualify with the package name if necessary -- ToDo: qualify with the package name if necessary
doc = ptext SLIT("Declaration for") <+> ppr (ifName decl) doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
......
...@@ -1032,7 +1032,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info) ...@@ -1032,7 +1032,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
newExtCoreBndr :: IfaceLetBndr -> IfL Id newExtCoreBndr :: IfaceLetBndr -> IfL Id
newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now
= do { mod <- getIfModule = do { mod <- getIfModule
; name <- newGlobalBinder mod (mkVarOccFS var) noSrcLoc ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
; ty' <- tcIfaceType ty ; ty' <- tcIfaceType ty
; return (mkLocalId name ty') } ; return (mkLocalId name ty') }
......
...@@ -110,7 +110,7 @@ module GHC ( ...@@ -110,7 +110,7 @@ module GHC (
-- ** Names -- ** Names
Name, Name,
nameModule, pprParenSymName, nameSrcLoc, nameModule, pprParenSymName, nameSrcSpan,
NamedThing(..), NamedThing(..),
RdrName(Qual,Unqual), RdrName(Qual,Unqual),
...@@ -175,7 +175,7 @@ module GHC ( ...@@ -175,7 +175,7 @@ module GHC (
mkSrcLoc, isGoodSrcLoc, mkSrcLoc, isGoodSrcLoc,
srcLocFile, srcLocLine, srcLocCol, srcLocFile, srcLocLine, srcLocCol,
SrcSpan, SrcSpan,
mkSrcSpan, srcLocSpan, mkSrcSpan, srcLocSpan, isGoodSrcSpan,
srcSpanStart, srcSpanEnd, srcSpanStart, srcSpanEnd,
srcSpanFile, srcSpanFile,
srcSpanStartLine, srcSpanEndLine, srcSpanStartLine, srcSpanEndLine,
......
...@@ -451,7 +451,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do ...@@ -451,7 +451,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
-- _result in scope at any time. -- _result in scope at any time.
let result_fs = FSLIT("_result") let result_fs = FSLIT("_result")
result_name = mkInternalName (getUnique result_fs) result_name = mkInternalName (getUnique result_fs)
(mkVarOccFS result_fs) (srcSpanStart span) (mkVarOccFS result_fs) span
result_id = Id.mkLocalId result_name result_ty result_id = Id.mkLocalId result_name result_ty
-- for each Id we're about to bind in the local envt: -- for each Id we're about to bind in the local envt:
...@@ -478,7 +478,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do ...@@ -478,7 +478,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
mkNewId :: OccName -> Id -> IO Id mkNewId :: OccName -> Id -> IO Id
mkNewId occ id = do mkNewId occ id = do
let uniq = idUnique id let uniq = idUnique id
loc = nameSrcLoc (idName id) loc = nameSrcSpan (idName id)
name = mkInternalName uniq occ loc name = mkInternalName uniq occ loc
ty = idType id ty = idType id
new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id) new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)
......
...@@ -20,7 +20,7 @@ import qualified GHC ...@@ -20,7 +20,7 @@ import qualified GHC
import TyCon ( tyConFamInst_maybe ) import TyCon ( tyConFamInst_maybe )