(F)SLIT -> (f)sLit in TcHsType

[ghc-hetmet.git] / compiler / typecheck / TcHsType.lhs

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 00bc2ed..309d13f 100644 (file)
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -53,6 +53,7 @@ import BasicTypes
 import SrcLoc
 import UniqSupply
 import Outputable
+import FastString
 
 import Control.Monad
 \end{code}
@@ -191,7 +192,7 @@ tc_hs_deriv tv_names1 (HsForAllTy _ tv_names2 (L _ []) (L _ ty))
     tc_hs_deriv (tv_names1 ++ tv_names2) ty
 
 tc_hs_deriv _ other
-  = failWithTc (ptext SLIT("Illegal deriving item") <+> ppr other)
+  = failWithTc (ptext (sLit "Illegal deriving item") <+> ppr other)
 \end{code}
 
        These functions are used during knot-tying in
@@ -373,7 +374,7 @@ kc_hs_type (HsBangTy b ty) = do
     return (HsBangTy b ty', kind)
 
 kc_hs_type ty@(HsSpliceTy _)
-  = failWithTc (ptext SLIT("Unexpected type splice:") <+> ppr ty)
+  = failWithTc (ptext (sLit "Unexpected type splice:") <+> ppr ty)
 
 -- remove the doc nodes here, no need to worry about the location since
 -- its the same for a doc node and it's child type node
@@ -399,8 +400,8 @@ kcApps fun_kind ppr_fun args = do
 
     kc_arg arg arg_kind = kcCheckHsType arg arg_kind
 
-    too_many_args = ptext SLIT("Kind error:") <+> quotes ppr_fun <+>
-                   ptext SLIT("is applied to too many type arguments")
+    too_many_args = ptext (sLit "Kind error:") <+> quotes ppr_fun <+>
+                   ptext (sLit "is applied to too many type arguments")
 
 ---------------------------
 kcHsContext :: LHsContext Name -> TcM (LHsContext Name)
@@ -487,7 +488,7 @@ ds_type (HsParTy ty)                -- Remove the parentheses markers
   = dsHsType ty
 
 ds_type ty@(HsBangTy _ _)      -- No bangs should be here
-  = failWithTc (ptext SLIT("Unexpected strictness annotation:") <+> ppr ty)
+  = failWithTc (ptext (sLit "Unexpected strictness annotation:") <+> ppr ty)
 
 ds_type (HsKindSig ty k)
   = dsHsType ty        -- Kind checking done already
@@ -597,9 +598,9 @@ GADT constructor signatures
 
 \begin{code}
 tcLHsConResTy :: LHsType Name -> TcM (TyCon, [TcType])
-tcLHsConResTy res_ty
-  = addErrCtxt (gadtResCtxt res_ty) $
-    case get_largs res_ty [] of
+tcLHsConResTy (L span res_ty)
+  = setSrcSpan span $
+    case get_args res_ty [] of
           (HsTyVar tc_name, args) 
              -> do { args' <- mapM dsHsType args
                    ; thing <- tcLookup tc_name
@@ -612,20 +613,16 @@ tcLHsConResTy res_ty
        -- because that causes a black hole, and for good reason.  Building
        -- the type means expanding type synonyms, and we can't do that
        -- inside the "knot".  So we have to work by steam.
-    get_largs (L _ ty) args = get_args ty args
-    get_args (HsAppTy fun arg)                   args = get_largs fun (arg:args)
-    get_args (HsParTy ty)                        args = get_largs ty  args
+    get_args (HsAppTy (L _ fun) arg)     args = get_args fun (arg:args)
+    get_args (HsParTy (L _ ty))          args = get_args ty  args
     get_args (HsOpTy ty1 (L span tc) ty2) args = (HsTyVar tc, ty1:ty2:args)
     get_args ty                          args = (ty, args)
 
-gadtResCtxt ty
-  = hang (ptext SLIT("In the result type of a data constructor:"))
-       2 (ppr ty)
 badGadtDecl ty
-  = hang (ptext SLIT("Malformed constructor result type:"))
+  = hang (ptext (sLit "Malformed constructor result type:"))
        2 (ppr ty)
 
-typeCtxt ty = ptext SLIT("In the type") <+> quotes (ppr ty)
+typeCtxt ty = ptext (sLit "In the type") <+> quotes (ppr ty)
 \end{code}
 
 %************************************************************************
@@ -661,7 +658,7 @@ tcTyVarBndrs bndrs thing_inside = do
   where
     zonk (KindedTyVar name kind) = do { kind' <- zonkTcKindToKind kind
                                      ; return (mkTyVar name kind') }
-    zonk (UserTyVar name) = WARN( True, ptext SLIT("Un-kinded tyvar") <+> ppr name )
+    zonk (UserTyVar name) = WARN( True, ptext (sLit "Un-kinded tyvar") <+> ppr name )
                            return (mkTyVar name liftedTypeKind)
 
 -----------------------------------
@@ -691,7 +688,7 @@ tcDataKindSig (Just kind)
 
 badKindSig :: Kind -> SDoc
 badKindSig kind 
- = hang (ptext SLIT("Kind signature on data type declaration has non-* return kind"))
+ = hang (ptext (sLit "Kind signature on data type declaration has non-* return kind"))
        2 (ppr kind)
 \end{code}
 
@@ -836,7 +833,7 @@ tcPatSig ctxt sig res_ty
 
 \begin{code}
 pprHsSigCtxt :: UserTypeCtxt -> LHsType Name -> SDoc
-pprHsSigCtxt ctxt hs_ty = vcat [ ptext SLIT("In") <+> pprUserTypeCtxt ctxt <> colon, 
+pprHsSigCtxt ctxt hs_ty = vcat [ ptext (sLit "In") <+> pprUserTypeCtxt ctxt <> colon, 
                                 nest 2 (pp_sig ctxt) ]
   where
     pp_sig (FunSigCtxt n)  = pp_n_colon n
@@ -848,19 +845,19 @@ pprHsSigCtxt ctxt hs_ty = vcat [ ptext SLIT("In") <+> pprUserTypeCtxt ctxt <> co
 
 
 wobblyPatSig sig_tvs
-  = hang (ptext SLIT("A pattern type signature cannot bind scoped type variables") 
+  = hang (ptext (sLit "A pattern type signature cannot bind scoped type variables") 
                <+> pprQuotedList sig_tvs)
-       2 (ptext SLIT("unless the pattern has a rigid type context"))
+       2 (ptext (sLit "unless the pattern has a rigid type context"))
                
 scopedNonVar n ty
-  = vcat [sep [ptext SLIT("The scoped type variable") <+> quotes (ppr n),
-              nest 2 (ptext SLIT("is bound to the type") <+> quotes (ppr ty))],
-         nest 2 (ptext SLIT("You can only bind scoped type variables to type variables"))]
+  = vcat [sep [ptext (sLit "The scoped type variable") <+> quotes (ppr n),
+              nest 2 (ptext (sLit "is bound to the type") <+> quotes (ppr ty))],
+         nest 2 (ptext (sLit "You can only bind scoped type variables to type variables"))]
 
 dupInScope n n' ty
-  = hang (ptext SLIT("The scoped type variables") <+> quotes (ppr n) <+> ptext SLIT("and") <+> quotes (ppr n'))
-       2 (vcat [ptext SLIT("are bound to the same type (variable)"),
-               ptext SLIT("Distinct scoped type variables must be distinct")])
+  = hang (ptext (sLit "The scoped type variables") <+> quotes (ppr n) <+> ptext (sLit "and") <+> quotes (ppr n'))
+       2 (vcat [ptext (sLit "are bound to the same type (variable)"),
+               ptext (sLit "Distinct scoped type variables must be distinct")])
 
 wrongEqualityErr
   = failWithTc (text "Equality predicate used as a type")