| ... |
... |
@@ -549,7 +549,7 @@ mkTopClosedFamEqFDs ax work_args work_rhs |
|
549
|
549
|
= do { let branches = fromBranches (coAxiomBranches ax)
|
|
550
|
550
|
; traceTcS "mkTopClosed" (ppr branches $$ ppr work_args $$ ppr work_rhs)
|
|
551
|
551
|
; case getRelevantBranches ax work_args work_rhs of
|
|
552
|
|
- [eqn] -> return [eqn]
|
|
|
552
|
+ [eqn] -> return [eqn] -- If there is just one relevant equation, use it
|
|
553
|
553
|
_ -> return [] }
|
|
554
|
554
|
| otherwise
|
|
555
|
555
|
= return []
|
| ... |
... |
@@ -580,6 +580,7 @@ hasRelevantGiven eqs_for_me work_args (EqCt { eq_rhs = work_rhs }) |
|
580
|
580
|
= False
|
|
581
|
581
|
|
|
582
|
582
|
getRelevantBranches :: CoAxiom Branched -> [TcType] -> Xi -> [FunDepEqns]
|
|
|
583
|
+-- Return the FunDepEqns that arise from each relevant branch
|
|
583
|
584
|
getRelevantBranches ax work_args work_rhs
|
|
584
|
585
|
= go [] (fromBranches (coAxiomBranches ax))
|
|
585
|
586
|
where
|
| ... |
... |
@@ -628,16 +629,6 @@ mkTopOpenFamEqFDs fam_tc inj_flags work_args work_rhs |
|
628
|
629
|
| otherwise
|
|
629
|
630
|
= Nothing
|
|
630
|
631
|
|
|
631
|
|
-trim_qtvs :: Subst -> [TcTyVar] -> (Subst,[TcTyVar])
|
|
632
|
|
--- Tricky stuff: see (TIF1) in
|
|
633
|
|
--- Note [Type inference for type families with injectivity]
|
|
634
|
|
-trim_qtvs subst [] = (subst, [])
|
|
635
|
|
-trim_qtvs subst (tv:tvs)
|
|
636
|
|
- | tv `elemSubst` subst = trim_qtvs subst tvs
|
|
637
|
|
- | otherwise = let !(subst1, tv') = substTyVarBndr subst tv
|
|
638
|
|
- !(subst', tvs') = trim_qtvs subst1 tvs
|
|
639
|
|
- in (subst', tv':tvs')
|
|
640
|
|
-
|
|
641
|
632
|
mkLocalFamEqFDs :: [EqCt] -> TyCon -> [Bool] -> [TcType] -> Xi -> TcS [FunDepEqns]
|
|
642
|
633
|
mkLocalFamEqFDs eqs_for_me fam_tc inj_flags work_args work_rhs
|
|
643
|
634
|
= do { let -- eqns_from_inerts: see (INJFAM:Wanted/other)
|
| ... |
... |
@@ -657,6 +648,16 @@ mkLocalFamEqFDs eqs_for_me fam_tc inj_flags work_args work_rhs |
|
657
|
648
|
|
|
658
|
649
|
mk_eqn iargs = mkInjectivityFDEqn inj_flags [] work_args iargs
|
|
659
|
650
|
|
|
|
651
|
+trim_qtvs :: Subst -> [TcTyVar] -> (Subst,[TcTyVar])
|
|
|
652
|
+-- Tricky stuff: see (TIF1) in
|
|
|
653
|
+-- Note [Type inference for type families with injectivity]
|
|
|
654
|
+trim_qtvs subst [] = (subst, [])
|
|
|
655
|
+trim_qtvs subst (tv:tvs)
|
|
|
656
|
+ | tv `elemSubst` subst = trim_qtvs subst tvs
|
|
|
657
|
+ | otherwise = let !(subst1, tv') = substTyVarBndr subst tv
|
|
|
658
|
+ !(subst', tvs') = trim_qtvs subst1 tvs
|
|
|
659
|
+ in (subst', tv':tvs')
|
|
|
660
|
+
|
|
660
|
661
|
-----------------------------------------
|
|
661
|
662
|
-- Built-in type families
|
|
662
|
663
|
-----------------------------------------
|