%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[TcClassDcl]{Typechecking class declarations}
+
+Typechecking class declarations
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcClassDcl ( tcClassSigs, tcClassDecl2,
getGenericInstances,
MethodSpec, tcMethodBind, mkMethodBind,
- tcAddDeclCtxt, badMethodErr
+ tcAddDeclCtxt, badMethodErr, badATErr, omittedATWarn
) where
#include "HsVersions.h"
import HsSyn
-import RnHsSyn ( maybeGenericMatch, extractHsTyVars )
-import RnExpr ( rnLExpr )
-import RnEnv ( lookupTopBndrRn, lookupImportedName )
-import Inst ( instToId, newDictBndr, newDictBndrs, newMethod, getOverlapFlag )
-import InstEnv ( mkLocalInstance )
-import TcEnv ( tcLookupLocatedClass,
- tcExtendTyVarEnv, tcExtendIdEnv,
- InstInfo(..), pprInstInfoDetails,
- simpleInstInfoTyCon, simpleInstInfoTy,
- InstBindings(..), newDFunName
- )
-import TcBinds ( TcPragFun, tcMonoBinds, tcPrags, mkPragFun, TcSigInfo(..),
- TcSigFun, mkTcSigFun )
-import TcHsType ( tcHsKindedType, tcHsSigType )
-import TcSimplify ( tcSimplifyCheck )
-import TcUnify ( checkSigTyVars, sigCtxt )
-import TcMType ( tcSkolSigTyVars )
-import TcType ( Type, SkolemInfo(ClsSkol, InstSkol), UserTypeCtxt( GenPatCtxt ),
- TcType, TcThetaType, TcTyVar, mkTyVarTys,
- mkClassPred, tcSplitSigmaTy, tcSplitFunTys,
- tcIsTyVarTy, tcSplitTyConApp_maybe, tcSplitForAllTys, tcSplitPhiTy,
- getClassPredTys_maybe, mkPhiTy, mkTyVarTy
- )
+import RnHsSyn
+import RnExpr
+import RnEnv
+import Inst
+import InstEnv
+import TcEnv
+import TcBinds
+import TcHsType
+import TcSimplify
+import TcUnify
+import TcMType
+import TcType
import TcRnMonad
-import Generics ( mkGenericRhs, validGenericInstanceType )
-import PrelInfo ( nO_METHOD_BINDING_ERROR_ID )
-import Class ( classTyVars, classBigSig,
- Class, ClassOpItem, DefMeth (..) )
-import TyCon ( TyCon, tyConName, tyConHasGenerics )
-import Type ( substTyWith )
-import MkId ( mkDefaultMethodId, mkDictFunId )
-import Id ( Id, idType, idName, mkUserLocal )
-import Name ( Name, NamedThing(..) )
-import NameEnv ( NameEnv, lookupNameEnv, mkNameEnv )
-import NameSet ( nameSetToList )
-import OccName ( reportIfUnused, mkDefaultMethodOcc )
-import RdrName ( RdrName, mkDerivedRdrName )
+import Generics
+import PrelInfo
+import Class
+import TyCon
+import Type
+import MkId
+import Id
+import Name
+import NameEnv
+import NameSet
+import OccName
+import RdrName
import Outputable
-import PrelNames ( genericTyConNames )
+import PrelNames
import DynFlags
-import ErrUtils ( dumpIfSet_dyn )
-import Util ( count, lengthIs, isSingleton, lengthExceeds )
-import Unique ( Uniquable(..) )
-import ListSetOps ( equivClassesByUniq, minusList )
-import SrcLoc ( Located(..), srcSpanStart, unLoc, noLoc )
-import Maybes ( seqMaybe, isJust, mapCatMaybes )
-import List ( partition )
-import BasicTypes ( RecFlag(..), Boxity(..) )
+import ErrUtils
+import Util
+import Unique
+import ListSetOps
+import SrcLoc
+import Maybes
+import List
+import BasicTypes
import Bag
import FastString
-\end{code}
+import Control.Monad
+\end{code}
Dictionary handling
-- between tcClassSigs and buildClass
tcClassSigs clas sigs def_methods
= do { dm_env <- checkDefaultBinds clas op_names def_methods
- ; mappM (tcClassSig dm_env) op_sigs }
+ ; mapM (tcClassSig dm_env) op_sigs }
where
op_sigs = [sig | sig@(L _ (TypeSig _ _)) <- sigs]
op_names = [n | sig@(L _ (TypeSig (L _ n) _)) <- op_sigs]
-- Check that all the defns ar generic, or none are
; checkTc (all_generic || none_generic) (mixedGenericErr op)
- ; returnM (op, all_generic)
+ ; return (op, all_generic)
}
where
n_generic = count (isJust . maybeGenericMatch) matches
Nothing -> NoDefMeth
Just False -> DefMeth
Just True -> GenDefMeth
- ; returnM (op_name, dm, op_ty) }
+ ; return (op_name, dm, op_ty) }
\end{code}
tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
tcdMeths = default_binds}))
- = recoverM (returnM (emptyLHsBinds, [])) $
- setSrcSpan loc $
- tcLookupLocatedClass class_name `thenM` \ clas ->
+ = recoverM (return (emptyLHsBinds, [])) $
+ setSrcSpan loc $ do
+ clas <- tcLookupLocatedClass class_name
-- We make a separate binding for each default method.
-- At one time I used a single AbsBinds for all of them, thus
-- default method for every class op, regardless of whether or not
-- the programmer supplied an explicit default decl for the class.
-- (If necessary we can fix that, but we don't have a convenient Id to hand.)
- in
- mapAndUnzipM tc_dm dm_sel_ids `thenM` \ (defm_binds, dm_ids_s) ->
- returnM (listToBag defm_binds, concat dm_ids_s)
+
+ (defm_binds, dm_ids_s) <- mapAndUnzipM tc_dm dm_sel_ids
+ return (listToBag defm_binds, concat dm_ids_s)
tcDefMeth origin clas tyvars binds_in sig_fn prag_fn sel_id
= do { dm_name <- lookupTopBndrRn (mkDefMethRdrName sel_id)
-- Check the context
{ dict_binds <- tcSimplifyCheck
- (ptext SLIT("class") <+> ppr clas)
+ loc
tyvars
[this_dict]
insts_needed
[instToId this_dict]
[(tyvars, local_dm_id, dm_inst_id, prags)]
(dict_binds `unionBags` defm_bind)
- ; returnM (noLoc full_bind, [local_dm_id]) }}
+ ; return (noLoc full_bind, [local_dm_id]) }}
mkDefMethRdrName :: Id -> RdrName
mkDefMethRdrName sel_id = mkDerivedRdrName (idName sel_id) mkDefaultMethodOcc
tcMethodBind inst_tyvars inst_theta avail_insts sig_fn prag_fn
(sel_id, meth_id, meth_bind)
- = recoverM (returnM emptyLHsBinds) $
+ = recoverM (return emptyLHsBinds) $ do
-- If anything fails, recover returning no bindings.
-- This is particularly useful when checking the default-method binding of
-- a class decl. If we don't recover, we don't add the default method to
let sel_name = idName sel_id
meth_sig_fn meth_name = ASSERT( meth_name == idName meth_id ) sig_fn sel_name
-- The meth_bind metions the meth_name, but sig_fn is indexed by sel_name
- in
- tcExtendTyVarEnv inst_tyvars (
- tcExtendIdEnv [meth_id] $ -- In scope for tcInstSig
- addErrCtxt (methodCtxt sel_id) $
- getLIE $
- tcMonoBinds [meth_bind] meth_sig_fn Recursive
- ) `thenM` \ ((meth_bind, mono_bind_infos), meth_lie) ->
+
+ ((meth_bind, mono_bind_infos), meth_lie)
+ <- tcExtendTyVarEnv inst_tyvars $
+ tcExtendIdEnv [meth_id] $ -- In scope for tcInstSig
+ addErrCtxt (methodCtxt sel_id) $
+ getLIE $
+ tcMonoBinds [meth_bind] meth_sig_fn Recursive
-- Now do context reduction. We simplify wrt both the local tyvars
-- and the ones of the class/instance decl, so that there is
let
[(_, Just sig, local_meth_id)] = mono_bind_infos
- in
+ loc = sig_loc sig
- addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $
- newDictBndrs (sig_loc sig) (sig_theta sig) `thenM` \ meth_dicts ->
- let
+ addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $ do
+ meth_dicts <- newDictBndrs loc (sig_theta sig)
+ let
meth_tvs = sig_tvs sig
all_tyvars = meth_tvs ++ inst_tyvars
all_insts = avail_insts ++ meth_dicts
- in
- tcSimplifyCheck
- (ptext SLIT("class or instance method") <+> quotes (ppr sel_id))
- all_tyvars all_insts meth_lie `thenM` \ lie_binds ->
- checkSigTyVars all_tyvars `thenM_`
+ lie_binds <- tcSimplifyCheck loc all_tyvars all_insts meth_lie
- tcPrags meth_id (prag_fn sel_name) `thenM` \ prags ->
- let
+ checkSigTyVars all_tyvars
+
+ prags <- tcPrags meth_id (prag_fn sel_name)
+ let
poly_meth_bind = noLoc $ AbsBinds meth_tvs
(map instToId meth_dicts)
[(meth_tvs, meth_id, local_meth_id, prags)]
(lie_binds `unionBags` meth_bind)
- in
- returnM (unitBag poly_meth_bind)
+
+ return (unitBag poly_meth_bind)
mkMethodBind :: InstOrigin
-- Find the binding for the specified method, or make
-- up a suitable default method if it isn't there
-mkMethodBind origin clas inst_tys meth_binds (sel_id, dm_info)
- = mkMethId origin clas sel_id inst_tys `thenM` \ (mb_inst, meth_id) ->
+mkMethodBind origin clas inst_tys meth_binds (sel_id, dm_info) = do
+ (mb_inst, meth_id) <- mkMethId origin clas sel_id inst_tys
let
meth_name = idName meth_id
- in
+
-- Figure out what method binding to use
-- If the user suppplied one, use it, else construct a default one
- getSrcSpanM `thenM` \ loc ->
- (case find_bind (idName sel_id) meth_name meth_binds of
- Just user_bind -> returnM user_bind
- Nothing ->
- mkDefMethRhs origin clas inst_tys sel_id loc dm_info `thenM` \ rhs ->
- -- Not infix decl
- returnM (noLoc $ mkFunBind (noLoc meth_name) [mkSimpleMatch [] rhs])
- ) `thenM` \ meth_bind ->
+ loc <- getSrcSpanM
+ meth_bind
+ <- case find_bind (idName sel_id) meth_name meth_binds of
+ Just user_bind -> return user_bind
+ Nothing -> do
+ rhs <- mkDefMethRhs origin clas inst_tys sel_id loc dm_info
+ -- Not infix decl
+ return (noLoc $ mkFunBind (noLoc meth_name) [mkSimpleMatch [] rhs])
- returnM (mb_inst, (sel_id, meth_id, meth_bind))
+ return (mb_inst, (sel_id, meth_id, meth_bind))
mkMethId :: InstOrigin -> Class
-> Id -> [TcType] -- Selector, and instance types
rho_ty = ASSERT( length tyvars == length inst_tys )
substTyWith tyvars inst_tys rho
(preds,tau) = tcSplitPhiTy rho_ty
- first_pred = head preds
+ first_pred = ASSERT( not (null preds)) head preds
in
-- The first predicate should be of form (C a b)
-- where C is the class in question
case getClassPredTys_maybe first_pred of
{ Just (clas1,tys) -> clas == clas1 ; Nothing -> False }
)
- if isSingleton preds then
+ if isSingleton preds then do
-- If it's the only one, make a 'method'
- getInstLoc origin `thenM` \ inst_loc ->
- newMethod inst_loc sel_id inst_tys `thenM` \ meth_inst ->
- returnM (Just meth_inst, instToId meth_inst)
- else
+ inst_loc <- getInstLoc origin
+ meth_inst <- newMethod inst_loc sel_id inst_tys
+ return (Just meth_inst, instToId meth_inst)
+ else do
-- If it's not the only one we need to be careful
-- For example, given 'op' defined thus:
-- class Foo a where
-- That is, the class-op's context is still there.
-- BUT: it can't be a Method any more, because it breaks
-- INVARIANT 2 of methods. (See the data decl for Inst.)
- newUnique `thenM` \ uniq ->
- getSrcSpanM `thenM` \ loc ->
+ uniq <- newUnique
+ loc <- getSrcSpanM
let
real_tau = mkPhiTy (tail preds) tau
- meth_id = mkUserLocal (getOccName sel_id) uniq real_tau
- (srcSpanStart loc) --TODO
- in
- returnM (Nothing, meth_id)
+ meth_id = mkUserLocal (getOccName sel_id) uniq real_tau loc
+
+ return (Nothing, meth_id)
-- The user didn't supply a method binding,
-- so we have to make up a default binding
-- The RHS of a default method depends on the default-method info
-mkDefMethRhs origin clas inst_tys sel_id loc DefMeth
- = -- An polymorphic default method
- lookupImportedName (mkDefMethRdrName sel_id) `thenM` \ dm_name ->
+mkDefMethRhs origin clas inst_tys sel_id loc DefMeth = do
+ -- An polymorphic default method
+ dm_name <- lookupImportedName (mkDefMethRdrName sel_id)
-- Might not be imported, but will be an OrigName
- traceRn (text "mkDefMeth" <+> ppr dm_name) `thenM_`
- returnM (nlHsVar dm_name)
+ traceRn (text "mkDefMeth" <+> ppr dm_name)
+ return (nlHsVar dm_name)
-mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth
- = -- No default method
+mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth = do
+ -- No default method
-- Warn only if -fwarn-missing-methods
- doptM Opt_WarnMissingMethods `thenM` \ warn ->
+ warn <- doptM Opt_WarnMissingMethods
warnTc (isInstDecl origin
&& warn
&& reportIfUnused (getOccName sel_id))
- (omittedMethodWarn sel_id) `thenM_`
- returnM error_rhs
+ (omittedMethodWarn sel_id)
+ return error_rhs
where
error_rhs = noLoc $ HsLam (mkMatchGroup [mkSimpleMatch wild_pats simple_rhs])
simple_rhs = nlHsApp (nlHsVar (getName nO_METHOD_BINDING_ERROR_ID))
(badGenericInstance sel_id (notGeneric tycon))
; dflags <- getDOpts
- ; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
+ ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
(vcat [ppr clas <+> ppr inst_tys,
nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
-- Rename it before returning it
; (rn_rhs, _) <- rnLExpr rhs
- ; returnM rn_rhs }
+ ; return rn_rhs }
where
rhs = mkGenericRhs sel_id clas_tyvar tycon
-- case we require that the instance decl is for a single-parameter
-- type class with type variable arguments:
-- instance (...) => C (T a b)
- clas_tyvar = head (classTyVars clas)
+ clas_tyvar = ASSERT (not (null (classTyVars clas))) head (classTyVars clas)
Just tycon = maybe_tycon
maybe_tycon = case inst_tys of
[ty] -> case tcSplitTyConApp_maybe ty of
other -> Nothing
other -> Nothing
-isInstDecl (SigOrigin (InstSkol _)) = True
-isInstDecl (SigOrigin (ClsSkol _)) = False
+isInstDecl (SigOrigin InstSkol) = True
+isInstDecl (SigOrigin (ClsSkol _)) = False
\end{code}
-- The renamer just puts the selector ID as the binder in the method binding
-- but we must use the method name; so we substitute it here. Crude but simple.
find_bind sel_name meth_name binds
- = foldlBag seqMaybe Nothing (mapBag f binds)
+ = foldlBag mplus Nothing (mapBag f binds)
where
f (L loc1 bind@(FunBind { fun_id = L loc2 op_name })) | op_name == sel_name
= Just (L loc1 (bind { fun_id = L loc2 meth_name }))
\begin{code}
getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo]
getGenericInstances class_decls
- = do { gen_inst_infos <- mappM (addLocM get_generics) class_decls
+ = do { gen_inst_infos <- mapM (addLocM get_generics) class_decls
; let { gen_inst_info = concat gen_inst_infos }
-- Return right away if there is no generic stuff
- ; if null gen_inst_info then returnM []
+ ; if null gen_inst_info then return []
else do
-- Otherwise print it out
{ dflags <- getDOpts
- ; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
- (vcat (map pprInstInfoDetails gen_inst_info)))
- ; returnM gen_inst_info }}
+ ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
+ (vcat (map pprInstInfoDetails gen_inst_info)))
+ ; return gen_inst_info }}
get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
| null generic_binds
- = returnM [] -- The comon case: no generic default methods
+ = return [] -- The comon case: no generic default methods
| otherwise -- A source class decl with generic default methods
- = recoverM (returnM []) $
- tcAddDeclCtxt decl $
- tcLookupLocatedClass class_name `thenM` \ clas ->
+ = recoverM (return []) $
+ tcAddDeclCtxt decl $ do
+ clas <- tcLookupLocatedClass class_name
-- Group by type, and
-- make an InstInfo out of each group
let
groups = groupWith listToBag generic_binds
- in
- mappM (mkGenericInstance clas) groups `thenM` \ inst_infos ->
+
+ inst_infos <- mapM (mkGenericInstance clas) groups
-- Check that there is only one InstInfo for each type constructor
-- The main way this can fail is if you write
-- f {| a+b |} ... = ...
-- f {| x+y |} ... = ...
-- Then at this point we'll have an InstInfo for each
+ --
+ -- The class should be unary, which is why simpleInstInfoTyCon should be ok
let
tc_inst_infos :: [(TyCon, InstInfo)]
tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
group `lengthExceeds` 1]
get_uniq (tc,_) = getUnique tc
- in
- mappM (addErrTc . dupGenericInsts) bad_groups `thenM_`
+
+ mapM (addErrTc . dupGenericInsts) bad_groups
-- Check that there is an InstInfo for each generic type constructor
let
missing = genericTyConNames `minusList` [tyConName tc | (tc,_) <- tc_inst_infos]
- in
- checkTc (null missing) (missingGenericInstances missing) `thenM_`
- returnM inst_infos
+ checkTc (null missing) (missingGenericInstances missing)
+
+ return inst_infos
where
generic_binds :: [(HsType Name, LHsBind Name)]
generic_binds = getGenericBinds def_methods
-> (HsType Name, LHsBinds Name)
-> TcM InstInfo
-mkGenericInstance clas (hs_ty, binds)
+mkGenericInstance clas (hs_ty, binds) = do
-- Make a generic instance declaration
-- For example: instance (C a, C b) => C (a+b) where { binds }
- = -- Extract the universally quantified type variables
+ -- Extract the universally quantified type variables
-- and wrap them as forall'd tyvars, so that kind inference
-- works in the standard way
let
sig_tvs = map (noLoc.UserTyVar) (nameSetToList (extractHsTyVars (noLoc hs_ty)))
hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
- in
+
-- Type-check the instance type, and check its form
- tcHsSigType GenPatCtxt hs_forall_ty `thenM` \ forall_inst_ty ->
+ forall_inst_ty <- tcHsSigType GenPatCtxt hs_forall_ty
let
(tyvars, inst_ty) = tcSplitForAllTys forall_inst_ty
- in
+
checkTc (validGenericInstanceType inst_ty)
- (badGenericInstanceType binds) `thenM_`
+ (badGenericInstanceType binds)
-- Make the dictionary function.
- getSrcSpanM `thenM` \ span ->
- getOverlapFlag `thenM` \ overlap_flag ->
- newDFunName clas [inst_ty] (srcSpanStart span) `thenM` \ dfun_name ->
+ span <- getSrcSpanM
+ overlap_flag <- getOverlapFlag
+ dfun_name <- newDFunName clas [inst_ty] span
let
inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
dfun_id = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
ispec = mkLocalInstance dfun_id overlap_flag
- in
- returnM (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] })
+
+ return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] })
\end{code}
tcAddDeclCtxt decl thing_inside
= addErrCtxt ctxt thing_inside
where
- thing = case decl of
- ClassDecl {} -> "class"
- TySynonym {} -> "type synonym"
- TyData {tcdND = NewType} -> "newtype"
- TyData {tcdND = DataType} -> "data type"
+ thing | isClassDecl decl = "class"
+ | isTypeDecl decl = "type synonym" ++ maybeInst
+ | isDataDecl decl = if tcdND decl == NewType
+ then "newtype" ++ maybeInst
+ else "data type" ++ maybeInst
+ | isFamilyDecl decl = "family"
+
+ maybeInst | isFamInstDecl decl = " instance"
+ | otherwise = ""
- ctxt = hsep [ptext SLIT("In the"), text thing,
- ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]
+ ctxt = hsep [ptext (sLit "In the"), text thing,
+ ptext (sLit "declaration for"), quotes (ppr (tcdName decl))]
defltMethCtxt clas
- = ptext SLIT("When checking the default methods for class") <+> quotes (ppr clas)
+ = ptext (sLit "When checking the default methods for class") <+> quotes (ppr clas)
methodCtxt sel_id
- = ptext SLIT("In the definition for method") <+> quotes (ppr sel_id)
+ = ptext (sLit "In the definition for method") <+> quotes (ppr sel_id)
badMethodErr clas op
- = hsep [ptext SLIT("Class"), quotes (ppr clas),
- ptext SLIT("does not have a method"), quotes (ppr op)]
+ = hsep [ptext (sLit "Class"), quotes (ppr clas),
+ ptext (sLit "does not have a method"), quotes (ppr op)]
+
+badATErr clas at
+ = hsep [ptext (sLit "Class"), quotes (ppr clas),
+ ptext (sLit "does not have an associated type"), quotes (ppr at)]
omittedMethodWarn sel_id
- = ptext SLIT("No explicit method nor default method for") <+> quotes (ppr sel_id)
+ = ptext (sLit "No explicit method nor default method for") <+> quotes (ppr sel_id)
+
+omittedATWarn at
+ = ptext (sLit "No explicit AT declaration for") <+> quotes (ppr at)
badGenericInstance sel_id because
- = sep [ptext SLIT("Can't derive generic code for") <+> quotes (ppr sel_id),
+ = sep [ptext (sLit "Can't derive generic code for") <+> quotes (ppr sel_id),
because]
notSimple inst_tys
- = vcat [ptext SLIT("because the instance type(s)"),
+ = vcat [ptext (sLit "because the instance type(s)"),
nest 2 (ppr inst_tys),
- ptext SLIT("is not a simple type of form (T a b c)")]
+ ptext (sLit "is not a simple type of form (T a1 ... an)")]
notGeneric tycon
- = vcat [ptext SLIT("because the instance type constructor") <+> quotes (ppr tycon) <+>
- ptext SLIT("was not compiled with -fgenerics")]
+ = vcat [ptext (sLit "because the instance type constructor") <+> quotes (ppr tycon) <+>
+ ptext (sLit "was not compiled with -fgenerics")]
badGenericInstanceType binds
- = vcat [ptext SLIT("Illegal type pattern in the generic bindings"),
+ = vcat [ptext (sLit "Illegal type pattern in the generic bindings"),
nest 4 (ppr binds)]
missingGenericInstances missing
- = ptext SLIT("Missing type patterns for") <+> pprQuotedList missing
+ = ptext (sLit "Missing type patterns for") <+> pprQuotedList missing
dupGenericInsts tc_inst_infos
- = vcat [ptext SLIT("More than one type pattern for a single generic type constructor:"),
+ = vcat [ptext (sLit "More than one type pattern for a single generic type constructor:"),
nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
- ptext SLIT("All the type patterns for a generic type constructor must be identical")
+ ptext (sLit "All the type patterns for a generic type constructor must be identical")
]
where
ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
mixedGenericErr op
- = ptext SLIT("Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
+ = ptext (sLit "Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
\end{code}
projects / ghc-hetmet.git / blobdiff