Replace calls to `ptext . sLit` with `text`
authorJan Stolarek <jan.stolarek@p.lodz.pl>
Fri, 15 Jan 2016 17:24:14 +0000 (18:24 +0100)
committerJan Stolarek <jan.stolarek@p.lodz.pl>
Mon, 18 Jan 2016 17:54:10 +0000 (18:54 +0100)
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

165 files changed:
compiler/basicTypes/BasicTypes.hs
compiler/basicTypes/DataCon.hs
compiler/basicTypes/Demand.hs
compiler/basicTypes/IdInfo.hs
compiler/basicTypes/Literal.hs
compiler/basicTypes/Name.hs
compiler/basicTypes/OccName.hs
compiler/basicTypes/PatSyn.hs
compiler/basicTypes/RdrName.hs
compiler/basicTypes/Var.hs
compiler/basicTypes/VarEnv.hs
compiler/cmm/CLabel.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmLint.hs
compiler/cmm/CmmType.hs
compiler/cmm/PprC.hs
compiler/cmm/PprCmm.hs
compiler/cmm/PprCmmDecl.hs
compiler/cmm/PprCmmExpr.hs
compiler/cmm/SMRep.hs
compiler/codeGen/StgCmmClosure.hs
compiler/codeGen/StgCmmEnv.hs
compiler/codeGen/StgCmmMonad.hs
compiler/coreSyn/CoreArity.hs
compiler/coreSyn/CoreLint.hs
compiler/coreSyn/CorePrep.hs
compiler/coreSyn/CoreStats.hs
compiler/coreSyn/CoreSubst.hs
compiler/coreSyn/CoreSyn.hs
compiler/coreSyn/CoreUnfold.hs
compiler/coreSyn/CoreUtils.hs
compiler/coreSyn/MkCore.hs
compiler/coreSyn/PprCore.hs
compiler/deSugar/Check.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/Desugar.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsBinds.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsForeign.hs
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsMonad.hs
compiler/deSugar/MatchLit.hs
compiler/deSugar/PmExpr.hs
compiler/ghci/ByteCodeInstr.hs
compiler/ghci/Linker.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsBinds.hs
compiler/hsSyn/HsDecls.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsImpExp.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsSyn.hs
compiler/hsSyn/HsTypes.hs
compiler/iface/IfaceSyn.hs
compiler/iface/IfaceType.hs
compiler/iface/LoadIface.hs
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/main/DriverMkDepend.hs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/DynamicLoading.hs
compiler/main/ErrUtils.hs
compiler/main/Finder.hs
compiler/main/GhcMake.hs
compiler/main/Hooks.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs
compiler/main/Packages.hs
compiler/main/PprTyThing.hs
compiler/main/SysTools.hs
compiler/main/TidyPgm.hs
compiler/nativeGen/AsmCodeGen.hs
compiler/nativeGen/Dwarf.hs
compiler/nativeGen/Dwarf/Types.hs
compiler/nativeGen/PIC.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/PprBase.hs
compiler/nativeGen/RegAlloc/Liveness.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/X86/Ppr.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/prelude/ForeignCall.hs
compiler/prelude/PrelRules.hs
compiler/profiling/CostCentre.hs
compiler/profiling/ProfInit.hs
compiler/rename/RnBinds.hs
compiler/rename/RnEnv.hs
compiler/rename/RnExpr.hs
compiler/rename/RnNames.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnTypes.hs
compiler/simplCore/CoreMonad.hs
compiler/simplCore/FloatOut.hs
compiler/simplCore/OccurAnal.hs
compiler/simplCore/SAT.hs
compiler/simplCore/SimplCore.hs
compiler/simplCore/SimplEnv.hs
compiler/simplCore/SimplMonad.hs
compiler/simplCore/SimplUtils.hs
compiler/simplCore/Simplify.hs
compiler/specialise/Rules.hs
compiler/specialise/SpecConstr.hs
compiler/specialise/Specialise.hs
compiler/stgSyn/CoreToStg.hs
compiler/stgSyn/StgLint.hs
compiler/stgSyn/StgSyn.hs
compiler/stranal/DmdAnal.hs
compiler/stranal/WwLib.hs
compiler/typecheck/FamInst.hs
compiler/typecheck/FunDeps.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcAnnotations.hs
compiler/typecheck/TcArrows.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcClassDcl.hs
compiler/typecheck/TcDefaults.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcEnv.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcEvidence.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcFlatten.hs
compiler/typecheck/TcForeign.hs
compiler/typecheck/TcGenGenerics.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcInteract.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcRules.hs
compiler/typecheck/TcSMonad.hs
compiler/typecheck/TcSimplify.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
compiler/typecheck/TcType.hs
compiler/typecheck/TcUnify.hs
compiler/typecheck/TcValidity.hs
compiler/types/Class.hs
compiler/types/Coercion.hs
compiler/types/FamInstEnv.hs
compiler/types/InstEnv.hs
compiler/types/OptCoercion.hs
compiler/types/TyCoRep.hs
compiler/types/Type.hs
compiler/utils/Outputable.hs
compiler/utils/UniqDFM.hs
compiler/utils/UniqFM.hs
compiler/vectorise/Vectorise/Builtins/Initialise.hs
compiler/vectorise/Vectorise/Exp.hs
compiler/vectorise/Vectorise/Monad/Global.hs
compiler/vectorise/Vectorise/Type/Env.hs

index 5db992d..54534d2 100644 (file)
@@ -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
index 466e3c1..8bf91d0 100644 (file)
@@ -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
index 1a6d1d1..65b8b2b 100644 (file)
@@ -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
index 64703f5..3bc1da0 100644 (file)
@@ -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)
index f1a99f7..18b4412 100644 (file)
@@ -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))
index 769b5aa..74eec8a 100644 (file)
@@ -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
index 40614ad..f7020a9 100644 (file)
@@ -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.
index d948a2b..a0430ca 100644 (file)
@@ -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
index ce69706..6e0350d 100644 (file)
@@ -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
index f57111f..11a4dee 100644 (file)
@@ -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
index 08c7965..0fa0f57 100644 (file)
@@ -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
index a7eb797..9304d66 100644 (file)
@@ -1000,11 +1000,11 @@ pprCLabel platform (DynamicLinkerLabel info lbl)
 
 pprCLabel _ PicBaseLabel
  | cGhcWithNativeCodeGen == "YES"
-   = ptext (sLit "1b")
+   = text "1b"
 
 pprCLabel platform (DeadStripPreventer lbl)
  | cGhcWithNativeCodeGen == "YES"
-   = pprCLabel platform lbl <> ptext (sLit "_dsp")
+   = pprCLabel platform lbl <> text "_dsp"
 
 pprCLabel platform lbl
    = getPprStyle $ \ sty ->
@@ -1028,22 +1028,22 @@ pprAsmCLbl _ lbl
 
 pprCLbl :: CLabel -> SDoc
 pprCLbl (StringLitLabel u)
-  = pprUnique u <> ptext (sLit "_str")
+  = pprUnique u <> text "_str"
 
 pprCLbl (CaseLabel u CaseReturnPt)
-  = hcat [pprUnique u, ptext (sLit "_ret")]
+  = hcat [pprUnique u, text "_ret"]
 pprCLbl (CaseLabel u CaseReturnInfo)
-  = hcat [pprUnique u, ptext (sLit "_info")]
+  = hcat [pprUnique u, text "_info"]
 pprCLbl (CaseLabel u (CaseAlt tag))
-  = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
+  = hcat [pprUnique u, pp_cSEP, int tag, text "_alt"]
 pprCLbl (CaseLabel u CaseDefault)
-  = hcat [pprUnique u, ptext (sLit "_dflt")]
+  = hcat [pprUnique u, text "_dflt"]
 
 pprCLbl (SRTLabel u)
-  = pprUnique u <> pp_cSEP <> ptext (sLit "srt")
+  = pprUnique u <> pp_cSEP <> text "srt"
 
-pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
-pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
+pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> text "srtd"
+pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> text "btm"
 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 -- until that gets resolved we'll just force them to start
 -- with a letter so the label will be legal assmbly code.
@@ -1053,56 +1053,56 @@ pprCLbl (CmmLabel _ str CmmCode)        = ftext str
 pprCLbl (CmmLabel _ str CmmData)        = ftext str
 pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
 
-pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
+pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> text "_fast"
 
 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
-  = hcat [ptext (sLit "stg_sel_"), text (show offset),
+  = hcat [text "stg_sel_", text (show offset),
           ptext (if upd_reqd
                  then (sLit "_upd_info")
                  else (sLit "_noupd_info"))
         ]
 
 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
-  = hcat [ptext (sLit "stg_sel_"), text (show offset),
+  = hcat [text "stg_sel_", text (show offset),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
                         else (sLit "_noupd_entry"))
         ]
 
 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
-  = hcat [ptext (sLit "stg_ap_"), text (show arity),
+  = hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_info")
                         else (sLit "_noupd_info"))
         ]
 
 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
-  = hcat [ptext (sLit "stg_ap_"), text (show arity),
+  = hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
                         else (sLit "_noupd_entry"))
         ]
 
 pprCLbl (CmmLabel _ fs CmmInfo)
-  = ftext fs <> ptext (sLit "_info")
+  = ftext fs <> text "_info"
 
 pprCLbl (CmmLabel _ fs CmmEntry)
-  = ftext fs <> ptext (sLit "_entry")
+  = ftext fs <> text "_entry"
 
 pprCLbl (CmmLabel _ fs CmmRetInfo)
-  = ftext fs <> ptext (sLit "_info")
+  = ftext fs <> text "_info"
 
 pprCLbl (CmmLabel _ fs CmmRet)
-  = ftext fs <> ptext (sLit "_ret")
+  = ftext fs <> text "_ret"
 
 pprCLbl (CmmLabel _ fs CmmClosure)
-  = ftext fs <> ptext (sLit "_closure")
+  = ftext fs <> text "_closure"
 
 pprCLbl (RtsLabel (RtsPrimOp primop))
-  = ptext (sLit "stg_") <> ppr primop
+  = text "stg_" <> ppr primop
 
 pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
-  = ptext (sLit "SLOW_CALL_fast_") <> text pat <> ptext (sLit "_ctr")
+  = text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr")
 
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str
@@ -1113,10 +1113,10 @@ pprCLbl (CC_Label cc)           = ppr cc
 pprCLbl (CCS_Label ccs)         = ppr ccs
 
 pprCLbl (PlainModuleInitLabel mod)
-   = ptext (sLit "__stginit_") <> ppr mod
+   = text "__stginit_" <> ppr mod
 
 pprCLbl (HpcTicksLabel mod)
-  = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
+  = text "_hpc_tickboxes_"  <> ppr mod <> ptext (sLit "_hpc")
 
 pprCLbl (AsmTempLabel {})       = panic "pprCLbl AsmTempLabel"
 pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
@@ -1127,19 +1127,19 @@ pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <>
                (case x of
-                       Closure          -> ptext (sLit "closure")
-                       SRT              -> ptext (sLit "srt")
-                       InfoTable        -> ptext (sLit "info")
-                       LocalInfoTable   -> ptext (sLit "info")
-                       Entry            -> ptext (sLit "entry")
-                       LocalEntry       -> ptext (sLit "entry")
-                       Slow             -> ptext (sLit "slow")
-                       RednCounts       -> ptext (sLit "ct")
-                       ConEntry         -> ptext (sLit "con_entry")
-                       ConInfoTable     -> ptext (sLit "con_info")
-                       StaticConEntry   -> ptext (sLit "static_entry")
-                       StaticInfoTable  -> ptext (sLit "static_info")
-                       ClosureTable     -> ptext (sLit "closure_tbl")
+                       Closure          -> text "closure"
+                       SRT              -> text "srt"
+                       InfoTable        -> text "info"
+                       LocalInfoTable   -> text "info"
+                       Entry            -> text "entry"
+                       LocalEntry       -> text "entry"
+                       Slow             -> text "slow"
+                       RednCounts       -> text "ct"
+                       ConEntry         -> text "con_entry"
+                       ConInfoTable     -> text "con_info"
+                       StaticConEntry   -> text "static_entry"
+                       StaticInfoTable  -> text "static_info"
+                       ClosureTable     -> text "closure_tbl"
                       )
 
 
index 1a10e68..5fea0e7 100644 (file)
@@ -1071,8 +1071,8 @@ data StackSlot = Occupied | Empty
      -- Occupied: a return address or part of an update frame
 
 instance Outputable StackSlot where
-  ppr Occupied = ptext (sLit "XXX")
-  ppr Empty    = ptext (sLit "---")
+  ppr Occupied = text "XXX"
+  ppr Empty    = text "---"
 
 dropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot]
 dropEmpty 0 ss           = Just ss
index 015337b..c009112 100644 (file)
@@ -17,7 +17,6 @@ import CmmLive
 import CmmSwitch (switchTargetsToList)
 import PprCmm ()
 import BlockId
-import FastString
 import Outputable
 import DynFlags
 
@@ -41,9 +40,9 @@ cmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g
 runCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc
 runCmmLint dflags l p =
    case unCL (l p) dflags of
-     Left err -> Just (vcat [ptext $ sLit ("Cmm lint error:"),
+     Left err -> Just (vcat [text "Cmm lint error:",
                              nest 2 err,
-                             ptext $ sLit ("Program was:"),
+                             text "Program was:",
                              nest 2 (ppr p)])
      Right _  -> Nothing
 
index f852d54..ae46330 100644 (file)
@@ -63,9 +63,9 @@ instance Outputable CmmType where
   ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid)
 
 instance Outputable CmmCat where
-  ppr FloatCat       = ptext $ sLit("F")
-  ppr GcPtrCat       = ptext $ sLit("P")
-  ppr BitsCat        = ptext $ sLit("I")
+  ppr FloatCat       = text "F"
+  ppr GcPtrCat       = text "P"
+  ppr BitsCat        = text "I"
   ppr (VecCat n cat) = ppr cat <> text "x" <> ppr n <> text "V"
 
 -- Why is CmmType stratified?  For native code generation,
index 3d3acec..e679d55 100644 (file)
@@ -66,7 +66,7 @@ pprCs dflags cmms
  = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
  where
    split_marker
-     | gopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER")
+     | gopt Opt_SplitObjs dflags = text "__STG_SPLIT_MARKER"
      | otherwise                 = empty
 
 writeCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO ()
@@ -112,13 +112,13 @@ pprTop (CmmProc infos clbl _ graph) =
 
 pprTop (CmmData _section (Statics lbl [CmmString str])) =
   hcat [
-    pprLocalness lbl, ptext (sLit "char "), ppr lbl,
-    ptext (sLit "[] = "), pprStringInCStyle str, semi
+    pprLocalness lbl, text "char ", ppr lbl,
+    text "[] = ", pprStringInCStyle str, semi
   ]
 
 pprTop (CmmData _section (Statics lbl [CmmUninitialised size])) =
   hcat [
-    pprLocalness lbl, ptext (sLit "char "), ppr lbl,
+    pprLocalness lbl, text "char ", ppr lbl,
     brackets (int size), semi
   ]
 
@@ -147,16 +147,16 @@ pprBBlock block =
 pprWordArray :: CLabel -> [CmmStatic] -> SDoc
 pprWordArray lbl ds
   = sdocWithDynFlags $ \dflags ->
-    hcat [ pprLocalness lbl, ptext (sLit "StgWord")
-         , space, ppr lbl, ptext (sLit "[] = {") ]
+    hcat [ pprLocalness lbl, text "StgWord"
+         , space, ppr lbl, text "[] = {" ]
     $$ nest 8 (commafy (pprStatics dflags ds))
-    $$ ptext (sLit "};")
+    $$ text "};"
 
 --
 -- has to be static, if it isn't globally visible
 --
 pprLocalness :: CLabel -> SDoc
-pprLocalness lbl | not $ externallyVisibleCLabel lbl = ptext (sLit "static ")
+pprLocalness lbl | not $ externallyVisibleCLabel lbl = text "static "
                  | otherwise = empty
 
 -- --------------------------------------------------------------------------
@@ -169,7 +169,7 @@ pprStmt stmt =
     sdocWithDynFlags $ \dflags ->
     case stmt of
     CmmEntry{}   -> empty
-    CmmComment _ -> empty -- (hang (ptext (sLit "/*")) 3 (ftext s)) $$ ptext (sLit "*/")
+    CmmComment _ -> empty -- (hang (text "/*") 3 (ftext s)) $$ ptext (sLit "*/")
                           -- XXX if the string contains "*/", we need to fix it
                           -- XXX we probably want to emit these comments when
                           -- some debugging option is on.  They can get quite
@@ -182,7 +182,7 @@ pprStmt stmt =
 
     CmmStore  dest src
         | typeWidth rep == W64 && wordWidth dflags /= W64
-        -> (if isFloatType rep then ptext (sLit "ASSIGN_DBL")
+        -> (if isFloatType rep then text "ASSIGN_DBL"
                                else ptext (sLit ("ASSIGN_Word64"))) <>
            parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
 
@@ -240,7 +240,7 @@ pprStmt stmt =
           -- We also need to cast mem primops to prevent conflicts with GCC
           -- builtins (see bug #5967).
           | Just _align <- machOpMemcpyishAlign op
-          = (ptext (sLit ";EF_(") <> fn <> char ')' <> semi) $$
+          = (text ";EF_(" <> fn <> char ')' <> semi) $$
             pprForeignCall fn cconv hresults hargs
           | otherwise
           = pprCall fn cconv hresults hargs
@@ -269,7 +269,7 @@ pprForeignCall fn cconv results args = fn_call
 pprCFunType :: SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc
 pprCFunType ppr_fn cconv ress args
   = sdocWithDynFlags $ \dflags ->
-    let res_type [] = ptext (sLit "void")
+    let res_type [] = text "void"
         res_type [(one, hint)] = machRepHintCType (localRegType one) hint
         res_type _ = panic "pprCFunType: only void or 1 return value supported"
 
@@ -281,16 +281,16 @@ pprCFunType ppr_fn cconv ress args
 -- ---------------------------------------------------------------------
 -- unconditional branches
 pprBranch :: BlockId -> SDoc
-pprBranch ident = ptext (sLit "goto") <+> pprBlockId ident <> semi
+pprBranch ident = text "goto" <+> pprBlockId ident <> semi
 
 
 -- ---------------------------------------------------------------------
 -- conditional branches to local labels
 pprCondBranch :: CmmExpr -> BlockId -> BlockId -> SDoc
 pprCondBranch expr yes no
-        = hsep [ ptext (sLit "if") , parens(pprExpr expr) ,
-                        ptext (sLit "goto"), pprBlockId yes <> semi,
-                        ptext (sLit "else goto"), pprBlockId no <> semi ]
+        = hsep [ text "if" , parens(pprExpr expr) ,
+                        text "goto", pprBlockId yes <> semi,
+                        text "else goto", pprBlockId no <> semi ]
 
 -- ---------------------------------------------------------------------
 -- a local table branch
@@ -299,7 +299,7 @@ pprCondBranch expr yes no
 --
 pprSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> SDoc
 pprSwitch dflags e ids
-  = (hang (ptext (sLit "switch") <+> parens ( pprExpr e ) <+> lbrace)
+  = (hang (text "switch" <+> parens ( pprExpr e ) <+> lbrace)
                 4 (vcat ( map caseify pairs ) $$ def)) $$ rbrace
   where
     (pairs, mbdef) = switchTargetsFallThrough ids
@@ -308,16 +308,16 @@ pprSwitch dflags e ids
     caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
         where
         do_fallthrough ix =
-                 hsep [ ptext (sLit "case") , pprHexVal ix (wordWidth dflags) <> colon ,
-                        ptext (sLit "/* fall through */") ]
+                 hsep [ text "case" , pprHexVal ix (wordWidth dflags) <> colon ,
+                        text "/* fall through */" ]
 
         final_branch ix =
-                hsep [ ptext (sLit "case") , pprHexVal ix (wordWidth dflags) <> colon ,
-                       ptext (sLit "goto") , (pprBlockId ident) <> semi ]
+                hsep [ text "case" , pprHexVal ix (wordWidth dflags) <> colon ,
+                       text "goto" , (pprBlockId ident) <> semi ]
 
     caseify (_     , _    ) = panic "pprSwitch: switch with no cases!"
 
-    def | Just l <- mbdef = ptext (sLit "default: goto") <+> pprBlockId l <> semi
+    def | Just l <- mbdef = text "default: goto" <+> pprBlockId l <> semi
         | otherwise       = empty
 
 -- ---------------------------------------------------------------------
@@ -360,8 +360,8 @@ pprExpr e = case e of
 pprLoad :: DynFlags -> CmmExpr -> CmmType -> SDoc
 pprLoad dflags e ty
   | width == W64, wordWidth dflags /= W64
-  = (if isFloatType ty then ptext (sLit "PK_DBL")
-                       else ptext (sLit "PK_Word64"))
+  = (if isFloatType ty then text "PK_DBL"
+                       else text "PK_Word64")
     <> parens (mkP_ <> pprExpr1 e)
 
   | otherwise
@@ -394,7 +394,7 @@ pprMachOpApp :: MachOp -> [CmmExpr] -> SDoc
 
 pprMachOpApp op args
   | isMulMayOfloOp op
-  = ptext (sLit "mulIntMayOflo") <> parens (commafy (map pprExpr args))
+  = text "mulIntMayOflo" <> parens (commafy (map pprExpr args))
   where isMulMayOfloOp (MO_U_MulMayOflo _) = True
         isMulMayOfloOp (MO_S_MulMayOflo _) = True
         isMulMayOfloOp _ = False
@@ -446,9 +446,9 @@ pprLit lit = case lit of
 
     CmmFloat f w       -> parens (machRep_F_CType w) <> str
         where d = fromRational f :: Double
-              str | isInfinite d && d < 0 = ptext (sLit "-INFINITY")
-                  | isInfinite d          = ptext (sLit "INFINITY")
-                  | isNaN d               = ptext (sLit "NAN")
+              str | isInfinite d && d < 0 = text "-INFINITY"
+                  | isInfinite d          = text "INFINITY"
+                  | isNaN d               = text "NAN"
                   | otherwise             = text (show d)
                 -- these constants come from <math.h>
                 -- see #1861
@@ -489,7 +489,7 @@ pprStatics dflags (CmmStaticLit (CmmFloat f W32) : rest)
   = pprPanic "pprStatics: float" (vcat (map ppr' rest))
     where ppr' (CmmStaticLit l) = sdocWithDynFlags $ \dflags ->
                                   ppr (cmmLitType dflags l)
-          ppr' _other           = ptext (sLit "bad static!")
+          ppr' _other           = text "bad static!"
 pprStatics dflags (CmmStaticLit (CmmFloat f W64) : rest)
   = map pprLit1 (doubleToWords dflags f) ++ pprStatics dflags rest
 pprStatics dflags (CmmStaticLit (CmmInt i W64) : rest)
@@ -536,8 +536,8 @@ pprMachOp_for_C mop = case mop of
         -- Integer operations
         MO_Add          _ -> char '+'
         MO_Sub          _ -> char '-'
-        MO_Eq           _ -> ptext (sLit "==")
-        MO_Ne           _ -> ptext (sLit "!=")
+        MO_Eq           _ -> text "=="
+        MO_Ne           _ -> text "!="
         MO_Mul          _ -> char '*'
 
         MO_S_Quot       _ -> char '/'
@@ -555,22 +555,22 @@ pprMachOp_for_C mop = case mop of
         MO_F_Quot       _ -> char '/'
 
         -- Signed comparisons
-        MO_S_Ge         _ -> ptext (sLit ">=")
-        MO_S_Le         _ -> ptext (sLit "<=")
+        MO_S_Ge         _ -> text ">="
+        MO_S_Le         _ -> text "<="
         MO_S_Gt         _ -> char '>'
         MO_S_Lt         _ -> char '<'
 
         -- & Unsigned comparisons
-        MO_U_Ge         _ -> ptext (sLit ">=")
-        MO_U_Le         _ -> ptext (sLit "<=")
+        MO_U_Ge         _ -> text ">="
+        MO_U_Le         _ -> text "<="
         MO_U_Gt         _ -> char '>'
         MO_U_Lt         _ -> char '<'
 
         -- & Floating-point comparisons
-        MO_F_Eq         _ -> ptext (sLit "==")
-        MO_F_Ne         _ -> ptext (sLit "!=")
-        MO_F_Ge         _ -> ptext (sLit ">=")
-        MO_F_Le         _ -> ptext (sLit "<=")
+        MO_F_Eq         _ -> text "=="
+        MO_F_Ne         _ -> text "!="
+        MO_F_Ge         _ -> text ">="
+        MO_F_Le         _ -> text "<="
         MO_F_Gt         _ -> char '>'
         MO_F_Lt         _ -> char '<'
 
@@ -580,9 +580,9 @@ pprMachOp_for_C mop = case mop of
         MO_Or           _ -> char '|'
         MO_Xor          _ -> char '^'
         MO_Not          _ -> char '~'
-        MO_Shl          _ -> ptext (sLit "<<")
-        MO_U_Shr        _ -> ptext (sLit ">>") -- unsigned shift right
-        MO_S_Shr        _ -> ptext (sLit ">>") -- signed shift right
+        MO_Shl          _ -> text "<<"
+        MO_U_Shr        _ -> text ">>" -- unsigned shift right
+        MO_S_Shr        _ -> text ">>" -- signed shift right
 
 -- Conversions.  Some of these will be NOPs, but never those that convert
 -- between ints and floats.
@@ -604,85 +604,85 @@ pprMachOp_for_C mop = case mop of
         MO_FS_Conv _from to -> parens (machRep_S_CType to)
 
         MO_S_MulMayOflo _ -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_S_MulMayOflo")
+                                (text "MO_S_MulMayOflo")
                                 (panic $ "PprC.pprMachOp_for_C: MO_S_MulMayOflo"
                                       ++ " should have been handled earlier!")
         MO_U_MulMayOflo _ -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_U_MulMayOflo")
+                                (text "MO_U_MulMayOflo")
                                 (panic $ "PprC.pprMachOp_for_C: MO_U_MulMayOflo"
                                       ++ " should have been handled earlier!")
 
         MO_V_Insert {}    -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_V_Insert")
+                                (text "MO_V_Insert")
                                 (panic $ "PprC.pprMachOp_for_C: MO_V_Insert"
                                       ++ " should have been handled earlier!")
         MO_V_Extract {}   -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_V_Extract")
+                                (text "MO_V_Extract")
                                 (panic $ "PprC.pprMachOp_for_C: MO_V_Extract"
                                       ++ " should have been handled earlier!")
 
         MO_V_Add {}       -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_V_Add")
+                                (text "MO_V_Add")
                                 (panic $ "PprC.pprMachOp_for_C: MO_V_Add"
                                       ++ " should have been handled earlier!")
         MO_V_Sub {}       -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_V_Sub")
+                                (text "MO_V_Sub")
                                 (panic $ "PprC.pprMachOp_for_C: MO_V_Sub"
                                       ++ " should have been handled earlier!")
         MO_V_Mul {}       -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_V_Mul")
+                                (text "MO_V_Mul")
                                 (panic $ "PprC.pprMachOp_for_C: MO_V_Mul"
                                       ++ " should have been handled earlier!")
 
         MO_VS_Quot {}     -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VS_Quot")
+                                (text "MO_VS_Quot")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VS_Quot"
                                       ++ " should have been handled earlier!")
         MO_VS_Rem {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VS_Rem")
+                                (text "MO_VS_Rem")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VS_Rem"
                                       ++ " should have been handled earlier!")
         MO_VS_Neg {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VS_Neg")
+                                (text "MO_VS_Neg")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VS_Neg"
                                       ++ " should have been handled earlier!")
 
         MO_VU_Quot {}     -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VU_Quot")
+                                (text "MO_VU_Quot")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VU_Quot"
                                       ++ " should have been handled earlier!")
         MO_VU_Rem {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VU_Rem")
+                                (text "MO_VU_Rem")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VU_Rem"
                                       ++ " should have been handled earlier!")
 
         MO_VF_Insert {}   -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Insert")
+                                (text "MO_VF_Insert")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Insert"
                                       ++ " should have been handled earlier!")
         MO_VF_Extract {}  -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Extract")
+                                (text "MO_VF_Extract")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Extract"
                                       ++ " should have been handled earlier!")
 
         MO_VF_Add {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Add")
+                                (text "MO_VF_Add")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Add"
                                       ++ " should have been handled earlier!")
         MO_VF_Sub {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Sub")
+                                (text "MO_VF_Sub")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Sub"
                                       ++ " should have been handled earlier!")
         MO_VF_Neg {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Neg")
+                                (text "MO_VF_Neg")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Neg"
                                       ++ " should have been handled earlier!")
         MO_VF_Mul {}      -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Mul")
+                                (text "MO_VF_Mul")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Mul"
                                       ++ " should have been handled earlier!")
         MO_VF_Quot {}     -> pprTrace "offending mop:"
-                                (ptext $ sLit "MO_VF_Quot")
+                                (text "MO_VF_Quot")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Quot"
                                       ++ " should have been handled earlier!")
 
