| ... |
... |
@@ -25,7 +25,7 @@ import GHC.Core.FamInstEnv |
|
25
|
25
|
import GHC.Core.Coercion
|
|
26
|
26
|
import GHC.Core.Predicate( EqRel(..) )
|
|
27
|
27
|
import GHC.Core.TyCon
|
|
28
|
|
-import GHC.Core.Type( tyConAppTyCon_maybe )
|
|
|
28
|
+import GHC.Core.TyCo.Rep( Type(..) )
|
|
29
|
29
|
import GHC.Core.Unify( tcUnifyTysForInjectivity, typeListsAreApart )
|
|
30
|
30
|
import GHC.Core.Coercion.Axiom
|
|
31
|
31
|
import GHC.Core.TyCo.Subst( elemSubst )
|
| ... |
... |
@@ -36,6 +36,7 @@ import GHC.Types.Var.Set |
|
36
|
36
|
|
|
37
|
37
|
import GHC.Utils.Outputable
|
|
38
|
38
|
import GHC.Utils.Panic
|
|
|
39
|
+import GHC.Utils.Misc( lengthExceeds )
|
|
39
|
40
|
|
|
40
|
41
|
import GHC.Data.Pair
|
|
41
|
42
|
import Data.Maybe( isNothing, mapMaybe )
|
| ... |
... |
@@ -543,8 +544,7 @@ tryFDEqns fam_tc work_args work_item@(EqCt { eq_ev = ev, eq_rhs= rhs }) mk_fd_eq |
|
543
|
544
|
-----------------------------------------
|
|
544
|
545
|
mkTopClosedFamEqFDs :: CoAxiom Branched -> [TcType] -> Xi -> TcS [FunDepEqns]
|
|
545
|
546
|
mkTopClosedFamEqFDs ax work_args work_rhs
|
|
546
|
|
- | Just tc <- tyConAppTyCon_maybe work_rhs -- Does RHS have anything useful to say?
|
|
547
|
|
- , isGenerativeTyCon tc Nominal
|
|
|
547
|
+ | isInformativeType work_rhs -- Does RHS have anything useful to say?
|
|
548
|
548
|
= do { let branches = fromBranches (coAxiomBranches ax)
|
|
549
|
549
|
; traceTcS "mkTopClosed" (ppr branches $$ ppr work_args $$ ppr work_rhs)
|
|
550
|
550
|
; case getRelevantBranches ax work_args work_rhs of
|
| ... |
... |
@@ -555,6 +555,16 @@ mkTopClosedFamEqFDs ax work_args work_rhs |
|
555
|
555
|
| otherwise
|
|
556
|
556
|
= return []
|
|
557
|
557
|
|
|
|
558
|
+isInformativeType :: Type -> Bool
|
|
|
559
|
+-- The type is headed by something generative, not just
|
|
|
560
|
+-- a type variable or a type-family application
|
|
|
561
|
+isInformativeType ty | Just ty' <- coreView ty = isInformativeType ty'
|
|
|
562
|
+isInformativeType (CastTy ty _) = isInformativeType ty
|
|
|
563
|
+isInformativeType (TyVarTy {}) = False
|
|
|
564
|
+isInformativeType (CoercionTy {}) = False -- Moot
|
|
|
565
|
+isInformativeType (TyConApp tc tys) = isGenerativeTyCon tc Nominal ||
|
|
|
566
|
+ tys `lengthExceeds` tyConArity tc
|
|
|
567
|
+isInformativeType _ = True -- AppTy, ForAllTy, FunTy, LitTy
|
|
558
|
568
|
|
|
559
|
569
|
getRelevantBranches :: CoAxiom Branched -> [TcType] -> Xi -> [CoAxBranch]
|
|
560
|
570
|
getRelevantBranches ax work_args work_rhs
|