diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2020-06-13 00:23:16 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2020-07-03 08:37:42 +0100 |
| commit | 4bf18646acbb5a59ad8716aedc32acfe2ead0f58 (patch) | |
| tree | 7704e27c8aad62e8e6aabbc70c2c9815a3aacac8 /compiler/GHC/Core/FamInstEnv.hs | |
| parent | edc8d22b2eea5d43dd6c3d0e4b2f85fc02ffa5ce (diff) | |
| download | haskell-4bf18646acbb5a59ad8716aedc32acfe2ead0f58.tar.gz | |
Improve handling of data type return kindswip/T18300
Following a long conversation with Richard, this patch tidies up the
handling of return kinds for data/newtype declarations (vanilla,
family, and instance).
I have substantially edited the Notes in TyCl, so they would
bear careful reading.
Fixes #18300, #18357
In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like
properties with ASSSERT. Instead Richard and I have added
a proper linter for axioms, and called it from lintGblEnv, which in
turn is called in tcRnModuleTcRnM
New tests (T18300, T18357) cause an ASSERT failure in HEAD.
Diffstat (limited to 'compiler/GHC/Core/FamInstEnv.hs')
| -rw-r--r-- | compiler/GHC/Core/FamInstEnv.hs | 11 |
1 files changed, 4 insertions, 7 deletions
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs index 8408bc5406..4a685ba096 100644 --- a/compiler/GHC/Core/FamInstEnv.hs +++ b/compiler/GHC/Core/FamInstEnv.hs @@ -640,16 +640,13 @@ 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 ax_tc lhs rhs roles loc - = -- See Note [CoAxioms are homogeneous] in "GHC.Core.Coercion.Axiom" - ASSERT( typeKind (mkTyConApp ax_tc lhs) `eqType` typeKind rhs ) - CoAxBranch { cab_tvs = tvs' +mkCoAxBranch tvs eta_tvs cvs lhs rhs roles loc + = CoAxBranch { cab_tvs = tvs' , cab_eta_tvs = eta_tvs' , cab_cvs = cvs' , cab_lhs = tidyTypes env lhs @@ -703,7 +700,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 fam_tc lhs_tys rhs_ty + branch = mkCoAxBranch tvs eta_tvs cvs lhs_tys rhs_ty (map (const Nominal) tvs) (getSrcSpan ax_name) @@ -721,7 +718,7 @@ mkNewTypeCoAxiom name tycon tvs roles rhs_ty , co_ax_tc = tycon , co_ax_branches = unbranched (branch { cab_incomps = [] }) } where - branch = mkCoAxBranch tvs [] [] tycon (mkTyVarTys tvs) rhs_ty + branch = mkCoAxBranch tvs [] [] (mkTyVarTys tvs) rhs_ty roles (getSrcSpan name) {- |