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