From: Ian Lynagh Date: Tue, 22 Apr 2008 11:47:13 +0000 (+0000) Subject: Change the last few (F)SLIT's into (f)sLit's X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f5d4c3239e57b0396672ffc302961f84398d730e Change the last few (F)SLIT's into (f)sLit's --- diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index df2758a..d85315a 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -119,7 +119,7 @@ isPrim _ = False pprDemands :: [Demand] -> Bool -> SDoc pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot where - pp_bot | bot = ptext SLIT("B") + pp_bot | bot = ptext (sLit "B") | otherwise = empty @@ -135,7 +135,7 @@ pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args)) instance Outputable Demand where ppr (WwLazy False) = empty - ppr other_demand = ptext SLIT("__D") <+> pprDemand other_demand + ppr other_demand = ptext (sLit "__D") <+> pprDemand other_demand instance Show Demand where showsPrec p d = showsPrecSDoc p (ppr d) diff --git a/compiler/cprAnalysis/CprAnalyse.lhs b/compiler/cprAnalysis/CprAnalyse.lhs index d6525c5..8f3c343 100644 --- a/compiler/cprAnalysis/CprAnalyse.lhs +++ b/compiler/cprAnalysis/CprAnalyse.lhs @@ -99,10 +99,10 @@ data AbsVal = Top -- Not a constructed product -- For pretty debugging instance Outputable AbsVal where - ppr Top = ptext SLIT("Top") - ppr (Fun r) = ptext SLIT("Fun->") <> (parens.ppr) r - ppr Tuple = ptext SLIT("Tuple ") - ppr Bot = ptext SLIT("Bot") + ppr Top = ptext (sLit "Top") + ppr (Fun r) = ptext (sLit "Fun->") <> (parens.ppr) r + ppr Tuple = ptext (sLit "Tuple ") + ppr Bot = ptext (sLit "Bot") -- lub takes the lowest upper bound of two abstract values, standard. diff --git a/compiler/ilxGen/IlxGen.lhs b/compiler/ilxGen/IlxGen.lhs index cf36eb8..012782f 100644 --- a/compiler/ilxGen/IlxGen.lhs +++ b/compiler/ilxGen/IlxGen.lhs @@ -2206,7 +2206,7 @@ ilxPrimOpTable op MakeStablePtrOp -> ty1_op (\ty1 -> ilxOpSeq [ilxOp "box", ty1, ilxOp "newobj void", repStablePtr {- ty1 -}, ilxOp "::.ctor(class [mscorlib]System.Object)"]) {- a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) -} MakeStableNameOp -> ty1_op (\ty1 -> ilxOpSeq [ilxOp "pop newobj void", repStableName {- ty1 -}, ilxOp "::.ctor()"]) - -- primOpInfo MakeStableNameOp = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed 2 [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy])) + -- primOpInfo MakeStableNameOp = mkGenPrimOp (sLit "makeStableName#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed 2 [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy])) EqStableNameOp -> ty1_op (\ty1 -> ilxOp "ceq") -- [alphaTyVar] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy alphaTy] (intPrimTy) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 41ff667..27058e4 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -137,7 +137,7 @@ static_flags :: [(String, OptKind IO)] -- -- The common (PassFlag addOpt) action puts the static flag into the bunch of -- things that are searched up by the top-level definitions like --- opt_foo = lookUp FSLIT("-dfoo") +-- opt_foo = lookUp (fsLit "-dfoo") -- Note that ordering is important in the following list: any flag which -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 6d3bf7c..fee6209 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -774,11 +774,11 @@ cmmExprConFold referenceKind expr CmmReg (CmmGlobal GCEnter1) | not opt_PIC -> cmmExprConFold referenceKind $ - CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_enter_1"))) + CmmLit (CmmLabel (mkRtsCodeLabel (sLit "__stg_gc_enter_1"))) CmmReg (CmmGlobal GCFun) | not opt_PIC -> cmmExprConFold referenceKind $ - CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_fun"))) + CmmLit (CmmLabel (mkRtsCodeLabel (sLit "__stg_gc_fun"))) #endif CmmReg (CmmGlobal mid) diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 5e9ff51..64fa024 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -714,7 +714,7 @@ pprASCII str do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w) pprAlign bytes = - IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2, + IF_ARCH_alpha(ptext (sLit ".align ") <> int pow2, IF_ARCH_i386(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes), IF_ARCH_x86_64(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes), IF_ARCH_sparc(ptext (sLit ".align ") <> int bytes, diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index a254a08..b24840d 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -280,7 +280,7 @@ boxHigherOrderArgs almost_expr args = do = do -- make a trivial let-binding for the top-level function uniq <- getUniqueMM let - new_var = mkSysLocal FSLIT("sf") uniq var_type + new_var = mkSysLocal (fsLit "sf") uniq var_type return ( (new_var, old_var) : bindings, StgVarArg new_var ) where var_type = idType old_var diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs index 1a85af9..3022f3c 100644 --- a/compiler/simplCore/SAT.lhs +++ b/compiler/simplCore/SAT.lhs @@ -292,7 +292,7 @@ getSATInfo var = projectFromEnv $ \env -> lookupVarEnv (idSATInfo env) var newSATName :: Id -> Type -> SatM Id newSATName _ ty - = SatM $ \us env -> (mkSysLocal FSLIT("$sat") (uniqFromSupply us) ty, env) + = SatM $ \us env -> (mkSysLocal (fsLit "$sat") (uniqFromSupply us) ty, env) getArgLists :: CoreExpr -> ([Staticness Type], [Staticness Id]) getArgLists expr @@ -377,7 +377,7 @@ saTransform binder rhs = do -- top-level or exported somehow.) -- A better fix is to use binder directly but with the TopLevel -- tag (or Exported tag) modified. - fake_binder = mkSysLocal FSLIT("sat") + fake_binder = mkSysLocal (fsLit "sat") (getUnique binder) (idType binder) rec_body = mkLams non_static_args diff --git a/compiler/stranal/SaLib.lhs b/compiler/stranal/SaLib.lhs index 18f468a..2561d97 100644 --- a/compiler/stranal/SaLib.lhs +++ b/compiler/stranal/SaLib.lhs @@ -87,12 +87,12 @@ mkAbsApproxFun d (AbsApproxFun ds val) = AbsApproxFun (d:ds) val mkAbsApproxFun d val = AbsApproxFun [d] val instance Outputable AbsVal where - ppr AbsTop = ptext SLIT("AbsTop") - ppr AbsBot = ptext SLIT("AbsBot") - ppr (AbsProd prod) = hsep [ptext SLIT("AbsProd"), ppr prod] - ppr (AbsFun bndr_ty body) = ptext SLIT("AbsFun") + ppr AbsTop = ptext (sLit "AbsTop") + ppr AbsBot = ptext (sLit "AbsBot") + ppr (AbsProd prod) = hsep [ptext (sLit "AbsProd"), ppr prod] + ppr (AbsFun bndr_ty body) = ptext (sLit "AbsFun") ppr (AbsApproxFun demands val) - = ptext SLIT("AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val + = ptext (sLit "AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val \end{code} %----------- diff --git a/compiler/stranal/StrictAnal.lhs b/compiler/stranal/StrictAnal.lhs index 7adbe3f..0463205 100644 --- a/compiler/stranal/StrictAnal.lhs +++ b/compiler/stranal/StrictAnal.lhs @@ -445,9 +445,9 @@ tick_demanded var (tot, demanded) else demanded) pp_stats (SaStats tlam dlam tc dc tlet dlet) - = hcat [ptext SLIT("Lambda vars: "), int (iBox dlam), char '/', int (iBox tlam), - ptext SLIT("; Case vars: "), int (iBox dc), char '/', int (iBox tc), - ptext SLIT("; Let vars: "), int (iBox dlet), char '/', int (iBox tlet) + = hcat [ptext (sLit "Lambda vars: "), int (iBox dlam), char '/', int (iBox tlam), + ptext (sLit "; Case vars: "), int (iBox dc), char '/', int (iBox tc), + ptext (sLit "; Let vars: "), int (iBox dlet), char '/', int (iBox tlet) ] #else /* OMIT_STRANAL_STATS */ diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index b9db015..e8bcca7 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -348,9 +348,9 @@ unifyKindMisMatch ty1 ty2 = do ty1' <- zonkTcKind ty1 ty2' <- zonkTcKind ty2 let - msg = hang (ptext SLIT("Couldn't match kind")) + msg = hang (ptext (sLit "Couldn't match kind")) 2 (sep [quotes (ppr ty1'), - ptext SLIT("against"), + ptext (sLit "against"), quotes (ppr ty2')]) failWithTc msg @@ -358,8 +358,8 @@ unifyKindCtxt swapped tv1 ty2 tidy_env -- not swapped => tv1 expected, ty2 infer -- tv1 and ty2 are zonked already = return msg where - msg = (env2, ptext SLIT("When matching the kinds of") <+> - sep [quotes pp_expected <+> ptext SLIT("and"), quotes pp_actual]) + msg = (env2, ptext (sLit "When matching the kinds of") <+> + sep [quotes pp_expected <+> ptext (sLit "and"), quotes pp_actual]) (pp_expected, pp_actual) | swapped = (pp2, pp1) | otherwise = (pp1, pp2) @@ -382,7 +382,7 @@ occurCheckErr ty containingTy extra = sep [ppr tidy_ty1, char '=', ppr tidy_ty2] ; failWithTcM (env2, hang msg 2 extra) } where - msg = ptext SLIT("Occurs check: cannot construct the infinite type:") + msg = ptext (sLit "Occurs check: cannot construct the infinite type:") \end{code} %************************************************************************ @@ -395,7 +395,7 @@ occurCheckErr ty containingTy newCoVars :: [(TcType,TcType)] -> TcM [CoVar] newCoVars spec = do { us <- newUniqueSupply - ; return [ mkCoVar (mkSysTvName uniq FSLIT("co")) + ; return [ mkCoVar (mkSysTvName uniq (fsLit "co")) (mkCoKind ty1 ty2) | ((ty1,ty2), uniq) <- spec `zip` uniqsFromSupply us] } @@ -474,9 +474,9 @@ newMetaTyVar box_info kind ; ref <- newMutVar Flexi ; let name = mkSysTvName uniq fs fs = case box_info of - BoxTv -> FSLIT("t") - TauTv -> FSLIT("t") - SigTv _ -> FSLIT("a") + BoxTv -> fsLit "t" + TauTv -> fsLit "t" + SigTv _ -> fsLit "a" -- We give BoxTv and TauTv the same string, because -- otherwise we get user-visible differences in error -- messages, which are confusing. If you want to see @@ -1179,10 +1179,10 @@ check_arg_type rank ty ; checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty) } ---------------------------------------- -forAllTyErr ty = sep [ptext SLIT("Illegal polymorphic or qualified type:"), ppr ty] -unliftedArgErr ty = sep [ptext SLIT("Illegal unlifted type:"), ppr ty] -ubxArgTyErr ty = sep [ptext SLIT("Illegal unboxed tuple type as function argument:"), ppr ty] -kindErr kind = sep [ptext SLIT("Expecting an ordinary type, but found a type of kind"), ppr kind] +forAllTyErr ty = sep [ptext (sLit "Illegal polymorphic or qualified type:"), ppr ty] +unliftedArgErr ty = sep [ptext (sLit "Illegal unlifted type:"), ppr ty] +ubxArgTyErr ty = sep [ptext (sLit "Illegal unboxed tuple type as function argument:"), ppr ty] +kindErr kind = sep [ptext (sLit "Expecting an ordinary type, but found a type of kind"), ppr kind] \end{code} Note [Liberal type synonyms] @@ -1239,11 +1239,11 @@ data SourceTyCtxt | InstThetaCtxt -- Context of an instance decl -- instance => C [a] where ... -pprSourceTyCtxt (ClassSCCtxt c) = ptext SLIT("the super-classes of class") <+> quotes (ppr c) -pprSourceTyCtxt SigmaCtxt = ptext SLIT("the context of a polymorphic type") -pprSourceTyCtxt (DataTyCtxt tc) = ptext SLIT("the context of the data type declaration for") <+> quotes (ppr tc) -pprSourceTyCtxt InstThetaCtxt = ptext SLIT("the context of an instance declaration") -pprSourceTyCtxt TypeCtxt = ptext SLIT("the context of a type") +pprSourceTyCtxt (ClassSCCtxt c) = ptext (sLit "the super-classes of class") <+> quotes (ppr c) +pprSourceTyCtxt SigmaCtxt = ptext (sLit "the context of a polymorphic type") +pprSourceTyCtxt (DataTyCtxt tc) = ptext (sLit "the context of the data type declaration for") <+> quotes (ppr tc) +pprSourceTyCtxt InstThetaCtxt = ptext (sLit "the context of an instance declaration") +pprSourceTyCtxt TypeCtxt = ptext (sLit "the context of a type") \end{code} \begin{code} @@ -1277,7 +1277,7 @@ check_pred_ty dflags ctxt pred@(ClassP cls tys) arity = classArity cls n_tys = length tys arity_err = arityErr "Class" class_name arity n_tys - how_to_allow = parens (ptext SLIT("Use -XFlexibleContexts to permit this")) + how_to_allow = parens (ptext (sLit "Use -XFlexibleContexts to permit this")) check_pred_ty dflags ctxt pred@(EqPred ty1 ty2) = do { -- Equational constraints are valid in all contexts if type @@ -1372,9 +1372,9 @@ checkAmbiguity forall_tyvars theta tau_tyvars not (ct_var `elemVarSet` extended_tau_vars) ambigErr pred - = sep [ptext SLIT("Ambiguous constraint") <+> quotes (pprPred pred), - nest 4 (ptext SLIT("At least one of the forall'd type variables mentioned by the constraint") $$ - ptext SLIT("must be reachable from the type after the '=>'"))] + = sep [ptext (sLit "Ambiguous constraint") <+> quotes (pprPred pred), + nest 4 (ptext (sLit "At least one of the forall'd type variables mentioned by the constraint") $$ + ptext (sLit "must be reachable from the type after the '=>'"))] \end{code} In addition, GHC insists that at least one type variable @@ -1393,49 +1393,49 @@ checkFreeness forall_tyvars theta complain pred = addErrTc (freeErr pred) freeErr pred - = sep [ ptext SLIT("All of the type variables in the constraint") <+> + = sep [ ptext (sLit "All of the type variables in the constraint") <+> quotes (pprPred pred) - , ptext SLIT("are already in scope") <+> - ptext SLIT("(at least one must be universally quantified here)") + , ptext (sLit "are already in scope") <+> + ptext (sLit "(at least one must be universally quantified here)") , nest 4 $ - ptext SLIT("(Use -XFlexibleContexts to lift this restriction)") + ptext (sLit "(Use -XFlexibleContexts to lift this restriction)") ] \end{code} \begin{code} checkThetaCtxt ctxt theta - = vcat [ptext SLIT("In the context:") <+> pprTheta theta, - ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ] + = vcat [ptext (sLit "In the context:") <+> pprTheta theta, + ptext (sLit "While checking") <+> pprSourceTyCtxt ctxt ] -badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty -eqPredTyErr sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty +badPredTyErr sty = ptext (sLit "Illegal constraint") <+> pprPred sty +eqPredTyErr sty = ptext (sLit "Illegal equational constraint") <+> pprPred sty $$ - parens (ptext SLIT("Use -XTypeFamilies to permit this")) -predTyVarErr pred = sep [ptext SLIT("Non type-variable argument"), - nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)] -dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups) + parens (ptext (sLit "Use -XTypeFamilies to permit this")) +predTyVarErr pred = sep [ptext (sLit "Non type-variable argument"), + nest 2 (ptext (sLit "in the constraint:") <+> pprPred pred)] +dupPredWarn dups = ptext (sLit "Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups) arityErr kind name n m - = hsep [ text kind, quotes (ppr name), ptext SLIT("should have"), + = hsep [ text kind, quotes (ppr name), ptext (sLit "should have"), n_arguments <> comma, text "but has been given", int m] where - n_arguments | n == 0 = ptext SLIT("no arguments") - | n == 1 = ptext SLIT("1 argument") - | True = hsep [int n, ptext SLIT("arguments")] + n_arguments | n == 0 = ptext (sLit "no arguments") + | n == 1 = ptext (sLit "1 argument") + | True = hsep [int n, ptext (sLit "arguments")] ----------------- notMonoType ty = do { ty' <- zonkTcType ty ; env0 <- tcInitTidyEnv ; let (env1, tidy_ty) = tidyOpenType env0 ty' - msg = ptext SLIT("Cannot match a monotype with") <+> quotes (ppr tidy_ty) + msg = ptext (sLit "Cannot match a monotype with") <+> quotes (ppr tidy_ty) ; failWithTcM (env1, msg) } notMonoArgs ty = do { ty' <- zonkTcType ty ; env0 <- tcInitTidyEnv ; let (env1, tidy_ty) = tidyOpenType env0 ty' - msg = ptext SLIT("Arguments of type synonym families must be monotypes") <+> quotes (ppr tidy_ty) + msg = ptext (sLit "Arguments of type synonym families must be monotypes") <+> quotes (ppr tidy_ty) ; failWithTcM (env1, msg) } \end{code} @@ -1508,7 +1508,7 @@ check_inst_head dflags clas tys text "Use -XMultiParamTypeClasses if you want to allow more.") instTypeErr pp_ty msg - = sep [ptext SLIT("Illegal instance declaration for") <+> quotes pp_ty, + = sep [ptext (sLit "Illegal instance declaration for") <+> quotes pp_ty, nest 4 msg] \end{code} @@ -1539,7 +1539,7 @@ checkValidInstance tyvars theta clas inst_tys (instTypeErr (pprClassPred clas inst_tys) msg) } where - msg = parens (vcat [ptext SLIT("the Coverage Condition fails for one of the functional dependencies;"), + msg = parens (vcat [ptext (sLit "the Coverage Condition fails for one of the functional dependencies;"), undecidableMsg]) \end{code} @@ -1576,11 +1576,11 @@ checkInstTermination tys theta = Nothing predUndecErr pred msg = sep [msg, - nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)] + nest 2 (ptext (sLit "in the constraint:") <+> pprPred pred)] -nomoreMsg = ptext SLIT("Variable occurs more often in a constraint than in the instance head") -smallerMsg = ptext SLIT("Constraint is no smaller than the instance head") -undecidableMsg = ptext SLIT("Use -fallow-undecidable-instances to permit this") +nomoreMsg = ptext (sLit "Variable occurs more often in a constraint than in the instance head") +smallerMsg = ptext (sLit "Constraint is no smaller than the instance head") +undecidableMsg = ptext (sLit "Use -fallow-undecidable-instances to permit this") \end{code} @@ -1715,22 +1715,22 @@ isTyFamFree = null . tyFamInsts -- Error messages tyFamInstInIndexErr ty - = hang (ptext SLIT("Illegal type family application in type instance") <> + = hang (ptext (sLit "Illegal type family application in type instance") <> colon) 4 $ ppr ty polyTyErr ty - = hang (ptext SLIT("Illegal polymorphic type in type instance") <> colon) 4 $ + = hang (ptext (sLit "Illegal polymorphic type in type instance") <> colon) 4 $ ppr ty famInstUndecErr ty msg = sep [msg, - nest 2 (ptext SLIT("in the type family application:") <+> + nest 2 (ptext (sLit "in the type family application:") <+> pprType ty)] -nestedMsg = ptext SLIT("Nested type family application") -nomoreVarMsg = ptext SLIT("Variable occurs more often than in instance head") -smallerAppMsg = ptext SLIT("Application is no smaller than the instance head") +nestedMsg = ptext (sLit "Nested type family application") +nomoreVarMsg = ptext (sLit "Variable occurs more often than in instance head") +smallerAppMsg = ptext (sLit "Application is no smaller than the instance head") \end{code} diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index 1759257..d509692 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -214,9 +214,9 @@ bindInstsOfPatId id thing_inside ; return (res, binds) } ------------------- -unBoxPatBndrType ty name = unBoxArgType ty (ptext SLIT("The variable") <+> quotes (ppr name)) -unBoxWildCardType ty = unBoxArgType ty (ptext SLIT("A wild-card pattern")) -unBoxViewPatType ty pat = unBoxArgType ty (ptext SLIT("The view pattern") <+> ppr pat) +unBoxPatBndrType ty name = unBoxArgType ty (ptext (sLit "The variable") <+> quotes (ppr name)) +unBoxWildCardType ty = unBoxArgType ty (ptext (sLit "A wild-card pattern")) +unBoxViewPatType ty pat = unBoxArgType ty (ptext (sLit "The view pattern") <+> ppr pat) unBoxArgType :: BoxyType -> SDoc -> TcM TcType -- In addition to calling unbox, unBoxArgType ensures that the type is of ArgTypeKind; @@ -237,7 +237,7 @@ unBoxArgType ty pp_this ; unifyType ty' ty2 ; return ty' }} where - msg = pp_this <+> ptext SLIT("cannot be bound to an unboxed tuple") + msg = pp_this <+> ptext (sLit "cannot be bound to an unboxed tuple") \end{code} @@ -900,7 +900,7 @@ newLitInst orig lit res_ty -- Make a LitInst = do { loc <- getInstLoc orig ; res_tau <- zapToMonotype res_ty ; new_uniq <- newUnique - ; let lit_nm = mkSystemVarName new_uniq FSLIT("lit") + ; let lit_nm = mkSystemVarName new_uniq (fsLit "lit") lit_inst = LitInst {tci_name = lit_nm, tci_lit = lit, tci_ty = res_tau, tci_loc = loc} ; extendLIE lit_inst @@ -980,7 +980,7 @@ patCtxt :: Pat Name -> Maybe Message -- Not all patterns are worth pushing a con patCtxt (VarPat _) = Nothing patCtxt (ParPat _) = Nothing patCtxt (AsPat _ _) = Nothing -patCtxt pat = Just (hang (ptext SLIT("In the pattern:")) +patCtxt pat = Just (hang (ptext (sLit "In the pattern:")) 4 (ppr pat)) ----------------------------------------------- @@ -999,10 +999,10 @@ sigPatCtxt pats bound_tvs pat_tys body_ty tidy_env (env2, tidy_pat_tys) = tidyOpenTypes env1 pat_tys' (env3, tidy_body_ty) = tidyOpenType env2 body_ty' ; return (env3, - sep [ptext SLIT("When checking an existential match that binds"), + sep [ptext (sLit "When checking an existential match that binds"), nest 4 (vcat (zipWith ppr_id show_ids tidy_tys)), - ptext SLIT("The pattern(s) have type(s):") <+> vcat (map ppr tidy_pat_tys), - ptext SLIT("The body has type:") <+> ppr tidy_body_ty + ptext (sLit "The pattern(s) have type(s):") <+> vcat (map ppr tidy_pat_tys), + ptext (sLit "The body has type:") <+> ppr tidy_body_ty ]) } where bound_ids = collectPatsBinders pats @@ -1014,38 +1014,38 @@ sigPatCtxt pats bound_tvs pat_tys body_ty tidy_env badFieldCon :: DataCon -> Name -> SDoc badFieldCon con field - = hsep [ptext SLIT("Constructor") <+> quotes (ppr con), - ptext SLIT("does not have field"), quotes (ppr field)] + = hsep [ptext (sLit "Constructor") <+> quotes (ppr con), + ptext (sLit "does not have field"), quotes (ppr field)] polyPatSig :: TcType -> SDoc polyPatSig sig_ty - = hang (ptext SLIT("Illegal polymorphic type signature in pattern:")) + = hang (ptext (sLit "Illegal polymorphic type signature in pattern:")) 2 (ppr sig_ty) -badTypePat pat = ptext SLIT("Illegal type pattern") <+> ppr pat +badTypePat pat = ptext (sLit "Illegal type pattern") <+> ppr pat existentialProcPat :: DataCon -> SDoc existentialProcPat con - = hang (ptext SLIT("Illegal constructor") <+> quotes (ppr con) <+> ptext SLIT("in a 'proc' pattern")) - 2 (ptext SLIT("Proc patterns cannot use existentials or GADTs")) + = hang (ptext (sLit "Illegal constructor") <+> quotes (ppr con) <+> ptext (sLit "in a 'proc' pattern")) + 2 (ptext (sLit "Proc patterns cannot use existentials or GADTs")) lazyPatErr pat tvs = failWithTc $ - hang (ptext SLIT("A lazy (~) pattern cannot bind existential type variables")) + hang (ptext (sLit "A lazy (~) pattern cannot bind existential type variables")) 2 (vcat (map pprSkolTvBinding tvs)) nonRigidMatch con - = hang (ptext SLIT("GADT pattern match in non-rigid context for") <+> quotes (ppr con)) - 2 (ptext SLIT("Solution: add a type signature")) + = hang (ptext (sLit "GADT pattern match in non-rigid context for") <+> quotes (ppr con)) + 2 (ptext (sLit "Solution: add a type signature")) nonRigidResult res_ty = do { env0 <- tcInitTidyEnv ; let (env1, res_ty') = tidyOpenType env0 res_ty - msg = hang (ptext SLIT("GADT pattern match with non-rigid result type") + msg = hang (ptext (sLit "GADT pattern match with non-rigid result type") <+> quotes (ppr res_ty')) - 2 (ptext SLIT("Solution: add a type signature")) + 2 (ptext (sLit "Solution: add a type signature")) ; failWithTcM (env1, msg) } inaccessibleAlt msg - = hang (ptext SLIT("Inaccessible case alternative:")) 2 msg + = hang (ptext (sLit "Inaccessible case alternative:")) 2 msg \end{code} diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index a237a5d..e34cfa0 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -215,9 +215,9 @@ subFunTys error_herald n_pats res_ty thing_inside mk_msg res_ty n_actual = error_herald <> comma $$ - sep [ptext SLIT("but its type") <+> quotes (pprType res_ty), - if n_actual == 0 then ptext SLIT("has none") - else ptext SLIT("has only") <+> speakN n_actual] + sep [ptext (sLit "but its type") <+> quotes (pprType res_ty), + if n_actual == 0 then ptext (sLit "has none") + else ptext (sLit "has only") <+> speakN n_actual] \end{code} \begin{code} @@ -880,7 +880,7 @@ wrapFunResCoercion arg_tys co_fn_res | null arg_tys = return co_fn_res | otherwise - = do { arg_ids <- newSysLocalIds FSLIT("sub") arg_tys + = do { arg_ids <- newSysLocalIds (fsLit "sub") arg_tys ; return (mkWpLams arg_ids <.> co_fn_res <.> mkWpApps arg_ids) } \end{code} @@ -994,8 +994,8 @@ unifyTheta :: TcThetaType -> TcThetaType -> TcM [CoercionI] -- Acutal and expected types unifyTheta theta1 theta2 = do { checkTc (equalLength theta1 theta2) - (vcat [ptext SLIT("Contexts differ in length"), - nest 2 $ parens $ ptext SLIT("Use -fglasgow-exts to allow this")]) + (vcat [ptext (sLit "Contexts differ in length"), + nest 2 $ parens $ ptext (sLit "Use -fglasgow-exts to allow this")]) ; uList unifyPred theta1 theta2 } @@ -1057,10 +1057,10 @@ data Outer = Unify Bool TcType TcType -- for this particular ty1,ty2 instance Outputable Outer where - ppr (Unify c ty1 ty2) = pp_c <+> pprParendType ty1 <+> ptext SLIT("~") + ppr (Unify c ty1 ty2) = pp_c <+> pprParendType ty1 <+> ptext (sLit "~") <+> pprParendType ty2 where - pp_c = if c then ptext SLIT("Top") else ptext SLIT("NonTop") + pp_c = if c then ptext (sLit "Top") else ptext (sLit "NonTop") ------------------------- @@ -1370,7 +1370,7 @@ uVar outer swapped tv1 nb2 ps_ty2 ty2 | otherwise = brackets (equals <+> ppr ty2) ; traceTc (text "uVar" <+> ppr outer <+> ppr swapped <+> sep [ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1 ), - nest 2 (ptext SLIT(" <-> ")), + nest 2 (ptext (sLit " <-> ")), ppr ps_ty2 <+> dcolon <+> ppr (typeKind ty2) <+> expansion]) ; details <- lookupTcTyVar tv1 ; case details of @@ -1740,9 +1740,9 @@ addSubCtxt orig actual_res_ty expected_res_ty thing_inside ; return (env2, message) } wrongArgsCtxt too_many_or_few fun - = ptext SLIT("Probable cause:") <+> quotes (ppr fun) - <+> ptext SLIT("is applied to") <+> text too_many_or_few - <+> ptext SLIT("arguments") + = ptext (sLit "Probable cause:") <+> quotes (ppr fun) + <+> ptext (sLit "is applied to") <+> text too_many_or_few + <+> ptext (sLit "arguments") ------------------ unifyForAllCtxt tvs phi1 phi2 env @@ -1751,8 +1751,8 @@ unifyForAllCtxt tvs phi1 phi2 env (env', tvs') = tidyOpenTyVars env tvs -- NB: not tidyTyVarBndrs (env1, phi1') = tidyOpenType env' phi1 (env2, phi2') = tidyOpenType env1 phi2 - msg = vcat [ptext SLIT("When matching") <+> quotes (ppr (mkForAllTys tvs' phi1')), - ptext SLIT(" and") <+> quotes (ppr (mkForAllTys tvs' phi2'))] + msg = vcat [ptext (sLit "When matching") <+> quotes (ppr (mkForAllTys tvs' phi1')), + ptext (sLit " and") <+> quotes (ppr (mkForAllTys tvs' phi2'))] \end{code} @@ -1842,7 +1842,7 @@ kindSimpleKind orig_swapped orig_kind | isLiftedTypeKind k = return liftedTypeKind | isUnliftedTypeKind k = return unliftedTypeKind go sw k@(TyVarTy _) = return k -- KindVars are always simple - go swapped kind = failWithTc (ptext SLIT("Unexpected kind unification failure:") + go swapped kind = failWithTc (ptext (sLit "Unexpected kind unification failure:") <+> ppr orig_swapped <+> ppr orig_kind) -- I think this can't actually happen @@ -1851,7 +1851,7 @@ kindSimpleKind orig_swapped orig_kind ---------------- kindOccurCheckErr tyvar ty - = hang (ptext SLIT("Occurs check: cannot construct the infinite kind:")) + = hang (ptext (sLit "Occurs check: cannot construct the infinite kind:")) 2 (sep [ppr tyvar, char '=', ppr ty]) \end{code} @@ -1919,25 +1919,25 @@ checkExpectedKind ty act_kind exp_kind (env2, tidy_act_kind) = tidyKind env1 act_kind err | n_exp_as < n_act_as -- E.g. [Maybe] - = quotes (ppr ty) <+> ptext SLIT("is not applied to enough type arguments") + = quotes (ppr ty) <+> ptext (sLit "is not applied to enough type arguments") -- Now n_exp_as >= n_act_as. In the next two cases, -- n_exp_as == 0, and hence so is n_act_as | isLiftedTypeKind exp_kind && isUnliftedTypeKind act_kind - = ptext SLIT("Expecting a lifted type, but") <+> quotes (ppr ty) - <+> ptext SLIT("is unlifted") + = ptext (sLit "Expecting a lifted type, but") <+> quotes (ppr ty) + <+> ptext (sLit "is unlifted") | isUnliftedTypeKind exp_kind && isLiftedTypeKind act_kind - = ptext SLIT("Expecting an unlifted type, but") <+> quotes (ppr ty) - <+> ptext SLIT("is lifted") + = ptext (sLit "Expecting an unlifted type, but") <+> quotes (ppr ty) + <+> ptext (sLit "is lifted") | otherwise -- E.g. Monad [Int] - = ptext SLIT("Kind mis-match") + = ptext (sLit "Kind mis-match") - more_info = sep [ ptext SLIT("Expected kind") <+> + more_info = sep [ ptext (sLit "Expected kind") <+> quotes (pprKind tidy_exp_kind) <> comma, - ptext SLIT("but") <+> quotes (ppr ty) <+> - ptext SLIT("has kind") <+> quotes (pprKind tidy_act_kind)] + ptext (sLit "but") <+> quotes (ppr ty) <+> + ptext (sLit "has kind") <+> quotes (pprKind tidy_act_kind)] failWithTcM (env2, err $$ more_info) \end{code} @@ -2022,7 +2022,7 @@ bleatEscapedTvs globals sig_tvs zonked_tvs ; (env3, msgs) <- foldlM check (env2, []) (tidy_tvs `zip` tidy_zonked_tvs) ; failWithTcM (env3, main_msg $$ nest 2 (vcat msgs)) } where - main_msg = ptext SLIT("Inferred type is less polymorphic than expected") + main_msg = ptext (sLit "Inferred type is less polymorphic than expected") check (tidy_env, msgs) (sig_tv, zonked_tv) | not (zonked_tv `elemVarSet` globals) = return (tidy_env, msgs) @@ -2033,18 +2033,18 @@ bleatEscapedTvs globals sig_tvs zonked_tvs ----------------------- escape_msg sig_tv zonked_tv globs | notNull globs - = vcat [sep [msg, ptext SLIT("is mentioned in the environment:")], + = vcat [sep [msg, ptext (sLit "is mentioned in the environment:")], nest 2 (vcat globs)] | otherwise - = msg <+> ptext SLIT("escapes") + = msg <+> ptext (sLit "escapes") -- Sigh. It's really hard to give a good error message -- all the time. One bad case is an existential pattern match. -- We rely on the "When..." context to help. where - msg = ptext SLIT("Quantified type variable") <+> quotes (ppr sig_tv) <+> is_bound_to + msg = ptext (sLit "Quantified type variable") <+> quotes (ppr sig_tv) <+> is_bound_to is_bound_to | sig_tv == zonked_tv = empty - | otherwise = ptext SLIT("is unified with") <+> quotes (ppr zonked_tv) <+> ptext SLIT("which") + | otherwise = ptext (sLit "is unified with") <+> quotes (ppr zonked_tv) <+> ptext (sLit "which") \end{code} These two context are used with checkSigTyVars @@ -2058,10 +2058,10 @@ sigCtxt id sig_tvs sig_theta sig_tau tidy_env = do (env1, tidy_sig_tvs) = tidyOpenTyVars tidy_env sig_tvs (env2, tidy_sig_rho) = tidyOpenType env1 (mkPhiTy sig_theta sig_tau) (env3, tidy_actual_tau) = tidyOpenType env2 actual_tau - sub_msg = vcat [ptext SLIT("Signature type: ") <+> pprType (mkForAllTys tidy_sig_tvs tidy_sig_rho), - ptext SLIT("Type to generalise:") <+> pprType tidy_actual_tau + sub_msg = vcat [ptext (sLit "Signature type: ") <+> pprType (mkForAllTys tidy_sig_tvs tidy_sig_rho), + ptext (sLit "Type to generalise:") <+> pprType tidy_actual_tau ] - msg = vcat [ptext SLIT("When trying to generalise the type inferred for") <+> quotes (ppr id), + msg = vcat [ptext (sLit "When trying to generalise the type inferred for") <+> quotes (ppr id), nest 2 sub_msg] return (env3, msg) diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index 69478be..7c8ad9d 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -389,7 +389,7 @@ type InternalReft = TyVarEnv (Coercion, Type) instance Outputable Refinement where ppr (Reft _in_scope env) - = ptext SLIT("Refinement") <+> + = ptext (sLit "Refinement") <+> braces (ppr env) emptyRefinement :: Refinement @@ -767,23 +767,23 @@ maybeErrToMaybe (Failed _) = Nothing \begin{code} misMatch :: Type -> Type -> SDoc misMatch t1 t2 - = ptext SLIT("Can't match types") <+> quotes (ppr t1) <+> - ptext SLIT("and") <+> quotes (ppr t2) + = ptext (sLit "Can't match types") <+> quotes (ppr t1) <+> + ptext (sLit "and") <+> quotes (ppr t2) lengthMisMatch :: [Type] -> [Type] -> SDoc lengthMisMatch tys1 tys2 - = sep [ptext SLIT("Can't match unequal length lists"), + = sep [ptext (sLit "Can't match unequal length lists"), nest 2 (ppr tys1), nest 2 (ppr tys2) ] kindMisMatch :: TyVar -> Type -> SDoc kindMisMatch tv1 t2 - = vcat [ptext SLIT("Can't match kinds") <+> quotes (ppr (tyVarKind tv1)) <+> - ptext SLIT("and") <+> quotes (ppr (typeKind t2)), - ptext SLIT("when matching") <+> quotes (ppr tv1) <+> - ptext SLIT("with") <+> quotes (ppr t2)] + = vcat [ptext (sLit "Can't match kinds") <+> quotes (ppr (tyVarKind tv1)) <+> + ptext (sLit "and") <+> quotes (ppr (typeKind t2)), + ptext (sLit "when matching") <+> quotes (ppr tv1) <+> + ptext (sLit "with") <+> quotes (ppr t2)] occursCheck :: TyVar -> Type -> SDoc occursCheck tv ty - = hang (ptext SLIT("Can't construct the infinite type")) + = hang (ptext (sLit "Can't construct the infinite type")) 2 (ppr tv <+> equals <+> ppr ty) \end{code} diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 5651cec..cd93c78 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -5,13 +5,13 @@ {- FastString: A compact, hash-consed, representation of character strings. Comparison is O(1), and you can get a Unique from them. - Generated by the FSLIT macro + Generated by fsLit Turn into SDoc with Outputable.ftext LitString: Just a wrapper for the Addr# of a C string (Ptr CChar). Practically no operations Outputing them is fast - Generated by the SLIT macro + Generated by sLit Turn into SDoc with Outputable.ptext Use LitString unless you want the facilities of FastString