Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
8adfc222
by sheaf at 2025-08-28T19:47:17-04:00
4 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Types/Evidence.hs
- + testsuite/tests/typecheck/should_compile/T26350.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
| ... | ... | @@ -430,7 +430,7 @@ tcApp rn_expr exp_res_ty |
| 430 | 430 | -- Step 5.2: typecheck the arguments, and monomorphise
|
| 431 | 431 | -- any un-unified instantiation variables
|
| 432 | 432 | ; tc_args <- tcValArgs DoQL inst_args
|
| 433 | - -- Step 5.3: zonk to expose the polymophism hidden under
|
|
| 433 | + -- Step 5.3: zonk to expose the polymorphism hidden under
|
|
| 434 | 434 | -- QuickLook instantiation variables in `app_res_rho`
|
| 435 | 435 | ; app_res_rho <- liftZonkM $ zonkTcType app_res_rho
|
| 436 | 436 | -- Step 5.4: subsumption check against the expected type
|
| ... | ... | @@ -206,9 +206,15 @@ instance Monoid HsWrapper where |
| 206 | 206 | (<.>) :: HsWrapper -> HsWrapper -> HsWrapper
|
| 207 | 207 | WpHole <.> c = c
|
| 208 | 208 | c <.> WpHole = c
|
| 209 | -WpCast c1 <.> WpCast c2 = WpCast (c1 `mkTransCo` c2)
|
|
| 209 | +WpCast c1 <.> WpCast c2 = WpCast (c2 `mkTransCo` c1)
|
|
| 210 | 210 | -- If we can represent the HsWrapper as a cast, try to do so: this may avoid
|
| 211 | 211 | -- unnecessary eta-expansion (see 'mkWpFun').
|
| 212 | + --
|
|
| 213 | + -- NB: <.> behaves like function composition:
|
|
| 214 | + --
|
|
| 215 | + -- WpCast c1 <.> WpCast c2 :: coercionLKind c2 ~> coercionRKind c1
|
|
| 216 | + --
|
|
| 217 | + -- This is thus the same as WpCast (c2 ; c1) and not WpCast (c1 ; c2).
|
|
| 212 | 218 | c1 <.> c2 = c1 `WpCompose` c2
|
| 213 | 219 | |
| 214 | 220 | -- | Smart constructor to create a 'WpFun' 'HsWrapper', which avoids introducing
|
| 1 | +{-# LANGUAGE DeepSubsumption #-}
|
|
| 2 | +{-# LANGUAGE TypeFamilies #-}
|
|
| 3 | +{-# LANGUAGE TypeOperators #-}
|
|
| 4 | + |
|
| 5 | +{-# OPTIONS_GHC -dcore-lint #-}
|
|
| 6 | + |
|
| 7 | +module T26350 where
|
|
| 8 | + |
|
| 9 | +import Control.Arrow (first)
|
|
| 10 | + |
|
| 11 | +infix 6 .-.
|
|
| 12 | + |
|
| 13 | +class AffineSpace p where
|
|
| 14 | + type Diff p
|
|
| 15 | + (.-.) :: p -> p -> Diff p
|
|
| 16 | + |
|
| 17 | +affineCombo :: (AffineSpace p, v ~ Diff p) => p -> (p,v) -> (v,v)
|
|
| 18 | +affineCombo z l = first (.-. z) l |
| ... | ... | @@ -862,6 +862,7 @@ test('DeepSubsumption06', normal, compile, ['-XHaskell98']) |
| 862 | 862 | test('DeepSubsumption07', normal, compile, ['-XHaskell2010'])
|
| 863 | 863 | test('DeepSubsumption08', normal, compile, [''])
|
| 864 | 864 | test('DeepSubsumption09', normal, compile, [''])
|
| 865 | +test('T26350', normal, compile, [''])
|
|
| 865 | 866 | test('T26225', normal, compile, [''])
|
| 866 | 867 | test('T26225b', normal, compile, [''])
|
| 867 | 868 | test('T21765', normal, compile, [''])
|