Simon Peyton Jones pushed to branch wip/T26746 at Glasgow Haskell Compiler / GHC
Commits:
-
aed32875
by Simon Peyton Jones at 2026-01-13T17:26:49+00:00
2 changed files:
Changes:
| ... | ... | @@ -478,7 +478,8 @@ tcUnwrapNewtype_maybe :: FamInstEnvs |
| 478 | 478 | -> Maybe (GlobalRdrElt, TcCoercion, Type)
|
| 479 | 479 | tcUnwrapNewtype_maybe faminsts rdr_env ty
|
| 480 | 480 | | Just (tc,tys) <- tcSplitTyConApp_maybe ty
|
| 481 | - = try_fam_unwrap tc tys
|
|
| 481 | + = firstJust (try_nt_unwrap tc tys)
|
|
| 482 | + (try_fam_unwrap tc tys)
|
|
| 482 | 483 | | otherwise
|
| 483 | 484 | = Nothing
|
| 484 | 485 | where
|
| ... | ... | @@ -490,7 +491,7 @@ tcUnwrapNewtype_maybe faminsts rdr_env ty |
| 490 | 491 | , Just (gre, nt_co, ty') <- try_nt_unwrap tc' tys'
|
| 491 | 492 | = Just (gre, mkTransCo fam_co nt_co, ty')
|
| 492 | 493 | | otherwise
|
| 493 | - = try_nt_unwrap tc tys
|
|
| 494 | + = Nothing
|
|
| 494 | 495 | |
| 495 | 496 | try_nt_unwrap tc tys
|
| 496 | 497 | | Just con <- newTyConDataCon_maybe tc
|
| ... | ... | @@ -356,13 +356,13 @@ can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ |
| 356 | 356 | -- See Note [Eager newtype decomposition]
|
| 357 | 357 | -- You might think that representational role would also be OK, but
|
| 358 | 358 | -- see Note [Even more eager newtype decomposition]
|
| 359 | - ok (ty1:tys1) (ty2:tys2) (r:rs)
|
|
| 360 | - | Phantom <- r = ok tys1 tys2 rs
|
|
| 361 | - | ty1 `tcEqType` ty2 = ok tys1 tys2 rs
|
|
| 359 | + ok (ty1:tys1) (ty2:tys2) rs
|
|
| 360 | + | Phantom : rs <- r = ok tys1 tys2 rs
|
|
| 361 | + | ty1 `tcEqType` ty2 = ok tys1 tys2 (drop 1 rs)
|
|
| 362 | 362 | | otherwise = False
|
| 363 | 363 | ok [] [] _ = True
|
| 364 | - ok _ _ [] = False -- Oversaturated TyCon
|
|
| 365 | - ok _ _ _ = pprPanic "can_eq_nc:mismatch" (ppr ty1 $$ ppr ty2)
|
|
| 364 | + ok _ _ _ = False -- Mis-matched lengths, just about possible because of
|
|
| 365 | + -- kind polymorphism. Anyway False is a safe result!
|
|
| 366 | 366 | |
| 367 | 367 | -- Unwrap newtypes, when in ReprEq only
|
| 368 | 368 | -- See Note [Solving newtype equalities: overview]
|
| ... | ... | @@ -1223,7 +1223,7 @@ There are three ways in which decomposing [W] (N ty1) ~r (N ty2) could be incomp |
| 1223 | 1223 | instance (a~Bool) => C [a]
|
| 1224 | 1224 | [W] g3 :: C [alpha]
|
| 1225 | 1225 | When we get around to solving `g3` we'll discover (g2:alpha~Bool)
|
| 1226 | - So that's a real infelity in the solver.
|
|
| 1226 | + So that's a real infelicity in the solver.
|
|
| 1227 | 1227 | |
| 1228 | 1228 | * Incompleteness example (EX4): check available Givens
|
| 1229 | 1229 | newtype Nt a = Mk Bool -- NB: a is not used in the RHS,
|