From 1c05d4fbb6ee7ab68470d0aa79d74a3a4f0d8383 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Fri, 6 Jun 2008 12:17:30 +0000 Subject: [PATCH] Fix Trac #2334: validity checking for type families When we deal with a family-instance declaration (TcTyClsDecls.tcFamInstDecl) we must check the TyCon for validity; for example, that a newtype has exactly one field. That is done all-at-once for normal declarations, and had been forgotten altogether for families. I also refactored the interface to tcFamInstDecl1 slightly. A slightly separate matter: if there's an error in family instances (e.g. overlap) we get a confusing error message cascade if we attempt to deal with 'deriving' clauses too; this patch bales out earlier in that case. Another slightly separate matter: standalone deriving for family instances can legitimately have more specific types, just like normal data decls. For example data instance F [a] = ... deriving instance (Eq a, Eq b) => Eq (F [(a,b)]) So tcLookupFamInstExact can a bit more forgiving than it was. --- compiler/typecheck/TcDeriv.lhs | 52 ++++++++++++++++++++--------------- compiler/typecheck/TcInstDcls.lhs | 3 ++ compiler/typecheck/TcTyClsDecls.lhs | 20 ++++++-------- 3 files changed, 42 insertions(+), 33 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 3aecc43..b1a2819 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -465,9 +465,29 @@ baleOut :: Message -> TcM (Maybe a) baleOut err = do { addErrTc err; return Nothing } \end{code} -Auxiliary lookup wrapper which requires that looked up family instances are -not type instances. If called with a vanilla tycon, the old type application -is simply returned. +Note [Looking up family instances for deriving] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +tcLookupFamInstExact is an auxiliary lookup wrapper which requires +that looked-up family instances exist. If called with a vanilla +tycon, the old type application is simply returned. + +If we have + data instance F () = ... deriving Eq + data instance F () = ... deriving Eq +then tcLookupFamInstExact will be confused by the two matches; +but that can't happen because tcInstDecls1 doesn't call tcDeriving +if there are any overlaps. + +There are two other things that might go wrong with the lookup. +First, we might see a standalone deriving clause + deriving Eq (F ()) +when there is no data instance F () in scope. + +Note that it's OK to have + data instance F [a] = ... + deriving Eq (F [(a,b)]) +where the match is not exact; the same holds for ordinary data types +with standalone deriving declrations. \begin{code} tcLookupFamInstExact :: TyCon -> [Type] -> TcM (TyCon, [Type]) @@ -477,18 +497,14 @@ tcLookupFamInstExact tycon tys | otherwise = do { maybeFamInst <- tcLookupFamInst tycon tys ; case maybeFamInst of - Nothing -> famInstNotFound tycon tys False - Just famInst@(_, rep_tys) - | not variable_only_subst -> famInstNotFound tycon tys True - | otherwise -> return famInst - where - tvs = map (Type.getTyVar - "TcDeriv.tcLookupFamInstExact") - rep_tys - variable_only_subst = all Type.isTyVarTy rep_tys && - sizeVarSet (mkVarSet tvs) == length tvs - -- renaming may have no repetitions + Nothing -> famInstNotFound tycon tys + Just famInst -> return famInst } + +famInstNotFound :: TyCon -> [Type] -> TcM a +famInstNotFound tycon tys + = failWithTc (ptext (sLit "No family instance for") + <+> quotes (pprTypeApp tycon (ppr tycon) tys)) \end{code} @@ -1182,12 +1198,4 @@ badDerivedPred pred = vcat [ptext (sLit "Can't derive instances where the instance context mentions"), ptext (sLit "type variables that are not data type parameters"), nest 2 (ptext (sLit "Offending constraint:") <+> ppr pred)] - -famInstNotFound :: TyCon -> [Type] -> Bool -> TcM a -famInstNotFound tycon tys notExact - = failWithTc (msg <+> quotes (pprTypeApp tycon (ppr tycon) tys)) - where - msg = ptext $ if notExact - then sLit "No family instance exactly matching" - else sLit "More than one family instance for" \end{code} diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 203ffe4..a2d8242 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -187,6 +187,9 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls -- decl, so it needs to know about all the instances possible -- NB: class instance declarations can contain derivings as -- part of associated data type declarations + failIfErrsM -- If the addInsts stuff gave any errors, don't + -- try the deriving stuff, becuase that may give + -- more errors still ; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls inst_decls deriv_decls ; addInsts deriv_inst_info $ do { diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index ba17fdd..35c7470 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -259,11 +259,14 @@ tcFamInstDecl (L loc decl) ; checkTc type_families $ badFamInstDecl (tcdLName decl) ; checkTc (not is_boot) $ badBootFamInstDeclErr - -- perform kind and type checking - ; tcFamInstDecl1 decl + -- Perform kind and type checking + ; tc <- tcFamInstDecl1 decl + ; checkValidTyCon tc -- Remember to check validity; + -- no recursion to worry about here + ; return (Just (ATyCon tc)) } -tcFamInstDecl1 :: TyClDecl Name -> TcM (Maybe TyThing) -- Nothing if error +tcFamInstDecl1 :: TyClDecl Name -> TcM TyCon -- "type instance" tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name}) @@ -292,10 +295,8 @@ tcFamInstDecl1 (decl@TySynonym {tcdLName = L loc tc_name}) -- (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)) - - ; return $ Just (ATyCon tycon) + ; buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs) + (Just (family, t_typats)) }} -- "newtype instance" and "data instance" @@ -338,7 +339,7 @@ tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name, -- (4) construct representation tycon ; rep_tc_name <- newFamInstTyConName tc_name loc ; let ex_ok = True -- Existentials ok for type families! - ; tycon <- fixM (\ tycon -> do + ; fixM (\ tycon -> do { data_cons <- mapM (addLocM (tcConDecl unbox_strict ex_ok tycon t_tvs)) k_cons ; tc_rhs <- @@ -354,9 +355,6 @@ tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name, -- dependency. (2) They are always valid loop breakers as -- they involve a coercion. }) - - -- construct result - ; return $ Just (ATyCon tycon) }} where h98_syntax = case cons of -- All constructors have same shape -- 1.7.10.4