\begin{code}
module TcTyClsDecls (
- tcTyAndClassDecls, tcFamInstDecl, mkRecSelBinds
+ tcTyAndClassDecls, kcDataDecl, tcConDecls, mkRecSelBinds,
+ checkValidTyCon, dataDeclChecks, badFamInstDecl
) where
#include "HsVersions.h"
import TcType
import TysWiredIn ( unitTy )
import Type
-import Generics
import Class
import TyCon
import DataCon
import Var
import VarSet
import Name
+import NameEnv
import Outputable
import Maybes
import Unify
-> [[LTyClDecl Name]] -- Mutually-recursive groups in dependency order
-> TcM (TcGblEnv, -- Input env extended by types and classes
-- and their implicit Ids,DataCons
- HsValBinds Name, -- Renamed bindings for record selectors
- [Id], -- Default method ids
- [LTyClDecl Name]) -- Kind-checked declarations
+ HsValBinds Name) -- Renamed bindings for record selectors
-- Fails if there are any errors
tcTyAndClassDecls boot_details decls_s
-- second time here. This doesn't matter as the definitions are
-- the same.
; let { implicit_things = concatMap implicitTyThings tyclss
- ; rec_sel_binds = mkRecSelBinds tyclss
+ ; rec_sel_binds = mkRecSelBinds [tc | ATyCon tc <- tyclss]
; dm_ids = mkDefaultMethodIds tyclss }
- ; env <- tcExtendGlobalEnv implicit_things getGblEnv
- -- We need the kind-checked declarations later, so we return them
- -- from here
- ; kc_decls <- kcTyClDecls tyclds_s
- ; return (env, rec_sel_binds, dm_ids, kc_decls) } }
+ ; env <- tcExtendGlobalEnv implicit_things $
+ tcExtendGlobalValEnv dm_ids $
+ getGblEnv
+ ; return (env, rec_sel_binds) } }
zipRecTyClss :: [[LTyClDecl Name]]
-> [TyThing] -- Knot-tied
%************************************************************************
%* *
- Type checking family instances
-%* *
-%************************************************************************
-
-Family instances are somewhat of a hybrid. They are processed together with
-class instance heads, but can contain data constructors and hence they share a
-lot of kinding and type checking code with ordinary algebraic data types (and
-GADTs).
-
-\begin{code}
-tcFamInstDecl :: TopLevelFlag -> LTyClDecl Name -> TcM TyThing
-tcFamInstDecl top_lvl (L loc decl)
- = -- Prime error recovery, set source location
- setSrcSpan loc $
- tcAddDeclCtxt decl $
- do { -- type family instances require -XTypeFamilies
- -- and can't (currently) be in an hs-boot file
- ; type_families <- xoptM Opt_TypeFamilies
- ; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
- ; checkTc type_families $ badFamInstDecl (tcdLName decl)
- ; checkTc (not is_boot) $ badBootFamInstDeclErr
-
- -- Perform kind and type checking
- ; tc <- tcFamInstDecl1 decl
- ; checkValidTyCon tc -- Remember to check validity;
- -- no recursion to worry about here
-
- -- Check that toplevel type instances are not for associated types.
- ; when (isTopLevel top_lvl && isAssocFamily tc)
- (addErr $ assocInClassErr (tcdName decl))
-
- ; return (ATyCon tc) }
-
-isAssocFamily :: TyCon -> Bool -- Is an assocaited type
-isAssocFamily tycon
- = case tyConFamInst_maybe tycon of
- Nothing -> panic "isAssocFamily: no family?!?"
- Just (fam, _) -> isTyConAssoc fam
-
-assocInClassErr :: Name -> SDoc
-assocInClassErr name
- = ptext (sLit "Associated type") <+> quotes (ppr name) <+>
- ptext (sLit "must be inside a class instance")
-
-
-
-tcFamInstDecl1 :: TyClDecl Name -> TcM TyCon
-
- -- "type instance"
-tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name})
- = kcIdxTyPats decl $ \k_tvs k_typats resKind family ->
- do { -- check that the family declaration is for a synonym
- checkTc (isFamilyTyCon family) (notFamily family)
- ; checkTc (isSynTyCon family) (wrongKindOfFamily family)
-
- ; -- (1) kind check the right-hand side of the type equation
- ; k_rhs <- kcCheckLHsType (tcdSynRhs decl) (EK resKind EkUnk)
- -- ToDo: the ExpKind could be better
-
- -- we need the exact same number of type parameters as the family
- -- declaration
- ; let famArity = tyConArity family
- ; checkTc (length k_typats == famArity) $
- wrongNumberOfParmsErr famArity
-
- -- (2) type check type equation
- ; tcTyVarBndrs k_tvs $ \t_tvs -> do { -- turn kinded into proper tyvars
- ; t_typats <- mapM tcHsKindedType k_typats
- ; t_rhs <- tcHsKindedType k_rhs
-
- -- (3) check the well-formedness of the instance
- ; checkValidTypeInst t_typats t_rhs
-
- -- (4) construct representation tycon
- ; rep_tc_name <- newFamInstTyConName tc_name t_typats loc
- ; buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs)
- (typeKind t_rhs)
- NoParentTyCon (Just (family, t_typats))
- }}
-
- -- "newtype instance" and "data instance"
-tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
- tcdCons = cons})
- = kcIdxTyPats decl $ \k_tvs k_typats resKind fam_tycon ->
- do { -- check that the family declaration is for the right kind
- checkTc (isFamilyTyCon fam_tycon) (notFamily fam_tycon)
- ; checkTc (isAlgTyCon fam_tycon) (wrongKindOfFamily fam_tycon)
-
- ; -- (1) kind check the data declaration as usual
- ; k_decl <- kcDataDecl decl k_tvs
- ; let k_ctxt = tcdCtxt k_decl
- k_cons = tcdCons k_decl
-
- -- result kind must be '*' (otherwise, we have too few patterns)
- ; checkTc (isLiftedTypeKind resKind) $ tooFewParmsErr (tyConArity fam_tycon)
-
- -- (2) type check indexed data type declaration
- ; tcTyVarBndrs k_tvs $ \t_tvs -> do { -- turn kinded into proper tyvars
- ; unbox_strict <- doptM Opt_UnboxStrictFields
-
- -- kind check the type indexes and the context
- ; t_typats <- mapM tcHsKindedType k_typats
- ; stupid_theta <- tcHsKindedContext k_ctxt
-
- -- (3) Check that
- -- (a) left-hand side contains no type family applications
- -- (vanilla synonyms are fine, though, and we checked for
- -- foralls earlier)
- ; mapM_ checkTyFamFreeness t_typats
-
- -- Check that we don't use GADT syntax in H98 world
- ; gadt_ok <- xoptM Opt_GADTs
- ; checkTc (gadt_ok || consUseH98Syntax cons) (badGadtDecl tc_name)
-
- -- (b) a newtype has exactly one constructor
- ; checkTc (new_or_data == DataType || isSingleton k_cons) $
- newtypeConError tc_name (length k_cons)
-
- -- (4) construct representation tycon
- ; rep_tc_name <- newFamInstTyConName tc_name t_typats loc
- ; let ex_ok = True -- Existentials ok for type families!
- ; fixM (\ rep_tycon -> do
- { let orig_res_ty = mkTyConApp fam_tycon t_typats
- ; data_cons <- tcConDecls unbox_strict ex_ok rep_tycon
- (t_tvs, orig_res_ty) k_cons
- ; tc_rhs <-
- case new_or_data of
- DataType -> return (mkDataTyConRhs data_cons)
- NewType -> ASSERT( not (null data_cons) )
- mkNewTyConRhs rep_tc_name rep_tycon (head data_cons)
- ; buildAlgTyCon rep_tc_name t_tvs stupid_theta tc_rhs Recursive
- False h98_syntax NoParentTyCon (Just (fam_tycon, t_typats))
- -- We always assume that indexed types are recursive. Why?
- -- (1) Due to their open nature, we can never be sure that a
- -- further instance might not introduce a new recursive
- -- dependency. (2) They are always valid loop breakers as
- -- they involve a coercion.
- })
- }}
- where
- h98_syntax = case cons of -- All constructors have same shape
- L _ (ConDecl { con_res = ResTyGADT _ }) : _ -> False
- _ -> True
-
-tcFamInstDecl1 d = pprPanic "tcFamInstDecl1" (ppr d)
-
--- Kind checking of indexed types
--- -
-
--- Kind check type patterns and kind annotate the embedded type variables.
---
--- * Here we check that a type instance matches its kind signature, but we do
--- not check whether there is a pattern for each type index; the latter
--- check is only required for type synonym instances.
-
-kcIdxTyPats :: TyClDecl Name
- -> ([LHsTyVarBndr Name] -> [LHsType Name] -> Kind -> TyCon -> TcM a)
- -- ^^kinded tvs ^^kinded ty pats ^^res kind
- -> TcM a
-kcIdxTyPats decl thing_inside
- = kcHsTyVars (tcdTyVars decl) $ \tvs ->
- do { let tc_name = tcdLName decl
- ; fam_tycon <- tcLookupLocatedTyCon tc_name
- ; let { (kinds, resKind) = splitKindFunTys (tyConKind fam_tycon)
- ; hs_typats = fromJust $ tcdTyPats decl }
-
- -- we may not have more parameters than the kind indicates
- ; checkTc (length kinds >= length hs_typats) $
- tooManyParmsErr (tcdLName decl)
-
- -- type functions can have a higher-kinded result
- ; let resultKind = mkArrowKinds (drop (length hs_typats) kinds) resKind
- ; typats <- zipWithM kcCheckLHsType hs_typats
- [ EK kind (EkArg (ppr tc_name) n)
- | (kind,n) <- kinds `zip` [1..]]
- ; thing_inside tvs typats resultKind fam_tycon
- }
-\end{code}
-
-
-%************************************************************************
-%* *
Kind checking
%* *
%************************************************************************
; checkTc idx_tys $ badFamInstDecl tc_name
; tycon <- buildAlgTyCon tc_name final_tvs []
- DataFamilyTyCon Recursive False True
+ DataFamilyTyCon Recursive True
parent Nothing
; return [ATyCon tycon]
}
{ extra_tvs <- tcDataKindSig mb_ksig
; let final_tvs = tvs' ++ extra_tvs
; stupid_theta <- tcHsKindedContext ctxt
- ; want_generic <- xoptM Opt_Generics
- ; unbox_strict <- doptM Opt_UnboxStrictFields
- ; empty_data_decls <- xoptM Opt_EmptyDataDecls
; kind_signatures <- xoptM Opt_KindSignatures
; existential_ok <- xoptM Opt_ExistentialQuantification
; gadt_ok <- xoptM Opt_GADTs
- ; gadtSyntax_ok <- xoptM Opt_GADTSyntax
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
; let ex_ok = existential_ok || gadt_ok -- Data cons can have existential context
- -- Check that we don't use GADT syntax in H98 world
- ; checkTc (gadtSyntax_ok || h98_syntax) (badGadtDecl tc_name)
-
-- Check that we don't use kind signatures without Glasgow extensions
; checkTc (kind_signatures || isNothing mb_ksig) (badSigTyDecl tc_name)
- -- Check that the stupid theta is empty for a GADT-style declaration
- ; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
+ ; dataDeclChecks tc_name new_or_data stupid_theta cons
- -- Check that a newtype has exactly one constructor
- -- Do this before checking for empty data decls, so that
- -- we don't suggest -XEmptyDataDecls for newtypes
- ; checkTc (new_or_data == DataType || isSingleton cons)
- (newtypeConError tc_name (length cons))
-
- -- Check that there's at least one condecl,
- -- or else we're reading an hs-boot file, or -XEmptyDataDecls
- ; checkTc (not (null cons) || empty_data_decls || is_boot)
- (emptyConDeclsErr tc_name)
-
; tycon <- fixM (\ tycon -> do
{ let res_ty = mkTyConApp tycon (mkTyVarTys final_tvs)
- ; data_cons <- tcConDecls unbox_strict ex_ok
- tycon (final_tvs, res_ty) cons
+ ; data_cons <- tcConDecls ex_ok tycon (final_tvs, res_ty) cons
; tc_rhs <-
if null cons && is_boot -- In a hs-boot file, empty cons means
then return AbstractTyCon -- "don't know"; hence Abstract
NewType -> ASSERT( not (null data_cons) )
mkNewTyConRhs tc_name tycon (head data_cons)
; buildAlgTyCon tc_name final_tvs stupid_theta tc_rhs is_rec
- (want_generic && canDoGenerics stupid_theta data_cons) (not h98_syntax)
- NoParentTyCon Nothing
+ (not h98_syntax) NoParentTyCon Nothing
})
; return [ATyCon tycon]
}
tcTyVarBndrs tvs $ \ tvs' -> do
{ ctxt' <- tcHsKindedContext ctxt
; fds' <- mapM (addLocM tc_fundep) fundeps
- ; sig_stuff <- tcClassSigs class_name sigs meths
+ ; (sig_stuff, gen_dm_env) <- tcClassSigs class_name sigs meths
; clas <- fixM $ \ clas -> do
{ let -- This little knot is just so we can get
-- hold of the name of the class TyCon, which we
; buildClass False {- Must include unfoldings for selectors -}
class_name tvs' ctxt' fds' (concat atss')
sig_stuff tc_isrec }
- ; return (AClass clas : map ATyCon (classATs clas))
+
+ ; let gen_dm_ids = [ AnId (mkExportedLocalId gen_dm_name gen_dm_ty)
+ | (sel_id, GenDefMeth gen_dm_name) <- classOpItems clas
+ , let gen_dm_tau = expectJust "tcTyClDecl1" $
+ lookupNameEnv gen_dm_env (idName sel_id)
+ , let gen_dm_ty = mkSigmaTy tvs'
+ [mkClassPred clas (mkTyVarTys tvs')]
+ gen_dm_tau
+ ]
+ class_ats = map ATyCon (classATs clas)
+
+ ; return (AClass clas : gen_dm_ids ++ class_ats )
-- NB: Order is important due to the call to `mkGlobalThings' when
-- tying the the type and class declaration type checking knot.
}
tcTyClDecl1 _ _ d = pprPanic "tcTyClDecl1" (ppr d)
+dataDeclChecks :: Name -> NewOrData -> ThetaType -> [LConDecl Name] -> TcM ()
+dataDeclChecks tc_name new_or_data stupid_theta cons
+ = do { -- Check that we don't use GADT syntax in H98 world
+ gadtSyntax_ok <- xoptM Opt_GADTSyntax
+ ; let h98_syntax = consUseH98Syntax cons
+ ; checkTc (gadtSyntax_ok || h98_syntax) (badGadtDecl tc_name)
+
+ -- Check that the stupid theta is empty for a GADT-style declaration
+ ; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
+
+ -- Check that a newtype has exactly one constructor
+ -- Do this before checking for empty data decls, so that
+ -- we don't suggest -XEmptyDataDecls for newtypes
+ ; checkTc (new_or_data == DataType || isSingleton cons)
+ (newtypeConError tc_name (length cons))
+
+ -- Check that there's at least one condecl,
+ -- or else we're reading an hs-boot file, or -XEmptyDataDecls
+ ; empty_data_decls <- xoptM Opt_EmptyDataDecls
+ ; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
+ ; checkTc (not (null cons) || empty_data_decls || is_boot)
+ (emptyConDeclsErr tc_name) }
+
-----------------------------------
-tcConDecls :: Bool -> Bool -> TyCon -> ([TyVar], Type)
+tcConDecls :: Bool -> TyCon -> ([TyVar], Type)
-> [LConDecl Name] -> TcM [DataCon]
-tcConDecls unbox ex_ok rep_tycon res_tmpl cons
- = mapM (addLocM (tcConDecl unbox ex_ok rep_tycon res_tmpl)) cons
+tcConDecls ex_ok rep_tycon res_tmpl cons
+ = mapM (addLocM (tcConDecl ex_ok rep_tycon res_tmpl)) cons
-tcConDecl :: Bool -- True <=> -funbox-strict_fields
- -> Bool -- True <=> -XExistentialQuantificaton or -XGADTs
+tcConDecl :: Bool -- True <=> -XExistentialQuantificaton or -XGADTs
-> TyCon -- Representation tycon
-> ([TyVar], Type) -- Return type template (with its template tyvars)
-> ConDecl Name
-> TcM DataCon
-tcConDecl unbox_strict existential_ok rep_tycon res_tmpl -- Data types
+tcConDecl existential_ok rep_tycon res_tmpl -- Data types
con@(ConDecl {con_name = name, con_qvars = tvs, con_cxt = ctxt
, con_details = details, con_res = res_ty })
= addErrCtxt (dataConCtxt name) $
; (univ_tvs, ex_tvs, eq_preds, res_ty') <- tcResultType res_tmpl tvs' res_ty
; let
tc_datacon is_infix field_lbls btys
- = do { (arg_tys, stricts) <- mapAndUnzipM (tcConArg unbox_strict) btys
+ = do { (arg_tys, stricts) <- mapAndUnzipM tcConArg btys
; buildDataCon (unLoc name) is_infix
stricts field_lbls
univ_tvs ex_tvs eq_preds ctxt' arg_tys
f _ _ = False
-------------------
-tcConArg :: Bool -- True <=> -funbox-strict_fields
- -> LHsType Name
- -> TcM (TcType, HsBang)
-tcConArg unbox_strict bty
+tcConArg :: LHsType Name -> TcM (TcType, HsBang)
+tcConArg bty
= do { arg_ty <- tcHsBangType bty
- ; let bang = getBangStrictness bty
- ; let strict_mark = chooseBoxingStrategy unbox_strict arg_ty bang
+ ; strict_mark <- chooseBoxingStrategy arg_ty (getBangStrictness bty)
; return (arg_ty, strict_mark) }
-- We attempt to unbox/unpack a strict field when either:
--
-- We have turned off unboxing of newtypes because coercions make unboxing
-- and reboxing more complicated
-chooseBoxingStrategy :: Bool -> TcType -> HsBang -> HsBang
-chooseBoxingStrategy unbox_strict_fields arg_ty bang
+chooseBoxingStrategy :: TcType -> HsBang -> TcM HsBang
+chooseBoxingStrategy arg_ty bang
= case bang of
- HsNoBang -> HsNoBang
- HsUnpack -> can_unbox HsUnpackFailed arg_ty
- HsStrict | unbox_strict_fields -> can_unbox HsStrict arg_ty
- | otherwise -> HsStrict
+ HsNoBang -> return HsNoBang
+ HsStrict -> do { unbox_strict <- doptM Opt_UnboxStrictFields
+ ; if unbox_strict then return (can_unbox HsStrict arg_ty)
+ else return HsStrict }
+ HsUnpack -> do { omit_prags <- doptM Opt_OmitInterfacePragmas
+ -- Do not respect UNPACK pragmas if OmitInterfacePragmas is on
+ -- See Trac #5252: unpacking means we must not conceal the
+ -- representation of the argument type
+ ; if omit_prags then return HsStrict
+ else return (can_unbox HsUnpackFailed arg_ty) }
HsUnpackFailed -> pprPanic "chooseBoxingStrategy" (ppr arg_ty)
-- Source code never has shtes
where
ATyCon tc -> checkValidTyCon tc
AClass cl -> do { checkValidClass cl
; mapM_ (addLocM checkValidTyCl) (tcdATs decl) }
+ AnId _ -> return () -- Generic default methods are checked
+ -- with their parent class
_ -> panic "checkValidTyCl"
; traceTc "Done validity of" (ppr thing)
}
-- One argument
; checkTc (null eq_spec) (newtypePredError con)
-- Return type is (T a b c)
- ; checkTc (null ex_tvs && null eq_theta && null dict_theta) (newtypeExError con)
+ ; checkTc (null ex_tvs && null theta) (newtypeExError con)
-- No existentials
; checkTc (not (any isBanged (dataConStrictMarks con)))
(newtypeStrictError con)
-- No strictness
}
where
- (_univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, _res_ty) = dataConFullSig con
+ (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig con
-------------------------------
checkValidClass :: Class -> TcM ()
unary = isSingleton tyvars
no_generics = null [() | (_, (GenDefMeth _)) <- op_stuff]
- check_op constrained_class_methods (sel_id, _)
+ check_op constrained_class_methods (sel_id, dm)
= addErrCtxt (classOpCtxt sel_id tau) $ do
{ checkValidTheta SigmaCtxt (tail theta)
-- The 'tail' removes the initial (C a) from the
; checkTc (tyVarsOfType tau `intersectsVarSet` grown_tyvars)
(noClassTyVarErr cls sel_id)
- -- Check that for a generic method, the type of
- -- the method is sufficiently simple
-{- -- JPM TODO (when reinstating, remove commenting-out of badGenericMethodType
- ; checkTc (dm /= GenDefMeth || validGenericMethodType tau)
- (badGenericMethodType op_name op_ty)
--}
+ ; case dm of
+ GenDefMeth dm_name -> do { dm_id <- tcLookupId dm_name
+ ; checkValidType (FunSigCtxt op_name) (idType dm_id) }
+ _ -> return ()
}
where
op_name = idName sel_id
when typechecking the [d| .. |] quote, and typecheck them later.
\begin{code}
-mkRecSelBinds :: [TyThing] -> HsValBinds Name
+mkRecSelBinds :: [TyCon] -> HsValBinds Name
-- NB We produce *un-typechecked* bindings, rather like 'deriving'
-- This makes life easier, because the later type checking will add
-- all necessary type abstractions and applications
-mkRecSelBinds ty_things
+mkRecSelBinds tycons
= ValBindsOut [(NonRecursive, b) | b <- binds] sigs
where
(sigs, binds) = unzip rec_sels
rec_sels = map mkRecSelBind [ (tc,fld)
- | ATyCon tc <- ty_things
+ | tc <- tycons
, fld <- tyConFields tc ]
mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, LHsBinds Name)
= ptext (sLit "The multi-parameter class") <+> quotes (ppr clas) <+>
ptext (sLit "cannot have generic methods")
-{- Commented out until the call is reinstated
-badGenericMethodType :: Name -> Kind -> SDoc
-badGenericMethodType op op_ty
- = hang (ptext (sLit "Generic method type is too complex"))
- 2 (vcat [ppr op <+> dcolon <+> ppr op_ty,
- ptext (sLit "You can only use type variables, arrows, lists, and tuples")])
--}
-
recSynErr :: [LTyClDecl Name] -> TcRn ()
recSynErr syn_decls
= setSrcSpan (getLoc (head sorted_decls)) $
quotes (ppr tc_name)
, nest 2 (parens $ ptext (sLit "Use -XTypeFamilies to allow indexed type families")) ]
-tooManyParmsErr :: Located Name -> SDoc
-tooManyParmsErr tc_name
- = ptext (sLit "Family instance has too many parameters:") <+>
- quotes (ppr tc_name)
-
-tooFewParmsErr :: Arity -> SDoc
-tooFewParmsErr arity
- = ptext (sLit "Family instance has too few parameters; expected") <+>
- ppr arity
-
-wrongNumberOfParmsErr :: Arity -> SDoc
-wrongNumberOfParmsErr exp_arity
- = ptext (sLit "Number of parameters must match family declaration; expected")
- <+> ppr exp_arity
-
-badBootFamInstDeclErr :: SDoc
-badBootFamInstDeclErr
- = ptext (sLit "Illegal family instance in hs-boot file")
-
-notFamily :: TyCon -> SDoc
-notFamily tycon
- = vcat [ ptext (sLit "Illegal family instance for") <+> quotes (ppr tycon)
- , nest 2 $ parens (ppr tycon <+> ptext (sLit "is not an indexed type family"))]
-
-wrongKindOfFamily :: TyCon -> SDoc
-wrongKindOfFamily family
- = ptext (sLit "Wrong category of family instance; declaration was for a")
- <+> kindOfFamily
- where
- kindOfFamily | isSynTyCon family = ptext (sLit "type synonym")
- | isAlgTyCon family = ptext (sLit "data type")
- | otherwise = pprPanic "wrongKindOfFamily" (ppr family)
-
emptyConDeclsErr :: Name -> SDoc
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext (sLit "has no constructors"),
projects / ghc-hetmet.git / blobdiff