Simon Peyton Jones pushed to branch wip/T27828 at Glasgow Haskell Compiler / GHC
Commits:
-
75745004
by Simon Peyton Jones at 2026-09-24T23:43:34+01:00
4 changed files:
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
Changes:
| ... | ... | @@ -610,12 +610,14 @@ compareBranches b1@(CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 }) |
| 610 | 610 | -- Here we need the cab_tvs of the two branches to be disinct.
|
| 611 | 611 | -- See Note [CoAxBranch type variables] in GHC.Core.Coercion.Axiom.
|
| 612 | 612 | SurelyApart -> BC_Apart
|
| 613 | - MaybeApart {} -> pprPanic "compareBranches" (ppr b1 $$ ppr b2)
|
|
| 614 | 613 | Unifiable subst | Type.substTyAddInScope subst rhs1 `eqType`
|
| 615 | 614 | Type.substTyAddInScope subst rhs2
|
| 616 | 615 | -> BC_Compat
|
| 617 | 616 | | otherwise
|
| 618 | 617 | -> BC_Incompat
|
| 618 | + MaybeApart {} -> BC_Incompat
|
|
| 619 | + -- An occurs check yields MaybeApart;
|
|
| 620 | + -- see Note [Infinitary substitutions] in GHC.Core.Unify
|
|
| 619 | 621 | where
|
| 620 | 622 | (commonlhs1, commonlhs2) = zipAndUnzip lhs1 lhs2
|
| 621 | 623 | -- See Note [Compatibility of eta-reduced axioms]
|
| ... | ... | @@ -112,7 +112,7 @@ coAxBranchToIfaceBranch tc lhs_s |
| 112 | 112 | , ifaxbRoles = roles
|
| 113 | 113 | , ifaxbRHS = toIfaceType rhs
|
| 114 | 114 | , ifaxbIncomps = iface_incomps }
|
| 115 | - where
|
|
| 115 | + where
|
|
| 116 | 116 | iface_incomps = map (expectJust
|
| 117 | 117 | . flip findIndex lhs_s
|
| 118 | 118 | . eqTypes
|
| ... | ... | @@ -338,7 +338,12 @@ data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr] |
| 338 | 338 | , ifaxbRoles :: [Role]
|
| 339 | 339 | , ifaxbRHS :: IfaceType
|
| 340 | 340 | , ifaxbIncomps :: [BranchIndex] }
|
| 341 | - -- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
|
|
| 341 | + -- We store the incompatibilities in IfaceAxBranch
|
|
| 342 | + -- just for (perhaps unnecessary) display purposes:
|
|
| 343 | + -- see Note [Displaying axiom incompatibilities]
|
|
| 344 | + -- When we construct a real CoAxBranch we compute cab_incomps directly
|
|
| 345 | + -- from the equations, ignoring the ifaxbIncomps.
|
|
| 346 | + -- We could consider getting rid of ifaxbIncomps altogether.
|
|
| 342 | 347 | |
| 343 | 348 | data IfaceConDecls
|
| 344 | 349 | = IfAbstractTyCon -- c.f TyCon.AbstractTyCon
|
| ... | ... | @@ -1111,15 +1111,14 @@ tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1 |
| 1111 | 1111 | ; return (tvs1', tvs2') }
|
| 1112 | 1112 | |
| 1113 | 1113 | tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
|
| 1114 | -tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
|
|
| 1114 | +tc_ax_branches if_branches = mapM tc_ax_branch if_branches
|
|
| 1115 | 1115 | |
| 1116 | -tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
|
|
| 1117 | -tc_ax_branch prev_branches
|
|
| 1118 | - (IfaceAxBranch { ifaxbTyVars = tv_bndrs
|
|
| 1116 | +tc_ax_branch :: IfaceAxBranch -> IfL CoAxBranch
|
|
| 1117 | +tc_ax_branch (IfaceAxBranch { ifaxbTyVars = tv_bndrs
|
|
| 1119 | 1118 | , ifaxbEtaTyVars = eta_tv_bndrs
|
| 1120 | 1119 | , ifaxbCoVars = cv_bndrs
|
| 1121 | 1120 | , ifaxbLHS = lhs, ifaxbRHS = rhs
|
| 1122 | - , ifaxbRoles = roles, ifaxbIncomps = _incomps })
|
|
| 1121 | + , ifaxbRoles = roles })
|
|
| 1123 | 1122 | = bindIfaceTyConBinders_AT
|
| 1124 | 1123 | (map (\b -> Bndr (IfaceTvBndr b) (NamedTCB Inferred)) tv_bndrs) $ \ tvs ->
|
| 1125 | 1124 | -- The _AT variant is needed here; see Note [CoAxBranch type variables] in GHC.Core.Coercion.Axiom
|
| ... | ... | @@ -1130,16 +1129,15 @@ tc_ax_branch prev_branches |
| 1130 | 1129 | ; this_mod <- getIfModule
|
| 1131 | 1130 | ; let loc = mkGeneralSrcSpan (fsLit "module " `appendFS`
|
| 1132 | 1131 | moduleNameFS (moduleName this_mod))
|
| 1133 | - br = CoAxBranch { cab_loc = loc
|
|
| 1134 | - , cab_tvs = binderVars tvs
|
|
| 1135 | - , cab_eta_tvs = eta_tvs
|
|
| 1136 | - , cab_cvs = cvs
|
|
| 1137 | - , cab_lhs = tc_lhs
|
|
| 1138 | - , cab_roles = roles
|
|
| 1139 | - , cab_rhs = tc_rhs
|
|
| 1140 | - , cab_overlaps = placeHolderOverlaps
|
|
| 1141 | - , cab_incomps = placeHolderIncomps }
|
|
| 1142 | - ; return (prev_branches ++ [br]) }
|
|
| 1132 | + ; return (CoAxBranch { cab_loc = loc
|
|
| 1133 | + , cab_tvs = binderVars tvs
|
|
| 1134 | + , cab_eta_tvs = eta_tvs
|
|
| 1135 | + , cab_cvs = cvs
|
|
| 1136 | + , cab_lhs = tc_lhs
|
|
| 1137 | + , cab_roles = roles
|
|
| 1138 | + , cab_rhs = tc_rhs
|
|
| 1139 | + , cab_overlaps = placeHolderOverlaps
|
|
| 1140 | + , cab_incomps = placeHolderIncomps }) }
|
|
| 1143 | 1141 | |
| 1144 | 1142 | tcIfaceDataCons :: Name -> TyCon -> IfaceConDecls -> IfL AlgTyConRhs
|
| 1145 | 1143 | tcIfaceDataCons tycon_name tycon if_cons
|