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

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

Test Plan: ./validate

Reviewers: bgamari, austin, goldfire, hvr, alanz

Subscribers: goldfire, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1784

3 files changed, 52 insertions, 53 deletions

diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index 7cef1b93d3..07db9bf775 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -310,8 +310,8 @@ coreToTopStgRhs dflags this_mod scope_fv_info (bndr, rhs)
     id_arity  = idArity bndr
     mk_arity_msg stg_arity
         = vcat [ppr bndr,
-                ptext (sLit "Id arity:") <+> ppr id_arity,
-                ptext (sLit "STG arity:") <+> ppr stg_arity]
+                text "Id arity:" <+> ppr id_arity,
+                text "STG arity:" <+> ppr stg_arity]
 
 mkTopStgRhs :: DynFlags -> Module -> FreeVarsInfo
             -> SRT -> Id -> StgBinderInfo -> StgExpr
@@ -663,7 +663,7 @@ coreToStgArgs (arg : args) = do         -- Non-type argument
         -- we complain.
         -- We also want to check if a pointer is cast to a non-ptr etc
 
-    WARN( bad_args, ptext (sLit "Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg )
+    WARN( bad_args, text "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" $$ ppr arg )
      return (stg_arg : stg_args, fvs, ticks ++ aticks)
 
 
diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index 7aa07b25d3..1499ae216c 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -25,7 +25,6 @@ import TyCon
 import Util
 import SrcLoc
 import Outputable
-import FastString
 import Control.Monad
 import Data.Function
 
@@ -64,12 +63,12 @@ lintStgBindings whodunnit binds
     case (initL (lint_binds binds)) of
       Nothing  -> binds
       Just msg -> pprPanic "" (vcat [
-                        ptext (sLit "*** Stg Lint ErrMsgs: in") <+>
-                              text whodunnit <+> ptext (sLit "***"),
+                        text "*** Stg Lint ErrMsgs: in" <+>
+                              text whodunnit <+> text "***",
                         msg,
-                        ptext (sLit "*** Offending Program ***"),
+                        text "*** Offending Program ***",
                         pprStgBindings binds,
-                        ptext (sLit "*** End of Offense ***")])
+                        text "*** End of Offense ***"])
   where
     lint_binds :: [StgBinding] -> LintM ()
 
@@ -168,7 +167,7 @@ lintStgExpr (StgOpApp _ args res_ty) = runMaybeT $ do
     return res_ty
 
 lintStgExpr (StgLam bndrs _) = do
-    addErrL (ptext (sLit "Unexpected StgLam") <+> ppr bndrs)
+    addErrL (text "Unexpected StgLam" <+> ppr bndrs)
     return Nothing
 
 lintStgExpr (StgLet binds body) = do
@@ -282,12 +281,12 @@ data LintLocInfo
 
 dumpLoc :: LintLocInfo -> (SrcSpan, SDoc)
 dumpLoc (RhsOf v) =
-  (srcLocSpan (getSrcLoc v), ptext (sLit " [RHS of ") <> pp_binders [v] <> char ']' )
+  (srcLocSpan (getSrcLoc v), text " [RHS of " <> pp_binders [v] <> char ']' )
 dumpLoc (LambdaBodyOf bs) =
-  (srcLocSpan (getSrcLoc (head bs)), ptext (sLit " [in body of lambda with binders ") <> pp_binders bs <> char ']' )
+  (srcLocSpan (getSrcLoc (head bs)), text " [in body of lambda with binders " <> pp_binders bs <> char ']' )
 
 dumpLoc (BodyOfLetRec bs) =
-  (srcLocSpan (getSrcLoc (head bs)), ptext (sLit " [in body of letrec with binders ") <> pp_binders bs <> char ']' )
+  (srcLocSpan (getSrcLoc (head bs)), text " [in body of letrec with binders " <> pp_binders bs <> char ']' )
 
 
 pp_binders :: [Id] -> SDoc
@@ -451,7 +450,7 @@ stgEqType orig_ty1 orig_ty2
 checkInScope :: Id -> LintM ()
 checkInScope id = LintM $ \loc scope errs
  -> if isLocalId id && not (id `elemVarSet` scope) then
-        ((), addErr errs (hsep [ppr id, ptext (sLit "is out of scope")]) loc)
+        ((), addErr errs (hsep [ppr id, text "is out of scope"]) loc)
     else
         ((), errs)
 
@@ -468,21 +467,21 @@ _mkCaseAltMsg _alts
 
 mkDefltMsg :: Id -> TyCon -> MsgDoc
 mkDefltMsg bndr tc
