diff options
| -rw-r--r-- | compiler/deSugar/DsMeta.hs | 4 | ||||
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 2 | ||||
| -rw-r--r-- | compiler/hsSyn/HsDecls.hs | 7 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 3 | ||||
| -rw-r--r-- | compiler/rename/RnSource.hs | 3 | ||||
| -rw-r--r-- | compiler/typecheck/TcHsType.hs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 395 |
7 files changed, 222 insertions, 202 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index ed2c612e94..085cfc5ec3 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -470,10 +470,10 @@ repAssocTyFamDefaults = mapM rep_deflt ------------------------- -- represent fundeps -- -repLFunDeps :: [Located (FunDep (Located Name))] -> DsM (Core [TH.FunDep]) +repLFunDeps :: [LHsFunDep GhcRn] -> DsM (Core [TH.FunDep]) repLFunDeps fds = repList funDepTyConName repLFunDep fds -repLFunDep :: Located (FunDep (Located Name)) -> DsM (Core TH.FunDep) +repLFunDep :: LHsFunDep GhcRn -> DsM (Core TH.FunDep) repLFunDep (L _ (xs, ys)) = do xs' <- repList nameTyConName (lookupBinder . unLoc) xs ys' <- repList nameTyConName (lookupBinder . unLoc) ys diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index fbecf9ce9e..66a2681f0b 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -598,7 +598,7 @@ cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs) cvtDerivs cs = do { cs' <- mapM cvtDerivClause cs ; returnL cs' } -cvt_fundep :: FunDep -> CvtM (Located (Class.FunDep (Located RdrName))) +cvt_fundep :: FunDep -> CvtM (LHsFunDep GhcPs) cvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs ; ys' <- mapM tNameL ys ; returnL (xs', ys') } diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 6dde482c9a..2d2e911645 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -18,7 +18,7 @@ -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@. module HsDecls ( -- * Toplevel declarations - HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, + HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour, -- ** Class or type declarations @@ -528,8 +528,7 @@ data TyClDecl pass tcdLName :: Located (IdP pass), -- ^ Name of the class tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables tcdFixity :: LexicalFixity, -- ^ Fixity used in the declaration - tcdFDs :: [Located (FunDep (Located (IdP pass)))], - -- ^ Functional deps + tcdFDs :: [LHsFunDep pass], -- ^ Functional deps tcdSigs :: [LSig pass], -- ^ Methods' signatures tcdMeths :: LHsBinds pass, -- ^ Default methods tcdATs :: [LFamilyDecl pass], -- ^ Associated types; @@ -546,6 +545,8 @@ data TyClDecl pass -- For details on above see note [Api annotations] in ApiAnnotation | XTyClDecl (XXTyClDecl pass) +type LHsFunDep pass = Located (FunDep (Located (IdP pass))) + data DataDeclRn = DataDeclRn { tcdDataCusk :: Bool -- ^ does this have a CUSK? , tcdFVs :: NameSet } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 681ecdeae0..5784b9ecdb 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -78,7 +78,6 @@ module RdrHsSyn ( import GhcPrelude import HsSyn -- Lots of it -import Class ( FunDep ) import TyCon ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe ) import DataCon ( DataCon, dataConTyCon ) import ConLike ( ConLike(..) ) @@ -142,7 +141,7 @@ mkInstD (L loc d) = L loc (InstD noExt d) mkClassDecl :: SrcSpan -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) - -> Located (a,[Located (FunDep (Located RdrName))]) + -> Located (a,[LHsFunDep GhcPs]) -> OrdList (LHsDecl GhcPs) -> P (LTyClDecl GhcPs) diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 596852031a..987ed177aa 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -2141,8 +2141,7 @@ extendPatSynEnv val_decls local_fix_env thing = do { ********************************************************* -} -rnFds :: [Located (FunDep (Located RdrName))] - -> RnM [Located (FunDep (Located Name))] +rnFds :: [LHsFunDep GhcPs] -> RnM [LHsFunDep GhcRn] rnFds fds = mapM (wrapLocM rn_fds) fds where diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 6048caa97b..ed488320b0 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -207,7 +207,8 @@ tcHsSigType ctxt sig_ty -- of kind * in a Template Haskell quote eg [t| Maybe |] -- Generalise here: see Note [Kind generalisation] - ; ty <- tc_hs_sig_type_and_gen skol_info sig_ty kind >>= zonkTcType + ; ty <- tc_hs_sig_type_and_gen skol_info sig_ty kind + ; ty <- zonkTcType ty ; checkValidType ctxt ty ; traceTc "end tcHsSigType }" (ppr ty) @@ -226,10 +227,9 @@ tc_hs_sig_type_and_gen skol_info (HsIB { hsib_ext = sig_vars = do { ((tkvs, ty), wanted) <- captureConstraints $ tcImplicitTKBndrs skol_info sig_vars $ tc_lhs_type typeLevelMode hs_ty kind - -- Any remaining variables (unsolved in the solveLocalEqualities in the - -- tcImplicitTKBndrs) - -- should be in the global tyvars, and therefore won't be quantified - -- over. + -- Any remaining variables (unsolved in the solveLocalEqualities + -- in the tcImplicitTKBndrs) should be in the global tyvars, + -- and therefore won't be quantified over ; let ty1 = mkSpecForAllTys tkvs ty ; kvs <- kindGeneralizeLocal wanted ty1 diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 97f794deae..fd032f8530 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -987,52 +987,222 @@ tcTyClDecl1 _parent roles_info tcTyClDecl1 _parent roles_info (ClassDecl { tcdLName = L _ class_name - , tcdCtxt = ctxt, tcdMeths = meths + , tcdCtxt = hs_ctxt, tcdMeths = meths , tcdFDs = fundeps, tcdSigs = sigs , tcdATs = ats, tcdATDefs = at_defs }) = ASSERT( isNothing _parent ) - do { clas <- fixM $ \ clas -> - -- We need the knot because 'clas' is passed into tcClassATs - tcTyClTyVars class_name $ \ binders res_kind -> - do { MASSERT2( tcIsConstraintKind res_kind - , ppr class_name $$ ppr res_kind ) - ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders) - ; let tycon_name = class_name -- We use the same name - roles = roles_info tycon_name -- for TyCon and Class - - ; ctxt' <- solveEqualities $ tcHsContext ctxt - ; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt' - -- Squeeze out any kind unification variables - ; fds' <- mapM (addLocM tc_fundep) fundeps - ; sig_stuff <- tcClassSigs class_name sigs meths - ; at_stuff <- tcClassATs class_name clas ats at_defs - ; mindef <- tcClassMinimalDef class_name sigs sig_stuff - -- TODO: Allow us to distinguish between abstract class, - -- and concrete class with no methods (maybe by - -- specifying a trailing where or not - ; sig_stuff' <- mapM zonkTcMethInfoToMethInfo sig_stuff - -- this zonk is really just to squeeze out the TcTyCons - -- and convert, e.g., Skolems to tyvars. We won't - -- see any unfilled metavariables here. - - ; is_boot <- tcIsHsBootOrSig - ; let body | is_boot, null ctxt', null at_stuff, null sig_stuff - = Nothing - | otherwise - = Just (ctxt', at_stuff, sig_stuff', mindef) - - ; clas <- buildClass class_name binders roles fds' body - ; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$ - ppr fds') - ; return clas } - - ; return (classTyCon clas) } + do { clas <- tcClassDecl1 roles_info class_name hs_ctxt + meths fundeps sigs ats at_defs + ; return (classTyCon clas) } + +tcTyClDecl1 _ _ (XTyClDecl _) = panic "tcTyClDecl1" + + +{- ********************************************************************* +* * + Class declarations +* * +********************************************************************* -} + +tcClassDecl1 :: RolesInfo -> Name -> LHsContext GhcRn + -> LHsBinds GhcRn -> [LHsFunDep GhcRn] -> [LSig GhcRn] + -> [LFamilyDecl GhcRn] -> [LTyFamDefltEqn GhcRn] + -> TcM Class +tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs + = fixM $ \ clas -> + -- We need the knot because 'clas' is passed into tcClassATs + tcTyClTyVars class_name $ \ binders res_kind -> + do { MASSERT2( tcIsConstraintKind res_kind + , ppr class_name $$ ppr res_kind ) + ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders) + ; let tycon_name = class_name -- We use the same name + roles = roles_info tycon_name -- for TyCon and Class + + ; (ctxt, fds, sig_stuff, at_stuff) + <- solveEqualities $ + do { ctxt <- tcHsContext hs_ctxt + ; fds <- mapM (addLocM tc_fundep) fundeps + ; sig_stuff <- tcClassSigs class_name sigs meths + ; at_stuff <- tcClassATs class_name clas ats at_defs + ; return (ctxt, fds, sig_stuff, at_stuff) } + + -- The solveEqualities will report errors for any + -- unsolved equalities, so these zonks should not encounter + -- any unfilled coercion variables unless there is such an error + -- The zonk also squeeze out the TcTyCons, and converts + -- Skolems to tyvars. + ; ctxt <- zonkTcTypeToTypes emptyZonkEnv ctxt + ; sig_stuff <- mapM zonkTcMethInfoToMethInfo sig_stuff + -- ToDo: do we need to zonk at_stuff? + + -- TODO: Allow us to distinguish between abstract class, + -- and concrete class with no methods (maybe by + -- specifying a trailing where or not + + ; mindef <- tcClassMinimalDef class_name sigs sig_stuff + ; is_boot <- tcIsHsBootOrSig + ; let body | is_boot, null ctxt, null at_stuff, null sig_stuff + = Nothing + | otherwise + = Just (ctxt, at_stuff, sig_stuff, mindef) + + ; clas <- buildClass class_name binders roles fds body + ; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$ + ppr fds) + ; return clas } where tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM (tcLookupTyVar . unLoc) tvs1 ; ; tvs2' <- mapM (tcLookupTyVar . unLoc) tvs2 ; ; return (tvs1', tvs2') } -tcTyClDecl1 _ _ (XTyClDecl _) = panic "tcTyClDecl1" + +{- 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 b = [a] -- Default + +Note that we can get default definitions only for type families, not data +families. +-} + +tcClassATs :: Name -- The class name (not knot-tied) + -> Class -- The class parent of this associated type + -> [LFamilyDecl GhcRn] -- Associated types. + -> [LTyFamDefltEqn GhcRn] -- Associated type defaults. + -> TcM [ClassATItem] +tcClassATs class_name cls ats at_defs + = do { -- Complain about associated type defaults for non associated-types + sequence_ [ failWithTc (badATErr class_name n) + | n <- map at_def_tycon at_defs + , not (n `elemNameSet` at_names) ] + ; mapM tc_at ats } + where + at_def_tycon :: LTyFamDefltEqn GhcRn -> Name + at_def_tycon (L _ eqn) = unLoc (feqn_tycon eqn) + + at_fam_name :: LFamilyDecl GhcRn -> Name + at_fam_name (L _ decl) = unLoc (fdLName decl) + + at_names = mkNameSet (map at_fam_name ats) + + at_defs_map :: NameEnv [LTyFamDefltEqn GhcRn] + -- Maps an AT in 'ats' to a list of all its default defs in 'at_defs' + at_defs_map = foldr (\at_def nenv -> extendNameEnv_C (++) nenv + (at_def_tycon at_def) [at_def]) + emptyNameEnv at_defs + + tc_at at = do { fam_tc <- addLocM (tcFamDecl1 (Just cls)) at + ; let at_defs = lookupNameEnv at_defs_map (at_fam_name at) + `orElse` [] + ; atd <- tcDefaultAssocDecl fam_tc at_defs + ; return (ATI fam_tc atd) } + +------------------------- +tcDefaultAssocDecl :: TyCon -- ^ Family TyCon (not knot-tied) + -> [LTyFamDefltEqn GhcRn] -- ^ Defaults + -> TcM (Maybe (KnotTied Type, SrcSpan)) -- ^ Type checked RHS +tcDefaultAssocDecl _ [] + = return Nothing -- No default declaration + +tcDefaultAssocDecl _ (d1:_:_) + = failWithTc (text "More than one default declaration for" + <+> ppr (feqn_tycon (unLoc d1))) + +tcDefaultAssocDecl fam_tc [L loc (FamEqn { feqn_tycon = L _ tc_name + , feqn_pats = hs_tvs + , feqn_rhs = rhs })] + | HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = imp_vars} + , hsq_explicit = exp_vars } <- hs_tvs + = -- See Note [Type-checking default assoc decls] + setSrcSpan loc $ + tcAddFamInstCtxt (text "default type instance") tc_name $ + do { traceTc "tcDefaultAssocDecl" (ppr tc_name) + ; let fam_tc_name = tyConName fam_tc + fam_arity = length (tyConVisibleTyVars fam_tc) + + -- Kind of family check + ; ASSERT( fam_tc_name == tc_name ) + checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc) + + -- Arity check + ; checkTc (exp_vars `lengthIs` fam_arity) + (wrongNumberOfParmsErr fam_arity) + + -- Typecheck RHS + ; let all_vars = imp_vars ++ map hsLTyVarName exp_vars + pats = map hsLTyVarBndrToType exp_vars + + -- NB: Use tcFamTyPats, not tcTyClTyVars. The latter expects to get + -- the LHsQTyVars used for declaring a tycon, but the names here + -- are different. + + -- You might think we should pass in some ClsInstInfo, as we're looking + -- at an associated type. But this would be wrong, because an associated + -- type default LHS can mention *different* type variables than the + -- enclosing class. So it's treated more as a freestanding beast. + ; (pats', rhs_ty) + <- tcFamTyPats fam_tc Nothing all_vars pats + (kcTyFamEqnRhs Nothing rhs) $ + \tvs pats rhs_kind -> + do { rhs_ty <- solveEqualities $ + tcCheckLHsType rhs rhs_kind + + -- Zonk the patterns etc into the Type world + ; (ze, _) <- zonkTyBndrsX emptyZonkEnv tvs + ; pats' <- zonkTcTypeToTypes ze pats + ; rhs_ty' <- zonkTcTypeToType ze rhs_ty + ; return (pats', rhs_ty') } + + -- See Note [Type-checking default assoc decls] + ; case tcMatchTys pats' (mkTyVarTys (tyConTyVars fam_tc)) of + Just subst -> return (Just (substTyUnchecked subst rhs_ty, loc) ) + Nothing -> failWithTc (defaultAssocKindErr fam_tc) + -- We check for well-formedness and validity later, + -- in checkValidClass + } +tcDefaultAssocDecl _ [L _ (XFamEqn _)] = panic "tcDefaultAssocDecl" +tcDefaultAssocDecl _ [L _ (FamEqn _ (L _ _) (XLHsQTyVars _) _ _)] + = panic "tcDefaultAssocDecl" + +{- Note [Type-checking default assoc decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this default declaration for an associated type + + class C a where + type F (a :: k) b :: * + type F x y = Proxy x -> y + +Note that the class variable 'a' doesn't scope over the default assoc +decl (rather oddly I think), and (less oddly) neither does the second +argument 'b' of the associated type 'F', or the kind variable 'k'. +Instead, the default decl is treated more like a top-level type +instance. + +However we store the default rhs (Proxy x -> y) in F's TyCon, using +F's own type variables, so we need to convert it to (Proxy a -> b). +We do this by calling tcMatchTys to match them up. This also ensures +that x's kind matches a's and similarly for y and b. The error +message isn't great, mind you. (Trac #11361 was caused by not doing a +proper tcMatchTys here.) + +Recall also that the left-hand side of an associated type family +default is always just variables -- no tycons here. Accordingly, +the patterns used in the tcMatchTys won't actually be knot-tied, +even though we're in the knot. This is too delicate for my taste, +but it works. + +-} + +{- ********************************************************************* +* * + Type family declarations +* * +********************************************************************* -} tcFamDecl1 :: Maybe Class -> FamilyDecl GhcRn -> TcM TyCon tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_name) @@ -1246,155 +1416,6 @@ tcDataDefn roles_info mkNewTyConRhs tc_name tycon (head data_cons) tcDataDefn _ _ _ _ (XHsDataDefn _) = panic "tcDataDefn" -{- -************************************************************************ -* * - Typechecking associated types (in class decls) - (including the associated-type defaults) -* * -************************************************************************ - -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 b = [a] -- Default - -Note that we can get default definitions only for type families, not data -families. --} - -tcClassATs :: Name -- The class name (not knot-tied) - -> Class -- The class parent of this associated type - -> [LFamilyDecl GhcRn] -- Associated types. - -> [LTyFamDefltEqn GhcRn] -- Associated type defaults. - -> TcM [ClassATItem] -tcClassATs class_name cls ats at_defs - = do { -- Complain about associated type defaults for non associated-types - sequence_ [ failWithTc (badATErr class_name n) - | n <- map at_def_tycon at_defs - , not (n `elemNameSet` at_names) ] - ; mapM tc_at ats } - where - at_def_tycon :: LTyFamDefltEqn GhcRn -> Name - at_def_tycon (L _ eqn) = unLoc (feqn_tycon eqn) - - at_fam_name :: LFamilyDecl GhcRn -> Name - at_fam_name (L _ decl) = unLoc (fdLName decl) - - at_names = mkNameSet (map at_fam_name ats) - - at_defs_map :: NameEnv [LTyFamDefltEqn GhcRn] - -- Maps an AT in 'ats' to a list of all its default defs in 'at_defs' - at_defs_map = foldr (\at_def nenv -> extendNameEnv_C (++) nenv - (at_def_tycon at_def) [at_def]) - emptyNameEnv at_defs - - tc_at at = do { fam_tc <- addLocM (tcFamDecl1 (Just cls)) at - ; let at_defs = lookupNameEnv at_defs_map (at_fam_name at) - `orElse` [] - ; atd <- tcDefaultAssocDecl fam_tc at_defs - ; return (ATI fam_tc atd) } - -------------------------- -tcDefaultAssocDecl :: TyCon -- ^ Family TyCon (not knot-tied) - -> [LTyFamDefltEqn GhcRn] -- ^ Defaults - -> TcM (Maybe (KnotTied Type, SrcSpan)) -- ^ Type checked RHS -tcDefaultAssocDecl _ [] - = return Nothing -- No default declaration - -tcDefaultAssocDecl _ (d1:_:_) - = failWithTc (text "More than one default declaration for" - <+> ppr (feqn_tycon (unLoc d1))) - -tcDefaultAssocDecl fam_tc [L loc (FamEqn { feqn_tycon = L _ tc_name - , feqn_pats = hs_tvs - , feqn_rhs = rhs })] - | HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = imp_vars} - , hsq_explicit = exp_vars } <- hs_tvs - = -- See Note [Type-checking default assoc decls] - setSrcSpan loc $ - tcAddFamInstCtxt (text "default type instance") tc_name $ - do { traceTc "tcDefaultAssocDecl" (ppr tc_name) - ; let fam_tc_name = tyConName fam_tc - fam_arity = length (tyConVisibleTyVars fam_tc) - - -- Kind of family check - ; ASSERT( fam_tc_name == tc_name ) - checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc) - - -- Arity check - ; checkTc (exp_vars `lengthIs` fam_arity) - (wrongNumberOfParmsErr fam_arity) - - -- Typecheck RHS - ; let all_vars = imp_vars ++ map hsLTyVarName exp_vars - pats = map hsLTyVarBndrToType exp_vars - - -- NB: Use tcFamTyPats, not tcTyClTyVars. The latter expects to get - -- the LHsQTyVars used for declaring a tycon, but the names here - -- are different. - - -- You might think we should pass in some ClsInstInfo, as we're looking - -- at an associated type. But this would be wrong, because an associated - -- type default LHS can mention *different* type variables than the - -- enclosing class. So it's treated more as a freestanding beast. - ; (pats', rhs_ty) - <- tcFamTyPats fam_tc Nothing all_vars pats - (kcTyFamEqnRhs Nothing rhs) $ - \tvs pats rhs_kind -> - do { rhs_ty <- solveEqualities $ - tcCheckLHsType rhs rhs_kind - - -- Zonk the patterns etc into the Type world - ; (ze, _) <- zonkTyBndrsX emptyZonkEnv tvs - ; pats' <- zonkTcTypeToTypes ze pats - ; rhs_ty' <- zonkTcTypeToType ze rhs_ty - ; return (pats', rhs_ty') } - - -- See Note [Type-checking default assoc decls] - ; case tcMatchTys pats' (mkTyVarTys (tyConTyVars fam_tc)) of - Just subst -> return (Just (substTyUnchecked subst rhs_ty, loc) ) - Nothing -> failWithTc (defaultAssocKindErr fam_tc) - -- We check for well-formedness and validity later, - -- in checkValidClass - } -tcDefaultAssocDecl _ [L _ (XFamEqn _)] = panic "tcDefaultAssocDecl" -tcDefaultAssocDecl _ [L _ (FamEqn _ (L _ _) (XLHsQTyVars _) _ _)] - = panic "tcDefaultAssocDecl" - -{- Note [Type-checking default assoc decls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this default declaration for an associated type - - class C a where - type F (a :: k) b :: * - type F x y = Proxy x -> y - -Note that the class variable 'a' doesn't scope over the default assoc -decl (rather oddly I think), and (less oddly) neither does the second -argument 'b' of the associated type 'F', or the kind variable 'k'. -Instead, the default decl is treated more like a top-level type -instance. - -However we store the default rhs (Proxy x -> y) in F's TyCon, using -F's own type variables, so we need to convert it to (Proxy a -> b). -We do this by calling tcMatchTys to match them up. This also ensures -that x's kind matches a's and similarly for y and b. The error -message isn't great, mind you. (Trac #11361 was caused by not doing a -proper tcMatchTys here.) - -Recall also that the left-hand side of an associated type family -default is always just variables -- no tycons here. Accordingly, -the patterns used in the tcMatchTys won't actually be knot-tied, -even though we're in the knot. This is too delicate for my taste, -but it works. - --} ------------------------- kcTyFamInstEqn :: TcTyCon -> LTyFamInstEqn GhcRn -> TcM () |