summaryrefslogtreecommitdiff
path: root/compiler/basicTypes
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/basicTypes')
-rw-r--r--compiler/basicTypes/BasicTypes.hs72
-rw-r--r--compiler/basicTypes/DataCon.hs18
-rw-r--r--compiler/basicTypes/Demand.hs5
-rw-r--r--compiler/basicTypes/IdInfo.hs27
-rw-r--r--compiler/basicTypes/Literal.hs4
-rw-r--r--compiler/basicTypes/Name.hs10
-rw-r--r--compiler/basicTypes/OccName.hs12
-rw-r--r--compiler/basicTypes/PatSyn.hs5
-rw-r--r--compiler/basicTypes/RdrName.hs30
-rw-r--r--compiler/basicTypes/Var.hs9
-rw-r--r--compiler/basicTypes/VarEnv.hs3
11 files changed, 95 insertions, 100 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 5db992de51..54534d2e74 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -192,8 +192,8 @@ bestOneShot OneShotLam _ = OneShotLam
pprOneShotInfo :: OneShotInfo -> SDoc
pprOneShotInfo NoOneShotInfo = empty
-pprOneShotInfo ProbOneShot = ptext (sLit "ProbOneShot")
-pprOneShotInfo OneShotLam = ptext (sLit "OneShot")
+pprOneShotInfo ProbOneShot = text "ProbOneShot"
+pprOneShotInfo OneShotLam = text "OneShot"
instance Outputable OneShotInfo where
ppr = pprOneShotInfo
@@ -211,8 +211,8 @@ data SwapFlag
| IsSwapped -- Args are: expected, actual
instance Outputable SwapFlag where
- ppr IsSwapped = ptext (sLit "Is-swapped")
- ppr NotSwapped = ptext (sLit "Not-swapped")
+ ppr IsSwapped = text "Is-swapped"
+ ppr NotSwapped = text "Not-swapped"
flipSwap :: SwapFlag -> SwapFlag
flipSwap IsSwapped = NotSwapped
@@ -327,9 +327,9 @@ data FixityDirection = InfixL | InfixR | InfixN
deriving (Eq, Data, Typeable)
instance Outputable FixityDirection where
- ppr InfixL = ptext (sLit "infixl")
- ppr InfixR = ptext (sLit "infixr")
- ppr InfixN = ptext (sLit "infix")
+ ppr InfixL = text "infixl"
+ ppr InfixR = text "infixr"
+ ppr InfixN = text "infix"
------------------------
maxPrecedence, minPrecedence :: Int
@@ -391,8 +391,8 @@ isTopLevel TopLevel = True
isTopLevel NotTopLevel = False
instance Outputable TopLevelFlag where
- ppr TopLevel = ptext (sLit "<TopLevel>")
- ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
+ ppr TopLevel = text "<TopLevel>"
+ ppr NotTopLevel = text "<NotTopLevel>"
{-
************************************************************************
@@ -440,8 +440,8 @@ boolToRecFlag True = Recursive
boolToRecFlag False = NonRecursive
instance Outputable RecFlag where
- ppr Recursive = ptext (sLit "Recursive")
- ppr NonRecursive = ptext (sLit "NonRecursive")
+ ppr Recursive = text "Recursive"
+ ppr NonRecursive = text "NonRecursive"
{-
************************************************************************
@@ -460,8 +460,8 @@ isGenerated Generated = True
isGenerated FromSource = False
instance Outputable Origin where
- ppr FromSource = ptext (sLit "FromSource")
- ppr Generated = ptext (sLit "Generated")
+ ppr FromSource = text "FromSource"
+ ppr Generated = text "Generated"
{-
************************************************************************
@@ -570,13 +570,13 @@ instance Outputable OverlapFlag where
instance Outputable OverlapMode where
ppr (NoOverlap _) = empty
- ppr (Overlappable _) = ptext (sLit "[overlappable]")
- ppr (Overlapping _) = ptext (sLit "[overlapping]")
- ppr (Overlaps _) = ptext (sLit "[overlap ok]")
- ppr (Incoherent _) = ptext (sLit "[incoherent]")
+ ppr (Overlappable _) = text "[overlappable]"
+ ppr (Overlapping _) = text "[overlapping]"
+ ppr (Overlaps _) = text "[overlap ok]"
+ ppr (Incoherent _) = text "[incoherent]"
pprSafeOverlap :: Bool -> SDoc
-pprSafeOverlap True = ptext $ sLit "[safe]"
+pprSafeOverlap True = text "[safe]"
pprSafeOverlap False = empty
{-
@@ -604,9 +604,9 @@ boxityTupleSort Unboxed = UnboxedTuple
tupleParens :: TupleSort -> SDoc -> SDoc
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 %)
- | opt_PprStyle_Debug = ptext (sLit "(%") <+> p <+> ptext (sLit "%)")
+ | opt_PprStyle_Debug = text "(%" <+> p <+> ptext (sLit "%)")
| otherwise = parens p
{-
@@ -746,10 +746,10 @@ zapFragileOcc occ = occ
instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07
ppr NoOccInfo = empty
- ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
- ppr IAmDead = ptext (sLit "Dead")
+ ppr (IAmALoopBreaker ro) = text "LoopBreaker" <> if ro then char '!' else empty
+ ppr IAmDead = text "Dead"
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
pp_lam | inside_lam = char 'L'
| otherwise = empty
@@ -776,8 +776,8 @@ data DefMethSpec ty
| GenericDM ty -- Default method given with code of this type
instance Outputable (DefMethSpec ty) where
- ppr VanillaDM = ptext (sLit "{- Has default method -}")
- ppr (GenericDM {}) = ptext (sLit "{- Has generic default method -}")
+ ppr VanillaDM = text "{- Has default method -}"
+ ppr (GenericDM {}) = text "{- Has generic default method -}"
{-
************************************************************************
@@ -790,8 +790,8 @@ instance Outputable (DefMethSpec ty) where
data SuccessFlag = Succeeded | Failed
instance Outputable SuccessFlag where
- ppr Succeeded = ptext (sLit "Succeeded")
- ppr Failed = ptext (sLit "Failed")
+ ppr Succeeded = text "Succeeded"
+ ppr Failed = text "Failed"
successIf :: Bool -> SuccessFlag
successIf True = Succeeded
@@ -888,7 +888,7 @@ data CompilerPhase
instance Outputable CompilerPhase where
ppr (Phase n) = int n
- ppr InitialPhase = ptext (sLit "InitialPhase")
+ ppr InitialPhase = text "InitialPhase"
-- See note [Pragma source text]
data Activation = NeverActive
@@ -1056,19 +1056,19 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
instance Outputable Activation where
- ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
- ppr NeverActive = brackets (ptext (sLit "NEVER"))
+ ppr AlwaysActive = brackets (text "ALWAYS")
+ ppr NeverActive = brackets (text "NEVER")
ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
ppr (ActiveAfter _ n) = brackets (int n)
instance Outputable RuleMatchInfo where
- ppr ConLike = ptext (sLit "CONLIKE")
- ppr FunLike = ptext (sLit "FUNLIKE")
+ ppr ConLike = text "CONLIKE"
+ ppr FunLike = text "FUNLIKE"
instance Outputable InlineSpec where
- ppr Inline = ptext (sLit "INLINE")
- ppr NoInline = ptext (sLit "NOINLINE")
- ppr Inlinable = ptext (sLit "INLINABLE")
+ ppr Inline = text "INLINE"
+ ppr NoInline = text "NOINLINE"
+ ppr Inlinable = text "INLINABLE"
ppr EmptyInlineSpec = empty
instance Outputable InlinePragma where
@@ -1080,7 +1080,7 @@ instance Outputable InlinePragma where
pp_act NoInline NeverActive = empty
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
pp_info | isFunLike info = empty
| otherwise = ppr info
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 466e3c1604..8bf91d0bb8 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -630,10 +630,10 @@ instance Outputable HsSrcBang where
ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
instance Outputable HsImplBang where
- ppr HsLazy = ptext (sLit "Lazy")
- ppr (HsUnpack Nothing) = ptext (sLit "Unpacked")
- ppr (HsUnpack (Just co)) = ptext (sLit "Unpacked") <> parens (ppr co)
- ppr HsStrict = ptext (sLit "StrictNotUnpacked")
+ ppr HsLazy = text "Lazy"
+ ppr (HsUnpack Nothing) = text "Unpacked"
+ ppr (HsUnpack (Just co)) = text "Unpacked" <> parens (ppr co)
+ ppr HsStrict = text "StrictNotUnpacked"
instance Outputable SrcStrictness where
ppr SrcLazy = char '~'
@@ -641,12 +641,12 @@ instance Outputable SrcStrictness where
ppr NoSrcStrict = empty
instance Outputable SrcUnpackedness where
- ppr SrcUnpack = ptext (sLit "{-# UNPACK #-}")
- ppr SrcNoUnpack = ptext (sLit "{-# NOUNPACK #-}")
+ ppr SrcUnpack = text "{-# UNPACK #-}"
+ ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
ppr NoSrcUnpack = empty
instance Outputable StrictnessMark where
- ppr MarkedStrict = ptext (sLit "!")
+ ppr MarkedStrict = text "!"
ppr NotMarkedStrict = empty
instance Binary SrcStrictness where
@@ -1042,7 +1042,7 @@ dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality
dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs}) 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 )
map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
@@ -1059,7 +1059,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs}) 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
where
tyvars = univ_tvs ++ ex_tvs
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 1a6d1d1fb4..65b8b2b9ee 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -72,7 +72,6 @@ import Maybes ( orElse )
import Type ( Type, isUnLiftedType )
import TyCon ( isNewTyCon, isClassTyCon )
import DataCon ( splitDataProductType_maybe )
-import FastString
{-
************************************************************************
@@ -787,8 +786,8 @@ data TypeShape = TsFun TypeShape
| TsUnk
instance Outputable TypeShape where
- ppr TsUnk = ptext (sLit "TsUnk")
- ppr (TsFun ts) = ptext (sLit "TsFun") <> parens (ppr ts)
+ ppr TsUnk = text "TsUnk"
+ ppr (TsFun ts) = text "TsFun" <> parens (ppr ts)
ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)
trimToType :: Demand -> TypeShape -> Demand
diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs
index 64703f59f4..3bc1da0ef4 100644
--- a/compiler/basicTypes/IdInfo.hs
+++ b/compiler/basicTypes/IdInfo.hs
@@ -81,7 +81,6 @@ import {-# SOURCE #-} PatSyn
import ForeignCall
import Outputable
import Module
-import FastString
import Demand
-- infixl so you can say (id `set` a `set` b)
@@ -166,17 +165,17 @@ pprIdDetails VanillaId = empty
pprIdDetails other = brackets (pp other)
where
pp VanillaId = panic "pprIdDetails"
- pp (DataConWorkId _) = ptext (sLit "DataCon")
- pp (DataConWrapId _) = ptext (sLit "DataConWrapper")
- pp (ClassOpId {}) = ptext (sLit "ClassOp")
- pp (PrimOpId _) = ptext (sLit "PrimOp")
- pp (FCallId _) = ptext (sLit "ForeignCall")
- pp (TickBoxOpId _) = ptext (sLit "TickBoxOp")
- pp (DFunId nt) = ptext (sLit "DFunId") <> ppWhen nt (ptext (sLit "(nt)"))
+ pp (DataConWorkId _) = text "DataCon"
+ pp (DataConWrapId _) = text "DataConWrapper"
+ pp (ClassOpId {}) = text "ClassOp"
+ pp (PrimOpId _) = text "PrimOp"
+ pp (FCallId _) = text "ForeignCall"
+ pp (TickBoxOpId _) = text "TickBoxOp"
+ pp (DFunId nt) = text "DFunId" <> ppWhen nt (text "(nt)")
pp (RecSelId { sel_naughty = is_naughty })
- = brackets $ ptext (sLit "RecSel")
- <> ppWhen is_naughty (ptext (sLit "(naughty)"))
- pp CoVarId = ptext (sLit "CoVarId")
+ = brackets $ text "RecSel"
+ <> ppWhen is_naughty (text "(naughty)")
+ pp CoVarId = text "CoVarId"
{-
************************************************************************
@@ -303,7 +302,7 @@ unknownArity = 0 :: Arity
ppArityInfo :: Int -> SDoc
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
ppr = ppCafInfo
ppCafInfo :: CafInfo -> SDoc
-ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
+ppCafInfo NoCafRefs = text "NoCafRefs"
ppCafInfo MayHaveCafRefs = empty
{-
@@ -493,4 +492,4 @@ data TickBoxOp
= TickBox Module {-# UNPACK #-} !TickBoxId
instance Outputable TickBoxOp where
- ppr (TickBox mod n) = ptext (sLit "tick") <+> ppr (mod,n)
+ ppr (TickBox mod n) = text "tick" <+> ppr (mod,n)
diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs
index f1a99f7980..18b441244c 100644
--- a/compiler/basicTypes/Literal.hs
+++ b/compiler/basicTypes/Literal.hs
@@ -446,7 +446,7 @@ litTag (LitInteger {}) = 11
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral _ (MachChar c) = pprPrimChar c
pprLiteral _ (MachStr s) = pprHsBytes s
-pprLiteral _ (MachNullAddr) = ptext (sLit "__NULL")
+pprLiteral _ (MachNullAddr) = text "__NULL"
pprLiteral _ (MachInt i) = pprPrimInt i
pprLiteral _ (MachInt64 i) = pprPrimInt64 i
pprLiteral _ (MachWord w) = pprPrimWord w
@@ -454,7 +454,7 @@ pprLiteral _ (MachWord64 w) = pprPrimWord64 w
pprLiteral _ (MachFloat f) = float (fromRat f) <> primFloatSuffix
pprLiteral _ (MachDouble d) = double (fromRat d) <> primDoubleSuffix
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
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 769b5aa044..74eec8aa14 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -514,7 +514,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
-- ToDo: maybe we could print all wired-in things unqualified
-- in code style, to reduce symbol table bloat?
| 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),
pprUnique uniq])
| BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax
@@ -583,7 +583,7 @@ ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))
-- Prints (if mod information is available) "Defined at <loc>" or
-- "Defined in <mod>" information for a Name.
pprDefinedAt :: Name -> SDoc
-pprDefinedAt name = ptext (sLit "Defined") <+> pprNameDefnLoc name
+pprDefinedAt name = text "Defined" <+> pprNameDefnLoc name
pprNameDefnLoc :: Name -> SDoc
-- Prints "at <loc>" or
@@ -593,12 +593,12 @@ pprNameDefnLoc name
-- nameSrcLoc rather than nameSrcSpan
-- It seems less cluttered to show a location
-- rather than a span for the definition point
- RealSrcLoc s -> ptext (sLit "at") <+> ppr s
+ RealSrcLoc s -> text "at" <+> ppr s
UnhelpfulLoc s
| isInternalName name || isSystemName name
- -> ptext (sLit "at") <+> ftext s
+ -> text "at" <+> ftext s
| 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
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index 40614add32..f7020a95f4 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -191,10 +191,10 @@ isValNameSpace VarName = True
isValNameSpace _ = False
pprNameSpace :: NameSpace -> SDoc
-pprNameSpace DataName = ptext (sLit "data constructor")
-pprNameSpace VarName = ptext (sLit "variable")
-pprNameSpace TvName = ptext (sLit "type variable")
-pprNameSpace TcClsName = ptext (sLit "type constructor or class")
+pprNameSpace DataName = text "data constructor"
+pprNameSpace VarName = text "variable"
+pprNameSpace TvName = text "type variable"
+pprNameSpace TcClsName = text "type constructor or class"
pprNonVarNameSpace :: NameSpace -> SDoc
pprNonVarNameSpace VarName = empty
@@ -203,8 +203,8 @@ pprNonVarNameSpace ns = pprNameSpace ns
pprNameSpaceBrief :: NameSpace -> SDoc
pprNameSpaceBrief DataName = char 'd'
pprNameSpaceBrief VarName = char 'v'
-pprNameSpaceBrief TvName = ptext (sLit "tv")
-pprNameSpaceBrief TcClsName = ptext (sLit "tc")
+pprNameSpaceBrief TvName = text "tv"
+pprNameSpaceBrief TcClsName = text "tc"
-- demoteNameSpace lowers the NameSpace if possible. We can not know
-- in advance, since a TvName can appear in an HsTyVar.
diff --git a/compiler/basicTypes/PatSyn.hs b/compiler/basicTypes/PatSyn.hs
index d948a2b89e..a0430ca319 100644
--- a/compiler/basicTypes/PatSyn.hs
+++ b/compiler/basicTypes/PatSyn.hs
@@ -31,7 +31,6 @@ import Outputable
import Unique
import Util
import BasicTypes
-import FastString
import Var
import FieldLabel
@@ -386,7 +385,7 @@ patSynInstArgTys (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
, psExTyVars = ex_tvs, psArgs = arg_tys })
inst_tys
= ASSERT2( length tyvars == length inst_tys
- , ptext (sLit "patSynInstArgTys") <+> ppr name $$ ppr tyvars $$ ppr inst_tys )
+ , text "patSynInstArgTys" <+> ppr name $$ ppr tyvars $$ ppr inst_tys )
map (substTyWith tyvars inst_tys) arg_tys
where
tyvars = univ_tvs ++ ex_tvs
@@ -401,5 +400,5 @@ patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
, psOrigResTy = res_ty })
inst_tys
= ASSERT2( length univ_tvs == length inst_tys
- , ptext (sLit "patSynInstResTy") <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
+ , text "patSynInstResTy" <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
substTyWith univ_tvs inst_tys res_ty
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index ce697064ad..6e0350da74 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -330,9 +330,9 @@ data LocalRdrEnv = LRE { lre_env :: OccEnv Name
instance Outputable LocalRdrEnv where
ppr (LRE {lre_env = env, lre_in_scope = ns})
- = hang (ptext (sLit "LocalRdrEnv {"))
- 2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
- , ptext (sLit "in_scope =")
+ = hang (text "LocalRdrEnv {")
+ 2 (vcat [ text "env =" <+> pprOccEnv ppr_elt env
+ , text "in_scope ="
<+> braces (pprWithCommas ppr (nameSetElems ns))
] <+> char '}')
where
@@ -437,10 +437,10 @@ data Parent = NoParent
instance Outputable Parent where
ppr NoParent = empty
- ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
- ppr (FldParent n f) = ptext (sLit "fldparent:")
+ ppr (ParentIs n) = text "parent:" <> ppr n
+ ppr (FldParent n f) = text "fldparent:"
<> ppr n <> colon <> ppr f
- ppr (PatternSynonym) = ptext (sLit "pattern synonym")
+ ppr (PatternSynonym) = text "pattern synonym"
plusParent :: Parent -> Parent -> Parent
-- See Note [Combining parents]
@@ -678,7 +678,7 @@ instance Outputable GlobalRdrElt where
pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv locals_only env
- = vcat [ ptext (sLit "GlobalRdrEnv") <+> ppWhen locals_only (ptext (sLit "(locals only)"))
+ = vcat [ text "GlobalRdrEnv" <+> ppWhen locals_only (ptext (sLit "(locals only)"))
<+> lbrace
, nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]
<+> rbrace) ]
@@ -687,7 +687,7 @@ pprGlobalRdrEnv locals_only env
| otherwise = gres
pp [] = empty
pp gres = hang (ppr occ
- <+> parens (ptext (sLit "unique") <+> ppr (getUnique occ))
+ <+> parens (text "unique" <+> ppr (getUnique occ))
<> colon)
2 (vcat (map ppr gres))
where
@@ -1094,7 +1094,7 @@ pprNameProvenance (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })
| otherwise = head pp_provs
where
pp_provs = pp_lcl ++ map pp_is iss
- pp_lcl = if lcl then [ptext (sLit "defined at") <+> ppr (nameSrcLoc name)]
+ pp_lcl = if lcl then [text "defined at" <+> ppr (nameSrcLoc name)]
else []
pp_is is = sep [ppr is, ppr_defn_site is name]
@@ -1105,25 +1105,25 @@ ppr_defn_site imp_spec name
| same_module && not (isGoodSrcSpan loc)
= empty -- Nothing interesting to say
| otherwise
- = parens $ hang (ptext (sLit "and originally defined") <+> pp_mod)
+ = parens $ hang (text "and originally defined" <+> pp_mod)
2 (pprLoc loc)
where
loc = nameSrcSpan name
defining_mod = nameModule name
same_module = importSpecModule imp_spec == moduleName defining_mod
pp_mod | same_module = empty
- | otherwise = ptext (sLit "in") <+> quotes (ppr defining_mod)
+ | otherwise = text "in" <+> quotes (ppr defining_mod)
instance Outputable ImportSpec where
ppr imp_spec
- = ptext (sLit "imported") <+> qual
- <+> ptext (sLit "from") <+> quotes (ppr (importSpecModule imp_spec))
+ = text "imported" <+> qual
+ <+> text "from" <+> quotes (ppr (importSpecModule imp_spec))
<+> pprLoc (importSpecLoc imp_spec)
where
- qual | is_qual (is_decl imp_spec) = ptext (sLit "qualified")
+ qual | is_qual (is_decl imp_spec) = text "qualified"
| otherwise = empty
pprLoc :: SrcSpan -> SDoc
-pprLoc (RealSrcSpan s) = ptext (sLit "at") <+> ppr s
+pprLoc (RealSrcSpan s) = text "at" <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty
diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs
index f57111fc40..11a4dee340 100644
--- a/compiler/basicTypes/Var.hs
+++ b/compiler/basicTypes/Var.hs
@@ -78,7 +78,6 @@ import Name hiding (varName)
import Unique
import Util
import DynFlags
-import FastString
import Outputable
import Data.Data
@@ -236,7 +235,7 @@ instance Outputable Var where
ppr_debug :: Var -> PprStyle -> SDoc
ppr_debug (TyVar {}) sty
- | debugStyle sty = brackets (ptext (sLit "tv"))
+ | debugStyle sty = brackets (text "tv")
ppr_debug (TcTyVar {tc_tv_details = d}) sty
| dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)
ppr_debug (Id { idScope = s, id_details = d }) sty
@@ -244,9 +243,9 @@ ppr_debug (Id { idScope = s, id_details = d }) sty
ppr_debug _ _ = empty
ppr_id_scope :: IdScope -> SDoc
-ppr_id_scope GlobalId = ptext (sLit "gid")
-ppr_id_scope (LocalId Exported) = ptext (sLit "lidx")
-ppr_id_scope (LocalId NotExported) = ptext (sLit "lid")
+ppr_id_scope GlobalId = text "gid"
+ppr_id_scope (LocalId Exported) = text "lidx"
+ppr_id_scope (LocalId NotExported) = text "lid"
instance NamedThing Var where
getName = varName
diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs
index 08c7965893..0fa0f57616 100644
--- a/compiler/basicTypes/VarEnv.hs
+++ b/compiler/basicTypes/VarEnv.hs
@@ -69,7 +69,6 @@ import Util
import Maybes
import Outputable
import StaticFlags
-import FastString
{-
************************************************************************
@@ -99,7 +98,7 @@ data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int
-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
instance Outputable InScopeSet where
- ppr (InScope s _) = ptext (sLit "InScope") <+> ppr s
+ ppr (InScope s _) = text "InScope" <+> ppr s
emptyInScopeSet :: InScopeSet
emptyInScopeSet = InScope emptyVarSet 1
View Lorry Controller Status