-  = ($$) (ptext (sLit "Binder of a case expression doesn't match type of scrutinee:"))
+  = ($$) (text "Binder of a case expression doesn't match type of scrutinee:")
          (ppr bndr $$ ppr (idType bndr) $$ ppr tc)
 
 mkFunAppMsg :: Type -> [Type] -> StgExpr -> MsgDoc
 mkFunAppMsg fun_ty arg_tys expr
   = vcat [text "In a function application, function type doesn't match arg types:",
-              hang (ptext (sLit "Function type:")) 4 (ppr fun_ty),
-              hang (ptext (sLit "Arg types:")) 4 (vcat (map (ppr) arg_tys)),
-              hang (ptext (sLit "Expression:")) 4 (ppr expr)]
+              hang (text "Function type:") 4 (ppr fun_ty),
+              hang (text "Arg types:") 4 (vcat (map (ppr) arg_tys)),
+              hang (text "Expression:") 4 (ppr expr)]
 
 mkRhsConMsg :: Type -> [Type] -> MsgDoc
 mkRhsConMsg fun_ty arg_tys
   = vcat [text "In a RHS constructor application, con type doesn't match arg types:",
-              hang (ptext (sLit "Constructor type:")) 4 (ppr fun_ty),
-              hang (ptext (sLit "Arg types:")) 4 (vcat (map (ppr) arg_tys))]
+              hang (text "Constructor type:") 4 (ppr fun_ty),
+              hang (text "Arg types:") 4 (vcat (map (ppr) arg_tys))]
 
 mkAltMsg1 :: Type -> MsgDoc
 mkAltMsg1 ty
@@ -515,15 +514,15 @@ mkAlgAltMsg4 ty arg
 
 _mkRhsMsg :: Id -> Type -> MsgDoc
 _mkRhsMsg binder ty
