Commit b8abd852 authored by Jan Stolarek's avatar Jan Stolarek

Replace calls to `ptext . sLit` with `text`

Summary:
In the past the canonical way for constructing an SDoc string literal was the
composition `ptext . sLit`.  But for some time now we have function `text` that
does the same.  Plus it has some rules that optimize its runtime behaviour.
This patch takes all uses of `ptext . sLit` in the compiler and replaces them
with calls to `text`.  The main benefits of this patch are clener (shorter) code
and less dependencies between module, because many modules now do not need to
import `FastString`.  I don't expect any performance benefits - we mostly use
SDocs to report errors and it seems there is little to be gained here.

Test Plan: ./validate

Reviewers: bgamari, austin, goldfire, hvr, alanz

Subscribers: goldfire, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1784
parent 817dd925
...@@ -192,8 +192,8 @@ bestOneShot OneShotLam _ = OneShotLam ...@@ -192,8 +192,8 @@ bestOneShot OneShotLam _ = OneShotLam
pprOneShotInfo :: OneShotInfo -> SDoc pprOneShotInfo :: OneShotInfo -> SDoc
pprOneShotInfo NoOneShotInfo = empty pprOneShotInfo NoOneShotInfo = empty
pprOneShotInfo ProbOneShot = ptext (sLit "ProbOneShot") pprOneShotInfo ProbOneShot = text "ProbOneShot"
pprOneShotInfo OneShotLam = ptext (sLit "OneShot") pprOneShotInfo OneShotLam = text "OneShot"
instance Outputable OneShotInfo where instance Outputable OneShotInfo where
ppr = pprOneShotInfo ppr = pprOneShotInfo
...@@ -211,8 +211,8 @@ data SwapFlag ...@@ -211,8 +211,8 @@ data SwapFlag
| IsSwapped -- Args are: expected, actual | IsSwapped -- Args are: expected, actual
instance Outputable SwapFlag where instance Outputable SwapFlag where
ppr IsSwapped = ptext (sLit "Is-swapped") ppr IsSwapped = text "Is-swapped"
ppr NotSwapped = ptext (sLit "Not-swapped") ppr NotSwapped = text "Not-swapped"
flipSwap :: SwapFlag -> SwapFlag flipSwap :: SwapFlag -> SwapFlag
flipSwap IsSwapped = NotSwapped flipSwap IsSwapped = NotSwapped
...@@ -327,9 +327,9 @@ data FixityDirection = InfixL | InfixR | InfixN ...@@ -327,9 +327,9 @@ data FixityDirection = InfixL | InfixR | InfixN
deriving (Eq, Data, Typeable) deriving (Eq, Data, Typeable)
instance Outputable FixityDirection where instance Outputable FixityDirection where
ppr InfixL = ptext (sLit "infixl") ppr InfixL = text "infixl"
ppr InfixR = ptext (sLit "infixr") ppr InfixR = text "infixr"
ppr InfixN = ptext (sLit "infix") ppr InfixN = text "infix"
------------------------ ------------------------
maxPrecedence, minPrecedence :: Int maxPrecedence, minPrecedence :: Int
...@@ -391,8 +391,8 @@ isTopLevel TopLevel = True ...@@ -391,8 +391,8 @@ isTopLevel TopLevel = True
isTopLevel NotTopLevel = False isTopLevel NotTopLevel = False
instance Outputable TopLevelFlag where instance Outputable TopLevelFlag where
ppr TopLevel = ptext (sLit "<TopLevel>") ppr TopLevel = text "<TopLevel>"
ppr NotTopLevel = ptext (sLit "<NotTopLevel>") ppr NotTopLevel = text "<NotTopLevel>"
{- {-
************************************************************************ ************************************************************************
...@@ -440,8 +440,8 @@ boolToRecFlag True = Recursive ...@@ -440,8 +440,8 @@ boolToRecFlag True = Recursive
boolToRecFlag False = NonRecursive boolToRecFlag False = NonRecursive
instance Outputable RecFlag where instance Outputable RecFlag where
ppr Recursive = ptext (sLit "Recursive") ppr Recursive = text "Recursive"
ppr NonRecursive = ptext (sLit "NonRecursive") ppr NonRecursive = text "NonRecursive"
{- {-
************************************************************************ ************************************************************************
...@@ -460,8 +460,8 @@ isGenerated Generated = True ...@@ -460,8 +460,8 @@ isGenerated Generated = True
isGenerated FromSource = False isGenerated FromSource = False
instance Outputable Origin where instance Outputable Origin where
ppr FromSource = ptext (sLit "FromSource") ppr FromSource = text "FromSource"
ppr Generated = ptext (sLit "Generated") ppr Generated = text "Generated"
{- {-
************************************************************************ ************************************************************************
...@@ -570,13 +570,13 @@ instance Outputable OverlapFlag where ...@@ -570,13 +570,13 @@ instance Outputable OverlapFlag where
instance Outputable OverlapMode where instance Outputable OverlapMode where
ppr (NoOverlap _) = empty ppr (NoOverlap _) = empty
ppr (Overlappable _) = ptext (sLit "[overlappable]") ppr (Overlappable _) = text "[overlappable]"
ppr (Overlapping _) = ptext (sLit "[overlapping]") ppr (Overlapping _) = text "[overlapping]"
ppr (Overlaps _) = ptext (sLit "[overlap ok]") ppr (Overlaps _) = text "[overlap ok]"
ppr (Incoherent _) = ptext (sLit "[incoherent]") ppr (Incoherent _) = text "[incoherent]"
pprSafeOverlap :: Bool -> SDoc pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True = ptext $ sLit "[safe]" pprSafeOverlap True = text "[safe]"
pprSafeOverlap False = empty pprSafeOverlap False = empty
{- {-
...@@ -604,9 +604,9 @@ boxityTupleSort Unboxed = UnboxedTuple ...@@ -604,9 +604,9 @@ boxityTupleSort Unboxed = UnboxedTuple
tupleParens :: TupleSort -> SDoc -> SDoc tupleParens :: TupleSort -> SDoc -> SDoc
tupleParens BoxedTuple p = parens p tupleParens BoxedTuple p = parens p
tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)") tupleParens UnboxedTuple p = text "(#" <+> p <+> ptext (sLit "#)")
tupleParens ConstraintTuple p -- In debug-style write (% Eq a, Ord b %) tupleParens ConstraintTuple p -- In debug-style write (% Eq a, Ord b %)
| opt_PprStyle_Debug = ptext (sLit "(%") <+> p <+> ptext (sLit "%)") | opt_PprStyle_Debug = text "(%" <+> p <+> ptext (sLit "%)")
| otherwise = parens p | otherwise = parens p
{- {-
...@@ -746,10 +746,10 @@ zapFragileOcc occ = occ ...@@ -746,10 +746,10 @@ zapFragileOcc occ = occ
instance Outputable OccInfo where instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07 -- only used for debugging; never parsed. KSW 1999-07
ppr NoOccInfo = empty ppr NoOccInfo = empty
ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty ppr (IAmALoopBreaker ro) = text "LoopBreaker" <> if ro then char '!' else empty
ppr IAmDead = ptext (sLit "Dead") ppr IAmDead = text "Dead"
ppr (OneOcc inside_lam one_branch int_cxt) ppr (OneOcc inside_lam one_branch int_cxt)
= ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args = text "Once" <> pp_lam <> pp_br <> pp_args
where where
pp_lam | inside_lam = char 'L' pp_lam | inside_lam = char 'L'
| otherwise = empty | otherwise = empty
...@@ -776,8 +776,8 @@ data DefMethSpec ty ...@@ -776,8 +776,8 @@ data DefMethSpec ty
| GenericDM ty -- Default method given with code of this type | GenericDM ty -- Default method given with code of this type
instance Outputable (DefMethSpec ty) where instance Outputable (DefMethSpec ty) where
ppr VanillaDM = ptext (sLit "{- Has default method -}") ppr VanillaDM = text "{- Has default method -}"
ppr (GenericDM {}) = ptext (sLit "{- Has generic default method -}") ppr (GenericDM {}) = text "{- Has generic default method -}"
{- {-
************************************************************************ ************************************************************************
...@@ -790,8 +790,8 @@ instance Outputable (DefMethSpec ty) where ...@@ -790,8 +790,8 @@ instance Outputable (DefMethSpec ty) where
data SuccessFlag = Succeeded | Failed data SuccessFlag = Succeeded | Failed
instance Outputable SuccessFlag where instance Outputable SuccessFlag where
ppr Succeeded = ptext (sLit "Succeeded") ppr Succeeded = text "Succeeded"
ppr Failed = ptext (sLit "Failed") ppr Failed = text "Failed"
successIf :: Bool -> SuccessFlag successIf :: Bool -> SuccessFlag
successIf True = Succeeded successIf True = Succeeded
...@@ -888,7 +888,7 @@ data CompilerPhase ...@@ -888,7 +888,7 @@ data CompilerPhase
instance Outputable CompilerPhase where instance Outputable CompilerPhase where
ppr (Phase n) = int n ppr (Phase n) = int n
ppr InitialPhase = ptext (sLit "InitialPhase") ppr InitialPhase = text "InitialPhase"
-- See note [Pragma source text] -- See note [Pragma source text]
data Activation = NeverActive data Activation = NeverActive
...@@ -1056,19 +1056,19 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma ...@@ -1056,19 +1056,19 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info } setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
instance Outputable Activation where instance Outputable Activation where
ppr AlwaysActive = brackets (ptext (sLit "ALWAYS")) ppr AlwaysActive = brackets (text "ALWAYS")
ppr NeverActive = brackets (ptext (sLit "NEVER")) ppr NeverActive = brackets (text "NEVER")
ppr (ActiveBefore _ n) = brackets (char '~' <> int n) ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
ppr (ActiveAfter _ n) = brackets (int n) ppr (ActiveAfter _ n) = brackets (int n)
instance Outputable RuleMatchInfo where instance Outputable RuleMatchInfo where
ppr ConLike = ptext (sLit "CONLIKE") ppr ConLike = text "CONLIKE"
ppr FunLike = ptext (sLit "FUNLIKE") ppr FunLike = text "FUNLIKE"
instance Outputable InlineSpec where instance Outputable InlineSpec where
ppr Inline = ptext (sLit "INLINE") ppr Inline = text "INLINE"
ppr NoInline = ptext (sLit "NOINLINE") ppr NoInline = text "NOINLINE"
ppr Inlinable = ptext (sLit "INLINABLE") ppr Inlinable = text "INLINABLE"
ppr EmptyInlineSpec = empty ppr EmptyInlineSpec = empty
instance Outputable InlinePragma where instance Outputable InlinePragma where
...@@ -1080,7 +1080,7 @@ instance Outputable InlinePragma where ...@@ -1080,7 +1080,7 @@ instance Outputable InlinePragma where
pp_act NoInline NeverActive = empty pp_act NoInline NeverActive = empty
pp_act _ act = ppr act pp_act _ act = ppr act
pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar) pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)
| otherwise = empty | otherwise = empty
pp_info | isFunLike info = empty pp_info | isFunLike info = empty
| otherwise = ppr info | otherwise = ppr info
......
...@@ -630,10 +630,10 @@ instance Outputable HsSrcBang where ...@@ -630,10 +630,10 @@ instance Outputable HsSrcBang where
ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
instance Outputable HsImplBang where instance Outputable HsImplBang where
ppr HsLazy = ptext (sLit "Lazy") ppr HsLazy = text "Lazy"
ppr (HsUnpack Nothing) = ptext (sLit "Unpacked") ppr (HsUnpack Nothing) = text "Unpacked"
ppr (HsUnpack (Just co)) = ptext (sLit "Unpacked") <> parens (ppr co) ppr (HsUnpack (Just co)) = text "Unpacked" <> parens (ppr co)
ppr HsStrict = ptext (sLit "StrictNotUnpacked") ppr HsStrict = text "StrictNotUnpacked"
instance Outputable SrcStrictness where instance Outputable SrcStrictness where
ppr SrcLazy = char '~' ppr SrcLazy = char '~'
...@@ -641,12 +641,12 @@ instance Outputable SrcStrictness where ...@@ -641,12 +641,12 @@ instance Outputable SrcStrictness where
ppr NoSrcStrict = empty ppr NoSrcStrict = empty
instance Outputable SrcUnpackedness where instance Outputable SrcUnpackedness where
ppr SrcUnpack = ptext (sLit "{-# UNPACK #-}") ppr SrcUnpack = text "{-# UNPACK #-}"
ppr SrcNoUnpack = ptext (sLit "{-# NOUNPACK #-}") ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
ppr NoSrcUnpack = empty ppr NoSrcUnpack = empty
instance Outputable StrictnessMark where instance Outputable StrictnessMark where
ppr MarkedStrict = ptext (sLit "!") ppr MarkedStrict = text "!"
ppr NotMarkedStrict = empty ppr NotMarkedStrict = empty
instance Binary SrcStrictness where instance Binary SrcStrictness where
...@@ -1042,7 +1042,7 @@ dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality ...@@ -1042,7 +1042,7 @@ dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality
dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs, dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs}) inst_tys dcExTyVars = ex_tvs}) inst_tys
= ASSERT2( length univ_tvs == length inst_tys = ASSERT2( length univ_tvs == length inst_tys
, ptext (sLit "dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys) , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
ASSERT2( null ex_tvs, ppr dc ) ASSERT2( null ex_tvs, ppr dc )
map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc) map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
...@@ -1059,7 +1059,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys, ...@@ -1059,7 +1059,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
dcUnivTyVars = univ_tvs, dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs}) inst_tys dcExTyVars = ex_tvs}) inst_tys
= ASSERT2( length tyvars == length inst_tys = ASSERT2( length tyvars == length inst_tys
, ptext (sLit "dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys ) , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
map (substTyWith tyvars inst_tys) arg_tys map (substTyWith tyvars inst_tys) arg_tys
where where
tyvars = univ_tvs ++ ex_tvs tyvars = univ_tvs ++ ex_tvs
......
...@@ -72,7 +72,6 @@ import Maybes ( orElse ) ...@@ -72,7 +72,6 @@ import Maybes ( orElse )
import Type ( Type, isUnLiftedType ) import Type ( Type, isUnLiftedType )
import TyCon ( isNewTyCon, isClassTyCon ) import TyCon ( isNewTyCon, isClassTyCon )
import DataCon ( splitDataProductType_maybe ) import DataCon ( splitDataProductType_maybe )
import FastString
{- {-
************************************************************************ ************************************************************************
...@@ -787,8 +786,8 @@ data TypeShape = TsFun TypeShape ...@@ -787,8 +786,8 @@ data TypeShape = TsFun TypeShape
| TsUnk | TsUnk
instance Outputable TypeShape where instance Outputable TypeShape where
ppr TsUnk = ptext (sLit "TsUnk") ppr TsUnk = text "TsUnk"
ppr (TsFun ts) = ptext (sLit "TsFun") <> parens (ppr ts) ppr (TsFun ts) = text "TsFun" <> parens (ppr ts)
ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss) ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)
trimToType :: Demand -> TypeShape -> Demand trimToType :: Demand -> TypeShape -> Demand
......
...@@ -81,7 +81,6 @@ import {-# SOURCE #-} PatSyn ...@@ -81,7 +81,6 @@ import {-# SOURCE #-} PatSyn
import ForeignCall import ForeignCall
import Outputable import Outputable
import Module import Module
import FastString
import Demand import Demand
-- infixl so you can say (id `set` a `set` b) -- infixl so you can say (id `set` a `set` b)
...@@ -166,17 +165,17 @@ pprIdDetails VanillaId = empty ...@@ -166,17 +165,17 @@ pprIdDetails VanillaId = empty
pprIdDetails other = brackets (pp other) pprIdDetails other = brackets (pp other)
where where
pp VanillaId = panic "pprIdDetails" pp VanillaId = panic "pprIdDetails"
pp (DataConWorkId _) = ptext (sLit "DataCon") pp (DataConWorkId _) = text "DataCon"
pp (DataConWrapId _) = ptext (sLit "DataConWrapper") pp (DataConWrapId _) = text "DataConWrapper"
pp (ClassOpId {}) = ptext (sLit "ClassOp") pp (ClassOpId {}) = text "ClassOp"
pp (PrimOpId _) = ptext (sLit "PrimOp") pp (PrimOpId _) = text "PrimOp"
pp (FCallId _) = ptext (sLit "ForeignCall") pp (FCallId _) = text "ForeignCall"
pp (TickBoxOpId _) = ptext (sLit "TickBoxOp") pp (TickBoxOpId _) = text "TickBoxOp"
pp (DFunId nt) = ptext (sLit "DFunId") <> ppWhen nt (ptext (sLit "(nt)")) pp (DFunId nt) = text "DFunId" <> ppWhen nt (text "(nt)")
pp (RecSelId { sel_naughty = is_naughty }) pp (RecSelId { sel_naughty = is_naughty })
= brackets $ ptext (sLit "RecSel") = brackets $ text "RecSel"
<> ppWhen is_naughty (ptext (sLit "(naughty)")) <> ppWhen is_naughty (text "(naughty)")
pp CoVarId = ptext (sLit "CoVarId") pp CoVarId = text "CoVarId"
{- {-
************************************************************************ ************************************************************************
...@@ -303,7 +302,7 @@ unknownArity = 0 :: Arity ...@@ -303,7 +302,7 @@ unknownArity = 0 :: Arity
ppArityInfo :: Int -> SDoc ppArityInfo :: Int -> SDoc
ppArityInfo 0 = empty ppArityInfo 0 = empty
ppArityInfo n = hsep [ptext (sLit "Arity"), int n] ppArityInfo n = hsep [text "Arity", int n]
{- {-
************************************************************************ ************************************************************************
...@@ -427,7 +426,7 @@ instance Outputable CafInfo where ...@@ -427,7 +426,7 @@ instance Outputable CafInfo where
ppr = ppCafInfo ppr = ppCafInfo
ppCafInfo :: CafInfo -> SDoc ppCafInfo :: CafInfo -> SDoc
ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs") ppCafInfo NoCafRefs = text "NoCafRefs"
ppCafInfo MayHaveCafRefs = empty ppCafInfo MayHaveCafRefs = empty
{- {-
...@@ -493,4 +492,4 @@ data TickBoxOp ...@@ -493,4 +492,4 @@ data TickBoxOp
= TickBox Module {-# UNPACK #-} !TickBoxId = TickBox Module {-# UNPACK #-} !TickBoxId
instance Outputable TickBoxOp where instance Outputable TickBoxOp where
ppr (TickBox mod n) = ptext (sLit "tick") <+> ppr (mod,n) ppr (TickBox mod n) = text "tick" <+> ppr (mod,n)
...@@ -446,7 +446,7 @@ litTag (LitInteger {}) = 11 ...@@ -446,7 +446,7 @@ litTag (LitInteger {}) = 11
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral _ (MachChar c) = pprPrimChar c pprLiteral _ (MachChar c) = pprPrimChar c
pprLiteral _ (MachStr s) = pprHsBytes s pprLiteral _ (MachStr s) = pprHsBytes s
pprLiteral _ (MachNullAddr) = ptext (sLit "__NULL") pprLiteral _ (MachNullAddr) = text "__NULL"
pprLiteral _ (MachInt i) = pprPrimInt i pprLiteral _ (MachInt i) = pprPrimInt i
pprLiteral _ (MachInt64 i) = pprPrimInt64 i pprLiteral _ (MachInt64 i) = pprPrimInt64 i
pprLiteral _ (MachWord w) = pprPrimWord w pprLiteral _ (MachWord w) = pprPrimWord w
...@@ -454,7 +454,7 @@ pprLiteral _ (MachWord64 w) = pprPrimWord64 w ...@@ -454,7 +454,7 @@ pprLiteral _ (MachWord64 w) = pprPrimWord64 w
pprLiteral _ (MachFloat f) = float (fromRat f) <> primFloatSuffix pprLiteral _ (MachFloat f) = float (fromRat f) <> primFloatSuffix
pprLiteral _ (MachDouble d) = double (fromRat d) <> primDoubleSuffix pprLiteral _ (MachDouble d) = double (fromRat d) <> primDoubleSuffix
pprLiteral add_par (LitInteger i _) = pprIntegerVal add_par i pprLiteral add_par (LitInteger i _) = pprIntegerVal add_par i
pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod) pprLiteral add_par (MachLabel l mb fod) = add_par (text "__label" <+> b <+> ppr fod)
where b = case mb of where b = case mb of
Nothing -> pprHsString l Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x)) Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
......
...@@ -514,7 +514,7 @@ pprExternal sty uniq mod occ is_wired is_builtin ...@@ -514,7 +514,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
-- ToDo: maybe we could print all wired-in things unqualified -- ToDo: maybe we could print all wired-in things unqualified
-- in code style, to reduce symbol table bloat? -- in code style, to reduce symbol table bloat?
| debugStyle sty = pp_mod <> ppr_occ_name occ | debugStyle sty = pp_mod <> ppr_occ_name occ
<> braces (hsep [if is_wired then ptext (sLit "(w)") else empty, <> braces (hsep [if is_wired then text "(w)" else empty,
pprNameSpaceBrief (occNameSpace occ), pprNameSpaceBrief (occNameSpace occ),
pprUnique uniq]) pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax | BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax
...@@ -583,7 +583,7 @@ ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ)) ...@@ -583,7 +583,7 @@ ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))
-- Prints (if mod information is available) "Defined at <loc>" or -- Prints (if mod information is available) "Defined at <loc>" or
-- "Defined in <mod>" information for a Name. -- "Defined in <mod>" information for a Name.
pprDefinedAt :: Name -> SDoc pprDefinedAt :: Name -> SDoc
pprDefinedAt name = ptext (sLit "Defined") <+> pprNameDefnLoc name pprDefinedAt name = text "Defined" <+> pprNameDefnLoc name
pprNameDefnLoc :: Name -> SDoc pprNameDefnLoc :: Name -> SDoc
-- Prints "at <loc>" or -- Prints "at <loc>" or
...@@ -593,12 +593,12 @@ pprNameDefnLoc name ...@@ -593,12 +593,12 @@ pprNameDefnLoc name
-- nameSrcLoc rather than nameSrcSpan -- nameSrcLoc rather than nameSrcSpan
-- It seems less cluttered to show a location -- It seems less cluttered to show a location
-- rather than a span for the definition point -- rather than a span for the definition point
RealSrcLoc s -> ptext (sLit "at") <+> ppr s RealSrcLoc s -> text "at" <+> ppr s
UnhelpfulLoc s UnhelpfulLoc s
| isInternalName name || isSystemName name | isInternalName name || isSystemName name
-> ptext (sLit "at") <+> ftext s -> text "at" <+> ftext s
| otherwise | otherwise
-> ptext (sLit "in") <+> quotes (ppr (nameModule name)) -> text "in" <+> quotes (ppr (nameModule name))
-- | Get a string representation of a 'Name' that's unique and stable -- | Get a string representation of a 'Name' that's unique and stable
......
...@@ -191,10 +191,10 @@ isValNameSpace VarName = True ...@@ -191,10 +191,10 @@ isValNameSpace VarName = True
isValNameSpace _ = False isValNameSpace _ = False
pprNameSpace :: NameSpace -> SDoc pprNameSpace :: NameSpace -> SDoc
pprNameSpace DataName = ptext (sLit "data constructor") pprNameSpace DataName = text "data constructor"
pprNameSpace VarName = ptext (sLit "variable") pprNameSpace VarName = text "variable"
pprNameSpace TvName = ptext (sLit "type variable") pprNameSpace TvName = text "type variable"
pprNameSpace TcClsName = ptext (sLit "type constructor or class") pprNameSpace TcClsName = text "type constructor or class"
pprNonVarNameSpace :: NameSpace -> SDoc pprNonVarNameSpace :: NameSpace -> SDoc
pprNonVarNameSpace VarName = empty pprNonVarNameSpace VarName = empty
...@@ -203,8 +203,8 @@ pprNonVarNameSpace ns = pprNameSpace ns ...@@ -203,8 +203,8 @@ pprNonVarNameSpace ns = pprNameSpace ns
pprNameSpaceBrief :: NameSpace -> SDoc pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief DataName = char 'd' pprNameSpaceBrief DataName = char 'd'
pprNameSpaceBrief VarName = char 'v' pprNameSpaceBrief VarName = char 'v'
pprNameSpaceBrief TvName = ptext (sLit "tv") pprNameSpaceBrief TvName = text "tv"
pprNameSpaceBrief TcClsName = ptext (sLit "tc") pprNameSpaceBrief TcClsName = text "tc"
-- demoteNameSpace lowers the NameSpace if possible. We can not know -- demoteNameSpace lowers the NameSpace if possible. We can not know
-- in advance, since a TvName can appear in an HsTyVar.