@@ -715,36 +715,36 @@ pprCallishMachOp_for_C :: CallishMachOp -> SDoc
 
 pprCallishMachOp_for_C mop
     = case mop of
-        MO_F64_Pwr      -> ptext (sLit "pow")
-        MO_F64_Sin      -> ptext (sLit "sin")
-        MO_F64_Cos      -> ptext (sLit "cos")
-        MO_F64_Tan      -> ptext (sLit "tan")
-        MO_F64_Sinh     -> ptext (sLit "sinh")
-        MO_F64_Cosh     -> ptext (sLit "cosh")
-        MO_F64_Tanh     -> ptext (sLit "tanh")
-        MO_F64_Asin     -> ptext (sLit "asin")
-        MO_F64_Acos     -> ptext (sLit "acos")
-        MO_F64_Atan     -> ptext (sLit "atan")
-        MO_F64_Log      -> ptext (sLit "log")
-        MO_F64_Exp      -> ptext (sLit "exp")
-        MO_F64_Sqrt     -> ptext (sLit "sqrt")
-        MO_F32_Pwr      -> ptext (sLit "powf")
-        MO_F32_Sin      -> ptext (sLit "sinf")
-        MO_F32_Cos      -> ptext (sLit "cosf")
-        MO_F32_Tan      -> ptext (sLit "tanf")
-        MO_F32_Sinh     -> ptext (sLit "sinhf")
-        MO_F32_Cosh     -> ptext (sLit "coshf")
-        MO_F32_Tanh     -> ptext (sLit "tanhf")
-        MO_F32_Asin     -> ptext (sLit "asinf")
-        MO_F32_Acos     -> ptext (sLit "acosf")
-        MO_F32_Atan     -> ptext (sLit "atanf")
-        MO_F32_Log      -> ptext (sLit "logf")
-        MO_F32_Exp      -> ptext (sLit "expf")
-        MO_F32_Sqrt     -> ptext (sLit "sqrtf")
-        MO_WriteBarrier -> ptext (sLit "write_barrier")
-        MO_Memcpy _     -> ptext (sLit "memcpy")
-        MO_Memset _     -> ptext (sLit "memset")
-        MO_Memmove _    -> ptext (sLit "memmove")
+        MO_F64_Pwr      -> text "pow"
+        MO_F64_Sin      -> text "sin"
+        MO_F64_Cos      -> text "cos"
+        MO_F64_Tan      -> text "tan"
+        MO_F64_Sinh     -> text "sinh"
+        MO_F64_Cosh     -> text "cosh"
+        MO_F64_Tanh     -> text "tanh"
+        MO_F64_Asin     -> text "asin"
+        MO_F64_Acos     -> text "acos"
+        MO_F64_Atan     -> text "atan"
+        MO_F64_Log      -> text "log"
+        MO_F64_Exp      -> text "exp"
+        MO_F64_Sqrt     -> text "sqrt"
+        MO_F32_Pwr      -> text "powf"
+        MO_F32_Sin      -> text "sinf"
+        MO_F32_Cos      -> text "cosf"
+        MO_F32_Tan      -> text "tanf"
+        MO_F32_Sinh     -> text "sinhf"
+        MO_F32_Cosh     -> text "coshf"
+        MO_F32_Tanh     -> text "tanhf"
+        MO_F32_Asin     -> text "asinf"
+        MO_F32_Acos     -> text "acosf"
+        MO_F32_Atan     -> text "atanf"
+        MO_F32_Log      -> text "logf"
+        MO_F32_Exp      -> text "expf"
+        MO_F32_Sqrt     -> text "sqrtf"
+        MO_WriteBarrier -> text "write_barrier"
+        MO_Memcpy _     -> text "memcpy"
+        MO_Memset _     -> text "memset"
+        MO_Memmove _    -> text "memmove"
         (MO_BSwap w)    -> ptext (sLit $ bSwapLabel w)
         (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)
         (MO_Clz w)      -> ptext (sLit $ clzLabel w)
@@ -776,17 +776,17 @@ pprCallishMachOp_for_C mop
 
 mkJMP_, mkFN_, mkIF_ :: SDoc -> SDoc
 
-mkJMP_ i = ptext (sLit "JMP_") <> parens i
-mkFN_  i = ptext (sLit "FN_")  <> parens i -- externally visible function
-mkIF_  i = ptext (sLit "IF_")  <> parens i -- locally visible
+mkJMP_ i = text "JMP_" <> parens i
+mkFN_  i = text "FN_"  <> parens i -- externally visible function
+mkIF_  i = text "IF_"  <> parens i -- locally visible
 
 -- from includes/Stg.h
 --
 mkC_,mkW_,mkP_ :: SDoc
 
-mkC_  = ptext (sLit "(C_)")        -- StgChar
-mkW_  = ptext (sLit "(W_)")        -- StgWord
-mkP_  = ptext (sLit "(P_)")        -- StgWord*
+mkC_  = text "(C_)"        -- StgChar
+mkW_  = text "(W_)"        -- StgWord
+mkP_  = text "(P_)"        -- StgWord*
 
 -- ---------------------------------------------------------------------
 --
@@ -819,8 +819,8 @@ pprAssign _ r1 r2
   | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 r2)
   | otherwise                    = mkAssign (pprExpr r2)
     where mkAssign x = if r1 == CmmGlobal BaseReg
-                       then ptext (sLit "ASSIGN_BaseReg") <> parens x <> semi
-                       else pprReg r1 <> ptext (sLit " = ") <> x <> semi
+                       then text "ASSIGN_BaseReg" <> parens x <> semi
+                       else pprReg r1 <> text " = " <> x <> semi
 
 -- ---------------------------------------------------------------------
 -- Registers
@@ -869,10 +869,10 @@ isStrangeTypeGlobal BaseReg             = True
 isStrangeTypeGlobal r                   = isFixedPtrGlobalReg r
 
 strangeRegType :: CmmReg -> Maybe SDoc
-strangeRegType (CmmGlobal CCCS) = Just (ptext (sLit "struct CostCentreStack_ *"))
-strangeRegType (CmmGlobal CurrentTSO) = Just (ptext (sLit "struct StgTSO_ *"))
-strangeRegType (CmmGlobal CurrentNursery) = Just (ptext (sLit "struct bdescr_ *"))
-strangeRegType (CmmGlobal BaseReg) = Just (ptext (sLit "struct StgRegTable_ *"))
+strangeRegType (CmmGlobal CCCS) = Just (text "struct CostCentreStack_ *")
+strangeRegType (CmmGlobal CurrentTSO) = Just (text "struct StgTSO_ *")
+strangeRegType (CmmGlobal CurrentNursery) = Just (text "struct bdescr_ *")
+strangeRegType (CmmGlobal BaseReg) = Just (text "struct StgRegTable_ *")
 strangeRegType _ = Nothing
 
 -- pprReg just prints the register name.
@@ -884,30 +884,30 @@ pprReg r = case r of
 
 pprAsPtrReg :: CmmReg -> SDoc
 pprAsPtrReg (CmmGlobal (VanillaReg n gcp))
-  = WARN( gcp /= VGcPtr, ppr n ) char 'R' <> int n <> ptext (sLit ".p")
+  = WARN( gcp /= VGcPtr, ppr n ) char 'R' <> int n <> text ".p"
 pprAsPtrReg other_reg = pprReg other_reg
 
 pprGlobalReg :: GlobalReg -> SDoc
 pprGlobalReg gr = case gr of
-    VanillaReg n _ -> char 'R' <> int n  <> ptext (sLit ".w")
+    VanillaReg n _ -> char 'R' <> int n  <> text ".w"
         -- pprGlobalReg prints a VanillaReg as a .w regardless
         -- Example:     R1.w = R1.w & (-0x8UL);
         --              JMP_(*R1.p);
     FloatReg   n   -> char 'F' <> int n
     DoubleReg  n   -> char 'D' <> int n
     LongReg    n   -> char 'L' <> int n
-    Sp             -> ptext (sLit "Sp")
-    SpLim          -> ptext (sLit "SpLim")
-    Hp             -> ptext (sLit "Hp")
-    HpLim          -> ptext (sLit "HpLim")
-    CCCS           -> ptext (sLit "CCCS")
-    CurrentTSO     -> ptext (sLit "CurrentTSO")
-    CurrentNursery -> ptext (sLit "CurrentNursery")
-    HpAlloc        -> ptext (sLit "HpAlloc")
-    BaseReg        -> ptext (sLit "BaseReg")
-    EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
-    GCEnter1       -> ptext (sLit "stg_gc_enter_1")
-    GCFun          -> ptext (sLit "stg_gc_fun")
+    Sp             -> text "Sp"
+    SpLim          -> text "SpLim"
+    Hp             -> text "Hp"
+    HpLim          -> text "HpLim"
+    CCCS           -> text "CCCS"
+    CurrentTSO     -> text "CurrentTSO"
+    CurrentNursery -> text "CurrentNursery"
+    HpAlloc        -> text "HpAlloc"
+    BaseReg        -> text "BaseReg"
+    EagerBlackholeInfo -> text "stg_EAGER_BLACKHOLE_info"
+    GCEnter1       -> text "stg_gc_enter_1"
+    GCFun          -> text "stg_gc_fun"
     other          -> panic $ "pprGlobalReg: Unsupported register: " ++ show other
 
 pprLocalReg :: LocalReg -> SDoc
@@ -927,12 +927,12 @@ pprCall ppr_fn cconv results args
   where
      ppr_assign []           rhs = rhs
      ppr_assign [(one,hint)] rhs
-         = pprLocalReg one <> ptext (sLit " = ")
+         = pprLocalReg one <> text " = "
                  <> pprUnHint hint (localRegType one) <> rhs
      ppr_assign _other _rhs = panic "pprCall: multiple results"
 
      pprArg (expr, AddrHint)
-        = cCast (ptext (sLit "void *")) expr
+        = cCast (text "void *") expr
         -- see comment by machRepHintCType below
      pprArg (expr, SignedHint)
         = sdocWithDynFlags $ \dflags ->
@@ -981,8 +981,8 @@ pprExternDecl _in_srt lbl
         hcat [ visibility, label_type lbl,
                lparen, ppr lbl, text ");" ]
  where
-  label_type lbl | isCFunctionLabel lbl = ptext (sLit "F_")
-                 | otherwise            = ptext (sLit "I_")
+  label_type lbl | isCFunctionLabel lbl = text "F_"
+                 | otherwise            = text "I_"
 
   visibility
      | externallyVisibleCLabel lbl = char 'E'
@@ -992,7 +992,7 @@ pprExternDecl _in_srt lbl
   -- we must generate an appropriate prototype for it, so that the C compiler will
   -- add the @n suffix to the label (#2276)
   stdcall_decl sz = sdocWithDynFlags $ \dflags ->
-        ptext (sLit "extern __attribute__((stdcall)) void ") <> ppr lbl
+        text "extern __attribute__((stdcall)) void " <> ppr lbl
         <> parens (commafy (replicate (sz `quot` wORD_SIZE dflags) (machRep_U_CType (wordWidth dflags))))
         <> semi
 
@@ -1071,11 +1071,11 @@ cLoad :: CmmExpr -> CmmType -> SDoc
 cLoad expr rep
     = sdocWithPlatform $ \platform ->
       if bewareLoadStoreAlignment (platformArch platform)
-      then let decl = machRepCType rep <+> ptext (sLit "x") <> semi
-               struct = ptext (sLit "struct") <+> braces (decl)
-               packed_attr = ptext (sLit "__attribute__((packed))")
+      then let decl = machRepCType rep <+> text "x" <> semi
+               struct = text "struct" <+> braces (decl)
+               packed_attr = text "__attribute__((packed))"
                cast = parens (struct <+> packed_attr <> char '*')
-           in parens (cast <+> pprExpr1 expr) <> ptext (sLit "->x")
+           in parens (cast <+> pprExpr1 expr) <> text "->x"
       else char '*' <> parens (cCast (machRepPtrCType rep) expr)
     where -- On these platforms, unaligned loads are known to cause problems
           bewareLoadStoreAlignment ArchAlpha    = True
@@ -1097,14 +1097,14 @@ isCmmWordType dflags ty = not (isFloatType ty)
 -- argument, we always cast the argument to (void *), to avoid warnings from
 -- the C compiler.
 machRepHintCType :: CmmType -> ForeignHint -> SDoc
-machRepHintCType _   AddrHint   = ptext (sLit "void *")
+machRepHintCType _   AddrHint   = text "void *"
 machRepHintCType rep SignedHint = machRep_S_CType (typeWidth rep)
 machRepHintCType rep _other     = machRepCType rep
 
 machRepPtrCType :: CmmType -> SDoc
 machRepPtrCType r
  = sdocWithDynFlags $ \dflags ->
-   if isCmmWordType dflags r then ptext (sLit "P_")
+   if isCmmWordType dflags r then text "P_"
                              else machRepCType r <> char '*'
 
 machRepCType :: CmmType -> SDoc
@@ -1114,30 +1114,30 @@ machRepCType ty | isFloatType ty = machRep_F_CType w
                   w = typeWidth ty
 
 machRep_F_CType :: Width -> SDoc
-machRep_F_CType W32 = ptext (sLit "StgFloat") -- ToDo: correct?
-machRep_F_CType W64 = ptext (sLit "StgDouble")
+machRep_F_CType W32 = text "StgFloat" -- ToDo: correct?
+machRep_F_CType W64 = text "StgDouble"
 machRep_F_CType _   = panic "machRep_F_CType"
 
 machRep_U_CType :: Width -> SDoc
 machRep_U_CType w
  = sdocWithDynFlags $ \dflags ->
    case w of
-   _ | w == wordWidth dflags -> ptext (sLit "W_")
-   W8  -> ptext (sLit "StgWord8")
-   W16 -> ptext (sLit "StgWord16")
-   W32 -> ptext (sLit "StgWord32")
-   W64 -> ptext (sLit "StgWord64")
+   _ | w == wordWidth dflags -> text "W_"
+   W8  -> text "StgWord8"
+   W16 -> text "StgWord16"
+   W32 -> text "StgWord32"
+   W64 -> text "StgWord64"
    _   -> panic "machRep_U_CType"
 
 machRep_S_CType :: Width -> SDoc
 machRep_S_CType w
  = sdocWithDynFlags $ \dflags ->
    case w of
-   _ | w == wordWidth dflags -> ptext (sLit "I_")
-   W8  -> ptext (sLit "StgInt8")
-   W16 -> ptext (sLit "StgInt16")
-   W32 -> ptext (sLit "StgInt32")
-   W64 -> ptext (sLit "StgInt64")
+   _ | w == wordWidth dflags -> text "I_"
+   W8  -> text "StgInt8"
+   W16 -> text "StgInt16"
+   W32 -> text "StgInt32"
+   W64 -> text "StgInt64"
    _   -> panic "machRep_S_CType"
 
 
@@ -1213,8 +1213,8 @@ commafy xs = hsep $ punctuate comma xs
 pprHexVal :: Integer -> Width -> SDoc
 pprHexVal w rep
   | w < 0     = parens (char '-' <>
-                    ptext (sLit "0x") <> intToDoc (-w) <> repsuffix rep)
-  | otherwise =     ptext (sLit "0x") <> intToDoc   w  <> repsuffix rep
+                    text "0x" <> intToDoc (-w) <> repsuffix rep)
+  | otherwise =     text "0x" <> intToDoc   w  <> repsuffix rep
   where
         -- type suffix for literals:
         -- Integer literals are unsigned in Cmm/C.  We explicitly cast to
@@ -1224,8 +1224,8 @@ pprHexVal w rep
 
       repsuffix W64 = sdocWithDynFlags $ \dflags ->
                if cINT_SIZE       dflags == 8 then char 'U'
-          else if cLONG_SIZE      dflags == 8 then ptext (sLit "UL")
-          else if cLONG_LONG_SIZE dflags == 8 then ptext (sLit "ULL")
+          else if cLONG_SIZE      dflags == 8 then text "UL"
+          else if cLONG_LONG_SIZE dflags == 8 then text "ULL"
           else panic "pprHexVal: Can't find a 64-bit type"
       repsuffix _ = char 'U'
 
index 5caea90..9517ea3 100644 (file)
@@ -102,13 +102,13 @@ instance Outputable CmmGraph where
 
 pprStackInfo :: CmmStackInfo -> SDoc
 pprStackInfo (StackInfo {arg_space=arg_space, updfr_space=updfr_space}) =
