Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/e9e8358a2fa0cdc35f6a23b7bdfa7165020f5410 >--------------------------------------------------------------- commit e9e8358a2fa0cdc35f6a23b7bdfa7165020f5410 Author: Jose Pedro Magalhaes <j...@cs.uu.nl> Date: Mon Nov 7 16:26:32 2011 +0000 Comments about associated type defaults >--------------------------------------------------------------- compiler/typecheck/TcTyClsDecls.lhs | 24 +++++++++++++++--------- compiler/types/Class.lhs | 2 ++ 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index d2e1cb4..cc706ae 100755 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -667,14 +667,21 @@ tcTyClDecl1 _ _ %* * %************************************************************************ -Example: class C a where +Note [Associated type defaults] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The following is an example of associated type defaults: + class C a where data D a type F a b :: * type F a Z = [a] -- Default type F a (S n) = F a n -- Default -We can get default defns only for type families, not data families +Note that: + - We can have more than one default definition for a single associated type, + as long as they do not overlap (same rules as for instances) + - We can get default definitions only for type families, not data families \begin{code} tcClassATs :: Name -- The class name (not knot-tied) @@ -697,13 +704,11 @@ tcClassATs class_name parent clas_tvs ats at_defs at_defs_map = foldr (\at_def nenv -> extendNameEnv_C (++) nenv (tcdName (unLoc at_def)) [at_def]) emptyNameEnv at_defs - tc_at at = do { traceTc "tcClassATs1" (ppr at) - ; [ATyCon fam_tc] <- addLocM (tcTyClDecl1 parent - (const Recursive)) at - ; let at_defs = lookupNameEnv at_defs_map (tcdName (unLoc at)) `orElse` [] - ; traceTc "tcClassATs2" (ppr at_defs) + tc_at at = do { [ATyCon fam_tc] <- addLocM (tcTyClDecl1 parent + (const Recursive)) at + ; let at_defs = lookupNameEnv at_defs_map (tcdName (unLoc at)) + `orElse` [] ; atd <- mapM (tcDefaultAssocDecl fam_tc clas_tvs) at_defs - ; traceTc "tcClassATs3" (ppr at) ; return (fam_tc, atd) } @@ -818,7 +823,8 @@ tcFamTyPats fam_tc tyvars pats kind_checker thing_inside -- Check that left-hand side contains no type family applications -- (vanilla synonyms are fine, though, and we checked for -- foralls earlier) --- ; mapM_ checkTyFamFreeness k_typats + -- JPM: MOVE TO CHECK VALID CLASS + ; mapM_ checkTyFamFreeness k_typats ; thing_inside (t_kvs ++ tvs') (fam_arg_kinds' ++ k_typats) resKind } } diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs old mode 100644 new mode 100755 index 5ead7ea..4412ad8 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -92,6 +92,8 @@ type ClassATItem = (TyCon, [ATDefault]) -- Default associated types from these templates. If the template list is empty, -- we assume that there is no default -- not that the default is to generate no -- instances (this only makes a difference for warnings). + -- We can have more than one default per type; see + -- Note [Associated type defaults] in TcTyClsDecls data ATDefault = ATD [TyVar] [Type] Type -- Each associated type default template is a triple of: _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
