diff options
| author | Richard Eisenberg <rae@richarde.dev> | 2019-08-18 16:02:50 +0200 |
|---|---|---|
| committer | Richard Eisenberg <rae@richarde.dev> | 2020-03-17 13:46:57 +0000 |
| commit | 53ff2cd0c49735e8f709ac8a5ceab68483eb89df (patch) | |
| tree | 2c22014de33e6d0fcdfef7e5436ff0abc7e0fca1 /compiler/GHC/Core/FamInstEnv.hs | |
| parent | 75168d07c9c30289709423fc184bbab8dcad0f4e (diff) | |
| download | haskell-53ff2cd0c49735e8f709ac8a5ceab68483eb89df.tar.gz | |
Fix #17021 by checking more return kinds
All the details are in new Note [Datatype return kinds] in
TcTyClsDecls.
Test case: typecheck/should_fail/T17021{,b}
typecheck/should_compile/T17021a
Updates haddock submodule
Diffstat (limited to 'compiler/GHC/Core/FamInstEnv.hs')
| -rw-r--r-- | compiler/GHC/Core/FamInstEnv.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs index c8e5a7a4f9..10dc63eb50 100644 --- a/compiler/GHC/Core/FamInstEnv.hs +++ b/compiler/GHC/Core/FamInstEnv.hs @@ -638,13 +638,16 @@ that Note. mkCoAxBranch :: [TyVar] -- original, possibly stale, tyvars -> [TyVar] -- Extra eta tyvars -> [CoVar] -- possibly stale covars + -> TyCon -- family/newtype TyCon (for error-checking only) -> [Type] -- LHS patterns -> Type -- RHS -> [Role] -> SrcSpan -> CoAxBranch -mkCoAxBranch tvs eta_tvs cvs lhs rhs roles loc - = CoAxBranch { cab_tvs = tvs' +mkCoAxBranch tvs eta_tvs cvs ax_tc lhs rhs roles loc + = -- See Note [CoAxioms are homogeneous] in Core.Coercion.Axiom + ASSERT( typeKind (mkTyConApp ax_tc lhs) `eqType` typeKind rhs ) + CoAxBranch { cab_tvs = tvs' , cab_eta_tvs = eta_tvs' , cab_cvs = cvs' , cab_lhs = tidyTypes env lhs @@ -698,7 +701,7 @@ mkSingleCoAxiom role ax_name tvs eta_tvs cvs fam_tc lhs_tys rhs_ty , co_ax_implicit = False , co_ax_branches = unbranched (branch { cab_incomps = [] }) } where - branch = mkCoAxBranch tvs eta_tvs cvs lhs_tys rhs_ty + branch = mkCoAxBranch tvs eta_tvs cvs fam_tc lhs_tys rhs_ty (map (const Nominal) tvs) (getSrcSpan ax_name) @@ -716,7 +719,7 @@ mkNewTypeCoAxiom name tycon tvs roles rhs_ty , co_ax_tc = tycon , co_ax_branches = unbranched (branch { cab_incomps = [] }) } where - branch = mkCoAxBranch tvs [] [] (mkTyVarTys tvs) rhs_ty + branch = mkCoAxBranch tvs [] [] tycon (mkTyVarTys tvs) rhs_ty roles (getSrcSpan name) {- |