From 485c8034041b7d7f26688c24b88a50a62e3d3229 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Fri, 29 Jun 2007 04:59:31 +0000 Subject: [PATCH] RHS of a type instance must be a tau type --- compiler/typecheck/TcTyClsDecls.lhs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 191e546..56ff0e1 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -259,7 +259,7 @@ tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name}) unless (isSynTyCon family) $ addErr (wrongKindOfFamily family) - ; -- (1) kind check the right hand side of the type equation + ; -- (1) kind check the right-hand side of the type equation ; k_rhs <- kcCheckHsType (tcdSynRhs decl) resKind -- (2) type check type equation @@ -267,7 +267,11 @@ tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name}) ; t_typats <- mappM tcHsKindedType k_typats ; t_rhs <- tcHsKindedType k_rhs - -- (3) construct representation tycon + ; -- (3) check that the right-hand side is a tau type + ; unless (isTauTy t_rhs) $ + addErr (polyTyErr t_rhs) + + -- (4) construct representation tycon ; rep_tc_name <- newFamInstTyConName tc_name loc ; tycon <- buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs) (Just (family, t_typats)) @@ -339,7 +343,7 @@ tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name, -- -- * 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 functions. +-- check is only required for type synonym instances. -- kcIdxTyPats :: TyClDecl Name -> ([LHsTyVarBndr Name] -> [LHsType Name] -> Kind -> TyCon -> TcM a) @@ -1203,6 +1207,10 @@ wrongKindOfFamily family = | isAlgTyCon family = ptext SLIT("data type") | otherwise = pprPanic "wrongKindOfFamily" (ppr family) +polyTyErr ty + = hang (ptext SLIT("Illegal polymorphic type in type instance") <> colon) 4 $ + ppr ty + emptyConDeclsErr tycon = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"), nest 2 $ ptext SLIT("(-fglasgow-exts permits this)")] -- 1.7.10.4