-  = vcat [hsep [ptext (sLit "The type of this binder doesn't match the type of its RHS:"),
+  = vcat [hsep [text "The type of this binder doesn't match the type of its RHS:",
                      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]
              ]
 
 mkUnLiftedTyMsg :: Id -> StgRhs -> SDoc
 mkUnLiftedTyMsg binder rhs
-  = (ptext (sLit "Let(rec) binder") <+> quotes (ppr binder) <+>
-     ptext (sLit "has unlifted type") <+> quotes (ppr (idType binder)))
+  = (text "Let(rec) binder" <+> quotes (ppr binder) <+>
+     text "has unlifted type" <+> quotes (ppr (idType binder)))
     $$
-    (ptext (sLit "RHS:") <+> ppr rhs)
+    (text "RHS:" <+> ppr rhs)
diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs
index f0eb2d5e93..204e843567 100644
--- a/compiler/stgSyn/StgSyn.hs
+++ b/compiler/stgSyn/StgSyn.hs
@@ -480,7 +480,7 @@ combineStgBinderInfo _            _            = NoStgBinderInfo
 --------------
 pp_binder_info :: StgBinderInfo -> SDoc
 pp_binder_info NoStgBinderInfo = empty
-pp_binder_info SatCallsOnly    = ptext (sLit "sat-only")
+pp_binder_info SatCallsOnly    = text "sat-only"
 
 {-
 ************************************************************************
@@ -609,7 +609,7 @@ nonEmptySRT NoSRT           = False
 nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
 
 pprSRT :: SRT -> SDoc
-pprSRT (NoSRT)          = ptext (sLit "_no_srt_")
+pprSRT (NoSRT)          = text "_no_srt_"
 pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
 
 {-
@@ -631,8 +631,8 @@ pprGenStgBinding (StgNonRec bndr rhs)
         4 (ppr rhs <> semi)
 
 pprGenStgBinding (StgRec pairs)
-  = vcat $ ifPprDebug (ptext $ sLit "{- StgRec (begin) -}") :
-           map (ppr_bind) pairs ++ [ifPprDebug $ ptext $ sLit "{- StgRec (end) -}"]
+  = vcat $ ifPprDebug (text "{- StgRec (begin) -}") :
+           map (ppr_bind) pairs ++ [ifPprDebug (text "{- StgRec (end) -}")]
   where
     ppr_bind (bndr, expr)
       = hang (hsep [pprBndr LetBind bndr, equals])
@@ -680,7 +680,7 @@ pprStgExpr (StgOpApp op args _)
 
 pprStgExpr (StgLam bndrs body)
   = sep [ char '\\' <+> ppr_list (map (pprBndr LambdaBind) bndrs)
-            <+> ptext (sLit "->"),
+            <+> text "->",
          pprStgExpr body ]
   where ppr_list = brackets . fsep . punctuate comma
 
@@ -696,13 +696,13 @@ pprStgExpr (StgLam bndrs body)
 pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
                         expr@(StgLet _ _))
   = ($$)
-      (hang (hcat [ptext (sLit "let { "), ppr bndr, ptext (sLit " = "),
+      (hang (hcat [text "let { ", ppr bndr, ptext (sLit " = "),
                           ppr cc,
                           pp_binder_info bi,
-                          ptext (sLit " ["), ifPprDebug (interppSP free_vars), ptext (sLit "] \\"),
-                          ppr upd_flag, ptext (sLit " ["),
+                          text " [", ifPprDebug (interppSP free_vars), ptext (sLit "] \\"),
+                          ppr upd_flag, text " [",
                           interppSP args, char ']'])
-            8 (sep [hsep [ppr rhs, ptext (sLit "} in")]]))
+            8 (sep [hsep [ppr rhs, text "} in"]]))
       (ppr expr)
 -}
 
@@ -710,23 +710,23 @@ pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag a
 
 pprStgExpr (StgLet bind expr@(StgLet _ _))
   = ($$)
-      (sep [hang (ptext (sLit "let {"))
-                2 (hsep [pprGenStgBinding bind, ptext (sLit "} in")])])
+      (sep [hang (text "let {")
+                2 (hsep [pprGenStgBinding bind, text "} in"])])
       (ppr expr)
 
 -- general case
 pprStgExpr (StgLet bind expr)
-  = sep [hang (ptext (sLit "let {")) 2 (pprGenStgBinding bind),
-           hang (ptext (sLit "} in ")) 2 (ppr expr)]
+  = sep [hang (text "let {") 2 (pprGenStgBinding bind),
+           hang (text "} in ") 2 (ppr expr)]
 
 pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
-  = sep [hang (ptext (sLit "let-no-escape {"))
+  = sep [hang (text "let-no-escape {")
                 2 (pprGenStgBinding bind),
-           hang (ptext (sLit "} in ") <>
+           hang (text "} in " <>
                    ifPprDebug (
                     nest 4 (
                       hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
-                             ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
+                             text "]; rhs lvs: [", interppSP (uniqSetToList lvs_rhss),
                              char ']'])))
                 2 (ppr expr)]
 
@@ -738,15 +738,15 @@ pprStgExpr (StgTick tickish expr)
 
 
 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
-  = sep [sep [ptext (sLit "case"),
+  = sep [sep [text "case",
            nest 4 (hsep [pprStgExpr expr,
              ifPprDebug (dcolon <+> ppr alt_type)]),
-           ptext (sLit "of"), pprBndr CaseBind bndr, char '{'],
+           text "of", pprBndr CaseBind bndr, char '{'],
            ifPprDebug (
            nest 4 (
              hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
-                    ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
-                    ptext (sLit "]; "),
+                    text "]; rhs lvs: [", interppSP (uniqSetToList lvs_rhss),
+                    text "]; ",
                     pprMaybeSRT srt])),
            nest 2 (vcat (map pprStgAlt alts)),
            char '}']
@@ -754,7 +754,7 @@ pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
 pprStgAlt :: (OutputableBndr bndr, Outputable occ, Ord occ)
           => GenStgAlt bndr occ -> SDoc
 pprStgAlt (con, params, _use_mask, expr)
-  = hang (hsep [ppr con, sep (map (pprBndr CaseBind) params), ptext (sLit "->")])
+  = hang (hsep [ppr con, sep (map (pprBndr CaseBind) params), text "->"])
          4 (ppr expr <> semi)
 
 pprStgOp :: StgOp -> SDoc
@@ -763,10 +763,10 @@ pprStgOp (StgPrimCallOp op)= ppr op
 pprStgOp (StgFCallOp op _) = ppr op
 
 instance Outputable AltType where
-  ppr PolyAlt        = ptext (sLit "Polymorphic")
-  ppr (UbxTupAlt n)  = ptext (sLit "UbxTup") <+> ppr n
-  ppr (AlgAlt tc)    = ptext (sLit "Alg")    <+> ppr tc
-  ppr (PrimAlt tc)   = ptext (sLit "Prim")   <+> ppr tc
+  ppr PolyAlt        = text "Polymorphic"
+  ppr (UbxTupAlt n)  = text "UbxTup" <+> ppr n
+  ppr (AlgAlt tc)    = text "Alg"    <+> ppr tc
+  ppr (PrimAlt tc)   = text "Prim"   <+> ppr tc
 
 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
 pprStgLVs lvs
@@ -784,7 +784,7 @@ pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp fun
   = hcat [ ppr cc,
            pp_binder_info bi,
            brackets (ifPprDebug (ppr free_var)),
-           ptext (sLit " \\"), ppr upd_flag, pprMaybeSRT srt, ptext (sLit " [] "), ppr func ]
+           text " \\", ppr upd_flag, pprMaybeSRT srt, ptext (sLit " [] "), ppr func ]
 
 -- general case
 pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
@@ -797,8 +797,8 @@ pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
 
 pprStgRhs (StgRhsCon cc con args)
   = hcat [ ppr cc,
-           space, ppr con, ptext (sLit "! "), brackets (interppSP args)]
+           space, ppr con, text "! ", brackets (interppSP args)]
 
 pprMaybeSRT :: SRT -> SDoc
 pprMaybeSRT (NoSRT) = empty
-pprMaybeSRT srt     = ptext (sLit "srt:") <> pprSRT srt
+pprMaybeSRT srt     = text "srt:" <> pprSRT srt