Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC Commits: b71acd03 by Simon Peyton Jones at 2025-11-16T17:39:32+00:00 Refine Yikes 3 - - - - - 1 changed file: - compiler/GHC/Tc/Solver/FunDeps.hs Changes: ===================================== compiler/GHC/Tc/Solver/FunDeps.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Core.FamInstEnv import GHC.Core.Coercion import GHC.Core.Predicate( EqRel(..) ) import GHC.Core.TyCon -import GHC.Core.Type( tyConAppTyCon_maybe ) +import GHC.Core.TyCo.Rep( Type(..) ) import GHC.Core.Unify( tcUnifyTysForInjectivity, typeListsAreApart ) import GHC.Core.Coercion.Axiom import GHC.Core.TyCo.Subst( elemSubst ) @@ -36,6 +36,7 @@ import GHC.Types.Var.Set import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc( lengthExceeds ) import GHC.Data.Pair 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 ----------------------------------------- mkTopClosedFamEqFDs :: CoAxiom Branched -> [TcType] -> Xi -> TcS [FunDepEqns] mkTopClosedFamEqFDs ax work_args work_rhs - | Just tc <- tyConAppTyCon_maybe work_rhs -- Does RHS have anything useful to say? - , isGenerativeTyCon tc Nominal + | isInformativeType work_rhs -- Does RHS have anything useful to say? = do { let branches = fromBranches (coAxiomBranches ax) ; traceTcS "mkTopClosed" (ppr branches $$ ppr work_args $$ ppr work_rhs) ; case getRelevantBranches ax work_args work_rhs of @@ -555,6 +555,16 @@ mkTopClosedFamEqFDs ax work_args work_rhs | otherwise = return [] +isInformativeType :: Type -> Bool +-- The type is headed by something generative, not just +-- a type variable or a type-family application +isInformativeType ty | Just ty' <- coreView ty = isInformativeType ty' +isInformativeType (CastTy ty _) = isInformativeType ty +isInformativeType (TyVarTy {}) = False +isInformativeType (CoercionTy {}) = False -- Moot +isInformativeType (TyConApp tc tys) = isGenerativeTyCon tc Nominal || + tys `lengthExceeds` tyConArity tc +isInformativeType _ = True -- AppTy, ForAllTy, FunTy, LitTy getRelevantBranches :: CoAxiom Branched -> [TcType] -> Xi -> [CoAxBranch] getRelevantBranches ax work_args work_rhs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b71acd03112ce0ae8ab889a0d0cbd261... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b71acd03112ce0ae8ab889a0d0cbd261... You're receiving this email because of your account on gitlab.haskell.org.