Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/Tc/Solver/FunDeps.hs
    ... ... @@ -553,16 +553,16 @@ mkTopClosedFamEqFDs ax work_args work_rhs
    553 553
         go (branch : later_branches)
    
    554 554
           | CoAxBranch { cab_tvs = qtvs, cab_lhs = lhs_tys
    
    555 555
                        , cab_rhs = rhs_ty, cab_incomps = incomps } <- branch
    
    556
    -      , not (eqnIsApart lhs_tys rhs_ty work_args work_rhs)
    
    557
    -      = if all no_match_branch incomps && all no_match_branch later_branches
    
    558
    -        then [FDEqns { fd_qtvs = qtvs, fd_eqs = zipWith Pair lhs_tys work_args }]
    
    559
    -        else []
    
    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 560
     
    
    561 561
           | otherwise
    
    562 562
           = go later_branches
    
    563 563
     
    
    564
    -    no_match_branch (CoAxBranch { cab_lhs = lhs_tys, cab_rhs = rhs_ty })
    
    565
    -      = eqnIsApart lhs_tys rhs_ty work_args work_rhs
    
    564
    +    irrelevant_branch (CoAxBranch { cab_lhs = lhs_tys, cab_rhs = rhs_ty })
    
    565
    +      = eqnIsIrrelevant lhs_tys rhs_ty work_args work_rhs
    
    566 566
     
    
    567 567
     mkTopOpenFamEqFDs :: TyCon -> [Bool] -> [TcType] -> Xi -> TcS [FunDepEqns]
    
    568 568
     -- Implements (INJFAM:Wanted/top)
    
    ... ... @@ -738,12 +738,12 @@ getInertFamEqsFor fam_tc work_args work_rhs
    738 738
                                                 , eq_rhs = inert_rhs })
    
    739 739
                                      <- equal_ct_list
    
    740 740
                                , NomEq == eq_rel
    
    741
    -                           , not (eqnIsApart inert_args inert_rhs work_args work_rhs) ] }
    
    741
    +                           , not (eqnIsIrrelevant inert_args inert_rhs work_args work_rhs) ] }
    
    742 742
     
    
    743
    -eqnIsApart :: [TcType] -> TcType
    
    744
    -           -> [TcType] -> TcType
    
    745
    -           -> Bool
    
    746
    -eqnIsApart lhs_tys1 rhs_ty1 lhs_tys2 rhs_ty2
    
    743
    +eqnIsIrrelevant :: [TcType] -> TcType
    
    744
    +                -> [TcType] -> TcType
    
    745
    +                -> Bool
    
    746
    +eqnIsIrrelevant lhs_tys1 rhs_ty1 lhs_tys2 rhs_ty2
    
    747 747
       = (rhs_ty1:lhs_tys1) `typeListsAreApart` (rhs_ty2:lhs_tys2)
    
    748 748
     
    
    749 749