| ... |
... |
@@ -545,24 +545,14 @@ mkTopClosedFamEqFDs :: CoAxiom Branched -> [TcType] -> Xi -> TcS [FunDepEqns] |
|
545
|
545
|
mkTopClosedFamEqFDs ax work_args work_rhs
|
|
546
|
546
|
= do { let branches = fromBranches (coAxiomBranches ax)
|
|
547
|
547
|
; traceTcS "mkTopClosed" (ppr branches $$ ppr work_args $$ ppr work_rhs)
|
|
548
|
|
- ; return (go branches) }
|
|
|
548
|
+ ; case filter relevant_branch branches of
|
|
|
549
|
+ [CoAxBranch { cab_tvs = qtvs, cab_lhs = lhs_tys }]
|
|
|
550
|
+ -> return [FDEqns { fd_qtvs = qtvs
|
|
|
551
|
+ , fd_eqs = zipWith Pair lhs_tys work_args }]
|
|
|
552
|
+ _ -> return [] }
|
|
549
|
553
|
where
|
|
550
|
|
- go :: [CoAxBranch] -> [FunDepEqns]
|
|
551
|
|
- go [] = []
|
|
552
|
|
-
|
|
553
|
|
- go (branch : later_branches)
|
|
554
|
|
- | CoAxBranch { cab_tvs = qtvs, cab_lhs = lhs_tys
|
|
555
|
|
- , cab_rhs = rhs_ty, cab_incomps = incomps } <- branch
|
|
556
|
|
- , not (eqnIsIrrelevant lhs_tys rhs_ty work_args work_rhs)
|
|
557
|
|
- , all irrelevant_branch incomps
|
|
558
|
|
- , all irrelevant_branch later_branches
|
|
559
|
|
- = [FDEqns { fd_qtvs = qtvs, fd_eqs = zipWith Pair lhs_tys work_args }]
|
|
560
|
|
-
|
|
561
|
|
- | otherwise
|
|
562
|
|
- = go later_branches
|
|
563
|
|
-
|
|
564
|
|
- irrelevant_branch (CoAxBranch { cab_lhs = lhs_tys, cab_rhs = rhs_ty })
|
|
565
|
|
- = eqnIsIrrelevant lhs_tys rhs_ty work_args work_rhs
|
|
|
554
|
+ relevant_branch (CoAxBranch { cab_lhs = lhs_tys, cab_rhs = rhs_ty })
|
|
|
555
|
+ = eqnIsRelevant lhs_tys rhs_ty work_args work_rhs
|
|
566
|
556
|
|
|
567
|
557
|
mkTopOpenFamEqFDs :: TyCon -> [Bool] -> [TcType] -> Xi -> TcS [FunDepEqns]
|
|
568
|
558
|
-- Implements (INJFAM:Wanted/top)
|
| ... |
... |
@@ -738,13 +728,13 @@ getInertFamEqsFor fam_tc work_args work_rhs |
|
738
|
728
|
, eq_rhs = inert_rhs })
|
|
739
|
729
|
<- equal_ct_list
|
|
740
|
730
|
, NomEq == eq_rel
|
|
741
|
|
- , not (eqnIsIrrelevant inert_args inert_rhs work_args work_rhs) ] }
|
|
|
731
|
+ , eqnIsRelevant inert_args inert_rhs work_args work_rhs ] }
|
|
742
|
732
|
|
|
743
|
|
-eqnIsIrrelevant :: [TcType] -> TcType
|
|
|
733
|
+eqnIsRelevant :: [TcType] -> TcType
|
|
744
|
734
|
-> [TcType] -> TcType
|
|
745
|
735
|
-> Bool
|
|
746
|
|
-eqnIsIrrelevant lhs_tys1 rhs_ty1 lhs_tys2 rhs_ty2
|
|
747
|
|
- = (rhs_ty1:lhs_tys1) `typeListsAreApart` (rhs_ty2:lhs_tys2)
|
|
|
736
|
+eqnIsRelevant lhs_tys1 rhs_ty1 lhs_tys2 rhs_ty2
|
|
|
737
|
+ = not ((rhs_ty1:lhs_tys1) `typeListsAreApart` (rhs_ty2:lhs_tys2))
|
|
748
|
738
|
|
|
749
|
739
|
|
|
750
|
740
|
{- Note [Type inference for type families with injectivity]
|