Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
940524ae
Commit
940524ae
authored
May 11, 2007
by
Simon Marlow
Browse files
Store a SrcSpan instead of a SrcLoc inside a Name
This has been a long-standing ToDo.
parent
485b80f9
Changes
40
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/Id.lhs
View file @
940524ae
...
...
@@ -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 -> Src
Loc
-> Id
mkUserLocal :: OccName -> Unique -> Type -> Src
Span
-> 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)) (getSrc
Loc
unwrkr)
wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrc
Span
unwrkr)
-- "Template locals" typically used in unfoldings
mkTemplateLocals :: [Type] -> [Id]
...
...
compiler/basicTypes/Name.lhs
View file @
940524ae
...
...
@@ -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 :: !Src
Loc
-- Definition site
n_loc :: !Src
Span
-- 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 -> Src
Loc
-> Name
mkInternalName :: Unique -> OccName -> Src
Span
-> 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 -> Src
Loc
-> Name
mkExternalName :: Unique -> Module -> OccName -> Src
Span
-> 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 = wiredInSrc
Loc
}
n_occ = occ, n_loc = wiredInSrc
Span
}
mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = Name { n_uniq = getKey# uniq, n_sort = System,
n_occ = occ, n_loc = noSrc
Loc
}
n_occ = occ, n_loc = noSrc
Span
}
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 = noSrc
Loc
}
n_occ = mkVarOcc str, n_loc = noSrc
Span
}
mkTickBoxOpName :: Unique -> String -> Name
mkTickBoxOpName uniq str
= Name { n_uniq = getKey# uniq, n_sort = Internal,
n_occ = mkVarOcc str, n_loc = noSrc
Loc
}
n_occ = mkVarOcc str, n_loc = noSrc
Span
}
mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
= Name { n_uniq = getKey# uniq,
n_sort = Internal,
n_occ = occ,
n_loc = noSrc
Loc
}
n_loc = noSrc
Span
}
\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}
compiler/basicTypes/SrcLoc.lhs
View file @
940524ae
...
...
@@ -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
Fast
String -- 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 ::
Fast
String -> 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") <+>
f
text mod
ppr (UnhelpfulLoc s) = ftext s
\end{code}
...
...
@@ -193,7 +193,7 @@ data SrcSpan
srcSpanCol :: !Int
}
| ImportedSpan String
-- Module name
| ImportedSpan
Fast
String -- 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 :: Src
Loc
-> SDoc
pprDefnLoc :: Src
Span
-> SDoc
-- "defined at ..." or "imported from ..."
pprDefnLoc loc
| isGoodSrc
Loc
loc = ptext SLIT("Defined at") <+> ppr loc
| otherwise = ppr loc
| isGoodSrc
Span
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") <+>
f
text mod
pprUserSpan (UnhelpfulSpan s) = ftext s
\end{code}
...
...
compiler/codeGen/CodeGen.lhs
View file @
940524ae
...
...
@@ -350,7 +350,7 @@ maybeExternaliseId dflags id
name = idName id
uniq = nameUnique name
new_occ = mkLocalOcc uniq (nameOccName name)
loc = nameSrc
Loc
name
loc = nameSrc
Span
name
-- We want to conjure up a name that can't clash with any
-- existing name. So we generate
-- Mod_$L243foo
...
...
compiler/coreSyn/CoreTidy.lhs
View file @
940524ae
...
...
@@ -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' noSrc
Loc
id' = mkUserLocal occ' (idUnique id) ty' noSrc
Span
`setIdInfo` vanillaIdInfo
var_env' = extendVarEnv var_env id id'
in
...
...
compiler/coreSyn/CoreUtils.lhs
View file @
940524ae
...
...
@@ -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) noSrc
Loc
mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrc
Span
id_bndrs = zipWith3 mk_id_var id_uniqs id_fss arg_tys
exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
...
...
compiler/deSugar/Check.lhs
View file @
940524ae
...
...
@@ -378,7 +378,7 @@ make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
hash_x = mkInternalName unboundKey {- doesn't matter much -}
(mkVarOccFS FSLIT("#x"))
noSrc
Loc
noSrc
Span
make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
...
...
compiler/deSugar/DsUtils.lhs
View file @
940524ae
...
...
@@ -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 noSrc
Loc
-- use mkSysLocal?
let name = mkInternalName uq2 occName noSrc
Span
-- use mkSysLocal?
let var = Id.mkLocalId name realWorldStatePrimTy
scrut <-
if opt_Hpc
...
...
compiler/ghci/Debugger.hs
View file @
940524ae
...
...
@@ -203,7 +203,7 @@ newGrimName cms userName = do
us
<-
mkSplitUniqSupply
'b'
let
unique
=
uniqFromSupply
us
occname
=
mkOccName
varName
userName
name
=
mkInternalName
unique
occname
noSrc
Loc
name
=
mkInternalName
unique
occname
noSrc
Span
return
name
skolemSubst
subst
=
subst
`
setTvSubstEnv
`
...
...
compiler/ghci/GhciTags.hs
View file @
940524ae
...
...
@@ -81,7 +81,7 @@ listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
listTags
unqual
modInfo
=
[
tagInfo
unqual
name
loc
|
name
<-
GHC
.
modInfoExports
modInfo
,
let
loc
=
nameSrc
Loc
name
,
let
loc
=
srcSpanStart
(
nameSrc
Span
name
)
,
isGoodSrcLoc
loc
]
...
...
compiler/ghci/InteractiveUI.hs
View file @
940524ae
...
...
@@ -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
.
nameSrc
Loc
name
let
loc
=
GHC
.
srcSpanStart
(
GHC
.
nameSrc
Span
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
.
nameSrc
Loc
name
let
loc
=
GHC
.
srcSpanStart
(
GHC
.
nameSrc
Span
name
)
if
GHC
.
isGoodSrcLoc
loc
then
do
tickArray
<-
getTickArray
(
GHC
.
nameModule
name
)
...
...
compiler/hsSyn/Convert.lhs
View file @
940524ae
...
...
@@ -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)) noSrc
Loc
)
thRdrName ctxt_ns occ (TH.NameL uniq) = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrc
Span
)
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
...
...
compiler/iface/BinIface.hs
View file @
940524ae
...
...
@@ -216,7 +216,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) =
let
us
=
nsUniqs
nc
uniq
=
uniqFromSupply
us
name
=
mkExternalName
uniq
mod
occ
noSrc
Loc
name
=
mkExternalName
uniq
mod
occ
noSrc
Span
new_cache
=
extendNameCache
cache
mod
occ
name
in
case
splitUniqSupply
us
of
{
(
us'
,
_
)
->
...
...
compiler/iface/IfaceEnv.lhs
View file @
940524ae
...
...
@@ -46,7 +46,7 @@ import Outputable
%*********************************************************
\begin{code}
newGlobalBinder :: Module -> OccName -> Src
Loc
-> TcRnIf a b Name
newGlobalBinder :: Module -> OccName -> Src
Span
-> 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 -> Src
Loc
-> Module -> OccName -> Src
Span
-> (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))
(nameSrc
Loc
base_name)
(nameSrc
Span
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 noSrc
Loc
name = mkExternalName uniq mod occ noSrc
Span
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 noSrc
Loc
}
; return $! mkInternalName uniq occ noSrc
Span
}
newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames occs
= do { uniqs <- newUniqueSupply
; return [ mkInternalName uniq occ noSrc
Loc
; return [ mkInternalName uniq occ noSrc
Span
| (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
\end{code}
compiler/iface/LoadIface.lhs
View file @
940524ae
...
...
@@ -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)
...
...
compiler/iface/TcIface.lhs
View file @
940524ae
...
...
@@ -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) noSrc
Loc
; name <- newGlobalBinder mod (mkVarOccFS var) noSrc
Span
; ty' <- tcIfaceType ty
; return (mkLocalId name ty') }
...
...
compiler/main/GHC.hs
View file @
940524ae
...
...
@@ -110,7 +110,7 @@ module GHC (
-- ** Names
Name
,
nameModule
,
pprParenSymName
,
nameSrc
Loc
,
nameModule
,
pprParenSymName
,
nameSrc
Span
,
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
,
...
...
compiler/main/InteractiveEval.hs
View file @
940524ae
...
...
@@ -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
=
nameSrc
Loc
(
idName
id
)
loc
=
nameSrc
Span
(
idName
id
)
name
=
mkInternalName
uniq
occ
loc
ty
=
idType
id
new_id
=
Id
.
mkGlobalId
VanillaGlobal
name
ty
(
idInfo
id
)
...
...
compiler/main/PprTyThing.hs
View file @
940524ae
...
...
@@ -20,7 +20,7 @@ import qualified GHC
import
TyCon
(
tyConFamInst_maybe
)
import
Type
(
pprTypeApp
)
import
GHC
(
TyThing
(
..
),
Src
Loc
)
import
GHC
(
TyThing
(
..
),
Src
Span
)
import
Outputable
-- -----------------------------------------------------------------------------
...
...
@@ -33,7 +33,7 @@ import Outputable
pprTyThingLoc
::
Bool
->
TyThing
->
SDoc
pprTyThingLoc
exts
tyThing
=
showWithLoc
loc
(
pprTyThing
exts
tyThing
)
where
loc
=
GHC
.
nameSrc
Loc
(
GHC
.
getName
tyThing
)
where
loc
=
GHC
.
nameSrc
Span
(
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
.
nameSrc
Loc
(
GHC
.
getName
tyThing
)
where
loc
=
GHC
.
nameSrc
Span
(
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
::
Src
Loc
->
SDoc
->
SDoc
showWithLoc
::
Src
Span
->
SDoc
->
SDoc
showWithLoc
loc
doc
=
hang
doc
2
(
char
'
\t
'
<>
comment
<+>
GHC
.
pprDefnLoc
loc
)
-- The tab tries to make them line up a bit
...
...
compiler/main/TidyPgm.lhs
View file @
940524ae
...
...
@@ -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 = nameSrc
Loc
name
loc = nameSrc
Span
name
(occ_env', occ') = tidyOccName occ_env (nameOccName name)
...
...
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment