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 (file)
--- 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
 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
 
 
                                | 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
 
 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)
 
 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 (file)
--- 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
 
 -- 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.
 
 
 -- 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 (file)
--- 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()"])
        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)
 
         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 (file)
--- 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
 --
 -- 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
 
 -- 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 (file)
--- 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 $
         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 $
         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)
 #endif
 
         CmmReg (CmmGlobal mid)

diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs
index 5e9ff51..64fa024 100644 (file)
--- 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 =
        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,
        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 (file)
--- 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
       = 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
         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 (file)
--- 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
 
 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
 
 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.
         -- 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
                 (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 (file)
--- 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
 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)
     ppr (AbsApproxFun demands val)

-      = ptext SLIT("AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
+      = ptext (sLit "AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val

 \end{code}
 
 %-----------
 \end{code}
 
 %-----------

diff --git a/compiler/stranal/StrictAnal.lhs b/compiler/stranal/StrictAnal.lhs
index 7adbe3f..0463205 100644 (file)
--- 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)
      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 */
        ]
 
 #else /* OMIT_STRANAL_STATS */

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index b9db015..e8bcca7 100644 (file)
--- 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
     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'), 
                   2 (sep [quotes (ppr ty1'), 

-                          ptext SLIT("against"), 
+                          ptext (sLit "against"), 

                           quotes (ppr ty2')])
     failWithTc msg
 
                           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
        -- 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)
 
     (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
              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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -395,7 +395,7 @@ occurCheckErr ty containingTy
 newCoVars :: [(TcType,TcType)] -> TcM [CoVar]
 newCoVars spec
   = do { us <- newUniqueSupply 
 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] }
 
                           (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
        ; 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
                -- 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) }
 
 ----------------------------------------
        ; 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]
 \end{code}
 
 Note [Liberal type synonyms]

@@ -1239,11 +1239,11 @@ data SourceTyCtxt
   | InstThetaCtxt      -- Context of an instance decl
                        --      instance <S> => C [a] where ...
                
   | InstThetaCtxt      -- Context of an instance decl
                        --      instance <S> => 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}
 \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
     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
 
 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
                        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
 \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
     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)
           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 $
        , 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
         ]
 \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
 
 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 <> 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'
 
 -----------------
 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'
        ; 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}
 
        ; 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
                 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}
 
         nest 4 msg]
 \end{code}
 

@@ -1539,7 +1539,7 @@ checkValidInstance tyvars theta clas inst_tys
                  (instTypeErr (pprClassPred clas inst_tys) msg)
        }
   where
                  (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}
 
                         undecidableMsg])
 \end{code}
 

@@ -1576,11 +1576,11 @@ checkInstTermination tys theta
       = Nothing
 
 predUndecErr pred msg = sep [msg,
       = 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}
 
 
 \end{code}
 
 

@@ -1715,22 +1715,22 @@ isTyFamFree = null . tyFamInsts
 -- Error messages
 
 tyFamInstInIndexErr ty
 -- 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 
          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, 
       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)]
 
                  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}
 
 
 \end{code}
 
 

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 1759257..d509692 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -214,9 +214,9 @@ bindInstsOfPatId id thing_inside
        ; return (res, binds) }
 
 -------------------
        ; 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; 
 
 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
        ; 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}
 
 
 \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
   = 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
                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 (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))
 
 -----------------------------------------------
                               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,
              (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)),
                      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
                ]) }
   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
 
 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
 
 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)
 
        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
 
 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 $
 
 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
        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
 
 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'))
                                <+> 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
        ; failWithTcM (env1, msg) }
 
 inaccessibleAlt msg

-  = hang (ptext SLIT("Inaccessible case alternative:")) 2 msg
+  = hang (ptext (sLit "Inaccessible case alternative:")) 2 msg

 \end{code}
 \end{code}

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index a237a5d..e34cfa0 100644 (file)
--- 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 $$ 
 
     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}
 \end{code}
 
 \begin{code}

@@ -880,7 +880,7 @@ wrapFunResCoercion arg_tys co_fn_res
   | null arg_tys          
   = return co_fn_res
   | otherwise
   | 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}
 
        ; 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)
 -- 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 
         }
 
        ; uList unifyPred theta1 theta2 
         }
 

@@ -1057,10 +1057,10 @@ data Outer = Unify Bool TcType TcType
        --                 for this particular ty1,ty2
 
 instance Outputable Outer where
        --                 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
                               <+> 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 ),
                        | 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
                             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
           ; 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
 
 ------------------
 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
     (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}
 
 
 \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
      | 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
 
                                  <+> 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
 
 ----------------
 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}
 
        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]
                (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
 
                      -- 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
 
                    | 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]
 
                    | 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,
                                      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}
 
            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
        ; (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)
 
     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 
 -----------------------
 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
          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
        -- 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
     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
 \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
        (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)
                    nest 2 sub_msg]
     
     return (env3, msg)

diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs
index 69478be..7c8ad9d 100644 (file)
--- 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)
 
 instance Outputable Refinement where
   ppr (Reft _in_scope env)

-    = ptext SLIT("Refinement") <+>
+    = ptext (sLit "Refinement") <+>

         braces (ppr env)
 
 emptyRefinement :: Refinement
         braces (ppr env)
 
 emptyRefinement :: Refinement

@@ -767,23 +767,23 @@ maybeErrToMaybe (Failed _)    = Nothing
 \begin{code}
 misMatch :: Type -> Type -> SDoc
 misMatch t1 t2
 \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
 
 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
         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
 
 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}
        2 (ppr tv <+> equals <+> ppr ty)
 \end{code}

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 5651cec..cd93c78 100644 (file)
--- 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.
 {-
 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
                 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
                 Turn into SDoc with Outputable.ptext
 
 Use LitString unless you want the facilities of FastString