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
-- 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
mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
......@@ -175,7 +175,7 @@ mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId uniq unwrkr ty
= mkLocalId wkr_name ty
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
mkTemplateLocals :: [Type] -> [Id]
......
......@@ -23,7 +23,7 @@ module Name (
tidyNameOcc,
hashName, localiseName,
nameSrcLoc,
nameSrcLoc, nameSrcSpan,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax,
......@@ -32,7 +32,7 @@ module Name (
-- Class NamedThing and overloaded friends
NamedThing(..),
getSrcLoc, getOccString
getSrcLoc, getSrcSpan, getOccString
) where
#include "HsVersions.h"
......@@ -66,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_loc :: !SrcLoc -- Definition site
n_loc :: !SrcSpan -- Definition site
}
-- NOTE: we make the n_loc field strict to eliminate some potential
......@@ -127,10 +127,12 @@ nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameSrcSpan :: Name -> SrcSpan
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}
......@@ -183,7 +185,7 @@ isSystemName other = False
%************************************************************************
\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
......@@ -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
-- 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 }
......@@ -204,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,
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,
n_occ = occ, n_loc = noSrcLoc }
n_occ = occ, n_loc = noSrcSpan }
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
......@@ -219,19 +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,
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 = noSrcLoc }
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,
n_loc = noSrcLoc }
n_loc = noSrcSpan }
\end{code}
\begin{code}
......@@ -406,9 +408,11 @@ class NamedThing a where
\begin{code}
getSrcLoc :: NamedThing a => a -> SrcLoc
getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String
getSrcLoc = nameSrcLoc . getName
getSrcSpan = nameSrcSpan . getName
getOccString = occNameString . getOccName
\end{code}
......@@ -11,7 +11,6 @@ module SrcLoc (
advanceSrcLoc,
importedSrcLoc, -- Unknown place in an interface
wiredInSrcLoc, -- Something wired into the compiler
generatedSrcLoc, -- Code generated within the compiler
interactiveSrcLoc, -- Code from an interactive session
......@@ -22,6 +21,8 @@ module SrcLoc (
SrcSpan, -- Abstract
noSrcSpan,
wiredInSrcSpan, -- Something wired into the compiler
importedSrcSpan, -- Unknown place in an interface
mkGeneralSrcSpan,
isGoodSrcSpan, isOneLineSpan,
mkSrcSpan, srcLocSpan,
......@@ -60,7 +61,7 @@ data SrcLoc
-- Don't ask me why lines start at 1 and columns start at
-- 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
\end{code}
......@@ -81,13 +82,12 @@ Things to make 'em:
mkSrcLoc x line col = SrcLoc x line col
noSrcLoc = UnhelpfulLoc FSLIT("<no location info>")
generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>")
wiredInSrcLoc = UnhelpfulLoc FSLIT("<wired into compiler>")
interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
mkGeneralSrcLoc :: FastString -> SrcLoc
mkGeneralSrcLoc = UnhelpfulLoc
importedSrcLoc :: String -> SrcLoc
importedSrcLoc :: FastString -> SrcLoc
importedSrcLoc mod_name = ImportedLoc mod_name
isGoodSrcLoc (SrcLoc _ _ _) = True
......@@ -150,7 +150,7 @@ instance Outputable SrcLoc where
hcat [text "{-# LINE ", int src_line, space,
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
\end{code}
......@@ -193,7 +193,7 @@ data SrcSpan
srcSpanCol :: !Int
}
| ImportedSpan String -- Module name
| ImportedSpan FastString -- Module name
| UnhelpfulSpan FastString -- Just a general indication
-- also used to indicate an empty span
......@@ -206,7 +206,9 @@ instance Ord SrcSpan where
(srcSpanStart a `compare` srcSpanStart b) `thenCmp`
(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 = UnhelpfulSpan
......@@ -306,11 +308,11 @@ combineSrcSpans start end
col2 = srcSpanEndCol end
file = srcSpanFile start
pprDefnLoc :: SrcLoc -> SDoc
pprDefnLoc :: SrcSpan -> SDoc
-- "defined at ..." or "imported from ..."
pprDefnLoc loc
| isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
| otherwise = ppr loc
| isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
| otherwise = ppr loc
instance Outputable SrcSpan where
ppr span
......@@ -347,7 +349,7 @@ pprUserSpan (SrcSpanPoint src_path line 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
\end{code}
......
......@@ -350,7 +350,7 @@ maybeExternaliseId dflags id
name = idName id
uniq = nameUnique 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
-- existing name. So we generate
-- Mod_$L243foo
......
......@@ -176,7 +176,7 @@ tidyIdBndr env@(tidy_env, var_env) id
-- which should save some space.
-- But note that tidyLetBndr puts some of it back.
ty' = tidyType env (idType id)
id' = mkUserLocal occ' (idUnique id) ty' noSrcLoc
id' = mkUserLocal occ' (idUnique id) ty' noSrcSpan
`setIdInfo` vanillaIdInfo
var_env' = extendVarEnv var_env id id'
in
......
......@@ -734,7 +734,7 @@ dataConInstPat arg_fun fss uniqs con inst_tys
co_kind = substTy subst (mkPredTy eq_pred)
-- 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
exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
......
......@@ -378,7 +378,7 @@ make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
hash_x = mkInternalName unboundKey {- doesn't matter much -}
(mkVarOccFS FSLIT("#x"))
noSrcLoc
noSrcSpan
make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
......
......@@ -948,7 +948,7 @@ mkTickBox ix vars e = do
| otherwise = mkBreakPointOpId uq mod ix
uq2 <- newUnique
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
scrut <-
if opt_Hpc
......
......@@ -203,7 +203,7 @@ newGrimName cms userName = do
us <- mkSplitUniqSupply 'b'
let unique = uniqFromSupply us
occname = mkOccName varName userName
name = mkInternalName unique occname noSrcLoc
name = mkInternalName unique occname noSrcSpan
return name
skolemSubst subst = subst `setTvSubstEnv`
......
......@@ -81,7 +81,7 @@ listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
listTags unqual modInfo =
[ tagInfo unqual name loc
| name <- GHC.modInfoExports modInfo
, let loc = nameSrcLoc name
, let loc = srcSpanStart (nameSrcSpan name)
, isGoodSrcLoc loc
]
......
......@@ -1556,7 +1556,7 @@ breakSwitch session args@(arg1:rest)
io $ putStrLn "Perhaps no modules are loaded for debugging?"
| otherwise = do -- try parsing it as an identifier
wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
let loc = GHC.nameSrcLoc name
let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then findBreakAndSet (GHC.nameModule name) $
findBreakByCoord (Just (GHC.srcLocFile loc))
......@@ -1678,7 +1678,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
listModuleLine mod (read arg2)
list2 [arg] = do
wantNameFromInterpretedModule noCanDo arg $ \name -> do
let loc = GHC.nameSrcLoc name
let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then do
tickArray <- getTickArray (GHC.nameModule name)
......
......@@ -573,7 +573,7 @@ thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
--
-- 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.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.NameU uniq) = mkRdrUnqual $! (mk_uniq_occ ctxt_ns occ uniq)
thRdrName ctxt_ns occ TH.NameS
......
......@@ -216,7 +216,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) =
let
us = nsUniqs nc
uniq = uniqFromSupply us
name = mkExternalName uniq mod occ noSrcLoc
name = mkExternalName uniq mod occ noSrcSpan
new_cache = extendNameCache cache mod occ name
in
case splitUniqSupply us of { (us',_) ->
......
......@@ -46,7 +46,7 @@ import Outputable
%*********************************************************
\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
-- Name for a thing, given its Module and OccName
--
......@@ -66,7 +66,7 @@ newGlobalBinder mod occ loc
allocateGlobalBinder
:: NameCache
-> Module -> OccName -> SrcLoc
-> Module -> OccName -> SrcSpan
-> (NameCache, Name)
allocateGlobalBinder name_supply mod occ loc
= case lookupOrigNameCache (nsNames name_supply) mod occ of
......@@ -114,7 +114,7 @@ newImplicitBinder :: Name -- Base name
newImplicitBinder base_name mk_sys_occ
= newGlobalBinder (nameModule base_name)
(mk_sys_occ (nameOccName base_name))
(nameSrcLoc base_name)
(nameSrcSpan base_name)
ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames exports = do
......@@ -155,7 +155,7 @@ lookupOrig mod occ
let
us = nsUniqs name_cache
uniq = uniqFromSupply us
name = mkExternalName uniq mod occ noSrcLoc
name = mkExternalName uniq mod occ noSrcSpan
new_cache = extendNameCache (nsNames name_cache) mod occ name
in
case splitUniqSupply us of { (us',_) -> do
......@@ -292,11 +292,11 @@ lookupIfaceTop occ
newIfaceName :: OccName -> IfL Name
newIfaceName occ
= do { uniq <- newUnique
; return $! mkInternalName uniq occ noSrcLoc }
; return $! mkInternalName uniq occ noSrcSpan }
newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames occs
= do { uniqs <- newUniqueSupply
; return [ mkInternalName uniq occ noSrcLoc
; return [ mkInternalName uniq occ noSrcSpan
| (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
\end{code}
......@@ -367,8 +367,7 @@ loadDecl ignore_prags mod (_version, decl)
-- * location
-- imported name, to fix the module correctly in the cache
mk_new_bndr mod occ
= newGlobalBinder mod occ
(importedSrcLoc (showSDoc (ppr (moduleName mod))))
= newGlobalBinder mod occ (importedSrcSpan (moduleNameFS (moduleName mod)))
-- ToDo: qualify with the package name if necessary
doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
......
......@@ -1032,7 +1032,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
newExtCoreBndr :: IfaceLetBndr -> IfL Id
newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now
= do { mod <- getIfModule
; name <- newGlobalBinder mod (mkVarOccFS var) noSrcLoc
; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
; ty' <- tcIfaceType ty
; return (mkLocalId name ty') }
......
......@@ -110,7 +110,7 @@ module GHC (
-- ** Names
Name,
nameModule, pprParenSymName, nameSrcLoc,
nameModule, pprParenSymName, nameSrcSpan,
NamedThing(..),
RdrName(Qual,Unqual),
......@@ -175,7 +175,7 @@ module GHC (
mkSrcLoc, isGoodSrcLoc,
srcLocFile, srcLocLine, srcLocCol,
SrcSpan,
mkSrcSpan, srcLocSpan,
mkSrcSpan, srcLocSpan, isGoodSrcSpan,
srcSpanStart, srcSpanEnd,
srcSpanFile,
srcSpanStartLine, srcSpanEndLine,
......
......@@ -451,7 +451,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
-- _result in scope at any time.
let result_fs = FSLIT("_result")
result_name = mkInternalName (getUnique result_fs)
(mkVarOccFS result_fs) (srcSpanStart span)
(mkVarOccFS result_fs) span
result_id = Id.mkLocalId result_name result_ty
-- for each Id we're about to bind in the local envt:
......@@ -478,7 +478,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
mkNewId :: OccName -> Id -> IO Id
mkNewId occ id = do
let uniq = idUnique id
loc = nameSrcLoc (idName id)
loc = nameSrcSpan (idName id)
name = mkInternalName uniq occ loc
ty = idType id
new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)
......
......@@ -20,7 +20,7 @@ import qualified GHC
import TyCon ( tyConFamInst_maybe )
import Type ( pprTypeApp )
import GHC ( TyThing(..), SrcLoc )
import GHC ( TyThing(..), SrcSpan )
import Outputable
-- -----------------------------------------------------------------------------
......@@ -33,7 +33,7 @@ import Outputable
pprTyThingLoc :: Bool -> TyThing -> SDoc
pprTyThingLoc exts tyThing
= showWithLoc loc (pprTyThing exts tyThing)
where loc = GHC.nameSrcLoc (GHC.getName tyThing)
where loc = GHC.nameSrcSpan (GHC.getName tyThing)
-- | Pretty-prints a 'TyThing'.
pprTyThing :: Bool -> TyThing -> SDoc
......@@ -46,7 +46,7 @@ pprTyThing exts (AClass cls) = pprClass exts cls
pprTyThingInContextLoc :: Bool -> TyThing -> SDoc
pprTyThingInContextLoc exts tyThing
= showWithLoc loc (pprTyThingInContext exts tyThing)
where loc = GHC.nameSrcLoc (GHC.getName tyThing)
where loc = GHC.nameSrcSpan (GHC.getName tyThing)
-- | Pretty-prints a 'TyThing' in context: that is, if the entity
-- is a data constructor, record selector, or class method, then
......@@ -228,7 +228,7 @@ add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs)
ppr_bndr :: GHC.NamedThing a => a -> SDoc
ppr_bndr a = GHC.pprParenSymName a
showWithLoc :: SrcLoc -> SDoc -> SDoc
showWithLoc :: SrcSpan -> SDoc -> SDoc
showWithLoc loc doc
= hang doc 2 (char '\t' <> comment <+> GHC.pprDefnLoc loc)
-- The tab tries to make them line up a bit
......
......@@ -28,10 +28,7 @@ import IdInfo {- loads of stuff -}
import InstEnv ( Instance, DFunId, instanceDFunId, setInstanceDFunId )
import NewDemand ( isBottomingSig, topSig )
import BasicTypes ( Arity, isNeverActive, isNonRuleLoopBreaker )
import Name ( Name, getOccName, nameOccName, mkInternalName,
localiseName, isExternalName, nameSrcLoc,
isWiredInName, getName
)
import Name
import NameSet ( NameSet, elemNameSet )
import IfaceEnv ( allocateGlobalBinder )
import NameEnv ( filterNameEnv, mapNameEnv )
......@@ -674,7 +671,7 @@ tidyTopName mod nc_var ext_ids occ_env id
global = isExternalName name
local = not global
internal = not external
loc = nameSrcLoc name
loc = nameSrcSpan name
(occ_env', occ') = tidyOccName occ_env (nameOccName name)
......
......@@ -61,7 +61,7 @@ import Unique ( Unique, Uniquable(..), hasKey,
)
import BasicTypes ( Boxity(..), Arity )
import Name ( Name, mkInternalName, mkExternalName )
import SrcLoc ( noSrcLoc )
import SrcLoc
import FastString
\end{code}
......@@ -75,14 +75,14 @@ import FastString
This *local* name is used by the interactive stuff
\begin{code}
itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcLoc
itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcSpan
\end{code}
\begin{code}
-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
-- during compiler debugging.
mkUnboundName :: RdrName -> Name
mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcSpan
isUnboundName :: Name -> Bool
isUnboundName name = name `hasKey` unboundKey
......@@ -508,17 +508,17 @@ breakpointJumpName
= mkInternalName
breakpointJumpIdKey
(mkOccNameFS varName FSLIT("breakpointJump"))
noSrcLoc
noSrcSpan
breakpointCondJumpName
= mkInternalName
breakpointCondJumpIdKey
(mkOccNameFS varName FSLIT("breakpointCondJump"))
noSrcLoc
noSrcSpan
breakpointAutoJumpName
= mkInternalName
breakpointAutoJumpIdKey
(mkOccNameFS varName FSLIT("breakpointAutoJump"))
noSrcLoc
noSrcSpan
-- PrelTup
fstName = varQual dATA_TUP FSLIT("fst") fstIdKey
......@@ -686,15 +686,15 @@ tcQual = mk_known_key_name tcName
clsQual = mk_known_key_name clsName
mk_known_key_name space mod str uniq
= mkExternalName uniq mod (mkOccNameFS space str) noSrcLoc
= mkExternalName uniq mod (mkOccNameFS space str) noSrcSpan
conName :: Module -> FastString -> Unique -> Name
conName mod occ uniq
= mkExternalName uniq mod (mkOccNameFS dataName occ) noSrcLoc
= mkExternalName uniq mod (mkOccNameFS dataName occ) noSrcSpan
methName :: Module -> FastString -> Unique -> Name
methName mod occ uniq
= mkExternalName uniq mod (mkVarOccFS occ) noSrcLoc
= mkExternalName uniq mod (mkVarOccFS occ) noSrcSpan
\end{code}
%************************************************************************
......
......@@ -57,7 +57,7 @@ import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
Kind, mkArrowKinds, mkArrowKind,
TyThing(..)
)
import SrcLoc ( noSrcLoc )
import SrcLoc
import Unique ( mkAlphaTyVarUnique, pprUnique )
import PrelNames
import FastString ( FastString, mkFastString )
......@@ -150,7 +150,7 @@ alphaTyVars is a list of type variables for use in templates:
tyVarList :: Kind -> [TyVar]
tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
(mkTyVarOcc (mkFastString name))
noSrcLoc) kind
noSrcSpan) kind
| u <- [2..],
let name | c <= 'z' = [c]
| otherwise = 't':show u
......
......@@ -115,7 +115,7 @@ newTopSrcBinder this_mod (L loc rdr_name)
-- the RdrName, not from the environment. In principle, it'd be fine to
-- have an arbitrary mixture of external core definitions in a single module,
-- (apart from module-initialisation issues, perhaps).
; newGlobalBinder rdr_mod rdr_occ (srcSpanStart loc) }
; newGlobalBinder rdr_mod rdr_occ loc }
--TODO, should pass the whole span
| otherwise
......@@ -123,7 +123,7 @@ newTopSrcBinder this_mod (L loc rdr_name)
(addErrAt loc (badQualBndrErr rdr_name))
-- Binders should not be qualified; if they are, and with a different
-- module name, we we get a confusing "M.T is not in scope" error later
; newGlobalBinder this_mod (rdrNameOcc rdr_name) (srcSpanStart loc) }
; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
\end{code}
%*********************************************************
......@@ -175,7 +175,7 @@ lookupTopBndrRn rdr_name
-- we don't bother to call newTopSrcBinder first
-- We assume there is no "parent" name
= do { loc <- getSrcSpanM
; newGlobalBinder rdr_mod rdr_occ (srcSpanStart loc) }
; newGlobalBinder rdr_mod rdr_occ loc }
| otherwise
= do { mb_gre <- lookupGreLocalRn rdr_name
......@@ -626,7 +626,7 @@ newLocalsRn rdr_names_w_loc
| otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
-- We only bind unqualified names here
-- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
mkInternalName uniq (rdrNameOcc rdr_name) loc
bindLocatedLocalsRn :: SDoc -- Documentation string for error message
-> [Located RdrName]
......
......@@ -27,7 +27,7 @@ import Id ( Id, idName, idType, isDataConWorkId_maybe,
import Var ( Var )
import VarEnv
import VarSet
import Name ( nameOccName, nameSrcLoc )
import Name
import Rules ( addIdSpecialisations, mkLocalRule, rulesOfBinds )
import OccName ( mkSpecOcc )
import ErrUtils ( dumpIfSet_dyn )
......@@ -982,7 +982,7 @@ spec_one env fn arg_bndrs body ((qvars, pats), rule_number)
-- a spec_rhs of unlifted type and no args
fn_name = idName fn
fn_loc = nameSrcLoc fn_name
fn_loc = nameSrcSpan fn_name
spec_occ = mkSpecOcc (nameOccName fn_name)
rule_name = mkFastString ("SC:" ++ showSDoc (ppr fn <> int rule_number))
spec_rhs = mkLams spec_lam_args spec_body
......
......@@ -32,7 +32,7 @@ import UniqSupply ( UniqSupply,
UniqSM, initUs_, thenUs, returnUs, getUniqueUs,
getUs, mapUs
)
import Name ( nameOccName, mkSpecOcc, getSrcLoc )
import Name
import MkId ( voidArgId, realWorldPrimId )
import FiniteMap
import Maybes ( catMaybes, maybeToBool )
......@@ -1184,7 +1184,7 @@ newIdSM old_id new_ty
let
-- Give the new Id a similar occurrence name to the old one
name = idName old_id
new_id = mkUserLocal (mkSpecOcc (nameOccName name)) uniq new_ty (getSrcLoc name)
new_id = mkUserLocal (mkSpecOcc (nameOccName name)) uniq new_ty (getSrcSpan name)
in
returnSM new_id
\end{code}
......
......@@ -329,7 +329,7 @@ newIPDict orig ip_name ty
\begin{code}
mkPredName :: Unique -> InstLoc -> PredType -> Name
mkPredName uniq loc pred_ty
= mkInternalName uniq occ (srcSpanStart (instLocSpan loc))
= mkInternalName uniq occ (instLocSpan loc)
where
occ = case pred_ty of
ClassP cls _ -> mkDictOcc (getOccName cls)
......@@ -413,7 +413,7 @@ newMethod inst_loc id tys
meth_id = mkUserLocal (mkMethodOcc (getOccName id)) new_uniq tau loc
inst = Method {tci_id = meth_id, tci_oid = id, tci_tys = tys,
tci_theta = theta, tci_loc = inst_loc}
loc = srcSpanStart (instLocSpan inst_loc)
loc = instLocSpan inst_loc
in
returnM inst
\end{code}
......
......@@ -452,8 +452,7 @@ mkMethId origin clas sel_id inst_tys
getSrcSpanM `thenM` \ loc ->
let
real_tau = mkPhiTy (tail preds) tau
meth_id = mkUserLocal (getOccName sel_id) uniq real_tau
(srcSpanStart loc) --TODO
meth_id = mkUserLocal (getOccName sel_id) uniq real_tau loc
in
returnM (Nothing, meth_id)