-  ptext (sLit "arg_space: ") <> ppr arg_space <+>
-  ptext (sLit "updfr_space: ") <> ppr updfr_space
+  text "arg_space: " <> ppr arg_space <+>
+  text "updfr_space: " <> ppr updfr_space
 
 pprTopInfo :: CmmTopInfo -> SDoc
 pprTopInfo (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
-  vcat [ptext (sLit "info_tbl: ") <> ppr info_tbl,
-        ptext (sLit "stack_info: ") <> ppr stack_info]
+  vcat [text "info_tbl: " <> ppr info_tbl,
+        text "stack_info: " <> ppr stack_info]
 
 ----------------------------------------------------------
 -- Outputting blocks and graphs
@@ -161,7 +161,7 @@ pprForeignConvention (ForeignConvention c args res ret) =
 
 pprReturnInfo :: CmmReturnInfo -> SDoc
 pprReturnInfo CmmMayReturn = empty
-pprReturnInfo CmmNeverReturns = ptext (sLit "never returns")
+pprReturnInfo CmmNeverReturns = text "never returns"
 
 pprForeignTarget :: ForeignTarget -> SDoc
 pprForeignTarget (ForeignTarget fn c) = ppr c <+> ppr_target fn
@@ -193,11 +193,11 @@ pprNode node = pp_node <+> pp_debug
 
       -- //tick bla<...>
       CmmTick t -> if gopt Opt_PprShowTicks dflags
-                   then ptext (sLit "//tick") <+> ppr t
+                   then text "//tick" <+> ppr t
                    else empty
 
       -- unwind reg = expr;
-      CmmUnwind r e -> ptext (sLit "unwind ") <> ppr r <+> char '=' <+> ppr e
+      CmmUnwind r e -> text "unwind " <> ppr r <+> char '=' <+> ppr e
 
       -- reg = expr;
       CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
@@ -213,75 +213,75 @@ pprNode node = pp_node <+> pp_debug
       CmmUnsafeForeignCall target results args ->
           hsep [ ppUnless (null results) $
                     parens (commafy $ map ppr results) <+> equals,
-                 ptext $ sLit "call",
+                 text "call",
                  ppr target <> parens (commafy $ map ppr args) <> semi]
 
       -- goto label;
-      CmmBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi
+      CmmBranch ident -> text "goto" <+> ppr ident <> semi
 
       -- if (expr) goto t; else goto f;
       CmmCondBranch expr t f l ->
-          hsep [ ptext (sLit "if")
+          hsep [ text "if"
                , parens(ppr expr)
                , case l of
                    Nothing -> empty
-                   Just b -> parens (ptext (sLit "likely:") <+> ppr b)
-               , ptext (sLit "goto")
+                   Just b -> parens (text "likely:" <+> ppr b)
+               , text "goto"
                , ppr t <> semi
-               , ptext (sLit "else goto")
+               , text "else goto"
                , ppr f <> semi
                ]
 
       CmmSwitch expr ids ->
-          hang (hsep [ ptext (sLit "switch")
+          hang (hsep [ text "switch"
                      , range
                      , if isTrivialCmmExpr expr
                        then ppr expr
                        else parens (ppr expr)
-                     , ptext (sLit "{")
+                     , text "{"
                      ])
              4 (vcat (map ppCase cases) $$ def) $$ rbrace
           where
             (cases, mbdef) = switchTargetsFallThrough ids
             ppCase (is,l) = hsep
-                            [ ptext (sLit "case")
+                            [ text "case"
                             , commafy $ map integer is
-                            , ptext (sLit ": goto")
+                            , text ": goto"
                             , ppr l <> semi
                             ]
             def | Just l <- mbdef = hsep
-                            [ ptext (sLit "default: goto")
+                            [ text "default: goto"
                             , ppr l <> semi
                             ]
                 | otherwise = empty
 
-            range = brackets $ hsep [integer lo, ptext (sLit ".."), integer hi]
+            range = brackets $ hsep [integer lo, text "..", integer hi]
               where (lo,hi) = switchTargetsRange ids
 
       CmmCall tgt k regs out res updfr_off ->
-          hcat [ ptext (sLit "call"), space
+          hcat [ text "call", space
                , pprFun tgt, parens (interpp'SP regs), space
                , returns <+>
-                 ptext (sLit "args: ") <> ppr out <> comma <+>
-                 ptext (sLit "res: ") <> ppr res <> comma <+>
-                 ptext (sLit "upd: ") <> ppr updfr_off
+                 text "args: " <> ppr out <> comma <+>
+                 text "res: " <> ppr res <> comma <+>
+                 text "upd: " <> ppr updfr_off
                , semi ]
           where pprFun f@(CmmLit _) = ppr f
                 pprFun f = parens (ppr f)
 
                 returns
-                  | Just r <- k = ptext (sLit "returns to") <+> ppr r <> comma
+                  | Just r <- k = text "returns to" <+> ppr r <> comma
                   | otherwise   = empty
 
       CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
-          hcat $ if i then [ptext (sLit "interruptible"), space] else [] ++
-               [ ptext (sLit "foreign call"), space
-               , ppr t, ptext (sLit "(...)"), space
-               , ptext (sLit "returns to") <+> ppr s
-                    <+> ptext (sLit "args:") <+> parens (ppr as)
-                    <+> ptext (sLit "ress:") <+> parens (ppr rs)
-               , ptext (sLit "ret_args:") <+> ppr a
-               , ptext (sLit "ret_off:") <+> ppr u
+          hcat $ if i then [text "interruptible", space] else [] ++
+               [ text "foreign call", space
+               , ppr t, text "(...)", space
+               , text "returns to" <+> ppr s
+                    <+> text "args:" <+> parens (ppr as)
+                    <+> text "ress:" <+> parens (ppr rs)
+               , text "ret_args:" <+> ppr a
+               , text "ret_off:" <+> ppr u
                , semi ]
 
     pp_debug :: SDoc
index 830f536..9364d2b 100644 (file)
@@ -59,7 +59,7 @@ pprCmms :: (Outputable info, Outputable g)
         => [GenCmmGroup CmmStatics info g] -> SDoc
 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
         where
-          separator = space $$ ptext (sLit "-------------------") $$ space
+          separator = space $$ text "-------------------" $$ space
 
 writeCmms :: (Outputable info, Outputable g)
           => DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
@@ -96,7 +96,7 @@ pprTop :: (Outputable d, Outputable info, Outputable i)
 
 pprTop (CmmProc info lbl live graph)
 
-  = vcat [ ppr lbl <> lparen <> rparen <+> ptext (sLit "// ") <+> ppr live
+  = vcat [ ppr lbl <> lparen <> rparen <+> text "// " <+> ppr live
          , nest 8 $ lbrace <+> ppr info $$ rbrace
          , nest 4 $ ppr graph
          , rbrace ]
@@ -117,15 +117,15 @@ pprInfoTable :: CmmInfoTable -> SDoc
 pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
                            , cit_prof = prof_info
                            , cit_srt = _srt })
-  = vcat [ ptext (sLit "label:") <+> ppr lbl
-         , ptext (sLit "rep:") <> ppr rep
+  = vcat [ text "label:" <+> ppr lbl
+         , text "rep:" <> ppr rep
          , case prof_info of
              NoProfilingInfo -> empty
-             ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
-                                         , ptext (sLit "desc: ") <> pprWord8String cd ] ]
+             ProfilingInfo ct cd -> vcat [ text "type:" <+> pprWord8String ct
+                                         , text "desc: " <> pprWord8String cd ] ]
 
 instance Outputable C_SRT where
-  ppr NoC_SRT = ptext (sLit "_no_srt_")
+  ppr NoC_SRT = text "_no_srt_"
   ppr (C_SRT label off bitmap)
       = parens (ppr label <> comma <> ppr off <> comma <> ppr bitmap)
 
@@ -146,7 +146,7 @@ pprStatics (Statics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
 
 pprStatic :: CmmStatic -> SDoc
 pprStatic s = case s of
-    CmmStaticLit lit   -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
+    CmmStaticLit lit   -> nest 4 $ text "const" <+> pprLit lit <> semi
     CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
     CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')
 
@@ -157,7 +157,7 @@ pprSection :: Section -> SDoc
 pprSection (Section t suffix) =
   section <+> doubleQuotes (pprSectionType t <+> char '.' <+> ppr suffix)
   where
-    section = ptext (sLit "section")
+    section = text "section"
 
 pprSectionType :: SectionType -> SDoc
 pprSectionType s = doubleQuotes (ptext t)
index 1f1c7f8..77c9240 100644 (file)
@@ -41,7 +41,6 @@ where
 import CmmExpr
 
 import Outputable
-import FastString
 
 import Data.Maybe
 import Numeric ( fromRat )
@@ -102,12 +101,12 @@ pprExpr1 e = pprExpr7 e
 
 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
 
-infixMachOp1 (MO_Eq     _) = Just (ptext (sLit "=="))
-infixMachOp1 (MO_Ne     _) = Just (ptext (sLit "!="))
-infixMachOp1 (MO_Shl    _) = Just (ptext (sLit "<<"))
-infixMachOp1 (MO_U_Shr  _) = Just (ptext (sLit ">>"))
-infixMachOp1 (MO_U_Ge   _) = Just (ptext (sLit ">="))
-infixMachOp1 (MO_U_Le   _) = Just (ptext (sLit "<="))
+infixMachOp1 (MO_Eq     _) = Just (text "==")
+infixMachOp1 (MO_Ne     _) = Just (text "!=")
+infixMachOp1 (MO_Shl    _) = Just (text "<<")
+infixMachOp1 (MO_U_Shr  _) = Just (text ">>")
+infixMachOp1 (MO_U_Ge   _) = Just (text ">=")
+infixMachOp1 (MO_U_Le   _) = Just (text "<=")
 infixMachOp1 (MO_U_Gt   _) = Just (char '>')
 infixMachOp1 (MO_U_Lt   _) = Just (char '<')
 infixMachOp1 _             = Nothing
@@ -255,24 +254,24 @@ pprGlobalReg gr
         FloatReg   n   -> char 'F' <> int n
         DoubleReg  n   -> char 'D' <> int n
         LongReg    n   -> char 'L' <> int n
-        XmmReg     n   -> ptext (sLit "XMM") <> int n
-        YmmReg     n   -> ptext (sLit "YMM") <> int n
-        ZmmReg     n   -> ptext (sLit "ZMM") <> int n
-        Sp             -> ptext (sLit "Sp")
-        SpLim          -> ptext (sLit "SpLim")
-        Hp             -> ptext (sLit "Hp")
-        HpLim          -> ptext (sLit "HpLim")
-        MachSp         -> ptext (sLit "MachSp")
-        UnwindReturnReg-> ptext (sLit "UnwindReturnReg")
-        CCCS           -> ptext (sLit "CCCS")
-        CurrentTSO     -> ptext (sLit "CurrentTSO")
-        CurrentNursery -> ptext (sLit "CurrentNursery")
-        HpAlloc        -> ptext (sLit "HpAlloc")
-        EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
-        GCEnter1       -> ptext (sLit "stg_gc_enter_1")
-        GCFun          -> ptext (sLit "stg_gc_fun")
-        BaseReg        -> ptext (sLit "BaseReg")
-        PicBaseReg     -> ptext (sLit "PicBaseReg")
+        XmmReg     n   -> text "XMM" <> int n
+        YmmReg     n   -> text "YMM" <> int n
+        ZmmReg     n   -> text "ZMM" <> int n
+        Sp             -> text "Sp"
+        SpLim          -> text "SpLim"
+        Hp             -> text "Hp"
+        HpLim          -> text "HpLim"
+        MachSp         -> text "MachSp"
+        UnwindReturnReg-> text "UnwindReturnReg"
+        CCCS           -> text "CCCS"
+        CurrentTSO     -> text "CurrentTSO"
+        CurrentNursery -> text "CurrentNursery"
+        HpAlloc        -> text "HpAlloc"
+        EagerBlackholeInfo -> text "stg_EAGER_BLACKHOLE_info"
+        GCEnter1       -> text "stg_gc_enter_1"
+        GCFun          -> text "stg_gc_fun"
+        BaseReg        -> text "BaseReg"
+        PicBaseReg     -> text "PicBaseReg"
 
 -----------------------------------------------------------------------------
 
index 6c00761..ecd8905 100644 (file)
@@ -498,44 +498,44 @@ instance Outputable SMRep where
    ppr (HeapRep static ps nps tyinfo)
      = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
      where
-       header = ptext (sLit "HeapRep")
-                <+> if static then ptext (sLit "static") else empty
+       header = text "HeapRep"
+                <+> if static then text "static" else empty
                 <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
        pp_n :: String -> Int -> SDoc
        pp_n _ 0 = empty
        pp_n s n = int n <+> text s
 
-   ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size
+   ppr (ArrayPtrsRep size _) = text "ArrayPtrsRep" <+> ppr size
 
-   ppr (SmallArrayPtrsRep size) = ptext (sLit "SmallArrayPtrsRep") <+> ppr size
+   ppr (SmallArrayPtrsRep size) = text "SmallArrayPtrsRep" <+> ppr size
 
-   ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words
+   ppr (ArrayWordsRep words) = text "ArrayWordsRep" <+> ppr words
 
-   ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs
+   ppr (StackRep bs) = text "StackRep" <+> ppr bs
 
-   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep
+   ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep
 
 instance Outputable ArgDescr where
-  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
-  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
+  ppr (ArgSpec n) = text "ArgSpec" <+> ppr n
+  ppr (ArgGen ls) = text "ArgGen" <+> ppr ls
 
 pprTypeInfo :: ClosureTypeInfo -> SDoc
 pprTypeInfo (Constr tag descr)
-  = ptext (sLit "Con") <+>
-    braces (sep [ ptext (sLit "tag:") <+> ppr tag
-                , ptext (sLit "descr:") <> text (show descr) ])
+  = text "Con" <+>
+    braces (sep [ text "tag:" <+> ppr tag
+                , text "descr:" <> text (show descr) ])
 
 pprTypeInfo (Fun arity args)
-  = ptext (sLit "Fun") <+>
-    braces (sep [ ptext (sLit "arity:") <+> ppr arity
+  = text "Fun" <+>
+    braces (sep [ text "arity:" <+> ppr arity
                 , ptext (sLit ("fun_type:")) <+> ppr args ])
 
 pprTypeInfo (ThunkSelector offset)
-  = ptext (sLit "ThunkSel") <+> ppr offset
+  = text "ThunkSel" <+> ppr offset
 
-pprTypeInfo Thunk     = ptext (sLit "Thunk")
-pprTypeInfo BlackHole = ptext (sLit "BlackHole")
-pprTypeInfo IndStatic = ptext (sLit "IndStatic")
+pprTypeInfo Thunk     = text "Thunk"
+pprTypeInfo BlackHole = text "BlackHole"
+pprTypeInfo IndStatic = text "IndStatic"
 
 -- XXX Does not belong here!!
 stringToWord8s :: String -> [Word8]
index d10903d..d3b9fac 100644 (file)
@@ -74,7 +74,6 @@ import CLabel
 import Id
 import IdInfo
 import DataCon
-import FastString
 import Name
 import Type
 import TyCoRep
@@ -104,8 +103,8 @@ data CgLoc
         -- and branch to the block id
 
 instance Outputable CgLoc where
-  ppr (CmmLoc e)    = ptext (sLit "cmm") <+> ppr e
-  ppr (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
+  ppr (CmmLoc e)    = text "cmm" <+> ppr e
+  ppr (LneLoc b rs) = text "lne" <+> ppr b <+> ppr rs
 
 type SelfLoopInfo = (Id, BlockId, [LocalReg])
 
index 4127b67..8dbb646 100644 (file)
@@ -38,7 +38,6 @@ import MkGraph
 import BlockId
 import CmmExpr
 import CmmUtils
-import FastString
 import Id
 import VarEnv
 import Control.Monad
@@ -158,7 +157,7 @@ cgLookupPanic id
   = do  local_binds <- getBinds
         pprPanic "StgCmmEnv: variable not found"
                 (vcat [ppr id,
-                ptext (sLit "local binds for:"),
+                text "local binds for:",
                 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
               ])
 
index 4203320..2742acd 100644 (file)
@@ -214,7 +214,7 @@ data CgIdInfo
 
 instance Outputable CgIdInfo where
   ppr (CgIdInfo { cg_id = id, cg_loc = loc })
-    = ppr id <+> ptext (sLit "-->") <+> ppr loc
+    = ppr id <+> text "-->" <+> ppr loc
 
 -- Sequel tells what to do with the result of this expression
 data Sequel
@@ -232,8 +232,8 @@ data Sequel
                         -- allocating primOp)
 
 instance Outputable Sequel where
-    ppr (Return b) = ptext (sLit "Return") <+> ppr b
-    ppr (AssignTo regs b) = ptext (sLit "AssignTo") <+> ppr regs <+> ppr b
+    ppr (Return b) = text "Return" <+> ppr b
+    ppr (AssignTo regs b) = text "AssignTo" <+> ppr regs <+> ppr b
 
 -- See Note [sharing continuations] below
 data ReturnKind
index e274ee2..8086299 100644 (file)
@@ -894,8 +894,8 @@ data EtaInfo = EtaVar Var       -- /\a. [],   [] a
              | EtaCo Coercion   -- [] |> co,  [] |> (sym co)
 
 instance Outputable EtaInfo where
-   ppr (EtaVar v) = ptext (sLit "EtaVar") <+> ppr v
-   ppr (EtaCo co) = ptext (sLit "EtaCo")  <+> ppr co
+   ppr (EtaVar v) = text "EtaVar" <+> ppr v
+   ppr (EtaCo co) = text "EtaCo"  <+> ppr co
 
 pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo]
 pushCoercion co1 (EtaCo co2 : eis)
index 2f6ab1c..ccd3b8e 100644 (file)
@@ -233,7 +233,7 @@ dumpPassResult dflags unqual mb_flag hdr extra_info binds rules
                      , pprCoreBindingsWithSize binds
                      , ppUnless (null rules) pp_rules ]
     pp_rules = vcat [ blankLine
-                    , ptext (sLit "------ Local rules for imported ids --------")
+                    , text "------ Local rules for imported ids --------"
                     , pprRules rules ]
 
 coreDumpFlag :: CoreToDo -> Maybe DumpFlag
@@ -286,9 +286,9 @@ displayLintResults dflags pass warns errs binds
   | not (isEmptyBag errs)
   = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle
            (vcat [ lint_banner "errors" (ppr pass), Err.pprMessageBag errs
-                 , ptext (sLit "*** Offending Program ***")
+                 , text "*** Offending Program ***"
                  , pprCoreBindings binds
-                 , ptext (sLit "*** End of Offense ***") ])
+                 , text "*** End of Offense ***" ])
        ; Err.ghcExit dflags 1 }
 
   | not (isEmptyBag warns)
@@ -301,9 +301,9 @@ displayLintResults dflags pass warns errs binds
   where
 
 lint_banner :: String -> SDoc -> SDoc
-lint_banner string pass = ptext (sLit "*** Core Lint")      <+> text string
-                          <+> ptext (sLit ": in result of") <+> pass
-                          <+> ptext (sLit "***")
+lint_banner string pass = text "*** Core Lint"      <+> text string
+                          <+> text ": in result of" <+> pass
+                          <+> text "***"
 
 showLintWarnings :: CoreToDo -> Bool
 -- Disable Lint warnings on the first simplifier pass, because
@@ -327,9 +327,9 @@ lintInteractiveExpr what hsc_env expr
       = do { log_action dflags dflags Err.SevDump noSrcSpan defaultDumpStyle
                (vcat [ lint_banner "errors" (text what)
                      , err
-                     , ptext (sLit "*** Offending Program ***")
+                     , text "*** Offending Program ***"
                      , pprCoreExpr expr
-                     , ptext (sLit "*** End of Offense ***") ])
+                     , text "*** End of Offense ***" ])
            ; Err.ghcExit dflags 1 }
 
 interactiveInScope :: HscEnv -> [Var]
@@ -469,7 +469,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
     do { ty <- lintCoreExpr rhs
        ; lintBinder binder -- Check match to RHS type
        ; binder_ty <- applySubstTy (idType binder)
-       ; ensureEqTys binder_ty ty (mkRhsMsg binder (ptext (sLit "RHS")) ty)
+       ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty)
 
         -- Check the let/app invariant
         -- See Note [CoreSyn let/app invariant] in CoreSyn
@@ -494,7 +494,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
        ; when (lf_check_inline_loop_breakers flags
                && isStrongLoopBreaker (idOccInfo binder)
                && isInlinePragma (idInlinePragma binder))
-              (addWarnL (ptext (sLit "INLINE binder is (non-rule) loop breaker:") <+> ppr binder))
+              (addWarnL (text "INLINE binder is (non-rule) loop breaker:" <+> ppr binder))
               -- Only non-rule loop breakers inhibit inlining
 
       -- Check whether arity and demand type are consistent (only if demand analysis
@@ -511,16 +511,16 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
        -- the type and the strictness signature. See Note [exprArity invariant]
        -- and Note [Trimming arity]
        ; checkL (idArity binder <= length (typeArity (idType binder)))
-           (ptext (sLit "idArity") <+> ppr (idArity binder) <+>
-           ptext (sLit "exceeds typeArity") <+>
+           (text "idArity" <+> ppr (idArity binder) <+>
+           text "exceeds typeArity" <+>
            ppr (length (typeArity (idType binder))) <> colon <+>
            ppr binder)
 
        ; case splitStrictSig (idStrictness binder) of
            (demands, result_info) | isBotRes result_info ->
              checkL (idArity binder <= length demands)
-               (ptext (sLit "idArity") <+> ppr (idArity binder) <+>
-               ptext (sLit "exceeds arity imposed by the strictness signature") <+>
+               (text "idArity" <+> ppr (idArity binder) <+>
+               text "exceeds arity imposed by the strictness signature" <+>
                ppr (idStrictness binder) <> colon <+>
                ppr binder)
            _ -> return ()
@@ -540,7 +540,7 @@ lintIdUnfolding :: Id -> Type -> Unfolding -> LintM ()
 lintIdUnfolding bndr bndr_ty (CoreUnfolding { uf_tmpl = rhs, uf_src = src })
   | isStableSource src
   = do { ty <- lintCoreExpr rhs
-       ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (ptext (sLit "unfolding")) ty) }
+       ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (text "unfolding") ty) }
 lintIdUnfolding  _ _ _
   = return ()       -- Do not Lint unstable unfoldings, because that leads
                     -- to exponential behaviour; c.f. CoreFVs.idUnfoldingVars
@@ -591,10 +591,10 @@ lintCoreExpr :: CoreExpr -> LintM OutType
 -- See Note [GHC Formalism]
 lintCoreExpr (Var var)
   = do  { checkL (not (var == oneTupleDataConId))
-                 (ptext (sLit "Illegal one-tuple"))
+                 (text "Illegal one-tuple")
 
         ; checkL (isId var && not (isCoVar var))
-                 (ptext (sLit "Non term variable") <+> ppr var)
+                 (text "Non term variable" <+> ppr var)
 
         ; checkDeadIdOcc var
         ; var' <- lookupIdInScope var
@@ -608,7 +608,7 @@ lintCoreExpr (Cast expr co)
        ; co' <- applySubstCo co
        ; (_, k2, from_ty, to_ty, r) <- lintCoercion co'
        ; lintL (classifiesTypeWithValues k2)
-               (ptext (sLit "Target of cast not # or *:") <+> ppr co)
+               (text "Target of cast not # or *:" <+> ppr co)
        ; lintRole co' Representational r
        ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty)
        ; return to_ty }
@@ -673,9 +673,9 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
      -- See Note [No alternatives lint check]
      ; when (null alts) $
      do { checkL (not (exprIsHNF scrut))
-          (ptext (sLit "No alternatives for a case scrutinee in head-normal form:") <+> ppr scrut)
+          (text "No alternatives for a case scrutinee in head-normal form:" <+> ppr scrut)
         ; checkL (exprIsBottom scrut)
-          (ptext (sLit "No alternatives for a case scrutinee not known to diverge for sure:") <+> ppr scrut)
+          (text "No alternatives for a case scrutinee not known to diverge for sure:" <+> ppr scrut)
         }
 
      -- See Note [Rules for floating-point comparisons] in PrelRules
@@ -712,7 +712,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
 -- This case can't happen; linting types in expressions gets routed through
 -- lintCoreArgs
 lintCoreExpr (Type ty)
-  = failWithL (ptext (sLit "Type found as expression") <+> ppr ty)
+  = failWithL (text "Type found as expression" <+> ppr ty)
 
 lintCoreExpr (Coercion co)
   = do { (k1, k2, ty1, ty2, role) <- lintInCo co
@@ -752,7 +752,7 @@ subtype of the required type, as one would expect.
 lintCoreArg  :: OutType -> CoreArg -> LintM OutType
 lintCoreArg fun_ty (Type arg_ty)
   = do { checkL (not (isCoercionTy arg_ty))
-                (ptext (sLit "Unnecessary coercion-to-type injection:")
+                (text "Unnecessary coercion-to-type injection:"
                   <+> ppr arg_ty)
        ; arg_ty' <- applySubstTy arg_ty
        ; lintTyApp fun_ty arg_ty' }
@@ -825,7 +825,7 @@ checkDeadIdOcc id
   | isDeadOcc (idOccInfo id)
   = do { in_case <- inCasePat
        ; checkL in_case
-                (ptext (sLit "Occurrence of a dead Id") <+> ppr id) }
+                (text "Occurrence of a dead Id" <+> ppr id) }
   | otherwise
   = return ()
 
@@ -981,7 +981,7 @@ lintAndScopeId :: InVar -> (OutVar -> LintM a) -> LintM a
 lintAndScopeId id linterF
   = do { flags <- getLintFlags
        ; checkL (not (lf_check_global_ids flags) || isLocalId id)
-                (ptext (sLit "Non-local Id binder") <+> ppr id)
+                (text "Non-local Id binder" <+> ppr id)
                 -- See Note [Checking for global Ids]
        ; (ty, k) <- lintInTy (idType id)
        ; lintL (not (isLevityPolymorphic k))
@@ -1027,7 +1027,7 @@ lintType (TyVarTy tv)
 
 lintType ty@(AppTy t1 t2)
   | TyConApp {} <- t1
-  = failWithL $ ptext (sLit "TyConApp to the left of AppTy:") <+> ppr ty
+  = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty
   | otherwise
   = do { k1 <- lintType t1
        ; k2 <- lintType t2
@@ -1041,7 +1041,7 @@ lintType ty@(TyConApp tc tys)
   | isUnLiftedTyCon tc || isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
        -- Also type synonyms and type families
   , length tys < tyConArity tc
-  = failWithL (hang (ptext (sLit "Un-saturated type application")) 2 (ppr ty))
+  = failWithL (hang (text "Un-saturated type application") 2 (ppr ty))
 
   | otherwise
   = do { checkTyCon tc
@@ -1053,7 +1053,7 @@ lintType ty@(TyConApp tc tys)
 lintType ty@(ForAllTy (Anon t1) t2)
   = do { k1 <- lintType t1
        ; k2 <- lintType t2
-       ; lintArrow (ptext (sLit "type or kind") <+> quotes (ppr ty)) k1 k2 }
+       ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 }
 
 lintType t@(ForAllTy (Named tv _vis) ty)
   = do { lintL (isTyVar tv) (text "Covar bound in type:" <+> ppr t)
@@ -1082,45 +1082,45 @@ lintKind :: OutKind -> LintM ()
 -- See Note [GHC Formalism]
 lintKind k = do { sk <- lintType k
                 ; unless ((isStarKind sk) || (isUnliftedTypeKind sk))
-                         (addErrL (hang (ptext (sLit "Ill-kinded kind:") <+> ppr k)
-                                      2 (ptext (sLit "has kind:") <+> ppr sk))) }
+                         (addErrL (hang (text "Ill-kinded kind:" <+> ppr k)
+                                      2 (text "has kind:" <+> ppr sk))) }
 
 -- confirms that a type is really *
 lintStar :: SDoc -> OutKind -> LintM ()
 lintStar doc k
   = lintL (classifiesTypeWithValues k)
-          (ptext (sLit "Non-*-like kind when *-like expected:") <+> ppr k $$
-           ptext (sLit "when checking") <+> doc)
+          (text "Non-*-like kind when *-like expected:" <+> ppr k $$
+           text "when checking" <+> doc)
 
 lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind
 -- If you edit this function, you may need to update the GHC formalism
 -- See Note [GHC Formalism]
 lintArrow what k1 k2   -- Eg lintArrow "type or kind `blah'" k1 k2
                        -- or lintarrow "coercion `blah'" k1 k2
-  = do { unless (okArrowArgKind k1)    (addErrL (msg (ptext (sLit "argument")) k1))
-       ; unless (okArrowResultKind k2) (addErrL (msg (ptext (sLit "result"))   k2))
+  = do { unless (okArrowArgKind k1)    (addErrL (msg (text "argument") k1))
+       ; unless (okArrowResultKind k2) (addErrL (msg (text "result")   k2))
        ; return liftedTypeKind }
   where
     msg ar k
-      = vcat [ hang (ptext (sLit "Ill-kinded") <+> ar)
-                  2 (ptext (sLit "in") <+> what)
-             , what <+> ptext (sLit "kind:") <+> ppr k ]
+      = vcat [ hang (text "Ill-kinded" <+> ar)
+                  2 (text "in" <+> what)
+             , what <+> text "kind:" <+> ppr k ]
 
 lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind
 lint_ty_app ty k tys
-  = lint_app (ptext (sLit "type") <+> quotes (ppr ty)) k tys
+  = lint_app (text "type" <+> quotes (ppr ty)) k tys
 
 ----------------
 lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind
 lint_co_app ty k tys
-  = lint_app (ptext (sLit "coercion") <+> quotes (ppr ty)) k tys
+  = lint_app (text "coercion" <+> quotes (ppr ty)) k tys
 
 ----------------
 lintTyLit :: TyLit -> LintM ()
 lintTyLit (NumTyLit n)
   | n >= 0    = return ()
   | otherwise = failWithL msg
-    where msg = ptext (sLit "Negative type literal:") <+> integer n
+    where msg = text "Negative type literal:" <+> integer n
 lintTyLit (StrTyLit _) = return ()
 
 lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind
@@ -1134,9 +1134,9 @@ lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind
 lint_app doc kfn kas
     = foldlM go_app kfn kas
   where
-    fail_msg = vcat [ hang (ptext (sLit "Kind application error in")) 2 doc
-                    , nest 2 (ptext (sLit "Function kind =") <+> ppr kfn)
-                    , nest 2 (ptext (sLit "Arg kinds =") <+> ppr kas) ]
+    fail_msg = vcat [ hang (text "Kind application error in") 2 doc
+                    , nest 2 (text "Function kind =" <+> ppr kfn)
+                    , nest 2 (text "Arg kinds =" <+> ppr kas) ]
 
     go_app kfn ka
       | Just kfn' <- coreView kfn
@@ -1168,15 +1168,15 @@ lintCoreRule fun_ty (Rule { ru_name = name, ru_bndrs = bndrs
     do { lhs_ty <- foldM lintCoreArg fun_ty args
        ; rhs_ty <- lintCoreExpr rhs
        ; ensureEqTys lhs_ty rhs_ty $
-         (rule_doc <+> vcat [ ptext (sLit "lhs type:") <+> ppr lhs_ty
-                            , ptext (sLit "rhs type:") <+> ppr rhs_ty ])
+         (rule_doc <+> vcat [ text "lhs type:" <+> ppr lhs_ty
+                            , text "rhs type:" <+> ppr rhs_ty ])
        ; let bad_bndrs = filterOut (`elemVarSet` exprsFreeVars args) bndrs
        ; checkL (null bad_bndrs)
-                (rule_doc <+> ptext (sLit "unbound") <+> ppr bad_bndrs)
+                (rule_doc <+> text "unbound" <+> ppr bad_bndrs)
             -- See Note [Linting rules]
     }
   where
-    rule_doc = ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon
+    rule_doc = text "Rule" <+> doubleQuotes (ftext name) <> colon
 
 {- Note [Linting rules]
 ~~~~~~~~~~~~~~~~~~~~~~~
@@ -1216,8 +1216,8 @@ lintInCo co
 lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType)
 lintStarCoercion g
   = do { (k1, k2, t1, t2, r) <- lintCoercion g
-       ; lintStar (ptext (sLit "the kind of the left type in") <+> ppr g) k1
-       ; lintStar (ptext (sLit "the kind of the right type in") <+> ppr g) k2
+       ; lintStar (text "the kind of the left type in" <+> ppr g) k1
+       ; lintStar (text "the kind of the right type in" <+> ppr g) k2
        ; lintRole g Nominal r
        ; return (t1, t2) }
 
@@ -1236,14 +1236,14 @@ lintCoercion co@(TyConAppCo r tc cos)
   , [co1,co2] <- cos
   = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1
        ; (k2,k'2,s2,t2,r2) <- lintCoercion co2
-       ; k <- lintArrow (ptext (sLit "coercion") <+> quotes (ppr co)) k1 k2
-       ; k' <- lintArrow (ptext (sLit "coercion") <+> quotes (ppr co)) k'1 k'2
+       ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2
+       ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2
        ; lintRole co1 r r1
        ; lintRole co2 r r2
        ; return (k, k', mkFunTy s1 s2, mkFunTy t1 t2, r) }
 
   | Just {} <- synTyConDefn_maybe tc
-  = failWithL (ptext (sLit "Synonym in TyConAppCo:") <+> ppr co)
+  = failWithL (text "Synonym in TyConAppCo:" <+> ppr co)
 
   | otherwise
   = do { checkTyCon tc
@@ -1255,9 +1255,9 @@ lintCoercion co@(TyConAppCo r tc cos)
 
 lintCoercion co@(AppCo co1 co2)
   | TyConAppCo {} <- co1
-  = failWithL (ptext (sLit "TyConAppCo to the left of AppCo:") <+> ppr co)
+  = failWithL (text "TyConAppCo to the left of AppCo:" <+> ppr co)
   | Refl _ (TyConApp {}) <- co1
-  = failWithL (ptext (sLit "Refl (TyConApp ...) to the left of AppCo:") <+> ppr co)
+  = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co)
   | otherwise
   = do { (k1,k2,s1,s2,r1) <- lintCoercion co1
        ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2
@@ -1265,7 +1265,7 @@ lintCoercion co@(AppCo co1 co2)
        ; k4 <- lint_co_app co k2 [(t2,k'2)]
        ; if r1 == Phantom
          then lintL (r2 == Phantom || r2 == Nominal)
-                     (ptext (sLit "Second argument in AppCo cannot be R:") $$
+                     (text "Second argument in AppCo cannot be R:" $$
                       ppr co)
          else lintRole co Nominal r2
        ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) }
@@ -1282,8 +1282,8 @@ lintCoercion (ForAllCo tv1 kind_co co)
 
 lintCoercion (CoVarCo cv)
   | not (isCoVar cv)
-  = failWithL (hang (ptext (sLit "Bad CoVarCo:") <+> ppr cv)
-                  2 (ptext (sLit "With offending type:") <+> ppr (varType cv)))
+  = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv)
+                  2 (text "With offending type:" <+> ppr (varType cv)))
   | otherwise
   = do { lintTyCoVarInScope cv
        ; cv' <- lookupIdInScope cv
@@ -1360,7 +1360,7 @@ lintCoercion co@(TransCo co1 co2)
   = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1
        ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2
        ; ensureEqTys ty1b ty2a
-               (hang (ptext (sLit "Trans coercion mis-match:") <+> ppr co)
+               (hang (text "Trans coercion mis-match:" <+> ppr co)
                    2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b]))
        ; lintRole co r1 r2
        ; return (k1a, k2b, ty1a, ty2b, r1) }
@@ -1392,7 +1392,7 @@ lintCoercion the_co@(NthCo n co)
                ks = typeKind ts
                kt = typeKind tt
 
-         ; _ -> failWithL (hang (ptext (sLit "Bad getNth:"))
+         ; _ -> failWithL (hang (text "Bad getNth:")
                               2 (ppr the_co $$ ppr s $$ ppr t)) }}}
 
 lintCoercion the_co@(LRCo lr co)
@@ -1407,7 +1407,7 @@ lintCoercion the_co@(LRCo lr co)
                ks_pick = typeKind s_pick
                kt_pick = typeKind t_pick
 
-           _ -> failWithL (hang (ptext (sLit "Bad LRCo:"))
+           _ -> failWithL (hang (text "Bad LRCo:")
                               2 (ppr the_co $$ ppr s $$ ppr t)) }
 
 lintCoercion (InstCo co arg)
@@ -1422,8 +1422,8 @@ lintCoercion (InstCo co arg)
                        substTyWith [tv1] [s1] t1,
                        substTyWith [tv2] [s2] t2, r)
             | otherwise
-            -> failWithL (ptext (sLit "Kind mis-match in inst coercion"))
-          _ -> failWithL (ptext (sLit "Bad argument of inst")) }
+            -> failWithL (text "Kind mis-match in inst coercion")
+          _ -> failWithL (text "Bad argument of inst") }
 
 lintCoercion co@(AxiomInstCo con ind cos)
   = do { unless (0 <= ind && ind < numBranches (coAxiomBranches con))
@@ -1646,7 +1646,7 @@ addMsg env msgs msg
    (loc, cxt1) = dumpLoc (head locs)
    cxts        = [snd (dumpLoc loc) | loc <- locs]
    context     | opt_PprStyle_Debug = vcat (reverse cxts) $$ cxt1 $$
-                                      ptext (sLit "Substitution:") <+> ppr (le_subst env)
+                                      text "Substitution:" <+> ppr (le_subst env)
                | otherwise          = cxt1
 
    mk_msg msg = mkLocMessage SevWarning (mkSrcSpan loc loc) (context $$ msg)
@@ -1702,14 +1702,14 @@ lookupIdInScope id
                 Nothing -> do { addErrL out_of_scope
                               ; return id } }
   where
-    out_of_scope = pprBndr LetBind id <+> ptext (sLit "is out of scope")
+    out_of_scope = pprBndr LetBind id <+> text "is out of scope"
 
 
 oneTupleDataConId :: Id -- Should not happen
 oneTupleDataConId = dataConWorkId (tupleDataCon Boxed 1)
 
 lintTyCoVarInScope :: Var -> LintM ()
-lintTyCoVarInScope v = lintInScope (ptext (sLit "is out of scope")) v
+lintTyCoVarInScope v = lintInScope (text "is out of scope") v
 
 lintInScope :: SDoc -> Var -> LintM ()
 lintInScope loc_msg var =
@@ -1730,9 +1730,9 @@ lintRole :: Outputable thing
           -> LintM ()
 lintRole co r1 r2
   = lintL (r1 == r2)
-          (ptext (sLit "Role incompatibility: expected") <+> ppr r1 <> comma <+>
-           ptext (sLit "got") <+> ppr r2 $$
-           ptext (sLit "in") <+> ppr co)
+          (text "Role incompatibility: expected" <+> ppr r1 <> comma <+>
+           text "got" <+> ppr r2 $$
+           text "in" <+> ppr co)
 
 {-
 ************************************************************************
@@ -1745,16 +1745,16 @@ lintRole co r1 r2
 dumpLoc :: LintLocInfo -> (SrcLoc, SDoc)
 
 dumpLoc (RhsOf v)
-  = (getSrcLoc v, brackets (ptext (sLit "RHS of") <+> pp_binders [v]))
+  = (getSrcLoc v, brackets (text "RHS of" <+> pp_binders [v]))
 
 dumpLoc (LambdaBodyOf b)
-  = (getSrcLoc b, brackets (ptext (sLit "in body of lambda with binder") <+> pp_binder b))
+  = (getSrcLoc b, brackets (text "in body of lambda with binder" <+> pp_binder b))
 
 dumpLoc (BodyOfLetRec [])
-  = (noSrcLoc, brackets (ptext (sLit "In body of a letrec with no binders")))
+  = (noSrcLoc, brackets (text "In body of a letrec with no binders"))
 
 dumpLoc (BodyOfLetRec bs@(_:_))
-  = ( getSrcLoc (head bs), brackets (ptext (sLit "in body of letrec with binders") <+> pp_binders bs))
+  = ( getSrcLoc (head bs), brackets (text "in body of letrec with binders" <+> pp_binders bs))
 
 dumpLoc (AnExpr e)
   = (noSrcLoc, text "In the expression:" <+> ppr e)
@@ -1766,7 +1766,7 @@ dumpLoc (CasePat (con, args, _))
   = (noSrcLoc, text "In the pattern of a case alternative:" <+> parens (ppr con <+> pp_binders args))
 
 dumpLoc (ImportedUnfolding locn)
-  = (locn, brackets (ptext (sLit "in an imported unfolding")))
+  = (locn, brackets (text "in an imported unfolding"))
 dumpLoc TopLevelBindings
   = (noSrcLoc, Outputable.empty)
 dumpLoc (InType ty)
@@ -1799,7 +1799,7 @@ mkScrutMsg var var_ty scrut_ty subst
   = vcat [text "Result binder in case doesn't match scrutinee:" <+> ppr var,
           text "Result binder type:" <+> ppr var_ty,--(idType var),
           text "Scrutinee type:" <+> ppr scrut_ty,
-     hsep [ptext (sLit "Current TCv subst"), ppr subst]]
+     hsep [text "Current TCv subst", ppr subst]]
 
 mkNonDefltMsg, mkNonIncreasingAltsMsg :: CoreExpr -> MsgDoc
 mkNonDefltMsg e
@@ -1849,98 +1849,98 @@ mkNewTyDataConAltMsg scrut_ty alt
 
 mkAppMsg :: Type -> Type -> CoreExpr -> MsgDoc
 mkAppMsg fun_ty arg_ty arg
-  = vcat [ptext (sLit "Argument value doesn't match argument type:"),
-              hang (ptext (sLit "Fun type:")) 4 (ppr fun_ty),
-              hang (ptext (sLit "Arg type:")) 4 (ppr arg_ty),
-              hang (ptext (sLit "Arg:")) 4 (ppr arg)]
+  = vcat [text "Argument value doesn't match argument type:",
+              hang (text "Fun type:") 4 (ppr fun_ty),
+              hang (text "Arg type:") 4 (ppr arg_ty),
+              hang (text "Arg:") 4 (ppr arg)]
 
 mkNonFunAppMsg :: Type -> Type -> CoreExpr -> MsgDoc
 mkNonFunAppMsg fun_ty arg_ty arg
-  = vcat [ptext (sLit "Non-function type in function position"),
-              hang (ptext (sLit "Fun type:")) 4 (ppr fun_ty),
-              hang (ptext (sLit "Arg type:")) 4 (ppr arg_ty),
-              hang (ptext (sLit "Arg:")) 4 (ppr arg)]
+  = vcat [text "Non-function type in function position",
+              hang (text "Fun type:") 4 (ppr fun_ty),
+              hang (text "Arg type:") 4 (ppr arg_ty),
+              hang (text "Arg:") 4 (ppr arg)]
 
 mkLetErr :: TyVar -> CoreExpr -> MsgDoc
 mkLetErr bndr rhs
-  = vcat [ptext (sLit "Bad `let' binding:"),
-          hang (ptext (sLit "Variable:"))
+  = vcat [text "Bad `let' binding:",
+          hang (text "Variable:")
                  4 (ppr bndr <+> dcolon <+> ppr (varType bndr)),
-          hang (ptext (sLit "Rhs:"))
+          hang (text "Rhs:")
                  4 (ppr rhs)]
 
 mkTyAppMsg :: Type -> Type -> MsgDoc
 mkTyAppMsg ty arg_ty
   = vcat [text "Illegal type application:",
-              hang (ptext (sLit "Exp type:"))
+              hang (text "Exp type:")
                  4 (ppr ty <+> dcolon <+> ppr (typeKind ty)),
-              hang (ptext (sLit "Arg type:"))
+              hang (text "Arg type:")
                  4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
 
 mkRhsMsg :: Id -> SDoc -> Type -> MsgDoc
 mkRhsMsg binder what ty
   = vcat
-    [hsep [ptext (sLit "The type of this binder doesn't match the type of its") <+> what <> colon,
+    [hsep [text "The type of this binder doesn't match the type of its" <+> what <> colon,
             ppr binder],
-     hsep [ptext (sLit "Binder's type:"), ppr (idType binder)],
-     hsep [ptext (sLit "Rhs type:"), ppr ty]]
+     hsep [text "Binder's type:", ppr (idType binder)],
+     hsep [text "Rhs type:", ppr ty]]
 
 mkLetAppMsg :: CoreExpr -> MsgDoc
 mkLetAppMsg e
-  = hang (ptext (sLit "This argument does not satisfy the let/app invariant:"))
+  = hang (text "This argument does not satisfy the let/app invariant:")
        2 (ppr e)
 
 mkRhsPrimMsg :: Id -> CoreExpr -> MsgDoc
 mkRhsPrimMsg binder _rhs
-  = vcat [hsep [ptext (sLit "The type of this binder is primitive:"),
+  = vcat [hsep [text "The type of this binder is primitive:",
                      ppr binder],
-              hsep [ptext (sLit "Binder's type:"), ppr (idType binder)]
+              hsep [text "Binder's type:", ppr (idType binder)]
              ]
 
 mkStrictMsg :: Id -> MsgDoc
 mkStrictMsg binder
-  = vcat [hsep [ptext (sLit "Recursive or top-level binder has strict demand info:"),
+  = vcat [hsep [text "Recursive or top-level binder has strict demand info:",
                      ppr binder],
-              hsep [ptext (sLit "Binder's demand info:"), ppr (idDemandInfo binder)]
+              hsep [text "Binder's demand info:", ppr (idDemandInfo binder)]
              ]
 
 mkNonTopExportedMsg :: Id -> MsgDoc
 mkNonTopExportedMsg binder
-  = hsep [ptext (sLit "Non-top-level binder is marked as exported:"), ppr binder]
+  = hsep [text "Non-top-level binder is marked as exported:", ppr binder]
 
 mkNonTopExternalNameMsg :: Id -> MsgDoc
 mkNonTopExternalNameMsg binder
-  = hsep [ptext (sLit "Non-top-level binder has an external name:"), ppr binder]
+  = hsep [text "Non-top-level binder has an external name:", ppr binder]
 
 mkKindErrMsg :: TyVar -> Type -> MsgDoc
 mkKindErrMsg tyvar arg_ty
-  = vcat [ptext (sLit "Kinds don't match in type application:"),
-          hang (ptext (sLit "Type variable:"))
+  = vcat [text "Kinds don't match in type application:",
+          hang (text "Type variable:")
                  4 (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)),
-          hang (ptext (sLit "Arg type:"))
+          hang (text "Arg type:")
                  4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
 
 {- Not needed now
 mkArityMsg :: Id -> MsgDoc
 mkArityMsg binder
-  = vcat [hsep [ptext (sLit "Demand type has"),
+  = vcat [hsep [text "Demand type has",
                 ppr (dmdTypeDepth dmd_ty),
-                ptext (sLit "arguments, rhs has"),
+                text "arguments, rhs has",
                 ppr (idArity binder),
-                ptext (sLit "arguments,"),
+                text "arguments,",
                 ppr binder],
-              hsep [ptext (sLit "Binder's strictness signature:"), ppr dmd_ty]
+              hsep [text "Binder's strictness signature:", ppr dmd_ty]
 
          ]
            where (StrictSig dmd_ty) = idStrictness binder
 -}
 mkCastErr :: Outputable casted => casted -> Coercion -> Type -> Type -> MsgDoc
 mkCastErr expr co from_ty expr_ty
-  = vcat [ptext (sLit "From-type of Cast differs from type of enclosed expression"),
-          ptext (sLit "From-type:") <+> ppr from_ty,
-          ptext (sLit "Type of enclosed expr:") <+> ppr expr_ty,
-          ptext (sLit "Actual enclosed expr:") <+> ppr expr,
-          ptext (sLit "Coercion used in cast:") <+> ppr co
+  = vcat [text "From-type of Cast differs from type of enclosed expression",
+          text "From-type:" <+> ppr from_ty,
+          text "Type of enclosed expr:" <+> ppr expr_ty,
+          text "Actual enclosed expr:" <+> ppr expr,
+          text "Coercion used in cast:" <+> ppr co
          ]
 
 mkBadUnivCoMsg :: LeftOrRight -> Coercion -> SDoc
@@ -1956,21 +1956,21 @@ mkBadProofIrrelMsg ty co
 
 mkBadTyVarMsg :: Var -> SDoc
 mkBadTyVarMsg tv
-  = ptext (sLit "Non-tyvar used in TyVarTy:")
+  = text "Non-tyvar used in TyVarTy:"
       <+> ppr tv <+> dcolon <+> ppr (varType tv)
 
 pprLeftOrRight :: LeftOrRight -> MsgDoc
-pprLeftOrRight CLeft  = ptext (sLit "left")
-pprLeftOrRight CRight = ptext (sLit "right")
+pprLeftOrRight CLeft  = text "left"
+pprLeftOrRight CRight = text "right"
 
 dupVars :: [[Var]] -> MsgDoc
 dupVars vars
-  = hang (ptext (sLit "Duplicate variables brought into scope"))
+  = hang (text "Duplicate variables brought into scope")
        2 (ppr vars)
 
 dupExtVars :: [[Name]] -> MsgDoc
 dupExtVars vars
-  = hang (ptext (sLit "Duplicate top-level variables with the same qualified name"))
+  = hang (text "Duplicate top-level variables with the same qualified name")
        2 (ppr vars)
 
 {-
index df18f8b..724f72b 100644 (file)
@@ -992,13 +992,13 @@ instance Outputable FloatingBind where
   ppr (FloatTick t) = ppr t
 
 instance Outputable Floats where
-  ppr (Floats flag fs) = ptext (sLit "Floats") <> brackets (ppr flag) <+>
+  ppr (Floats flag fs) = text "Floats" <> brackets (ppr flag) <+>
                          braces (vcat (map ppr (fromOL fs)))
 
 instance Outputable OkToSpec where
-  ppr OkToSpec    = ptext (sLit "OkToSpec")
-  ppr IfUnboxedOk = ptext (sLit "IfUnboxedOk")
-  ppr NotOkToSpec = ptext (sLit "NotOkToSpec")
+  ppr OkToSpec    = text "OkToSpec"
+  ppr IfUnboxedOk = text "IfUnboxedOk"
+  ppr NotOkToSpec = text "NotOkToSpec"
 
 -- Can we float these binds out of the rhs of a let?  We cache this decision
 -- to avoid having to recompute it in a non-linear way when there are
index 456943c..9ad8321 100644 (file)
@@ -15,7 +15,6 @@ import CoreSyn
 import Outputable
 import Coercion
 import Var
-import FastString (sLit)
 import Type (Type, typeSize, seqType)
 import Id (idType)
 import CoreSeq (megaSeqIdInfo)
@@ -27,9 +26,9 @@ data CoreStats = CS { cs_tm :: Int    -- Terms
 
 instance Outputable CoreStats where
  ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3 })
-   = braces (sep [ptext (sLit "terms:")     <+> intWithCommas i1 <> comma,
-                  ptext (sLit "types:")     <+> intWithCommas i2 <> comma,
-                  ptext (sLit "coercions:") <+> intWithCommas i3])
+   = braces (sep [text "terms:"     <+> intWithCommas i1 <> comma,
+                  text "types:"     <+> intWithCommas i2 <> comma,
+                  text "coercions:" <+> intWithCommas i3])
 
 plusCS :: CoreStats -> CoreStats -> CoreStats
 plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1 })
index bc96d0f..8cc609d 100644 (file)
@@ -231,7 +231,7 @@ extendTCvSubst subst v r
   | Just co <- isCoercionTy_maybe r
   = extendCvSubst subst v co
   | otherwise
-  = pprPanic "CoreSubst.extendTCvSubst" (ppr v <+> ptext (sLit "|->") <+> ppr r)
+  = pprPanic "CoreSubst.extendTCvSubst" (ppr v <+> text "|->" <+> ppr r)
 
 -- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTCvSubst'
 extendTCvSubstList :: Subst -> [(TyVar,Type)] -> Subst
@@ -274,7 +274,7 @@ lookupIdSubst doc (Subst in_scope ids _ _) v
   | Just e  <- lookupVarEnv ids       v = e
   | Just v' <- lookupInScope in_scope v = Var v'
         -- Vital! See Note [Extending the Subst]
-  | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> doc <+> ppr v
+  | otherwise = WARN( True, text "CoreSubst.lookupIdSubst" <+> doc <+> ppr v
                             $$ ppr in_scope)
                 Var v
 
@@ -344,10 +344,10 @@ setInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs
 
 instance Outputable Subst where
   ppr (Subst in_scope ids tvs cvs)
-        =  ptext (sLit "<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
-        $$ ptext (sLit " IdSubst   =") <+> ppr ids
-        $$ ptext (sLit " TvSubst   =") <+> ppr tvs
-        $$ ptext (sLit " CvSubst   =") <+> ppr cvs
+        =  text "<InScope =" <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
+        $$ text " IdSubst   =" <+> ppr ids
+        $$ text " TvSubst   =" <+> ppr tvs
+        $$ text " CvSubst   =" <+> ppr cvs
          <> char '>'
 
 {-
@@ -714,7 +714,7 @@ substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
            -- Do NOT optimise the RHS (previously we did simplOptExpr here)
            -- See Note [Substitute lazily]
   where
-    doc = ptext (sLit "subst-rule") <+> ppr fn_name
+    doc = text "subst-rule" <+> ppr fn_name
     (subst', bndrs') = substBndrs subst bndrs
 
 ------------------
index cd3bcb1..c725dc3 100644 (file)
@@ -102,7 +102,6 @@ import Module
 import TyCon
 import BasicTypes
 import DynFlags
-import FastString
 import Outputable
 import Util
 import SrcLoc     ( RealSrcSpan, containsSpan )
@@ -1327,7 +1326,7 @@ the occurrence info is wrong
 instance Outputable AltCon where
   ppr (DataAlt dc) = ppr dc
   ppr (LitAlt lit) = ppr lit
-  ppr DEFAULT      = ptext (sLit "__DEFAULT")
+  ppr DEFAULT      = text "__DEFAULT"
 
 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
index d033dde..2a7906a 100644 (file)
@@ -59,7 +59,6 @@ import PrelNames
 import TysPrim          ( realWorldStatePrimTy )
 import Bag
 import Util
-import FastString
 import Outputable
 import ForeignCall
 
@@ -181,7 +180,7 @@ specUnfolding _dflags subst new_bndrs spec_args
 specUnfolding _ _ _ _ _ = noUnfolding
 
 spec_doc :: SDoc
-spec_doc = ptext (sLit "specUnfolding")
+spec_doc = text "specUnfolding"
 
 {-
 Note [Specialising unfoldings]
@@ -864,7 +863,7 @@ data ExprSize
              }
 
 instance Outputable ExprSize where
-  ppr TooBig         = ptext (sLit "TooBig")
+  ppr TooBig         = text "TooBig"
   ppr (SizeIs a _ c) = brackets (int a <+> int c)
 
 -- subtract the discount before deciding whether to bale out. eg. we
@@ -996,9 +995,9 @@ data ArgSummary = TrivArg       -- Nothing interesting
                                 -- ..or con-like. Note [Conlike is interesting]
 
 instance Outputable ArgSummary where
-  ppr TrivArg    = ptext (sLit "TrivArg")
-  ppr NonTrivArg = ptext (sLit "NonTrivArg")
-  ppr ValueArg   = ptext (sLit "ValueArg")
+  ppr TrivArg    = text "TrivArg"
+  ppr NonTrivArg = text "NonTrivArg"
+  ppr ValueArg   = text "ValueArg"
 
 nonTriv ::  ArgSummary -> Bool
 nonTriv TrivArg = False
@@ -1018,12 +1017,12 @@ data CallCtxt
                         -- that decomposes its scrutinee
 
 instance Outputable CallCtxt where
-  ppr CaseCtxt    = ptext (sLit "CaseCtxt")
-  ppr ValAppCtxt  = ptext (sLit "ValAppCtxt")
-  ppr BoringCtxt  = ptext (sLit "BoringCtxt")
-  ppr RhsCtxt     = ptext (sLit "RhsCtxt")
-  ppr DiscArgCtxt = ptext (sLit "DiscArgCtxt")
-  ppr RuleArgCtxt = ptext (sLit "RuleArgCtxt")
+  ppr CaseCtxt    = text "CaseCtxt"
+  ppr ValAppCtxt  = text "ValAppCtxt"
+  ppr BoringCtxt  = text "BoringCtxt"
+  ppr RhsCtxt     = text "RhsCtxt"
+  ppr DiscArgCtxt = text "DiscArgCtxt"
+  ppr RuleArgCtxt = text "RuleArgCtxt"
 
 callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info
   = case idUnfolding id of
@@ -1055,7 +1054,7 @@ tryUnfolding dflags id lone_variable
              arg_infos cont_info unf_template is_top
              is_wf is_exp guidance
  = case guidance of
-     UnfNever -> traceInline dflags str (ptext (sLit "UnfNever")) Nothing
+     UnfNever -> traceInline dflags str (text "UnfNever") Nothing
 
      UnfWhen { ug_arity = uf_arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }
         | enough_args && (boring_ok || some_benefit)
index d89612a..9c2f16c 100644 (file)
@@ -183,10 +183,10 @@ applyTypeToArgs e op_ty args
     go_ty_args op_ty rev_tys args
        = go (applyTysD panic_msg_w_hdr op_ty (reverse rev_tys)) args
 
-    panic_msg_w_hdr = hang (ptext (sLit "applyTypeToArgs")) 2 panic_msg
-    panic_msg = vcat [ ptext (sLit "Expression:") <+> pprCoreExpr e
-                     , ptext (sLit "Type:") <+> ppr op_ty
-                     , ptext (sLit "Args:") <+> ppr args ]
+    panic_msg_w_hdr = hang (text "applyTypeToArgs") 2 panic_msg
+    panic_msg = vcat [ text "Expression:" <+> pprCoreExpr e
+                     , text "Type:" <+> ppr op_ty
+                     , text "Args:" <+> ppr args ]
 
 
 {-
@@ -202,8 +202,8 @@ applyTypeToArgs e op_ty args
 mkCast :: CoreExpr -> Coercion -> CoreExpr
 mkCast e co
   | ASSERT2( coercionRole co == Representational
-           , ptext (sLit "coercion") <+> ppr co <+> ptext (sLit "passed to mkCast")
-             <+> ppr e <+> ptext (sLit "has wrong role") <+> ppr (coercionRole co) )
+           , text "coercion" <+> ppr co <+> ptext (sLit "passed to mkCast")
+             <+> ppr e <+> text "has wrong role" <+> ppr (coercionRole co) )
     isReflCo co
   = e
 
@@ -218,9 +218,9 @@ mkCast (Cast expr co2) co
   = WARN(let { Pair  from_ty  _to_ty  = coercionKind co;
                Pair _from_ty2  to_ty2 = coercionKind co2} in
             not (from_ty `eqType` to_ty2),
-             vcat ([ ptext (sLit "expr:") <+> ppr expr
-                   , ptext (sLit "co2:") <+> ppr co2
-                   , ptext (sLit "co:") <+> ppr co ]) )
+             vcat ([ text "expr:" <+> ppr expr
+                   , text "co2:" <+> ppr co2
+                   , text "co:" <+> ppr co ]) )
     mkCast expr (mkTransCo co2 co)
 
 mkCast (Tick t expr) co
index e869ebe..e012f2c 100644 (file)
@@ -366,8 +366,8 @@ data FloatBind
       -- See Note [Floating cases] in SetLevels
 
 instance Outputable FloatBind where
-  ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b
-  ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b)
+  ppr (FloatLet b) = text "LET" <+> ppr b
+  ppr (FloatCase e b c bs) = hang (text "CASE" <+> ppr e <+> ptext (sLit "of") <+> ppr b)
                                 2 (ppr c <+> ppr bs)
 
 wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
index 147ff31..9ce1dad 100644 (file)
@@ -76,7 +76,7 @@ type Annotation b = Expr b -> SDoc
 
 -- | Annotate with the size of the right-hand-side
 sizeAnn :: CoreExpr -> SDoc
-sizeAnn e = ptext (sLit "-- RHS size:") <+> ppr (exprStats e)
+sizeAnn e = text "-- RHS size:" <+> ppr (exprStats e)
 
 -- | No annotation
 noAnn :: Expr b -> SDoc
@@ -94,12 +94,12 @@ pprTopBind ann (NonRec binder expr)
  = ppr_binding ann (binder,expr) $$ blankLine
 
 pprTopBind _ (Rec [])
-  = ptext (sLit "Rec { }")
+  = text "Rec { }"
 pprTopBind ann (Rec (b:bs))
-  = vcat [ptext (sLit "Rec {"),
+  = vcat [text "Rec {",
           ppr_binding ann b,
           vcat [blankLine $$ ppr_binding ann b | b <- bs],
-          ptext (sLit "end Rec }"),
+          text "end Rec }",
           blankLine]
 
 ppr_bind :: OutputableBndr b => Annotation b -> Bind b -> SDoc
@@ -123,7 +123,7 @@ noParens pp = pp
 pprOptCo :: Coercion -> SDoc
 pprOptCo co = sdocWithDynFlags $ \dflags ->
               if gopt Opt_SuppressCoercions dflags
-              then ptext (sLit "...")
+              then text "..."
               else parens (sep [ppr co, dcolon <+> ppr (coercionType co)])
 
 ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
@@ -131,19 +131,19 @@ ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
         -- an atomic value (e.g. function args)
 
 ppr_expr _       (Var name)    = ppr name
-ppr_expr add_par (Type ty)     = add_par (ptext (sLit "TYPE:") <+> ppr ty)       -- Weird
-ppr_expr add_par (Coercion co) = add_par (ptext (sLit "CO:") <+> ppr co)
+ppr_expr add_par (Type ty)     = add_par (text "TYPE:" <+> ppr ty)       -- Weird
+ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co)
 ppr_expr add_par (Lit lit)     = pprLiteral add_par lit
 
 ppr_expr add_par (Cast expr co)
-  = add_par $ sep [pprParendExpr expr, ptext (sLit "`cast`") <+> pprOptCo co]
+  = add_par $ sep [pprParendExpr expr, text "`cast`" <+> pprOptCo co]
 
 ppr_expr add_par expr@(Lam _ _)
   = let
         (bndrs, body) = collectBinders expr
     in
     add_par $
-    hang (ptext (sLit "\\") <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)
+    hang (text "\\" <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)
          2 (pprCoreExpr body)
 
 ppr_expr add_par expr@(App {})
@@ -180,18 +180,18 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
   = sdocWithDynFlags $ \dflags ->
     if gopt Opt_PprCaseAsLet dflags
     then add_par $  -- See Note [Print case as let]
-         sep [ sep [ ptext (sLit "let! {")
+         sep [ sep [ text "let! {"
                      <+> ppr_case_pat con args
-                     <+> ptext (sLit "~")
+                     <+> text "~"
                      <+> ppr_bndr var
-                   , ptext (sLit "<-") <+> ppr_expr id expr
-                     <+> ptext (sLit "} in") ]
+                   , text "<-" <+> ppr_expr id expr
+                     <+> text "} in" ]
              , pprCoreExpr rhs
              ]
     else add_par $
-         sep [sep [ptext (sLit "case") <+> pprCoreExpr expr,
+         sep [sep [text "case" <+> pprCoreExpr expr,
                    ifPprDebug (text "return" <+> ppr ty),
-                   sep [ptext (sLit "of") <+> ppr_bndr var,
+                   sep [text "of" <+> ppr_bndr var,
                         char '{' <+> ppr_case_pat con args <+> arrow]
                ],
               pprCoreExpr rhs,
@@ -202,10 +202,10 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
 
 ppr_expr add_par (Case expr var ty alts)
   = add_par $
-    sep [sep [ptext (sLit "case")
+    sep [sep [text "case"
                 <+> pprCoreExpr expr
                 <+> ifPprDebug (text "return" <+> ppr ty),
-              ptext (sLit "of") <+> ppr_bndr var <+> char '{'],
+              text "of" <+> ppr_bndr var <+> char '{'],
          nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),
          char '}'
     ]
@@ -220,16 +220,16 @@ ppr_expr add_par (Case expr var ty alts)
 ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body)
   = add_par $
     vcat [
-      hsep [ptext (sLit "let {"), (pprBndr LetBind val_bdr $$ ppr val_bndr), equals],
+      hsep [text "let {", (pprBndr LetBind val_bdr $$ ppr val_bndr), equals],
       nest 2 (pprCoreExpr rhs),
-      ptext (sLit "} in"),
+      text "} in",
       pprCoreExpr body ]
 
 ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
   = add_par
-    (hang (ptext (sLit "let {"))
+    (hang (text "let {")
           2 (hsep [ppr_binding (val_bdr,rhs),
-                   ptext (sLit "} in")])
+                   text "} in"])
      $$
      pprCoreExpr expr)
 -}
@@ -237,7 +237,7 @@ ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
 -- General case (recursive case, too)
 ppr_expr add_par (Let bind expr)
   = add_par $
-    sep [hang (ptext keyword) 2 (ppr_bind noAnn bind <+> ptext (sLit "} in")),
+    sep [hang (ptext keyword) 2 (ppr_bind noAnn bind <+> text "} in"),
          pprCoreExpr expr]
   where
     keyword = case bind of
@@ -274,8 +274,8 @@ pprArg (Type ty)
  = sdocWithDynFlags $ \dflags ->
    if gopt Opt_SuppressTypeApplications dflags
    then empty
-   else ptext (sLit "@") <+> pprParendType ty
-pprArg (Coercion co) = ptext (sLit "@~") <+> pprOptCo co
+   else text "@" <+> pprParendType ty
+pprArg (Coercion co) = text "@~" <+> pprOptCo co
 pprArg expr          = pprParendExpr expr
 
 {-
@@ -312,7 +312,7 @@ pprCoreBinder bind_site bndr
 
 pprUntypedBinder :: Var -> SDoc
 pprUntypedBinder binder
-  | isTyVar binder = ptext (sLit "@") <+> ppr binder    -- NB: don't print kind
+  | isTyVar binder = text "@" <+> ppr binder    -- NB: don't print kind
   | otherwise      = pprIdBndr binder
 
 pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc
@@ -339,7 +339,7 @@ pprTypedLamBinder bind_site debug_on var
     suppress_sigs = gopt Opt_SuppressTypeSignatures
 
     unf_info = unfoldingInfo (idInfo var)
-    pp_unf | hasSomeUnfolding unf_info = ptext (sLit "Unf=") <> ppr unf_info
+    pp_unf | hasSomeUnfolding unf_info = text "Unf=" <> ppr unf_info
            | otherwise                 = empty
 
 pprTypedLetBinder :: Var -> SDoc
@@ -355,7 +355,7 @@ pprTypedLetBinder binder
 pprKindedTyVarBndr :: TyVar -> SDoc
 -- Print a type variable binder with its kind (but not if *)
 pprKindedTyVarBndr tyvar
-  = ptext (sLit "@") <+> pprTvBndr tyvar
+  = text "@" <+> pprTvBndr tyvar
 
 -- pprIdBndr does *not* print the type
 -- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
@@ -379,10 +379,10 @@ pprIdBndrInfo info
     has_lbv   = not (hasNoOneShotInfo lbv_info)
 
     doc = showAttributes
-          [ (has_prag, ptext (sLit "InlPrag=") <> ppr prag_info)
-          , (has_occ,  ptext (sLit "Occ=") <> ppr occ_info)
-          , (has_dmd,  ptext (sLit "Dmd=") <> ppr dmd_info)
-          , (has_lbv , ptext (sLit "OS=") <> ppr lbv_info)
+          [ (has_prag, text "InlPrag=" <> ppr prag_info)
+          , (has_occ,  text "Occ=" <> ppr occ_info)
+          , (has_dmd,  text "Dmd=" <> ppr dmd_info)
+          , (has_lbv , text "OS=" <> ppr lbv_info)
           ]
 
 {-
@@ -397,19 +397,19 @@ ppIdInfo id info
     ppUnless (gopt Opt_SuppressIdInfo dflags) $
     showAttributes
     [ (True, pp_scope <> ppr (idDetails id))
-    , (has_arity,        ptext (sLit "Arity=") <> int arity)
-    , (has_called_arity, ptext (sLit "CallArity=") <> int called_arity)
-    , (has_caf_info,     ptext (sLit "Caf=") <> ppr caf_info)
-    , (True,             ptext (sLit "Str=") <> pprStrictness str_info)
-    , (has_unf,          ptext (sLit "Unf=") <> ppr unf_info)
-    , (not (null rules), ptext (sLit "RULES:") <+> vcat (map pprRule rules))
+    , (has_arity,        text "Arity=" <> int arity)
+    , (has_called_arity, text "CallArity=" <> int called_arity)
+    , (has_caf_info,     text "Caf=" <> ppr caf_info)
+    , (True,             text "Str=" <> pprStrictness str_info)
+    , (has_unf,          text "Unf=" <> ppr unf_info)
+    , (not (null rules), text "RULES:" <+> vcat (map pprRule rules))
     ]   -- Inline pragma, occ, demand, one-shot info
         -- printed out with all binders (when debug is on);
         -- see PprCore.pprIdBndr
   where
-    pp_scope | isGlobalId id   = ptext (sLit "GblId")
-             | isExportedId id = ptext (sLit "LclIdX")
-             | otherwise       = ptext (sLit "LclId")
+    pp_scope | isGlobalId id   = text "GblId"
+             | isExportedId id = text "LclIdX"
+             | otherwise       = text "LclId"
 
     arity = arityInfo info
     has_arity = arity /= 0
@@ -441,47 +441,47 @@ showAttributes stuff
 -}
 
 instance Outputable UnfoldingGuidance where
-    ppr UnfNever  = ptext (sLit "NEVER")
+    ppr UnfNever  = text "NEVER"
     ppr (UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok })
-      = ptext (sLit "ALWAYS_IF") <>
-        parens (ptext (sLit "arity=")     <> int arity    <> comma <>
-                ptext (sLit "unsat_ok=")  <> ppr unsat_ok <> comma <>
-                ptext (sLit "boring_ok=") <> ppr boring_ok)
+      = text "ALWAYS_IF" <>
+        parens (text "arity="     <> int arity    <> comma <>
+                text "unsat_ok="  <> ppr unsat_ok <> comma <>
+                text "boring_ok=" <> ppr boring_ok)
     ppr (UnfIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })
-      = hsep [ ptext (sLit "IF_ARGS"),
+      = hsep [ text "IF_ARGS",
                brackets (hsep (map int cs)),
                int size,
                int discount ]
 
 instance Outputable UnfoldingSource where
-  ppr InlineCompulsory  = ptext (sLit "Compulsory")
-  ppr InlineStable      = ptext (sLit "InlineStable")
-  ppr InlineRhs         = ptext (sLit "<vanilla>")
+  ppr InlineCompulsory  = text "Compulsory"
+  ppr InlineStable      = text "InlineStable"
+  ppr InlineRhs         = text "<vanilla>"
 
 instance Outputable Unfolding where
-  ppr NoUnfolding                = ptext (sLit "No unfolding")
-  ppr (OtherCon cs)              = ptext (sLit "OtherCon") <+> ppr cs
+  ppr NoUnfolding                = text "No unfolding"
+  ppr (OtherCon cs)              = text "OtherCon" <+> ppr cs
   ppr (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })
-       = hang (ptext (sLit "DFun:") <+> ptext (sLit "\\")
+       = hang (text "DFun:" <+> ptext (sLit "\\")
                 <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)
             2 (ppr con <+> sep (map ppr args))
   ppr (CoreUnfolding { uf_src = src
                      , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf
                      , uf_is_conlike=conlike, uf_is_work_free=wf
                      , uf_expandable=exp, uf_guidance=g })
-        = ptext (sLit "Unf") <> braces (pp_info $$ pp_rhs)
+        = text "Unf" <> braces (pp_info $$ pp_rhs)
     where
       pp_info = fsep $ punctuate comma
-                [ ptext (sLit "Src=")        <> ppr src
-                , ptext (sLit "TopLvl=")     <> ppr top
-                , ptext (sLit "Value=")      <> ppr hnf
-                , ptext (sLit "ConLike=")    <> ppr conlike
-                , ptext (sLit "WorkFree=")   <> ppr wf
-                , ptext (sLit "Expandable=") <> ppr exp
-                , ptext (sLit "Guidance=")   <> ppr g ]
+                [ text "Src="        <> ppr src
+                , text "TopLvl="     <> ppr top
+                , text "Value="      <> ppr hnf
+                , text "ConLike="    <> ppr conlike
+                , text "WorkFree="   <> ppr wf
+                , text "Expandable=" <> ppr exp
+                , text "Guidance="   <> ppr g ]
       pp_tmpl = sdocWithDynFlags $ \dflags ->
                 ppUnless (gopt Opt_SuppressUnfoldings dflags) $
-                ptext (sLit "Tmpl=") <+> ppr rhs
+                text "Tmpl=" <+> ppr rhs
       pp_rhs | isStableSource src = pp_tmpl
              | otherwise          = empty
             -- Don't print the RHS or we get a quadratic
@@ -501,16 +501,16 @@ pprRules rules = vcat (map pprRule rules)
 
 pprRule :: CoreRule -> SDoc
 pprRule (BuiltinRule { ru_fn = fn, ru_name = name})
-  = ptext (sLit "Built in rule for") <+> ppr fn <> colon <+> doubleQuotes (ftext name)
+  = text "Built in rule for" <+> ppr fn <> colon <+> doubleQuotes (ftext name)
 
 pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
                 ru_bndrs = tpl_vars, ru_args = tpl_args,
                 ru_rhs = rhs })
   = hang (doubleQuotes (ftext name) <+> ppr act)
-       4 (sep [ptext (sLit "forall") <+>
+       4 (sep [text "forall" <+>
                   sep (map (pprCoreBinder LambdaBind) tpl_vars) <> dot,
                nest 2 (ppr fn <+> sep (map pprArg tpl_args)),
-               nest 2 (ptext (sLit "=") <+> pprCoreExpr rhs)
+               nest 2 (text "=" <+> pprCoreExpr rhs)
             ])
 
 {-
@@ -521,24 +521,24 @@ pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
 
 instance Outputable id => Outputable (Tickish id) where
   ppr (HpcTick modl ix) =
-      hcat [ptext (sLit "hpc<"),
+      hcat [text "hpc<",
             ppr modl, comma,
             ppr ix,
-            ptext (sLit ">")]
+            text ">"]
   ppr (Breakpoint ix vars) =
-      hcat [ptext (sLit "break<"),
+      hcat [text "break<",
             ppr ix,
-            ptext (sLit ">"),
+            text ">",
             parens (hcat (punctuate comma (map ppr vars)))]
   ppr (ProfNote { profNoteCC = cc,
                   profNoteCount = tick,
                   profNoteScope = scope }) =
       case (tick,scope) of
-         (True,True)  -> hcat [ptext (sLit "scctick<"), ppr cc, char '>']
-         (True,False) -> hcat [ptext (sLit "tick<"),    ppr cc, char '>']
-         _            -> hcat [ptext (sLit "scc<"),     ppr cc, char '>']
+         (True,True)  -> hcat [text "scctick<", ppr cc, char '>']
+         (True,False) -> hcat [text "tick<",    ppr cc, char '>']
+         _            -> hcat [text "scc<",     ppr cc, char '>']
   ppr (SourceNote span _) =
-      hcat [ ptext (sLit "src<"), pprUserRealSpan True span, char '>']
+      hcat [ text "src<", pprUserRealSpan True span, char '>']
 
 {-
 -----------------------------------------------------
@@ -547,14 +547,14 @@ instance Outputable id => Outputable (Tickish id) where
 -}
 
 instance Outputable CoreVect where
-  ppr (Vect     var e)               = hang (ptext (sLit "VECTORISE") <+> ppr var <+> char '=')
+  ppr (Vect     var e)               = hang (text "VECTORISE" <+> ppr var <+> char '=')
                                          4 (pprCoreExpr e)
-  ppr (NoVect   var)                 = ptext (sLit "NOVECTORISE") <+> ppr var
-  ppr (VectType False var Nothing)   = ptext (sLit "VECTORISE type") <+> ppr var
-  ppr (VectType True  var Nothing)   = ptext (sLit "VECTORISE SCALAR type") <+> ppr var
-  ppr (VectType False var (Just tc)) = ptext (sLit "VECTORISE type") <+> ppr var <+> char '=' <+>
+  ppr (NoVect   var)                 = text "NOVECTORISE" <+> ppr var
+  ppr (VectType False var Nothing)   = text "VECTORISE type" <+> ppr var
+  ppr (VectType True  var Nothing)   = text "VECTORISE SCALAR type" <+> ppr var
+  ppr (VectType False var (Just tc)) = text "VECTORISE type" <+> ppr var <+> char '=' <+>
                                        ppr tc
-  ppr (VectType True var (Just tc))  = ptext (sLit "VECTORISE SCALAR type") <+> ppr var <+>
+  ppr (VectType True var (Just tc))  = text "VECTORISE SCALAR type" <+> ppr var <+>
                                        char '=' <+> ppr tc
-  ppr (VectClass tc)                 = ptext (sLit "VECTORISE class") <+> ppr tc
-  ppr (VectInst var)                 = ptext (sLit "VECTORISE SCALAR instance") <+> ppr var
+  ppr (VectClass tc)                 = text "VECTORISE class" <+> ppr tc
+  ppr (VectInst var)                 = text "VECTORISE SCALAR instance" <+> ppr var
index 5d8a171..de53a4a 100644 (file)
@@ -1408,15 +1408,15 @@ isAnyPmCheckEnabled dflags (DsMatchContext kind _loc)
 warnManyGuards :: DsMatchContext -> DsM ()
 warnManyGuards (DsMatchContext kind loc)
   = putSrcSpanDs loc $ warnDs $ vcat
-      [ sep [ ptext (sLit "Too many guards in") <+> pprMatchContext kind
-            , ptext (sLit "Guard checking has been over-simplified") ]
-      , parens (ptext (sLit "Use:") <+> (opt_1 $$ opt_2)) ]
+      [ sep [ text "Too many guards in" <+> pprMatchContext kind
+            , text "Guard checking has been over-simplified" ]
+      , parens (text "Use:" <+> (opt_1 $$ opt_2)) ]
   where
-    opt_1 = hang (ptext (sLit "-Wno-too-many-guards")) 2 $
-      ptext (sLit "to suppress this warning")
-    opt_2 = hang (ptext (sLit "-ffull-guard-reasoning")) 2 $ vcat
-      [ ptext (sLit "to run the full checker (may increase")
-      , ptext (sLit "compilation time and memory consumption)") ]
+    opt_1 = hang (text "-Wno-too-many-guards") 2 $
+      text "to suppress this warning"
+    opt_2 = hang (text "-ffull-guard-reasoning") 2 $ vcat
+      [ text "to run the full checker (may increase"
+      , text "compilation time and memory consumption)" ]
 
 dsPmWarn :: DynFlags -> DsMatchContext -> DsM PmResult -> DsM ()
 dsPmWarn dflags ctx@(DsMatchContext kind loc) mPmResult
@@ -1438,15 +1438,15 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) mPmResult
     pprEqns qs text = pp_context ctx (ptext (sLit text)) $ \f ->
       vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$ dots qs
 
-    pprEqnsU qs = pp_context ctx (ptext (sLit "are non-exhaustive")) $ \_ ->
+    pprEqnsU qs = pp_context ctx (text "are non-exhaustive") $ \_ ->
       case qs of -- See #11245
-           [([],_)] -> ptext (sLit "Guards do not cover entire pattern space")
+           [([],_)] -> text "Guards do not cover entire pattern space"
            _missing -> let us = map ppr_uncovered qs
-                       in  hang (ptext (sLit "Patterns not matched:")) 4
+                       in  hang (text "Patterns not matched:") 4
                                 (vcat (take maximum_output us) $$ dots us)
 
 dots :: [a] -> SDoc
-dots qs | qs `lengthExceeds` maximum_output = ptext (sLit "...")
+dots qs | qs `lengthExceeds` maximum_output = text "..."
         | otherwise                         = empty
 
 exhaustive :: DynFlags -> HsMatchContext id -> Bool
@@ -1467,8 +1467,8 @@ exhaustive _dflags (StmtCtxt {}) = False -- Don't warn about incomplete patterns
 
 pp_context :: DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
 pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun
-  = vcat [ptext (sLit "Pattern match(es)") <+> msg,
-          sep [ ptext (sLit "In") <+> ppr_match <> char ':'
+  = vcat [text "Pattern match(es)" <+> msg,
+          sep [ text "In" <+> ppr_match <> char ':'
               , nest 4 (rest_of_msg_fun pref)]]
   where
     (ppr_match, pref)
@@ -1478,20 +1478,20 @@ pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun
 
 ppr_pats :: HsMatchContext Name -> [Pat Id] -> SDoc
 ppr_pats kind pats
-  = sep [sep (map ppr pats), matchSeparator kind, ptext (sLit "...")]
+  = sep [sep (map ppr pats), matchSeparator kind, text "..."]
 
 ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat Id] -> SDoc
 ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn))
 
 ppr_constraint :: (SDoc,[PmLit]) -> SDoc
-ppr_constraint (var, lits) = var <+> ptext (sLit "is not one of")
+ppr_constraint (var, lits) = var <+> text "is not one of"
                                  <+> braces (pprWithCommas ppr lits)
 
 ppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc
 ppr_uncovered (expr_vec, complex)
   | null cs   = fsep vec -- there are no literal constraints
   | otherwise = hang (fsep vec) 4 $
-                  ptext (sLit "where") <+> vcat (map ppr_constraint cs)
+                  text "where" <+> vcat (map ppr_constraint cs)
   where
     sdoc_vec = mapM pprPmExprWithParens expr_vec
     (vec,cs) = runPmPprM sdoc_vec (filterComplex complex)
index 762883b..ae8b6ab 100644 (file)
@@ -13,6 +13,8 @@ import GHCi.RemoteTypes
 import Data.Array
 import ByteCodeTypes
 import GHC.Stack.CCS
+import Foreign.C
+import qualified Data.ByteString as B
 #endif
 import Type
 import HsSyn
@@ -41,13 +43,11 @@ import CLabel
 import Util
 
 import Data.Time
-import Foreign.C
 import System.Directory
 
 import Trace.Hpc.Mix
 import Trace.Hpc.Util
 
-import qualified Data.ByteString as B
 import Data.Map (Map)
 import qualified Data.Map as Map
 
@@ -1328,9 +1328,9 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
          <> text "(void) __attribute__((constructor));"
     , text "static void hpc_init_" <> ppr this_mod <> text "(void)"
     , braces (vcat [
-        ptext (sLit "extern StgWord64 ") <> tickboxes <>
-               ptext (sLit "[]") <> semi,
-        ptext (sLit "hs_hpc_module") <>
+        text "extern StgWord64 " <> tickboxes <>
+               text "[]" <> semi,
+        text "hs_hpc_module" <>
           parens (hcat (punctuate comma [
               doubleQuotes full_name_str,
               int tickCount, -- really StgWord32
index da6085d..1c175f2 100644 (file)
@@ -598,22 +598,22 @@ warnRuleShadowing rule_name rule_act fn_id arg_ids
       | isLocalId lhs_id || canUnfold (idUnfolding lhs_id)
                        -- If imported with no unfolding, no worries
       , idInlineActivation lhs_id `competesWith` rule_act
-      = warnDs (vcat [ hang (ptext (sLit "Rule") <+> pprRuleName rule_name
-                               <+> ptext (sLit "may never fire"))
-                            2 (ptext (sLit "because") <+> quotes (ppr lhs_id)
-                               <+> ptext (sLit "might inline first"))
-                     , ptext (sLit "Probable fix: add an INLINE[n] or NOINLINE[n] pragma for")
+      = warnDs (vcat [ hang (text "Rule" <+> pprRuleName rule_name
+                               <+> text "may never fire")
+                            2 (text "because" <+> quotes (ppr lhs_id)
+                               <+> text "might inline first")
+                     , text "Probable fix: add an INLINE[n] or NOINLINE[n] pragma for"
                        <+> quotes (ppr lhs_id)
                      , ifPprDebug (ppr (idInlineActivation lhs_id) $$ ppr rule_act) ])
 
       | check_rules_too
       , bad_rule : _ <- get_bad_rules lhs_id
-      = warnDs (vcat [ hang (ptext (sLit "Rule") <+> pprRuleName rule_name
-                               <+> ptext (sLit "may never fire"))
-                            2 (ptext (sLit "because rule") <+> pprRuleName (ruleName bad_rule)
-                               <+> ptext (sLit "for")<+> quotes (ppr lhs_id)
-                               <+> ptext (sLit "might fire first"))
-                      , ptext (sLit "Probable fix: add phase [n] or [~n] to the competing rule")
+      = warnDs (vcat [ hang (text "Rule" <+> pprRuleName rule_name
+                               <+> text "may never fire")
+                            2 (text "because rule" <+> pprRuleName (ruleName bad_rule)
+                               <+> text "for"<+> quotes (ppr lhs_id)
+                               <+> text "might fire first")
+                      , text "Probable fix: add phase [n] or [~n] to the competing rule"
                       , ifPprDebug (ppr bad_rule) ])
 
       | otherwise
index cc831d7..3691afb 100644 (file)
@@ -47,7 +47,6 @@ import Bag
 import VarSet
 import SrcLoc
 import ListSetOps( assocDefault )
-import FastString
 import Data.List
 
 data DsCmdEnv = DsCmdEnv {
@@ -74,7 +73,7 @@ mkCmdEnv tc_meths
 
     find_meth prs std_name
       = assocDefault (mk_panic std_name) prs std_name
-    mk_panic std_name = pprPanic "mkCmdEnv" (ptext (sLit "Not found:") <+> ppr std_name)
+    mk_panic std_name = pprPanic "mkCmdEnv" (text "Not found:" <+> ppr std_name)
 
 -- arr :: forall b c. (b -> c) -> a b c
 do_arr :: DsCmdEnv -> Type -> Type -> CoreExpr -> CoreExpr
index 84f67e9..4b500a3 100644 (file)
@@ -604,7 +604,7 @@ dsSpec :: Maybe CoreExpr        -- Just rhs => RULE is for a local binding
 dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
   | isJust (isClassOpId_maybe poly_id)
   = putSrcSpanDs loc $
-    do { warnDs (ptext (sLit "Ignoring useless SPECIALISE pragma for class method selector")
+    do { warnDs (text "Ignoring useless SPECIALISE pragma for class method selector"
                  <+> quotes (ppr poly_id))
        ; return Nothing  }  -- There is no point in trying to specialise a class op
                             -- Moreover, classops don't (currently) have an inl_sat arity set
@@ -612,7 +612,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
 
   | no_act_spec && isNeverActive rule_act
   = putSrcSpanDs loc $
-    do { warnDs (ptext (sLit "Ignoring useless SPECIALISE pragma for NOINLINE function:")
+    do { warnDs (text "Ignoring useless SPECIALISE pragma for NOINLINE function:"
                  <+> quotes (ppr poly_id))
        ; return Nothing  }  -- Function is NOINLINE, and the specialiation inherits that
                             -- See Note [Activation pragmas for SPECIALISE]
@@ -626,9 +626,9 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
        ; (bndrs, ds_lhs) <- liftM collectBinders
                                   (dsHsWrapper spec_co (Var poly_id))
        ; let spec_ty = mkPiTypes bndrs (exprType ds_lhs)
-       ; -- pprTrace "dsRule" (vcat [ ptext (sLit "Id:") <+> ppr poly_id
-         --                         , ptext (sLit "spec_co:") <+> ppr spec_co
-         --                         , ptext (sLit "ds_rhs:") <+> ppr ds_lhs ]) $
+       ; -- pprTrace "dsRule" (vcat [ text "Id:" <+> ppr poly_id
+         --                         , text "spec_co:" <+> ppr spec_co
+         --                         , text "ds_rhs:" <+> ppr ds_lhs ]) $
          case decomposeRuleLhs bndrs ds_lhs of {
            Left msg -> do { warnDs msg; return Nothing } ;
            Right (rule_bndrs, _fn, args) -> do
@@ -652,7 +652,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
 
 -- Commented out: see Note [SPECIALISE on INLINE functions]
 --       ; when (isInlinePragma id_inl)
---              (warnDs $ ptext (sLit "SPECIALISE pragma on INLINE function probably won't fire:")
+--              (warnDs $ text "SPECIALISE pragma on INLINE function probably won't fire:"
 --                        <+> quotes (ppr poly_name))
 
        ; return (Just (unitOL (spec_id, spec_rhs), rule))
@@ -705,7 +705,7 @@ dsMkUserRule this_mod is_local name act fn bndrs args rhs = do
     return rule
 
 ruleOrphWarn :: CoreRule -> SDoc
-ruleOrphWarn rule = ptext (sLit "Orphan rule:") <+> ppr rule
+ruleOrphWarn rule = text "Orphan rule:" <+> ppr rule
 
 {- Note [SPECIALISE on INLINE functions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -782,12 +782,12 @@ decomposeRuleLhs orig_bndrs orig_lhs
 
   | Just (fn_id, args) <- decompose fun2 args2
   , let extra_dict_bndrs = mk_extra_dict_bndrs fn_id args
-  = -- pprTrace "decmposeRuleLhs" (vcat [ ptext (sLit "orig_bndrs:") <+> ppr orig_bndrs
-    --                                  , ptext (sLit "orig_lhs:") <+> ppr orig_lhs
-    --                                  , ptext (sLit "lhs1:")     <+> ppr lhs1
-    --                                  , ptext (sLit "extra_dict_bndrs:") <+> ppr extra_dict_bndrs
-    --                                  , ptext (sLit "fn_id:") <+> ppr fn_id
-    --                                  , ptext (sLit "args:")   <+> ppr args]) $
+  = -- pprTrace "decmposeRuleLhs" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
+    --                                  , text "orig_lhs:" <+> ppr orig_lhs
+    --                                  , text "lhs1:"     <+> ppr lhs1
+    --                                  , text "extra_dict_bndrs:" <+> ppr extra_dict_bndrs
+    --                                  , text "fn_id:" <+> ppr fn_id
+    --                                  , text "args:"   <+> ppr args]) $
     Right (orig_bndrs ++ extra_dict_bndrs, fn_id, args)
 
   | otherwise
@@ -816,18 +816,18 @@ decomposeRuleLhs orig_bndrs orig_lhs
 
    decompose _ _ = Nothing
 
-   bad_shape_msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar"))
+   bad_shape_msg = hang (text "RULE left-hand side too complicated to desugar")
                       2 (vcat [ text "Optimised lhs:" <+> ppr lhs2
                               , text "Orig lhs:" <+> ppr orig_lhs])
-   dead_msg bndr = hang (sep [ ptext (sLit "Forall'd") <+> pp_bndr bndr
-                             , ptext (sLit "is not bound in RULE lhs")])
+   dead_msg bndr = hang (sep [ text "Forall'd" <+> pp_bndr bndr
+                             , text "is not bound in RULE lhs"])
                       2 (vcat [ text "Orig bndrs:" <+> ppr orig_bndrs
                               , text "Orig lhs:" <+> ppr orig_lhs
                               , text "optimised lhs:" <+> ppr lhs2 ])
    pp_bndr bndr
-    | isTyVar bndr                      = ptext (sLit "type variable") <+> quotes (ppr bndr)
-    | Just pred <- evVarPred_maybe bndr = ptext (sLit "constraint") <+> quotes (ppr pred)
-    | otherwise                         = ptext (sLit "variable") <+> quotes (ppr bndr)
+    | isTyVar bndr                      = text "type variable" <+> quotes (ppr bndr)
+    | Just pred <- evVarPred_maybe bndr = text "constraint" <+> quotes (ppr pred)
+    | otherwise                         = text "variable" <+> quotes (ppr bndr)
 
    drop_dicts :: CoreExpr -> CoreExpr
    drop_dicts e
index 068218e..22a8707 100644 (file)
@@ -369,7 +369,7 @@ dsExpr (HsMultiIf res_ty alts)
        ; extractMatchResult match_result error_expr }
   where
     mkErrorExpr = mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID res_ty
-                               (ptext (sLit "multi-way if"))
+                               (text "multi-way if")
 
 {-
 \noindent
@@ -999,7 +999,7 @@ warnDiscardedDoBindings rhs rhs_ty
            -- Warn about discarding non-() things in 'monadic' binding
        ; if warn_unused && not (isUnitTy norm_elt_ty)
          then warnDs (badMonadBind rhs elt_ty
-                           (ptext (sLit "-fno-warn-unused-do-bind")))
+                           (text "-fno-warn-unused-do-bind"))
          else
 
            -- Warn about discarding m a things in 'monadic' binding of the same type,
@@ -1009,7 +1009,7 @@ warnDiscardedDoBindings rhs rhs_ty
                          Just (elt_m_ty, _)
                             | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty
                             -> warnDs (badMonadBind rhs elt_ty
-                                           (ptext (sLit "-fno-warn-wrong-do-bind")))
+                                           (text "-fno-warn-wrong-do-bind"))
                          _ -> return () } } }
 
   | otherwise   -- RHS does have type of form (m ty), which is weird
@@ -1017,11 +1017,11 @@ warnDiscardedDoBindings rhs rhs_ty
 
 badMonadBind :: LHsExpr Id -> Type -> SDoc -> SDoc
 badMonadBind rhs elt_ty flag_doc
-  = vcat [ hang (ptext (sLit "A do-notation statement discarded a result of type"))
+  = vcat [ hang (text "A do-notation statement discarded a result of type")
               2 (quotes (ppr elt_ty))
-         , hang (ptext (sLit "Suppress this warning by saying"))
-              2 (quotes $ ptext (sLit "_ <-") <+> ppr rhs)
-         , ptext (sLit "or by using the flag") <+>  flag_doc ]
+         , hang (text "Suppress this warning by saying")
+              2 (quotes $ text "_ <-" <+> ppr rhs)
+         , text "or by using the flag" <+>  flag_doc ]
 
 {-
 ************************************************************************
index 2ee9373..0805ca0 100644 (file)
@@ -534,7 +534,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
 
   arg_cname n stg_ty
         | libffi    = char '*' <> parens (stg_ty <> char '*') <>
-                      ptext (sLit "args") <> brackets (int (n-1))
+                      text "args" <> brackets (int (n-1))
         | otherwise = text ('a':show n)
 
   -- generate a libffi-style stub if this is a "wrapper" and libffi is enabled
@@ -580,7 +580,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
   -- Now we can cook up the prototype for the exported function.
   pprCconv = ccallConvAttribute cc
 
-  header_bits = ptext (sLit "extern") <+> fun_proto <> semi
+  header_bits = text "extern" <+> fun_proto <> semi
 
   fun_args
     | null aug_arg_info = text "void"
@@ -589,8 +589,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
 
   fun_proto
     | libffi
-      = ptext (sLit "void") <+> ftext c_nm <>
-          parens (ptext (sLit "void *cif STG_UNUSED, void* resp, void** args, void* the_stableptr"))
+      = text "void" <+> ftext c_nm <>
+          parens (text "void *cif STG_UNUSED, void* resp, void** args, void* the_stableptr")
     | otherwise
       = cResType <+> pprCconv <+> ftext c_nm <> parens fun_args
 
@@ -633,14 +633,14 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
     fun_proto  $$
     vcat
      [ lbrace
-     ,   ptext (sLit "Capability *cap;")
+     ,   text "Capability *cap;"
      ,   declareResult
      ,   declareCResult
      ,   text "cap = rts_lock();"
           -- create the application + perform it.
-     ,   ptext (sLit "rts_evalIO") <> parens (
+     ,   text "rts_evalIO" <> parens (
                 char '&' <> cap <>
-                ptext (sLit "rts_apply") <> parens (
+                text "rts_apply" <> parens (
                     cap <>
                     text "(HaskellObj)"
                  <> ptext (if is_IO_res_ty
@@ -651,15 +651,15 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
                 ) <+> comma
                <> text "&ret"
              ) <> semi
-     ,   ptext (sLit "rts_checkSchedStatus") <> parens (doubleQuotes (ftext c_nm)
+     ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (ftext c_nm)
                                                 <> comma <> text "cap") <> semi
      ,   assignCResult
-     ,   ptext (sLit "rts_unlock(cap);")
+     ,   text "rts_unlock(cap);"
      ,   ppUnless res_hty_is_unit $
          if libffi
                   then char '*' <> parens (ffi_cResType <> char '*') <>
-                       ptext (sLit "resp = cret;")
-                  else ptext (sLit "return cret;")
+                       text "resp = cret;"
+                  else text "return cret;"
      , rbrace
      ]
 
@@ -720,7 +720,7 @@ toCType = f False
               = f voidOK t'
            -- Otherwise we don't know the C type. If we are allowing
            -- void then return that; otherwise something has gone wrong.
-           | voidOK = (Nothing, ptext (sLit "void"))
+           | voidOK = (Nothing, text "void")
            | otherwise
               = pprPanic "toCType" (ppr t)
 
index d835995..f6c2b60 100644 (file)
@@ -31,7 +31,6 @@ import Match
 import PrelNames
 import SrcLoc
 import Outputable
-import FastString
 import TcType
 import ListSetOps( getNth )
 import Util
@@ -582,7 +581,7 @@ dePArrComp (LetStmt (L _ ds) : qs) pa cea = do
     let projBody = mkCoreLet (NonRec let'v clet) $
                    mkCoreTup [Var v, Var let'v]
         errTy    = exprType projBody
-        errMsg   = ptext (sLit "DsListComp.dePArrComp: internal error!")
+        errMsg   = text "DsListComp.dePArrComp: internal error!"
     cerr <- mkErrorAppDs pAT_ERROR_ID errTy errMsg
     ccase <- matchSimply (Var v) (StmtCtxt PArrComp) pa projBody cerr
     let pa'    = mkLHsPatTup [pa, mkLHsPatTup (map nlVarPat xs)]
@@ -648,7 +647,7 @@ mkLambda :: Type                        -- type of the argument
          -> DsM (CoreExpr, Type)
 mkLambda ty p ce = do
     v <- newSysLocalDs ty
-    let errMsg = ptext (sLit "DsListComp.deLambda: internal error!")
+    let errMsg = text "DsListComp.deLambda: internal error!"
         ce'ty  = exprType ce
     cerr <- mkErrorAppDs pAT_ERROR_ID ce'ty errMsg
     res <- matchSimply (Var v) (StmtCtxt PArrComp) p ce cerr
index acd32ba..ca427a4 100644 (file)
@@ -2271,5 +2271,5 @@ notHandledL loc what doc
 notHandled :: String -> SDoc -> DsM a
 notHandled what doc = failWithDs msg
   where
-    msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
+    msg = hang (text what <+> text "not (yet) handled by Template Haskell")
              2 doc
index befad44..92bfde0 100644 (file)
@@ -195,11 +195,11 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
                    _           -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err
                } }
 
-        paErr       = ptext (sLit "To use ParallelArrays,") <+> specBackend $$ hint1 $$ hint2
-        veErr       = ptext (sLit "To use -fvectorise,") <+> specBackend $$ hint1 $$ hint2
-        specBackend = ptext (sLit "you must specify a DPH backend package")
-        hint1       = ptext (sLit "Look for packages named 'dph-lifted-*' with 'ghc-pkg'")
-        hint2       = ptext (sLit "You may need to install them with 'cabal install dph-examples'")
+        paErr       = text "To use ParallelArrays," <+> specBackend $$ hint1 $$ hint2
+        veErr       = text "To use -fvectorise," <+> specBackend $$ hint1 $$ hint2
+        specBackend = text "you must specify a DPH backend package"
+        hint1       = text "Look for packages named 'dph-lifted-*' with 'ghc-pkg'"
+        hint2       = text "You may need to install them with 'cabal install dph-examples'"
 
     initDPHBuiltins thing_inside
       = do {   -- If '-XParallelArrays' given, we populate the builtin table for desugaring those
@@ -261,7 +261,7 @@ mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
          -> (DsGblEnv, DsLclEnv)
 mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var static_binds_var
   = let if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
-        if_lenv = mkIfLclEnv mod (ptext (sLit "GHC error in desugarer lookup in") <+> ppr mod)
+        if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod)
         real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1)
         gbl_env = DsGblEnv { ds_mod     = mod
                            , ds_fam_inst_env = fam_inst_env
index 301d3a6..2fab875 100644 (file)
@@ -139,9 +139,9 @@ warnAboutIdentities dflags (Var conv_fn) type_of_conv
   , idName conv_fn `elem` conversionNames
   , Just (arg_ty, res_ty) <- splitFunTy_maybe type_of_conv
   , arg_ty `eqType` res_ty  -- So we are converting  ty -> ty
-  = warnDs (vcat [ ptext (sLit "Call of") <+> ppr conv_fn <+> dcolon <+> ppr type_of_conv
-                 , nest 2 $ ptext (sLit "can probably be omitted")
-                 , parens (ptext (sLit "Use -fno-warn-identities to suppress this message"))
+  = warnDs (vcat [ text "Call of" <+> ppr conv_fn <+> dcolon <+> ppr type_of_conv
+                 , nest 2 $ text "can probably be omitted"
+                 , parens (text "Use -fno-warn-identities to suppress this message")
            ])
 warnAboutIdentities _ _ _ = return ()
 
@@ -173,9 +173,9 @@ warnAboutOverflowedLiterals dflags lit
     check :: forall a. (Bounded a, Integral a) => Integer -> Name -> a -> DsM ()
     check i tc _proxy
       = when (i < minB || i > maxB) $ do
-        warnDs (vcat [ ptext (sLit "Literal") <+> integer i
-                       <+> ptext (sLit "is out of the") <+> ppr tc <+> ptext (sLit "range")
-                       <+> integer minB <> ptext (sLit "..") <> integer maxB
+        warnDs (vcat [ text "Literal" <+> integer i
+                       <+> text "is out of the" <+> ppr tc <+> ptext (sLit "range")
+                       <+> integer minB <> text ".." <> integer maxB
                      , sug ])
       where
         minB = toInteger (minBound :: a)
@@ -183,7 +183,7 @@ warnAboutOverflowedLiterals dflags lit
         sug | minB == -i   -- Note [Suggest NegativeLiterals]
             , i > 0
             , not (xopt LangExt.NegativeLiterals dflags)
-            = ptext (sLit "If you are trying to write a large negative literal, use NegativeLiterals")
+            = text "If you are trying to write a large negative literal, use NegativeLiterals"
             | otherwise = Outputable.empty
 
 {-
@@ -209,7 +209,7 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
   , let check :: forall a. (Enum a, Num a) => a -> DsM ()
         check _proxy
           = when (null enumeration) $
-            warnDs (ptext (sLit "Enumeration is empty"))
+            warnDs (text "Enumeration is empty")
           where
             enumeration :: [a]
             enumeration = case mThn of
index 4ca9461..3c5fe28 100644 (file)
@@ -22,7 +22,6 @@ import TysWiredIn
 import Outputable
 import Util
 import SrcLoc
-import FastString -- sLit
 import VarSet
 
 import Data.Maybe (mapMaybe)
@@ -332,8 +331,8 @@ filterComplex = zipWith rename nameList . map mkGroup
 
     -- Try nice names p,q,r,s,t before using the (ugly) t_i
     nameList :: [SDoc]
-    nameList = map (ptext . sLit) ["p","q","r","s","t"] ++
-                 [ ptext (sLit ('t':show u)) | u <- [(0 :: Int)..] ]
+    nameList = map text ["p","q","r","s","t"] ++
+                 [ text ('t':show u) | u <- [(0 :: Int)..] ]
 
 -- ----------------------------------------------------------------------------
 
index 985bec4..f1f6f70 100644 (file)
@@ -167,21 +167,21 @@ pprCoreExprShort expr@(Lam _ _)
   = let
         (bndrs, _) = collectBinders expr
     in
-    char '\\' <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow <+> ptext (sLit "...")
+    char '\\' <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow <+> text "..."
 
 pprCoreExprShort (Case _expr var _ty _alts)
- = ptext (sLit "case of") <+> ppr var
+ = text "case of" <+> ppr var
 
-pprCoreExprShort (Let (NonRec x _) _) = ptext (sLit "let") <+> ppr x <+> ptext (sLit ("= ... in ..."))
-pprCoreExprShort (Let (Rec bs) _) = ptext (sLit "let {") <+> ppr (fst (head bs)) <+> ptext (sLit ("= ...; ... } in ..."))
+pprCoreExprShort (Let (NonRec x _) _) = text "let" <+> ppr x <+> ptext (sLit ("= ... in ..."))
+pprCoreExprShort (Let (Rec bs) _) = text "let {" <+> ppr (fst (head bs)) <+> ptext (sLit ("= ...; ... } in ..."))
 
 pprCoreExprShort (Tick t e) = ppr t <+> pprCoreExprShort e
-pprCoreExprShort (Cast e _) = pprCoreExprShort e <+> ptext (sLit "`cast` T")
+pprCoreExprShort (Cast e _) = pprCoreExprShort e <+> text "`cast` T"
 
 pprCoreExprShort e = pprCoreExpr e
 
 pprCoreAltShort :: CoreAlt -> SDoc
-pprCoreAltShort (con, args, expr) = ppr con <+> sep (map ppr args) <+> ptext (sLit "->") <+> pprCoreExprShort expr
+pprCoreAltShort (con, args, expr) = ppr con <+> sep (map ppr args) <+> text "->" <+> pprCoreExprShort expr
 
 instance Outputable BCInstr where
    ppr (STKCHECK n)          = text "STKCHECK" <+> ppr n
index 44d272e..982b4fc 100644 (file)
@@ -546,22 +546,22 @@ normalObjectSuffix = phaseInputExt StopLn
 
 failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
 failNonStd dflags srcspan = dieWith dflags srcspan $
-  ptext (sLit "Cannot load") <+> compWay <+>
-     ptext (sLit "objects when GHC is built") <+> ghciWay $$
-  ptext (sLit "To fix this, either:") $$
-  ptext (sLit "  (1) Use -fexternal-interprter, or") $$
-  ptext (sLit "  (2) Build the program twice: once") <+>
-                       ghciWay <> ptext (sLit ", and then") $$
-  ptext (sLit "      with") <+> compWay <+>
-     ptext (sLit "using -osuf to set a different object file suffix.")
+  text "Cannot load" <+> compWay <+>
+     text "objects when GHC is built" <+> ghciWay $$
+  text "To fix this, either:" $$
+  text "  (1) Use -fexternal-interprter, or" $$
+  text "  (2) Build the program twice: once" <+>
+                       ghciWay <> text ", and then" $$
+  text "      with" <+> compWay <+>
+     text "using -osuf to set a different object file suffix."
     where compWay
-            | WayDyn `elem` ways dflags = ptext (sLit "-dynamic")
-            | WayProf `elem` ways dflags = ptext (sLit "-prof")
-            | otherwise = ptext (sLit "normal")
+            | WayDyn `elem` ways dflags = text "-dynamic"
+            | WayProf `elem` ways dflags = text "-prof"
+            | otherwise = text "normal"
           ghciWay
-            | dynamicGhc = ptext (sLit "with -dynamic")
-            | rtsIsProfiled = ptext (sLit "with -prof")
-            | otherwise = ptext (sLit "the normal way")
+            | dynamicGhc = text "with -dynamic"
+            | rtsIsProfiled = text "with -prof"
+            | otherwise = text "the normal way"
 
 getLinkDeps :: HscEnv -> HomePackageTable
             -> PersistentLinkerState
@@ -649,11 +649,11 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 
     no_obj :: Outputable a => a -> IO b
     no_obj mod = dieWith dflags span $
-                     ptext (sLit "cannot find object file for module ") <>
+                     text "cannot find object file for module " <>
                         quotes (ppr mod) $$
                      while_linking_expr
 
-    while_linking_expr = ptext (sLit "while linking an interpreted expression")
+    while_linking_expr = text "while linking an interpreted expression"
 
         -- This one is a build-system bug
 
@@ -691,7 +691,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
                 ok <- doesFileExist new_file
                 if (not ok)
                    then dieWith dflags span $
-                          ptext (sLit "cannot find object file ")
+                          text "cannot find object file "
                                 <> quotes (text new_file) $$ while_linking_expr
                    else return (DotO new_file)
             adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
index c76fc3a..5b0b1a4 100644 (file)
@@ -124,7 +124,7 @@ wrapMsg what item (CvtM m)
   where
         -- Show the item in pretty syntax normally,
         -- but with all its constructors if you say -dppr-debug
-    msg sty = hang (ptext (sLit "When splicing a TH") <+> text what <> colon)
+    msg sty = hang (text "When splicing a TH" <+> text what <> colon)
                  2 (if debugStyle sty
                     then text (show item)
                     else text (pprint item))
@@ -148,7 +148,7 @@ cvtDec (TH.ValD pat body ds)
   | otherwise
   = do  { pat' <- cvtPat pat
         ; body' <- cvtGuard body
-        ; ds' <- cvtLocalDecs (ptext (sLit "a where clause")) ds
+        ; ds' <- cvtLocalDecs (text "a where clause") ds
         ; returnJustL $ Hs.ValD $
           PatBind { pat_lhs = pat', pat_rhs = GRHSs body' (noLoc ds')
                   , pat_rhs_ty = placeHolderType, bind_fvs = placeHolderNames
@@ -156,9 +156,9 @@ cvtDec (TH.ValD pat body ds)
 
 cvtDec (TH.FunD nm cls)
   | null cls
-  = failWith (ptext (sLit "Function binding for")
+  = failWith (text "Function binding for"
                  <+> quotes (text (TH.pprint nm))
-                 <+> ptext (sLit "has no equations"))
+                 <+> text "has no equations")
   | otherwise
   = do  { nm' <- vNameL nm
         ; cls' <- mapM cvtClause cls
@@ -229,7 +229,7 @@ cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
 cvtDec (ClassD ctxt cl tvs fds decs)
   = do  { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
         ; fds'  <- mapM cvt_fundep fds
-        ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs (ptext (sLit "a class declaration")) decs
+        ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs (text "a class declaration") decs
         ; unless (null adts')
             (failWith $ (text "Default data instance declarations"
                      <+> text "are not allowed:")
@@ -251,7 +251,7 @@ cvtDec (ClassD ctxt cl tvs fds decs)
                         Left (_, msg) -> failWith msg
 
 cvtDec (InstanceD ctxt ty decs)
-  = do  { let doc = ptext (sLit "an instance declaration")
+  = do  { let doc = text "an instance declaration"
         ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs
         ; unless (null fams') (failWith (mkBadDecMsg doc fams'))
         ; ctxt' <- cvtContext ctxt
@@ -429,7 +429,7 @@ is_bind decl                   = Right decl
 
 mkBadDecMsg :: Outputable a => MsgDoc -> [a] -> MsgDoc
 mkBadDecMsg doc bads
-  = sep [ ptext (sLit "Illegal declaration(s) in") <+> doc <> colon
+  = sep [ text "Illegal declaration(s) in" <+> doc <> colon
         , nest 2 (vcat (map Outputable.ppr bads)) ]
 
 ---------------------------------------------------
@@ -552,7 +552,7 @@ cvtForD (ImportF callconv safety from nm ty)
                                  from (noLoc from)
   = mk_imp impspec
   | otherwise
-  = failWith $ text (show from) <+> ptext (sLit "is not a valid ccall impent")
+  = failWith $ text (show from) <+> text "is not a valid ccall impent"
   where
     mk_imp impspec
       = do { nm' <- vNameL nm
@@ -695,7 +695,7 @@ cvtClause :: TH.Clause -> CvtM (Hs.LMatch RdrName (LHsExpr RdrName))
 cvtClause (Clause ps body wheres)
   = do  { ps' <- cvtPats ps
         ; g'  <- cvtGuard body
-        ; ds' <- cvtLocalDecs (ptext (sLit "a where clause")) wheres
+        ; ds' <- cvtLocalDecs (text "a where clause") wheres
         ; returnL $ Hs.Match NonFunBindMatch ps' Nothing
                              (GRHSs g' (noLoc ds')) }
 
@@ -734,10 +734,10 @@ cvtl e = wrapL (cvt e)
     cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
                             ; return $ HsIf (Just noSyntaxExpr) x' y' z' }
     cvt (MultiIfE alts)
-      | null alts      = failWith (ptext (sLit "Multi-way if-expression with no alternatives"))
+      | null alts      = failWith (text "Multi-way if-expression with no alternatives")
       | otherwise      = do { alts' <- mapM cvtpair alts
                             ; return $ HsMultiIf placeHolderType alts' }
-    cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (ptext (sLit "a let expression")) ds
+    cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (text "a let expression") ds
                             ; e' <- cvtl e; return $ HsLet (noLoc ds') e' }
     cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM cvtMatch ms
                             ; return $ HsCase e' (mkMatchGroup FromSource ms') }
@@ -885,7 +885,7 @@ cvtOpApp x op y
 
 cvtHsDo :: HsStmtContext Name.Name -> [TH.Stmt] -> CvtM (HsExpr RdrName)
 cvtHsDo do_or_lc stmts
-  | null stmts = failWith (ptext (sLit "Empty stmt list in do-block"))
+  | null stmts = failWith (text "Empty stmt list in do-block")
   | otherwise
   = do  { stmts' <- cvtStmts stmts
         ; let Just (stmts'', last') = snocView stmts'
@@ -896,9 +896,9 @@ cvtHsDo do_or_lc stmts
 
         ; return $ HsDo do_or_lc (noLoc (stmts'' ++ [last''])) placeHolderType }
   where
-    bad_last stmt = vcat [ ptext (sLit "Illegal last statement of") <+> pprAStmtContext do_or_lc <> colon
+    bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon
                          , nest 2 $ Outputable.ppr stmt
-                         , ptext (sLit "(It should be an expression.)") ]
+                         , text "(It should be an expression.)" ]
 
 cvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt RdrName (LHsExpr RdrName)]
 cvtStmts = mapM cvtStmt
@@ -906,7 +906,7 @@ cvtStmts = mapM cvtStmt
 cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt RdrName (LHsExpr RdrName))
 cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
 cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
-cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (ptext (sLit "a let binding")) ds
+cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (text "a let binding") ds
                             ; returnL $ LetStmt (noLoc ds') }
 cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' noSyntaxExpr noSyntaxExpr }
                        where
@@ -916,7 +916,7 @@ cvtMatch :: TH.Match -> CvtM (Hs.LMatch RdrName (LHsExpr RdrName))
 cvtMatch (TH.Match p body decs)
   = do  { p' <- cvtPat p
         ; g' <- cvtGuard body
-        ; decs' <- cvtLocalDecs (ptext (sLit "a where clause")) decs
+        ; decs' <- cvtLocalDecs (text "a where clause") decs
         ; returnL $ Hs.Match NonFunBindMatch [p'] Nothing
                              (GRHSs g' (noLoc decs')) }
 
@@ -1343,8 +1343,8 @@ isVarName (TH.Name occ _)
 
 badOcc :: OccName.NameSpace -> String -> SDoc
 badOcc ctxt_ns occ
-  = ptext (sLit "Illegal") <+> pprNameSpace ctxt_ns
-        <+> ptext (sLit "name:") <+> quotes (text occ)
+  = text "Illegal" <+> pprNameSpace ctxt_ns
+        <+> text "name:" <+> quotes (text occ)
 
 thRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
 -- This turns a TH Name into a RdrName; used for both binders and occurrences
index 3f502c9..c130f4d 100644 (file)
@@ -445,8 +445,8 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsValBindsLR id
         pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
    where
      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
-     pp_rec Recursive    = ptext (sLit "rec")
-     pp_rec NonRecursive = ptext (sLit "nonrec")
+     pp_rec Recursive    = text "rec"
+     pp_rec NonRecursive = text "nonrec"
 
 pprLHsBinds :: (OutputableBndr idL, OutputableBndr idR) => LHsBindsLR idL idR -> SDoc
 pprLHsBinds binds
@@ -566,15 +566,15 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
   = sdocWithDynFlags $ \ dflags ->
     if gopt Opt_PrintTypecheckerElaboration dflags then
       -- Show extra information (bug number: #10662)
-      hang (ptext (sLit "AbsBinds") <+> brackets (interpp'SP tyvars)
+      hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
                                     <+> brackets (interpp'SP dictvars))
          2 $ braces $ vcat
-      [ ptext (sLit "Exports:") <+>
+      [ text "Exports:" <+>
           brackets (sep (punctuate comma (map ppr exports)))
-      , ptext (sLit "Exported types:") <+>
+      , text "Exported types:" <+>
           vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
-      , ptext (sLit "Binds:") <+> pprLHsBinds val_binds
-      , ptext (sLit "Evidence:") <+> ppr ev_binds ]
+      , text "Binds:" <+> pprLHsBinds val_binds
+      , text "Evidence:" <+> ppr ev_binds ]
     else
       pprLHsBinds val_binds
 ppr_monobind (AbsBindsSig { abs_tvs         = tyvars
@@ -594,7 +594,7 @@ ppr_monobind (AbsBindsSig { abs_tvs         = tyvars
 instance (OutputableBndr id) => Outputable (ABExport id) where
   ppr (ABE { abe_wrap = wrap, abe_inst_wrap = inst_wrap
            , abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
-    = vcat [ ppr gbl <+> ptext (sLit "<=") <+> ppr lcl
+    = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
            , nest 2 (pprTcSpecPrags prags)
            , nest 2 (ppr wrap)
            , nest 2 (ppr inst_wrap)]
@@ -603,7 +603,7 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (PatSynBind idL
   ppr (PSB{ psb_id = L _ psyn, psb_args = details, psb_def = pat, psb_dir = dir })
       = ppr_lhs <+> ppr_rhs
     where
-      ppr_lhs = ptext (sLit "pattern") <+> ppr_details
+      ppr_lhs = text "pattern" <+> ppr_details
       ppr_simple syntax = syntax <+> ppr pat
 
       ppr_details = case details of
@@ -614,9 +614,9 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (PatSynBind idL
                       <> braces (sep (punctuate comma (map ppr vs)))
 
       ppr_rhs = case dir of
-          Unidirectional           -> ppr_simple (ptext (sLit "<-"))
+          Unidirectional           -> ppr_simple (text "<-")
           ImplicitBidirectional    -> ppr_simple equals
-          ExplicitBidirectional mg -> ppr_simple (ptext (sLit "<-")) <+> ptext (sLit "where") $$
+          ExplicitBidirectional mg -> ppr_simple (text "<-") <+> ptext (sLit "where") $$
                                       (nest 2 $ pprFunBind psyn mg)
 
 pprTicks :: SDoc -> SDoc -> SDoc
@@ -888,17 +888,17 @@ isMinimalLSig (L _ (MinimalSig {})) = True
 isMinimalLSig _                    = False
 
 hsSigDoc :: Sig name -> SDoc
-hsSigDoc (TypeSig {})           = ptext (sLit "type signature")
-hsSigDoc (PatSynSig {})         = ptext (sLit "pattern synonym signature")
+hsSigDoc (TypeSig {})           = text "type signature"
+hsSigDoc (PatSynSig {})         = text "pattern synonym signature"
 hsSigDoc (ClassOpSig is_deflt _ _)
- | is_deflt                     = ptext (sLit "default type signature")
- | otherwise                    = ptext (sLit "class method signature")
-hsSigDoc (IdSig {})             = ptext (sLit "id signature")
-hsSigDoc (SpecSig {})           = ptext (sLit "SPECIALISE pragma")
-hsSigDoc (InlineSig _ prag)     = ppr (inlinePragmaSpec prag) <+> ptext (sLit "pragma")
-hsSigDoc (SpecInstSig {})       = ptext (sLit "SPECIALISE instance pragma")
-hsSigDoc (FixSig {})            = ptext (sLit "fixity declaration")
-hsSigDoc (MinimalSig {})        = ptext (sLit "MINIMAL pragma")
+ | is_deflt                     = text "default type signature"
+ | otherwise                    = text "class method signature"
+hsSigDoc (IdSig {})             = text "id signature"
+hsSigDoc (SpecSig {})           = text "SPECIALISE pragma"
+hsSigDoc (InlineSig _ prag)     = ppr (inlinePragmaSpec prag) <+> text "pragma"
+hsSigDoc (SpecInstSig {})       = text "SPECIALISE instance pragma"
+hsSigDoc (FixSig {})            = text "fixity declaration"
+hsSigDoc (MinimalSig {})        = text "MINIMAL pragma"
 
 {-
 Check if signatures overlap; this is used when checking for duplicate
@@ -912,7 +912,7 @@ instance (OutputableBndr name) => Outputable (Sig name) where
 ppr_sig :: OutputableBndr name => Sig name -> SDoc
 ppr_sig (TypeSig vars ty)    = pprVarSig (map unLoc vars) (ppr ty)
 ppr_sig (ClassOpSig is_deflt vars ty)
-  | is_deflt                 = ptext (sLit "default") <+> pprVarSig (map unLoc vars) (ppr ty)
+  | is_deflt                 = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)
   | otherwise                = pprVarSig (map unLoc vars) (ppr ty)
 ppr_sig (IdSig id)           = pprVarSig [id] (ppr (varType id))
 ppr_sig (FixSig fix_sig)     = ppr fix_sig
@@ -920,16 +920,16 @@ ppr_sig (SpecSig var ty inl)
   = pragBrackets (pprSpec (unLoc var) (interpp'SP ty) inl)
 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> pprPrefixOcc (unLoc var))
 ppr_sig (SpecInstSig _ ty)
-  = pragBrackets (ptext (sLit "SPECIALIZE instance") <+> ppr ty)
+  = pragBrackets (text "SPECIALIZE instance" <+> ppr ty)
 ppr_sig (MinimalSig _ bf)         = pragBrackets (pprMinimalSig bf)
 ppr_sig (PatSynSig name sig_ty)
-  = ptext (sLit "pattern") <+> pprPrefixOcc (unLoc name) <+> dcolon
+  = text "pattern" <+> pprPrefixOcc (unLoc name) <+> dcolon
                            <+> ppr sig_ty
 
 pprPatSynSig :: (OutputableBndr name)
              => name -> Bool -> SDoc -> Maybe SDoc -> Maybe SDoc -> SDoc -> SDoc
 pprPatSynSig ident _is_bidir tvs req prov ty
-  = ptext (sLit "pattern") <+> pprPrefixOcc ident <+> dcolon <+>
+  = text "pattern" <+> pprPrefixOcc ident <+> dcolon <+>
     tvs <+> context <+> ty
   where
     context = case (req, prov) of
@@ -944,7 +944,7 @@ instance OutputableBndr name => Outputable (FixitySig name) where
       pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
 
 pragBrackets :: SDoc -> SDoc
-pragBrackets doc = ptext (sLit "{-#") <+> doc <+> ptext (sLit "#-}")
+pragBrackets doc = text "{-#" <+> doc <+> ptext (sLit "#-}")
 
 pprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc
 pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]
@@ -952,20 +952,20 @@ pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]
     pprvars = hsep $ punctuate comma (map pprPrefixOcc vars)
 
 pprSpec :: (OutputableBndr id) => id -> SDoc -> InlinePragma -> SDoc
-pprSpec var pp_ty inl = ptext (sLit "SPECIALIZE") <+> pp_inl <+> pprVarSig [var] pp_ty
+pprSpec var pp_ty inl = text "SPECIALIZE" <+> pp_inl <+> pprVarSig [var] pp_ty
   where
     pp_inl | isDefaultInlinePragma inl = empty
            | otherwise = ppr inl
 
 pprTcSpecPrags :: TcSpecPrags -> SDoc
-pprTcSpecPrags IsDefaultMethod = ptext (sLit "<default method>")
+pprTcSpecPrags IsDefaultMethod = text "<default method>"
 pprTcSpecPrags (SpecPrags ps)  = vcat (map (ppr . unLoc) ps)
 
 instance Outputable TcSpecPrag where
-  ppr (SpecPrag var _ inl) = pprSpec var (ptext (sLit "<type>")) inl
+  ppr (SpecPrag var _ inl) = pprSpec var (text "<type>") inl
 
 pprMinimalSig :: OutputableBndr name => LBooleanFormula (Located name) -> SDoc
-pprMinimalSig (L _ bf) = ptext (sLit "MINIMAL") <+> ppr (fmap unLoc bf)
+pprMinimalSig (L _ bf) = text "MINIMAL" <+> ppr (fmap unLoc bf)
 
 {-
 ************************************************************************
index a1f24b4..75544ab 100644 (file)
@@ -104,7 +104,6 @@ import Class
 import Outputable
 import Util
 import SrcLoc
-import FastString
 
 import Bag
 import Data.Maybe ( fromMaybe )
@@ -652,7 +651,7 @@ instance OutputableBndr name
 
     ppr (FamDecl { tcdFam = decl }) = ppr decl
     ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdRhs = rhs })
-      = hang (ptext (sLit "type") <+>
+      = hang (text "type" <+>
               pp_vanilla_decl_head ltycon tyvars [] <+> equals)
           4 (ppr rhs)
 
@@ -667,12 +666,12 @@ instance OutputableBndr name
       = top_matter
 
       | otherwise       -- Laid out
-      = vcat [ top_matter <+> ptext (sLit "where")
+      = vcat [ top_matter <+> text "where"
              , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
                                      map ppr_fam_deflt_eqn at_defs ++
                                      pprLHsBindsForUser methods sigs) ]
       where
-        top_matter = ptext (sLit "class")
+        top_matter = text "class"
                      <+> pp_vanilla_decl_head lclas tyvars (unLoc context)
                      <+> pprFundeps (map unLoc fds)
 
@@ -690,8 +689,8 @@ pp_vanilla_decl_head thing tyvars context
  = hsep [pprHsContext context, pprPrefixOcc (unLoc thing), ppr tyvars]
 
 pprTyClDeclFlavour :: TyClDecl a -> SDoc
-pprTyClDeclFlavour (ClassDecl {})   = ptext (sLit "class")
-pprTyClDeclFlavour (SynDecl {})     = ptext (sLit "type")
+pprTyClDeclFlavour (ClassDecl {})   = text "class"
+pprTyClDeclFlavour (SynDecl {})     = text "type"
 pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
   = pprFlavour info <+> text "family"
 pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
@@ -909,16 +908,16 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
                Nothing -> empty
     (pp_where, pp_eqns) = case info of
       ClosedTypeFamily mb_eqns ->
-        ( ptext (sLit "where")
+        ( text "where"
         , case mb_eqns of
-            Nothing   -> ptext (sLit "..")
+            Nothing   -> text ".."
             Just eqns -> vcat $ map ppr_fam_inst_eqn eqns )
       _ -> (empty, empty)
 
 pprFlavour :: FamilyInfo name -> SDoc
-pprFlavour DataFamily            = ptext (sLit "data")
-pprFlavour OpenTypeFamily        = ptext (sLit "type")
-pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type")
+pprFlavour DataFamily            = text "data"
+pprFlavour OpenTypeFamily        = text "type"
+pprFlavour (ClosedTypeFamily {}) = text "type"
 
 instance Outputable (FamilyInfo name) where
   ppr info = pprFlavour info <+> text "family"
@@ -1100,21 +1099,21 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
                Just kind -> dcolon <+> ppr kind
     pp_derivings = case derivings of
                      Nothing -> empty
-                     Just (L _ ds) -> hsep [ ptext (sLit "deriving")
+                     Just (L _ ds) -> hsep [ text "deriving"
                                            , parens (interpp'SP ds)]
 
 instance OutputableBndr name => Outputable (HsDataDefn name) where
-   ppr d = pp_data_defn (\_ -> ptext (sLit "Naked HsDataDefn")) d
+   ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
 
 instance Outputable NewOrData where
-  ppr NewType  = ptext (sLit "newtype")
-  ppr DataType = ptext (sLit "data")
+  ppr NewType  = text "newtype"
+  ppr DataType = text "data"
 
 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
 pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
-  = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
+  = hang (text "where") 2 (vcat (map ppr cs))
 pp_condecls cs                    -- In H98 syntax
-  = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
+  = equals <+> sep (punctuate (text " |") (map ppr cs))
 
 instance (OutputableBndr name) => Outputable (ConDecl name) where
     ppr = pprConDecl
@@ -1311,10 +1310,10 @@ instance (OutputableBndr name) => Outputable (TyFamInstDecl name) where
 
 pprTyFamInstDecl :: OutputableBndr name => TopLevelFlag -> TyFamInstDecl name -> SDoc
 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
-   = ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
+   = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
 
 ppr_instance_keyword :: TopLevelFlag -> SDoc
-ppr_instance_keyword TopLevel    = ptext (sLit "instance")
+ppr_instance_keyword TopLevel    = text "instance"
 ppr_instance_keyword NotTopLevel = empty
 
 ppr_fam_inst_eqn :: OutputableBndr name => LTyFamInstEqn name -> SDoc
@@ -1362,24 +1361,24 @@ instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
       = top_matter
 
       | otherwise       -- Laid out
-      = vcat [ top_matter <+> ptext (sLit "where")
+      = vcat [ top_matter <+> text "where"
              , nest 2 $ pprDeclList $
                map (pprTyFamInstDecl NotTopLevel . unLoc)   ats ++
                map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
                pprLHsBindsForUser binds sigs ]
       where
-        top_matter = ptext (sLit "instance") <+> ppOverlapPragma mbOverlap
+        top_matter = text "instance" <+> ppOverlapPragma mbOverlap
                                              <+> ppr inst_ty
 
 ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc
 ppOverlapPragma mb =
   case mb of
     Nothing           -> empty
-    Just (L _ (NoOverlap _))    -> ptext (sLit "{-# NO_OVERLAP #-}")
-    Just (L _ (Overlappable _)) -> ptext (sLit "{-# OVERLAPPABLE #-}")
-    Just (L _ (Overlapping _))  -> ptext (sLit "{-# OVERLAPPING #-}")
-    Just (L _ (Overlaps _))     -> ptext (sLit "{-# OVERLAPS #-}")
-    Just (L _ (Incoherent _))   -> ptext (sLit "{-# INCOHERENT #-}")
+    Just (L _ (NoOverlap _))    -> text "{-# NO_OVERLAP #-}"
+    Just (L _ (Overlappable _)) -> text "{-# OVERLAPPABLE #-}"
+    Just (L _ (Overlapping _))  -> text "{-# OVERLAPPING #-}"
+    Just (L _ (Overlaps _))     -> text "{-# OVERLAPS #-}"
+    Just (L _ (Incoherent _))   -> text "{-# INCOHERENT #-}"
 
 
 instance (OutputableBndr name) => Outputable (InstDecl name) where
@@ -1423,7 +1422,7 @@ deriving instance (DataId name) => Data (DerivDecl name)
 
 instance (OutputableBndr name) => Outputable (DerivDecl name) where
     ppr (DerivDecl ty o)
-        = hsep [ptext (sLit "deriving instance"), ppOverlapPragma o, ppr ty]
+        = hsep [text "deriving instance", ppOverlapPragma o, ppr ty]
 
 {-
 ************************************************************************
@@ -1452,7 +1451,7 @@ instance (OutputableBndr name)
               => Outputable (DefaultDecl name) where
 
     ppr (DefaultDecl tys)
-      = ptext (sLit "default") <+> parens (interpp'SP tys)
+      = text "default" <+> parens (interpp'SP tys)
 
 {-
 ************************************************************************
@@ -1553,10 +1552,10 @@ data ForeignExport = CExport  (Located CExportSpec) -- contains the calling
 
 instance OutputableBndr name => Outputable (ForeignDecl name) where
   ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
-    = hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
+    = hang (text "foreign import" <+> ppr fimport <+> ppr n)
          2 (dcolon <+> ppr ty)
   ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =
-    hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
+    hang (text "foreign export" <+> ppr fexport <+> ppr n)
        2 (dcolon <+> ppr ty)
 
 instance Outputable ForeignImport where
@@ -1569,15 +1568,15 @@ instance Outputable ForeignImport where
                Just (Header _ header) -> ftext header
 
       pprCEntity (CLabel lbl) =
-        ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
+        text "static" <+> pp_hdr <+> char '&' <> ppr lbl
       pprCEntity (CFunction (StaticTarget _ lbl _ isFun)) =
-            ptext (sLit "static")
+            text "static"
         <+> pp_hdr
-        <+> (if isFun then empty else ptext (sLit "value"))
+        <+> (if isFun then empty else text "value")
         <+> ppr lbl
       pprCEntity (CFunction (DynamicTarget)) =
-        ptext (sLit "dynamic")
-      pprCEntity (CWrapper) = ptext (sLit "wrapper")
+        text "dynamic"
+      pprCEntity (CWrapper) = text "wrapper"
 
 instance Outputable ForeignExport where
   ppr (CExport  (L _ (CExportStatic _ lbl cconv)) _) =
@@ -1874,11 +1873,11 @@ annProvenanceName_maybe (TypeAnnProvenance (L _ name))  = Just name
 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
 
 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
-pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
+pprAnnProvenance ModuleAnnProvenance       = text "ANN module"
 pprAnnProvenance (ValueAnnProvenance (L _ name))
-  = ptext (sLit "ANN") <+> ppr name
+  = text "ANN" <+> ppr name
 pprAnnProvenance (TypeAnnProvenance (L _ name))
-  = ptext (sLit "ANN type") <+> ppr name
+  = text "ANN type" <+> ppr name
 
 {-
 ************************************************************************
@@ -1903,7 +1902,7 @@ data RoleAnnotDecl name
 
 instance OutputableBndr name => Outputable (RoleAnnotDecl name) where
   ppr (RoleAnnotDecl ltycon roles)
-    = ptext (sLit "type role") <+> ppr ltycon <+>
+    = text "type role" <+> ppr ltycon <+>
       hsep (map (pp_role . unLoc) roles)
     where
       pp_role Nothing  = underscore
index 6b395a3..62b6a68 100644 (file)
@@ -647,7 +647,7 @@ ppr_expr (HsOverLit lit)  = ppr lit
 ppr_expr (HsPar e)        = parens (ppr_lexpr e)
 
 ppr_expr (HsCoreAnn _ (StringLiteral _ s) e)
-  = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
+  = vcat [text "HsCoreAnn" <+> ftext s, ppr_lexpr e]
 
 ppr_expr (HsApp e1 e2)
   = let (fun, args) = collect_args e1 [e2] in
@@ -681,7 +681,7 @@ ppr_expr (SectionL expr op)
     pp_expr = pprDebugParendExpr expr
 
     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
-                       4 (hsep [pp_expr, ptext (sLit "x_ )")])
+                       4 (hsep [pp_expr, text "x_ )"])
     pp_infixly v = (sep [pp_expr, pprInfixOcc v])
 
 ppr_expr (SectionR op expr)
@@ -691,7 +691,7 @@ ppr_expr (SectionR op expr)
   where
     pp_expr = pprDebugParendExpr expr
 
-    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
+    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
                        4 (pp_expr <> rparen)
     pp_infixly v = sep [pprInfixOcc v, pp_expr]
 
@@ -710,33 +710,33 @@ ppr_expr (HsLam matches)
   = pprMatches (LambdaExpr :: HsMatchContext id) matches
 
 ppr_expr (HsLamCase _ matches)
-  = sep [ sep [ptext (sLit "\\case {")],
+  = sep [ sep [text "\\case {"],
           nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
 
 ppr_expr (HsCase expr matches)
-  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
           nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
 
 ppr_expr (HsIf _ e1 e2 e3)
-  = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
+  = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],
          nest 4 (ppr e2),
-         ptext (sLit "else"),
+         text "else",
          nest 4 (ppr e3)]
 
 ppr_expr (HsMultiIf _ alts)
-  = sep $ ptext (sLit "if") : map ppr_alt alts
+  = sep $ text "if" : map ppr_alt alts
   where ppr_alt (L _ (GRHS guards expr)) =
           sep [ vbar <+> interpp'SP guards
-              , ptext (sLit "->") <+> pprDeeper (ppr expr) ]
+              , text "->" <+> pprDeeper (ppr expr) ]
 
 -- special case: let ... in let ...
 ppr_expr (HsLet (L _ binds) expr@(L _ (HsLet _ _)))
-  = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
+  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
          ppr_lexpr expr]
 
 ppr_expr (HsLet (L _ binds) expr)
-  = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
-         hang (ptext (sLit "in"))  2 (ppr expr)]
+  = sep [hang (text "let") 2 (pprBinds binds),
+         hang (text "in")  2 (ppr expr)]
 
 ppr_expr (HsDo do_or_list_comp (L _ stmts) _) = pprDo do_or_list_comp stmts
 
@@ -765,10 +765,10 @@ ppr_expr (PArrSeq  _ info) = paBrackets (ppr info)
 ppr_expr EWildPat       = char '_'
 ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
 ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
-ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
+ppr_expr (EViewPat p e) = ppr p <+> text "->" <+> ppr e
 
 ppr_expr (HsSCC _ (StringLiteral _ lbl) expr)
-  = sep [ ptext (sLit "{-# SCC") <+> doubleQuotes (ftext lbl) <+> ptext (sLit "#-}"),
+  = sep [ text "{-# SCC" <+> doubleQuotes (ftext lbl) <+> ptext (sLit "#-}"),
           pprParendExpr expr ]
 
 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
@@ -780,34 +780,34 @@ ppr_expr (HsTypeOut (HsWC { hswc_body = ty }))
 ppr_expr (HsSpliceE s)         = pprSplice s
 ppr_expr (HsBracket b)         = pprHsBracket b
 ppr_expr (HsRnBracketOut e []) = ppr e
-ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps
+ppr_expr (HsRnBracketOut e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
 ppr_expr (HsTcBracketOut e []) = ppr e
-ppr_expr (HsTcBracketOut e ps) = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps
+ppr_expr (HsTcBracketOut e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
 
 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
-  = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
+  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
 
 ppr_expr (HsStatic e)
-  = hsep [ptext (sLit "static"), pprParendExpr e]
+  = hsep [text "static", pprParendExpr e]
 
 ppr_expr (HsTick tickish exp)
   = pprTicks (ppr exp) $
     ppr tickish <+> ppr_lexpr exp
 ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
   = pprTicks (ppr exp) $
-    hcat [ptext (sLit "bintick<"),
+    hcat [text "bintick<",
           ppr tickIdTrue,
-          ptext (sLit ","),
+          text ",",
           ppr tickIdFalse,
-          ptext (sLit ">("),
-          ppr exp,ptext (sLit ")")]
+          text ">(",
+          ppr exp, text ")"]
 ppr_expr (HsTickPragma _ externalSrcLoc _ exp)
   = pprTicks (ppr exp) $
-    hcat [ptext (sLit "tickpragma<"),
+    hcat [text "tickpragma<",
           pprExternalSrcLoc externalSrcLoc,
-          ptext (sLit ">("),
+          text ">(",
           ppr exp,
-          ptext (sLit ")")]
+          text ")"]
 
 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
   = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
@@ -821,8 +821,8 @@ ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
 ppr_expr (HsArrForm (L _ (HsVar (L _ v))) (Just _) [arg1, arg2])
   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
 ppr_expr (HsArrForm op _ args)
-  = hang (ptext (sLit "(|") <+> ppr_lexpr op)
-         4 (sep (map (pprCmdArg.unLoc) args) <+> ptext (sLit "|)"))
+  = hang (text "(|" <+> ppr_lexpr op)
+         4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
 ppr_expr (HsRecFld f) = ppr f
 
 pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
@@ -1051,23 +1051,23 @@ ppr_cmd (HsCmdLam matches)
   = pprMatches (LambdaExpr :: HsMatchContext id) matches
 
 ppr_cmd (HsCmdCase expr matches)
-  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
           nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
 
 ppr_cmd (HsCmdIf _ e ct ce)
-  = sep [hsep [ptext (sLit "if"), nest 2 (ppr e), ptext (sLit "then")],
+  = sep [hsep [text "if", nest 2 (ppr e), ptext (sLit "then")],
          nest 4 (ppr ct),
-         ptext (sLit "else"),
+         text "else",
          nest 4 (ppr ce)]
 
 -- special case: let ... in let ...
 ppr_cmd (HsCmdLet (L _ binds) cmd@(L _ (HsCmdLet _ _)))
-  = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
+  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
          ppr_lcmd cmd]
 
 ppr_cmd (HsCmdLet (L _ binds) cmd)
-  = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
-         hang (ptext (sLit "in"))  2 (ppr cmd)]
+  = sep [hang (text "let") 2 (pprBinds binds),
+         hang (text "in")  2 (ppr cmd)]
 
 ppr_cmd (HsCmdDo (L _ stmts) _)  = pprDo ArrowExpr stmts
 
@@ -1085,8 +1085,8 @@ ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp False)
 ppr_cmd (HsCmdArrForm (L _ (HsVar (L _ v))) (Just _) [arg1, arg2])
   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
 ppr_cmd (HsCmdArrForm op _ args)
-  = hang (ptext (sLit "(|") <> ppr_lexpr op)
-         4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
+  = hang (text "(|" <> ppr_lexpr op)
+         4 (sep (map (pprCmdArg.unLoc) args) <> text "|)")
 
 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
 pprCmdArg (HsCmdTop cmd@(L _ (HsCmdArrForm _ Nothing [])) _ _ _)
@@ -1635,23 +1635,23 @@ instance (OutputableBndr idL, OutputableBndr idR, Outputable body)
 pprStmt :: forall idL idR body . (OutputableBndr idL, OutputableBndr idR, Outputable body)
         => (StmtLR idL idR body) -> SDoc
 pprStmt (LastStmt expr ret_stripped _)
-  = ifPprDebug (ptext (sLit "[last]")) <+>
-       (if ret_stripped then ptext (sLit "return") else empty) <+>
+  = ifPprDebug (text "[last]") <+>
+       (if ret_stripped then text "return" else empty) <+>
        ppr expr
 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, larrow, ppr expr]
-pprStmt (LetStmt (L _ binds))     = hsep [ptext (sLit "let"), pprBinds binds]
+pprStmt (LetStmt (L _ binds))     = hsep [text "let", pprBinds binds]
 pprStmt (BodyStmt expr _ _ _)     = ppr expr
-pprStmt (ParStmt stmtss _ _)      = sep (punctuate (ptext (sLit " | ")) (map ppr stmtss))
+pprStmt (ParStmt stmtss _ _)      = sep (punctuate (text " | ") (map ppr stmtss))
 
 pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form })
   = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])
 
 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
                  , recS_later_ids = later_ids })
-  = ptext (sLit "rec") <+>
+  = text "rec" <+>
     vcat [ ppr_do_stmts segment
-         , ifPprDebug (vcat [ ptext (sLit "rec_ids=") <> ppr rec_ids
-                            , ptext (sLit "later_ids=") <> ppr later_ids])]
+         , ifPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids
+                            , text "later_ids=" <> ppr later_ids])]
 
 pprStmt (ApplicativeStmt args mb_join _)
   = getPprStyle $ \style ->
@@ -1678,43 +1678,43 @@ pprStmt (ApplicativeStmt args mb_join _)
 
    pp_debug =
      let
-         ap_expr = sep (punctuate (ptext (sLit " |")) (map pp_arg args))
+         ap_expr = sep (punctuate (text " |") (map pp_arg args))
      in
        if isNothing mb_join
           then ap_expr
-          else ptext (sLit "join") <+> parens ap_expr
+          else text "join" <+> parens ap_expr
 
    pp_arg (_, ApplicativeArgOne pat expr) =
      ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt idL)
    pp_arg (_, ApplicativeArgMany stmts return pat) =
      ppr pat <+>
-     ptext (sLit "<-") <+>
+     text "<-" <+>
      ppr (HsDo DoExpr (noLoc
                 (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))
            (error "pprStmt"))
 
 pprTransformStmt :: OutputableBndr id => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc
 pprTransformStmt bndrs using by
-  = sep [ ptext (sLit "then") <+> ifPprDebug (braces (ppr bndrs))
+  = sep [ text "then" <+> ifPprDebug (braces (ppr bndrs))
         , nest 2 (ppr using)
         , nest 2 (pprBy by)]
 
 pprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc
 pprTransStmt by using ThenForm
-  = sep [ ptext (sLit "then"), nest 2 (ppr using), nest 2 (pprBy by)]
+  = sep [ text "then", nest 2 (ppr using), nest 2 (pprBy by)]
 pprTransStmt by using GroupForm
-  = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
+  = sep [ text "then group", nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
 
 pprBy :: Outputable body => Maybe body -> SDoc
 pprBy Nothing  = empty
-pprBy (Just e) = ptext (sLit "by") <+> ppr e
+pprBy (Just e) = text "by" <+> ppr e
 
 pprDo :: (OutputableBndr id, Outputable body)
       => HsStmtContext any -> [LStmt id body] -> SDoc
-pprDo DoExpr        stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
-pprDo GhciStmtCtxt  stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
-pprDo ArrowExpr     stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
-pprDo MDoExpr       stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts
+pprDo DoExpr        stmts = text "do"  <+> ppr_do_stmts stmts
+pprDo GhciStmtCtxt  stmts = text "do"  <+> ppr_do_stmts stmts
+pprDo ArrowExpr     stmts = text "do"  <+> ppr_do_stmts stmts
+pprDo MDoExpr       stmts = text "mdo" <+> ppr_do_stmts stmts
 pprDo ListComp      stmts = brackets    $ pprComp stmts
 pprDo PArrComp      stmts = paBrackets  $ pprComp stmts
 pprDo MonadComp     stmts = brackets    $ pprComp stmts
@@ -1862,14 +1862,14 @@ pprPendingSplice :: OutputableBndr id => SplicePointName -> LHsExpr id -> SDoc
 pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
 
 pprSplice :: OutputableBndr id => HsSplice id -> SDoc
-pprSplice (HsTypedSplice   n e)  = ppr_splice (ptext (sLit "$$")) n e
-pprSplice (HsUntypedSplice n e)  = ppr_splice (ptext (sLit "$"))  n e
+pprSplice (HsTypedSplice   n e)  = ppr_splice (text "$$") n e
+pprSplice (HsUntypedSplice n e)  = ppr_splice (text "$")  n e
 pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s
 
 ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc
 ppr_quasi n quoter quote = ifPprDebug (brackets (ppr n)) <>
                            char '[' <> ppr quoter <> vbar <>
-                           ppr quote <> ptext (sLit "|]")
+                           ppr quote <> text "|]"
 
 ppr_splice :: OutputableBndr id => SDoc -> id -> LHsExpr id -> SDoc
 ppr_splice herald n e
@@ -1910,15 +1910,15 @@ pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
 pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
 pprHsBracket (TypBr t)   = thBrackets (char 't') (ppr t)
 pprHsBracket (VarBr True n)  = char '\''         <> ppr n
-pprHsBracket (VarBr False n) = ptext (sLit "''") <> ppr n
+pprHsBracket (VarBr False n) = text "''" <> ppr n
 pprHsBracket (TExpBr e)  = thTyBrackets (ppr e)
 
 thBrackets :: SDoc -> SDoc -> SDoc
 thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>
-                             pp_body <+> ptext (sLit "|]")
+                             pp_body <+> text "|]"
 
 thTyBrackets :: SDoc -> SDoc
-thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
+thTyBrackets pp_body = text "[||" <+> pp_body <+> ptext (sLit "||]")
 
 instance Outputable PendingRnSplice where
   ppr (PendingRnSplice _ n e) = pprPendingSplice n e
@@ -1954,7 +1954,7 @@ instance OutputableBndr id => Outputable (ArithSeqInfo id) where
       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
 
 pp_dotdot :: SDoc
-pp_dotdot = ptext (sLit " .. ")
+pp_dotdot = text " .. "
 
 {-
 ************************************************************************
@@ -2015,13 +2015,13 @@ isMonadCompExpr (TransStmtCtxt ctxt) = isMonadCompExpr ctxt
 isMonadCompExpr _                    = False
 
 matchSeparator :: HsMatchContext id -> SDoc
-matchSeparator (FunRhs {})  = ptext (sLit "=")
-matchSeparator CaseAlt      = ptext (sLit "->")
-matchSeparator IfAlt        = ptext (sLit "->")
-matchSeparator LambdaExpr   = ptext (sLit "->")
-matchSeparator ProcExpr     = ptext (sLit "->")
-matchSeparator PatBindRhs   = ptext (sLit "=")
-matchSeparator (StmtCtxt _) = ptext (sLit "<-")
+matchSeparator (FunRhs {})  = text "="
+matchSeparator CaseAlt      = text "->"
+matchSeparator IfAlt        = text "->"
+matchSeparator LambdaExpr   = text "->"
+matchSeparator ProcExpr     = text "->"
+matchSeparator PatBindRhs   = text "="
+matchSeparator (StmtCtxt _) = text "<-"
 matchSeparator RecUpd       = panic "unused"
 matchSeparator ThPatSplice  = panic "unused"
 matchSeparator ThPatQuote   = panic "unused"
@@ -2029,34 +2029,34 @@ matchSeparator PatSyn       = panic "unused"
 
 pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
 pprMatchContext ctxt
-  | want_an ctxt = ptext (sLit "an") <+> pprMatchContextNoun ctxt
-  | otherwise    = ptext (sLit "a")  <+> pprMatchContextNoun ctxt
+  | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt
+  | otherwise    = text "a"  <+> pprMatchContextNoun ctxt
   where
     want_an (FunRhs {}) = True  -- Use "an" in front
     want_an ProcExpr    = True
     want_an _           = False
 
 pprMatchContextNoun :: Outputable id => HsMatchContext id -> SDoc
-pprMatchContextNoun (FunRhs fun)    = ptext (sLit "equation for")
+pprMatchContextNoun (FunRhs fun)    = text "equation for"
                                       <+> quotes (ppr fun)
-pprMatchContextNoun CaseAlt         = ptext (sLit "case alternative")
-pprMatchContextNoun IfAlt           = ptext (sLit "multi-way if alternative")
-pprMatchContextNoun RecUpd          = ptext (sLit "record-update construct")
-pprMatchContextNoun ThPatSplice     = ptext (sLit "Template Haskell pattern splice")
-pprMatchContextNoun ThPatQuote      = ptext (sLit "Template Haskell pattern quotation")
-pprMatchContextNoun PatBindRhs      = ptext (sLit "pattern binding")
-pprMatchContextNoun LambdaExpr      = ptext (sLit "lambda abstraction")
-pprMatchContextNoun ProcExpr        = ptext (sLit "arrow abstraction")
-pprMatchContextNoun (StmtCtxt ctxt) = ptext (sLit "pattern binding in")
+pprMatchContextNoun CaseAlt         = text "case alternative"
+pprMatchContextNoun IfAlt           = text "multi-way if alternative"
+pprMatchContextNoun RecUpd          = text "record-update construct"
+pprMatchContextNoun ThPatSplice     = text "Template Haskell pattern splice"
+pprMatchContextNoun ThPatQuote      = text "Template Haskell pattern quotation"
+pprMatchContextNoun PatBindRhs      = text "pattern binding"
+pprMatchContextNoun LambdaExpr      = text "lambda abstraction"
+pprMatchContextNoun ProcExpr        = text "arrow abstraction"
+pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in"
                                       $$ pprStmtContext ctxt
-pprMatchContextNoun PatSyn          = ptext (sLit "pattern synonym declaration")
+pprMatchContextNoun PatSyn          = text "pattern synonym declaration"
 
 -----------------
 pprAStmtContext, pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
 pprAStmtContext ctxt = article <+> pprStmtContext ctxt
   where
-    pp_an = ptext (sLit "an")
-    pp_a  = ptext (sLit "a")
+    pp_an = text "an"
+    pp_a  = text "a"
     article = case ctxt of
                   MDoExpr       -> pp_an
                   PArrComp      -> pp_an
@@ -2065,14 +2065,14 @@ pprAStmtContext ctxt = article <+> pprStmtContext ctxt
 
 
 -----------------
-pprStmtContext GhciStmtCtxt    = ptext (sLit "interactive GHCi command")
-pprStmtContext DoExpr          = ptext (sLit "'do' block")
-pprStmtContext MDoExpr         = ptext (sLit "'mdo' block")
-pprStmtContext ArrowExpr       = ptext (sLit "'do' block in an arrow command")
-pprStmtContext ListComp        = ptext (sLit "list comprehension")
-pprStmtContext MonadComp       = ptext (sLit "monad comprehension")
-pprStmtContext PArrComp        = ptext (sLit "array comprehension")
-pprStmtContext (PatGuard ctxt) = ptext (sLit "pattern guard for") $$ pprMatchContext ctxt
+pprStmtContext GhciStmtCtxt    = text "interactive GHCi command"
+pprStmtContext DoExpr          = text "'do' block"
+pprStmtContext MDoExpr         = text "'mdo' block"
+pprStmtContext ArrowExpr       = text "'do' block in an arrow command"
+pprStmtContext ListComp        = text "list comprehension"
+pprStmtContext MonadComp       = text "monad comprehension"
+pprStmtContext PArrComp        = text "array comprehension"
+pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt
 
 -- Drop the inner contexts when reporting errors, else we get
 --     Unexpected transform statement
@@ -2080,49 +2080,49 @@ pprStmtContext (PatGuard ctxt) = ptext (sLit "pattern guard for") $$ pprMatchCon
 --          transformed branch of
 --          transformed branch of monad comprehension
 pprStmtContext (ParStmtCtxt c)
- | opt_PprStyle_Debug = sep [ptext (sLit "parallel branch of"), pprAStmtContext c]
+ | opt_PprStyle_Debug = sep [text "parallel branch of", pprAStmtContext c]
  | otherwise          = pprStmtContext c
 pprStmtContext (TransStmtCtxt c)
- | opt_PprStyle_Debug = sep [ptext (sLit "transformed branch of"), pprAStmtContext c]
+ | opt_PprStyle_Debug = sep [text "transformed branch of", pprAStmtContext c]
  | otherwise          = pprStmtContext c
 
 
 -- Used to generate the string for a *runtime* error message
 matchContextErrString :: Outputable id => HsMatchContext id -> SDoc
-matchContextErrString (FunRhs fun)         = ptext (sLit "function") <+> ppr fun
-matchContextErrString CaseAlt              = ptext (sLit "case")
-matchContextErrString IfAlt                = ptext (sLit "multi-way if")
-matchContextErrString PatBindRhs           = ptext (sLit "pattern binding")
-matchContextErrString RecUpd               = ptext (sLit "record update")
-matchContextErrString LambdaExpr           = ptext (sLit "lambda")
-matchContextErrString ProcExpr             = ptext (sLit "proc")
+matchContextErrString (FunRhs fun)         = text "function" <+> ppr fun
+matchContextErrString CaseAlt              = text "case"
+matchContextErrString IfAlt                = text "multi-way if"
+matchContextErrString PatBindRhs           = text "pattern binding"
+matchContextErrString RecUpd               = text "record update"
+matchContextErrString LambdaExpr           = text "lambda"
+matchContextErrString ProcExpr             = text "proc"
 matchContextErrString ThPatSplice                = panic "matchContextErrString"  -- Not used at runtime
 matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime
 matchContextErrString PatSyn                     = panic "matchContextErrString"  -- Not used at runtime
 matchContextErrString (StmtCtxt (ParStmtCtxt c))   = matchContextErrString (StmtCtxt c)
 matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)
-matchContextErrString (StmtCtxt (PatGuard _))      = ptext (sLit "pattern guard")
-matchContextErrString (StmtCtxt GhciStmtCtxt)      = ptext (sLit "interactive GHCi command")
-matchContextErrString (StmtCtxt DoExpr)            = ptext (sLit "'do' block")
-matchContextErrString (StmtCtxt ArrowExpr)         = ptext (sLit "'do' block")
-matchContextErrString (StmtCtxt MDoExpr)           = ptext (sLit "'mdo' block")
-matchContextErrString (StmtCtxt ListComp)          = ptext (sLit "list comprehension")
-matchContextErrString (StmtCtxt MonadComp)         = ptext (sLit "monad comprehension")
-matchContextErrString (StmtCtxt PArrComp)          = ptext (sLit "array comprehension")
+matchContextErrString (StmtCtxt (PatGuard _))      = text "pattern guard"
+matchContextErrString (StmtCtxt GhciStmtCtxt)      = text "interactive GHCi command"
+matchContextErrString (StmtCtxt DoExpr)            = text "'do' block"
+matchContextErrString (StmtCtxt ArrowExpr)         = text "'do' block"
+matchContextErrString (StmtCtxt MDoExpr)           = text "'mdo' block"
+matchContextErrString (StmtCtxt ListComp)          = text "list comprehension"
+matchContextErrString (StmtCtxt MonadComp)         = text "monad comprehension"
+matchContextErrString (StmtCtxt PArrComp)          = text "array comprehension"
 
 pprMatchInCtxt :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
                => HsMatchContext idL -> Match idR body -> SDoc
-pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> colon)
+pprMatchInCtxt ctxt match  = hang (text "In" <+> pprMatchContext ctxt <> colon)
                              4 (pprMatch ctxt match)
 
 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
                => HsStmtContext idL -> StmtLR idL idR body -> SDoc
 pprStmtInCtxt ctxt (LastStmt e _ _)
   | isListCompExpr ctxt      -- For [ e | .. ], do not mutter about "stmts"
-  = hang (ptext (sLit "In the expression:")) 2 (ppr e)
+  = hang (text "In the expression:") 2 (ppr e)
 
 pprStmtInCtxt ctxt stmt
-  = hang (ptext (sLit "In a stmt of") <+> pprAStmtContext ctxt <> colon)
+  = hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon)
        2 (ppr_stmt stmt)
   where
     -- For Group and Transform Stmts, don't print the nested stmts!
index b854b98..493a92b 100644 (file)
@@ -90,7 +90,7 @@ instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name)
                     , ideclSource = from, ideclSafe = safe
                     , ideclQualified = qual, ideclImplicit = implicit
                     , ideclAs = as, ideclHiding = spec })
-      = hang (hsep [ptext (sLit "import"), ppr_imp from, pp_implicit implicit, pp_safe safe,
+      = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
                     pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
              4 (pp_spec spec)
       where
@@ -101,22 +101,22 @@ instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name)
         pp_pkg (Just (StringLiteral _ p)) = doubleQuotes (ftext p)
 
         pp_qual False   = empty
-        pp_qual True    = ptext (sLit "qualified")
+        pp_qual True    = text "qualified"
 
         pp_safe False   = empty
-        pp_safe True    = ptext (sLit "safe")
+        pp_safe True    = text "safe"
 
         pp_as Nothing   = empty
-        pp_as (Just a)  = ptext (sLit "as") <+> ppr a
+        pp_as (Just a)  = text "as" <+> ppr a
 
-        ppr_imp True  = ptext (sLit "{-# SOURCE #-}")
+        ppr_imp True  = text "{-# SOURCE #-}"
         ppr_imp False = empty
 
         pp_spec Nothing             = empty
         pp_spec (Just (False, (L _ ies))) = ppr_ies ies
-        pp_spec (Just (True, (L _ ies))) = ptext (sLit "hiding") <+> ppr_ies ies
+        pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies
 
-        ppr_ies []  = ptext (sLit "()")
+        ppr_ies []  = text "()"
         ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
 
 {-
@@ -219,7 +219,7 @@ pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
 pprImpExp name = type_pref <+> pprPrefixOcc name
     where
     occ = occName name
-    type_pref | isTcOcc occ && isSymOcc occ = ptext (sLit "type")
+    type_pref | isTcOcc occ && isSymOcc occ = text "type"
               | otherwise                   = empty
 
 instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
@@ -239,7 +239,7 @@ instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
                 let (bs, as) = splitAt pos (map (pprImpExp . unLoc) withs)
                 in bs ++ [text ".."] ++ as
     ppr (IEModuleContents mod')
-        = ptext (sLit "module") <+> ppr mod'
+        = text "module" <+> ppr mod'
     ppr (IEGroup n _)           = text ("<IEGroup: " ++ show n ++ ">")
     ppr (IEDoc doc)             = ppr doc
     ppr (IEDocNamed string)     = text ("<IEDocNamed: " ++ string ++ ">")
index ff1ce1e..9bb91d2 100644 (file)
@@ -56,7 +56,6 @@ import TyCon
 import Outputable
 import Type
 import SrcLoc
-import FastString
 import Bag -- collect ev vars from pats
 import Maybes
 -- libraries:
@@ -431,7 +430,7 @@ instance (Outputable arg)
   ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
         = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
         where
-          dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
+          dotdot = text ".." <+> ifPprDebug (ppr (drop n flds))
 
 instance (Outputable id, Outputable arg)
       => Outputable (HsRecField' id arg) where
index 72525b2..c226dfe 100644 (file)
@@ -50,7 +50,6 @@ import OccName          ( HasOccName )
 import Outputable
 import SrcLoc
 import Module           ( ModuleName )
-import FastString
 
 -- libraries:
 import Data.Data hiding ( Fixity )
@@ -120,11 +119,11 @@ instance (OutputableBndr name, HasOccName name)
       = vcat [
             pp_mb mbDoc,
             case exports of
-              Nothing -> pp_header (ptext (sLit "where"))
+              Nothing -> pp_header (text "where")
               Just es -> vcat [
                            pp_header lparen,
                            nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),
-                           nest 4 (ptext (sLit ") where"))
+                           nest 4 (text ") where")
                           ],
             pp_nonnull imports,
             pp_nonnull decls
@@ -134,7 +133,7 @@ instance (OutputableBndr name, HasOccName name)
            Nothing -> pp_modname <+> rest
            Just d -> vcat [ pp_modname, ppr d, rest ]
 
-        pp_modname = ptext (sLit "module") <+> ppr name
+        pp_modname = text "module" <+> ppr name
 
 pp_mb :: Outputable t => Maybe t -> SDoc
 pp_mb (Just x) = ppr x
index 83161b3..15de6a0 100644 (file)
@@ -1195,7 +1195,7 @@ ppr_fun_ty ctxt_prec ty1 ty2
         p2 = ppr_mono_lty TopPrec ty2
     in
     maybeParen ctxt_prec FunPrec $
-    sep [p1, ptext (sLit "->") <+> p2]
+    sep [p1, text "->" <+> p2]
 
 --------------------------
 ppr_app_ty :: OutputableBndr name => TyPrec -> HsAppType name -> SDoc
index 6f26e23..7b6b34c 100644 (file)
@@ -527,7 +527,7 @@ pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
                   pprWithCommas pprIfaceIdBndr cvs)
     pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
     maybe_incomps = ppUnless (null incomps) $ parens $
-                    ptext (sLit "incompatible indices:") <+> ppr incomps
+                    text "incompatible indices:" <+> ppr incomps
 
 instance Outputable IfaceAnnotation where
   ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
@@ -609,7 +609,7 @@ ppr_trim xs
   where
     go (Just doc) (_,     so_far) = (False, doc : so_far)
     go Nothing    (True,  so_far) = (True, so_far)
-    go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)
+    go Nothing    (False, so_far) = (True, text "..." : so_far)
 
 isIfaceDataInstance :: IfaceTyConParent -> Bool
 isIfaceDataInstance IfNoParent = False
@@ -637,12 +637,12 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
 
     gadt_style = gadt || any (not . isVanillaIfaceConDecl) cons
     cons       = visibleIfConDecls condecls
-    pp_where   = ppWhen (gadt_style && not (null cons)) $ ptext (sLit "where")
+    pp_where   = ppWhen (gadt_style && not (null cons)) $ text "where"
     pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
 
     pp_lhs = case parent of
                IfNoParent -> pprIfaceDeclHead context ss tycon kind tc_tyvars
-               _          -> ptext (sLit "instance") <+> pprIfaceTyConParent parent
+               _          -> text "instance" <+> pprIfaceTyConParent parent
 
     pp_roles
       | is_data_instance = empty
@@ -682,9 +682,9 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
     (tc_bndrs, _, _) = splitIfaceSigmaTy kind
 
     pp_nd = case condecls of
-              IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
-              IfDataTyCon{}     -> ptext (sLit "data")
-              IfNewTyCon{}      -> ptext (sLit "newtype")
+              IfAbstractTyCon d -> text "abstract" <> ppShowIface ss (parens (ppr d))
+              IfDataTyCon{}     -> text "data"
+              IfNewTyCon{}      -> text "newtype"
 
     pp_extra = vcat [pprCType ctype, pprRec isrec, text "Kind:" <+> ppr kind]
 
@@ -695,14 +695,14 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
                             , ifFDs    = fds, ifMinDef = minDef
                             , ifKind   = kind })
   = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) bndrs roles
-         , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas kind tyvars
+         , text "class" <+> pprIfaceDeclHead context ss clas kind tyvars
                                 <+> pprFundeps fds <+> pp_where
          , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
                         , ppShowAllSubs ss (pprMinDef minDef)])]
     where
       (bndrs, _, _) = splitIfaceSigmaTy kind
 
-      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))
+      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
 
       asocs = ppr_trim $ map maybeShowAssoc ats
       dsigs = ppr_trim $ map maybeShowSig sigs
@@ -720,16 +720,16 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
 
       pprMinDef :: BooleanFormula IfLclName -> SDoc
       pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
-        ptext (sLit "{-# MINIMAL") <+>
+        text "{-# MINIMAL" <+>
         pprBooleanFormula
           (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
-        ptext (sLit "#-}")
+        text "#-}"
 
 pprIfaceDecl ss (IfaceSynonym { ifName    = tc
                               , ifTyVars  = tv
                               , ifSynRhs  = mono_ty
                               , ifSynKind = kind})
-  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc kind tv <+> equals)
+  = hang (text "type" <+> pprIfaceDeclHead [] ss tc kind tv <+> equals)
        2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
   where
     (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
@@ -738,7 +738,7 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
                              , ifFamFlav = rhs, ifFamKind = kind
                              , ifResVar = res_var, ifFamInj = inj })
   | IfaceDataFamilyTyCon <- rhs
-  = ptext (sLit "data family") <+> pprIfaceDeclHead [] ss tycon kind tyvars
+  = text "data family" <+> pprIfaceDeclHead [] ss tycon kind tyvars
 
   | otherwise
   = hang (text "type family" <+> pprIfaceDeclHead [] ss tycon kind tyvars)
@@ -758,20 +758,20 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
        tvs -> hsep [vbar, ppr res, text "->", interppSP (map fst tvs)]
 
     pp_rhs IfaceDataFamilyTyCon
-      = ppShowIface ss (ptext (sLit "data"))
+      = ppShowIface ss (text "data")
     pp_rhs IfaceOpenSynFamilyTyCon
-      = ppShowIface ss (ptext (sLit "open"))
+      = ppShowIface ss (text "open")
     pp_rhs IfaceAbstractClosedSynFamilyTyCon
-      = ppShowIface ss (ptext (sLit "closed, abstract"))
+      = ppShowIface ss (text "closed, abstract")
     pp_rhs (IfaceClosedSynFamilyTyCon {})
       = empty  -- see pp_branches
     pp_rhs IfaceBuiltInSynFamTyCon
-      = ppShowIface ss (ptext (sLit "built-in"))
+      = ppShowIface ss (text "built-in")
 
     pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
       = hang (text "where")
            2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
-              $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax))
+              $$ ppShowIface ss (text "axiom" <+> ppr ax))
     pp_branches _ = Outputable.empty
 
 pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatBuilder = builder,
@@ -798,13 +798,13 @@ pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
 
 pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
                            , ifAxBranches = branches })
-  = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
+  = hang (text "axiom" <+> ppr name <> dcolon)
        2 (vcat $ map (pprAxBranch (ppr tycon)) branches)
 
 
 pprCType :: Maybe CType -> SDoc
 pprCType Nothing      = Outputable.empty
-pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType
+pprCType (Just cType) = text "C type:" <+> ppr cType
 
 -- if, for each role, suppress_if role is True, then suppress the role
 -- output
@@ -814,11 +814,11 @@ pprRoles suppress_if tyCon bndrs roles
   = sdocWithDynFlags $ \dflags ->
       let froles = suppressIfaceInvisibles dflags bndrs roles
       in ppUnless (all suppress_if roles || null froles) $
-         ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles)
+         text "type role" <+> tyCon <+> hsep (map ppr froles)
 
 pprRec :: RecFlag -> SDoc
 pprRec NonRecursive = Outputable.empty
-pprRec Recursive    = ptext (sLit "RecFlag: Recursive")
+pprRec Recursive    = text "RecFlag: Recursive"
 
 pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
 pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
@@ -834,7 +834,7 @@ pprIfaceClassOp ss (IfaceClassOp n ty dm)
   = pp_sig n ty $$ generic_dm
   where
    generic_dm | Just (GenericDM dm_ty) <- dm
-              =  ptext (sLit "default") <+> pp_sig n dm_ty
+              =  text "default" <+> pp_sig n dm_ty
               | otherwise
               = empty
    pp_sig n ty = pprPrefixIfDeclBndr ss n <+> dcolon <+> pprIfaceSigmaType ty
@@ -848,7 +848,7 @@ pprIfaceAT ss (IfaceAT d mb_def)
          , case mb_def of
               Nothing  -> Outputable.empty
               Just rhs -> nest 2 $
-                          ptext (sLit "Default:") <+> ppr rhs ]
+                          text "Default:" <+> ppr rhs ]
 
 instance Outputable IfaceTyConParent where
   ppr p = pprIfaceTyConParent p
@@ -912,8 +912,8 @@ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls
 
     ppr_bang IfNoBang = ppWhen opt_PprStyle_Debug $ char '_'
     ppr_bang IfStrict = char '!'
-    ppr_bang IfUnpack = ptext (sLit "{-# UNPACK #-}")
-    ppr_bang (IfUnpackCo co) = ptext (sLit "! {-# UNPACK #-}") <>
+    ppr_bang IfUnpack = text "{-# UNPACK #-}"
+    ppr_bang (IfUnpackCo co) = text "! {-# UNPACK #-}" <>
                                pprParendIfaceCoercion co
 
     pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty
@@ -939,22 +939,22 @@ instance Outputable IfaceRule where
   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
     = sep [hsep [pprRuleName name, ppr act,
-                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
+                 text "forall" <+> pprIfaceBndrs bndrs],
            nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
-                        ptext (sLit "=") <+> ppr rhs])
+                        text "=" <+> ppr rhs])
       ]
 
 instance Outputable IfaceClsInst where
   ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag
                     , ifInstCls = cls, ifInstTys = mb_tcs})
-    = hang (ptext (sLit "instance") <+> ppr flag
+    = hang (text "instance" <+> ppr flag
                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
          2 (equals <+> ppr dfun_id)
 
 instance Outputable IfaceFamInst where
   ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
                     , ifFamInstAxiom = tycon_ax})
-    = hang (ptext (sLit "family instance") <+>
+    = hang (text "family instance" <+>
             ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
          2 (equals <+> ppr tycon_ax)
 
@@ -1024,37 +1024,37 @@ pprIfaceExpr add_par i@(IfaceLam _ _)
     collect bs e              = (reverse bs, e)
 
 pprIfaceExpr add_par (IfaceECase scrut ty)
-  = add_par (sep [ ptext (sLit "case") <+> pprIfaceExpr noParens scrut
-                 , ptext (sLit "ret_ty") <+> pprParendIfaceType ty
-                 , ptext (sLit "of {}") ])
+  = add_par (sep [ text "case" <+> pprIfaceExpr noParens scrut
+                 , text "ret_ty" <+> pprParendIfaceType ty
+                 , text "of {}" ])
 
 pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
-  = add_par (sep [ptext (sLit "case")
-                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
+  = add_par (sep [text "case"
+                        <+> pprIfaceExpr noParens scrut <+> text "of"
                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
                   pprIfaceExpr noParens rhs <+> char '}'])
 
 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
-  = add_par (sep [ptext (sLit "case")
-                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
+  = add_par (sep [text "case"
+                        <+> pprIfaceExpr noParens scrut <+> text "of"
                         <+> ppr bndr <+> char '{',
                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)
   = sep [pprParendIfaceExpr expr,
-         nest 2 (ptext (sLit "`cast`")),
+         nest 2 (text "`cast`"),
          pprParendIfaceCoercion co]
 
 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
-  = add_par (sep [ptext (sLit "let {"),
+  = add_par (sep [text "let {",
                   nest 2 (ppr_bind (b, rhs)),
-                  ptext (sLit "} in"),
+                  text "} in",
                   pprIfaceExpr noParens body])
 
 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
-  = add_par (sep [ptext (sLit "letrec {"),
+  = add_par (sep [text "letrec {",
                   nest 2 (sep (map ppr_bind pairs)),
-                  ptext (sLit "} in"),
+                  text "} in",
                   pprIfaceExpr noParens body])
 
 pprIfaceExpr add_par (IfaceTick tickish e)
@@ -1096,36 +1096,36 @@ instance Outputable IfaceConAlt where
 ------------------
 instance Outputable IfaceIdDetails where
   ppr IfVanillaId       = Outputable.empty
-  ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
+  ppr (IfRecSelId tc b) = text "RecSel" <+> ppr tc
                           <+> if b
-                                then ptext (sLit "<naughty>")
+                                then text "<naughty>"
                                 else Outputable.empty
-  ppr IfDFunId          = ptext (sLit "DFunId")
+  ppr IfDFunId          = text "DFunId"
 
 instance Outputable IfaceIdInfo where
   ppr NoInfo       = Outputable.empty
-  ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
-                     <+> ptext (sLit "-}")
+  ppr (HasInfo is) = text "{-" <+> pprWithCommas ppr is
+                     <+> text "-}"
 
 instance Outputable IfaceInfoItem where
-  ppr (HsUnfold lb unf)     = ptext (sLit "Unfolding")
-                              <> ppWhen lb (ptext (sLit "(loop-breaker)"))
+  ppr (HsUnfold lb unf)     = text "Unfolding"
+                              <> ppWhen lb (text "(loop-breaker)")
                               <> colon <+> ppr unf
-  ppr (HsInline prag)       = ptext (sLit "Inline:") <+> ppr prag
-  ppr (HsArity arity)       = ptext (sLit "Arity:") <+> int arity
-  ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
-  ppr HsNoCafRefs           = ptext (sLit "HasNoCafRefs")
+  ppr (HsInline prag)       = text "Inline:" <+> ppr prag
+  ppr (HsArity arity)       = text "Arity:" <+> int arity
+  ppr (HsStrictness str) = text "Strictness:" <+> pprIfaceStrictSig str
+  ppr HsNoCafRefs           = text "HasNoCafRefs"
 
 instance Outputable IfaceUnfolding where
-  ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
+  ppr (IfCompulsory e)     = text "<compulsory>" <+> parens (ppr e)
   ppr (IfCoreUnfold s e)   = (if s
-                                then ptext (sLit "<stable>")
+                                then text "<stable>"
                                 else Outputable.empty)
                               <+> parens (ppr e)
-  ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
+  ppr (IfInlineRule a uok bok e) = sep [text "InlineRule"
                                             <+> ppr (a,uok,bok),
                                         pprParendIfaceExpr e]
-  ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
+  ppr (IfDFunUnfold bs es) = hang (text "DFun:" <+> sep (map ppr bs) <> dot)
                                 2 (sep (map pprParendIfaceExpr es))
 
 {-
index ac3f1b6..09c7c6b 100644 (file)
@@ -637,7 +637,7 @@ ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
 
 ppr_ty ctxt_prec (IfaceCastTy ty co)
   = maybeParen ctxt_prec FunPrec $
-    sep [ppr_ty FunPrec ty, ptext (sLit "`cast`"), ppr_co FunPrec co]
+    sep [ppr_ty FunPrec ty, text "`cast`", ppr_co FunPrec co]
 
 ppr_ty ctxt_prec (IfaceCoercionTy co)
   = ppr_co ctxt_prec co
@@ -778,7 +778,7 @@ pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
 pprTyTcApp ctxt_prec tc tys dflags
   | ifaceTyConName tc `hasKey` ipClassKey
   , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
-  = char '?' <> ftext n <> ptext (sLit "::") <> ppr_ty TopPrec ty
+  = char '?' <> ftext n <> text "::" <> ppr_ty TopPrec ty
 
   | ifaceTyConName tc == consDataConName
   , not (gopt Opt_PrintExplicitKinds dflags)
@@ -873,7 +873,7 @@ ppr_co _         (IfaceCoVarCo covar)       = ppr covar
 
 ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
   = maybeParen ctxt_prec TyConPrec $
-    ptext (sLit "UnsafeCo") <+> ppr r <+>
+    text "UnsafeCo" <+> ppr r <+>
     pprParendIfaceType ty1 <+> pprParendIfaceType ty2
 
 ppr_co _         (IfaceUnivCo _ _ ty1 ty2)
@@ -881,7 +881,7 @@ ppr_co _         (IfaceUnivCo _ _ ty1 ty2)
 
 ppr_co ctxt_prec (IfaceInstCo co ty)
   = maybeParen ctxt_prec TyConPrec $
-    ptext (sLit "Inst") <+> pprParendIfaceCoercion co
+    text "Inst" <+> pprParendIfaceCoercion co
                         <+> pprParendIfaceCoercion ty
 
 ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)
@@ -891,12 +891,12 @@ ppr_co ctxt_prec co
   = ppr_special_co ctxt_prec doc cos
   where (doc, cos) = case co of
                      { IfaceAxiomInstCo n i cos -> (ppr n <> brackets (ppr i), cos)
-                     ; IfaceSymCo co            -> (ptext (sLit "Sym"), [co])
-                     ; IfaceTransCo co1 co2     -> (ptext (sLit "Trans"), [co1,co2])
-                     ; IfaceNthCo d co          -> (ptext (sLit "Nth:") <> int d,
+                     ; IfaceSymCo co            -> (text "Sym", [co])
+                     ; IfaceTransCo co1 co2     -> (text "Trans", [co1,co2])
+                     ; IfaceNthCo d co          -> (text "Nth:" <> int d,
                                                     [co])
                      ; IfaceLRCo lr co          -> (ppr lr, [co])
-                     ; IfaceSubCo co            -> (ptext (sLit "Sub"), [co])
+                     ; IfaceSubCo co            -> (text "Sub", [co])
                      ; _                        -> panic "pprIfaceCo" }
 
 ppr_special_co :: TyPrec -> SDoc -> [IfaceCoercion] -> SDoc
index 35c6b22..c044136 100644 (file)
@@ -141,11 +141,11 @@ importDecl name
             Nothing    -> return (Failed not_found_msg)
     }}}
   where
-    nd_doc = ptext (sLit "Need decl for") <+> ppr name
-    not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
+    nd_doc = text "Need decl for" <+> ppr name
+    not_found_msg = hang (text "Can't find interface-file declaration for" <+>
                                 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
-                       2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
-                                ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
+                       2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
+                                text "Use -ddump-if-trace to get an idea of which file caused the error"])
 
 
 {-
@@ -325,7 +325,7 @@ loadWiredInHomeIface name
   = ASSERT( isWiredInName name )
     do _ <- loadSysInterface doc (nameModule name); return ()
   where
-    doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
+    doc = text "Need home interface for wired-in thing" <+> ppr name
 
 ------------------