Simon Peyton Jones pushed to branch wip/T26543b at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/Tc/Utils/Unify.hs
    ... ... @@ -3651,6 +3651,7 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs
    3651 3651
         lhs_info           = metaTyVarInfo lhs_tv
    
    3652 3652
         lhs_tv_lvl         = tcTyVarLevel lhs_tv
    
    3653 3653
         lhs_tv_is_concrete = isConcreteTyVar lhs_tv
    
    3654
    +    lhs_tv_nm          = tyVarName lhs_tv
    
    3654 3655
     
    
    3655 3656
         forall_ok = case caller of
    
    3656 3657
                        UC_QuickLook -> isQLInstTyVar lhs_tv
    
    ... ... @@ -3670,7 +3671,7 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs
    3670 3671
            -- c.f. checkTyVar, the TEFTyVar case
    
    3671 3672
            | tcTyVarLevel tv `strictlyDeeperThan` lhs_tv_lvl = False
    
    3672 3673
            | lhs_tv_is_concrete, not (isConcreteTyVar tv)    = False
    
    3673
    -       | simple_occurs_check lhs_tv tv                   = False
    
    3674
    +       | simple_occurs_check lhs_tv_nm tv                = False
    
    3674 3675
            | otherwise                                       = True
    
    3675 3676
     
    
    3676 3677
         rhs_is_ok (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r})
    
    ... ... @@ -4725,12 +4726,12 @@ simpleOccursCheck (OC_Check lhs_tv occ_prob) occ_tv
    4725 4726
       | simple_occurs_check lhs_tv occ_tv = TyVarCheck_Error (cteProblem occ_prob)
    
    4726 4727
       | otherwise                         = TyVarCheck_Success
    
    4727 4728
     
    
    4728
    -simple_occurs_check :: TcTyVar -> TcTyVar -> Bool  -- True <=> occurs check
    
    4729
    +simple_occurs_check :: Name -> TcTyVar -> Bool  -- True <=> occurs check
    
    4729 4730
     -- Check for an occurrence of lhs_tv in occ_tv or its kind
    
    4730 4731
     simple_occurs_check lhs_tv occ_tv
    
    4731
    -  | lhs_tv == tyVarName occ_tcv                    = True
    
    4732
    -  | anyFreeVarsOfType check_fv (tyVarKind occ_tcv) = True
    
    4733
    -  | otherwise                                      = False
    
    4732
    +  | lhs_tv == tyVarName occ_tv                                        = True
    
    4733
    +  | anyFreeVarsOfType (simple_occurs_check lhs_tv) (tyVarKind occ_tv) = True
    
    4734
    +  | otherwise                                                         = False
    
    4734 4735
     
    
    4735 4736
     -------------------------
    
    4736 4737
     tyVarLevelCheck :: LevelCheck m -> TcTyVar -> TyVarCheckResult m