Simon Peyton Jones pushed to branch wip/26805 at Glasgow Haskell Compiler / GHC
Commits:
-
198f7eeb
by Simon Peyton Jones at 2026-01-20T11:42:51+00:00
6 changed files:
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Types/Constraint.hs
- + testsuite/tests/simplCore/should_compile/T26805.hs
- + testsuite/tests/simplCore/should_compile/T26805.stderr
- testsuite/tests/simplCore/should_compile/all.T
Changes:
| ... | ... | @@ -22,7 +22,7 @@ import GHC.Tc.Errors.Types |
| 22 | 22 | import GHC.Tc.Gen.HsType
|
| 23 | 23 | import GHC.Tc.Solver.Monad ( runTcS )
|
| 24 | 24 | import GHC.Tc.Solver.Solve ( solveWanteds )
|
| 25 | -import GHC.Tc.Types.Constraint ( isEmptyWC, andWC, mkSimpleWC )
|
|
| 25 | +import GHC.Tc.Types.Constraint ( isSolvedWC, andWC, mkSimpleWC )
|
|
| 26 | 26 | import GHC.Tc.Types.Origin ( CtOrigin(DefaultOrigin) )
|
| 27 | 27 | import GHC.Tc.Utils.Env
|
| 28 | 28 | import GHC.Tc.Utils.Monad
|
| ... | ... | @@ -296,7 +296,7 @@ simplifyDefault cls dflt_ty@(L l _) |
| 296 | 296 | , text "inst_pred:" <+> ppr inst_pred
|
| 297 | 297 | , text "all_wanteds " <+> ppr all_wanteds
|
| 298 | 298 | , text "unsolved:" <+> ppr unsolved ]
|
| 299 | - ; let is_instance = isEmptyWC unsolved
|
|
| 299 | + ; let is_instance = isSolvedWC unsolved
|
|
| 300 | 300 | ; return $
|
| 301 | 301 | if | is_instance
|
| 302 | 302 | , ClassPred _ tys <- classifyPredType inst_pred
|
| ... | ... | @@ -663,6 +663,12 @@ Some wrinkles: |
| 663 | 663 | of the caller (#15164). You might worry about having a solved-dict that uses
|
| 664 | 664 | a Given -- but that too will have been subject to short-cut solving so it's fine.
|
| 665 | 665 | |
| 666 | +(SCS4) In `tryShortCutSolver`, when deciding if we have "completely solved" the
|
|
| 667 | + constraint, we must use `isSolvedWC` not `isEmptyWC`. The latter says "False"
|
|
| 668 | + if the residual constraint has any implications, even solved ones; and we
|
|
| 669 | + don't want to reject short-cut solving just because we have some leftover
|
|
| 670 | + /solved/ implications. #26805 was a case in point.
|
|
| 671 | + |
|
| 666 | 672 | Note [Shortcut solving: incoherence]
|
| 667 | 673 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 668 | 674 | This optimization relies on coherence of dictionaries to be correct. When we
|
| ... | ... | @@ -798,7 +804,11 @@ tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w }) |
| 798 | 804 | |
| 799 | 805 | -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints
|
| 800 | 806 | do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w))
|
| 801 | - ; return (isEmptyWC residual) }
|
|
| 807 | + ; return (isSolvedWC residual) }
|
|
| 808 | + -- NB: isSolvedWC, not isEmptyWC (#26805). We might succeed
|
|
| 809 | + -- in fully-solving the constraint but still leave some
|
|
| 810 | + -- /solved/ implications in the residual.
|
|
| 811 | + -- See (SCS4) in Note [Shortcut solving]
|
|
| 802 | 812 | |
| 803 | 813 | | otherwise
|
| 804 | 814 | -> return False }
|
| ... | ... | @@ -1055,6 +1055,13 @@ mkImplicWC :: Bag Implication -> WantedConstraints |
| 1055 | 1055 | mkImplicWC implic
|
| 1056 | 1056 | = emptyWC { wc_impl = implic }
|
| 1057 | 1057 | |
| 1058 | +-- | `isEmptyWC` sess if a `WantedConstraints` is truly empty, including
|
|
| 1059 | +-- having no implications.
|
|
| 1060 | +--
|
|
| 1061 | +-- It's possible that it might have /solved/ implications, which are left around
|
|
| 1062 | +-- just so we can report unreachable code. So:
|
|
| 1063 | +-- isEmptyWC implies isSolvedWC-
|
|
| 1064 | +-- but not vice versa
|
|
| 1058 | 1065 | isEmptyWC :: WantedConstraints -> Bool
|
| 1059 | 1066 | isEmptyWC (WC { wc_simple = f, wc_impl = i, wc_errors = errors })
|
| 1060 | 1067 | = isEmptyBag f && isEmptyBag i && isEmptyBag errors
|
| 1 | +{-# LANGUAGE GADTs #-}
|
|
| 2 | +{-# LANGUAGE ImpredicativeTypes #-}
|
|
| 3 | +{-# LANGUAGE TypeData #-}
|
|
| 4 | +module T26805( interpret ) where
|
|
| 5 | + |
|
| 6 | +import Data.Kind (Type)
|
|
| 7 | + |
|
| 8 | +data Phantom (sh :: Type) = Phantom -- newtype fails to specialise as well
|
|
| 9 | + |
|
| 10 | +instance Show (Phantom sh) where
|
|
| 11 | + show Phantom = "show"
|
|
| 12 | + |
|
| 13 | +type Foo r = (forall sh. Show (Phantom sh), Num r)
|
|
| 14 | +-- this specialises fine:
|
|
| 15 | +-- type Foo r = (Num r)
|
|
| 16 | + |
|
| 17 | +type data TK = TKScalar Type
|
|
| 18 | + |
|
| 19 | +data AstTensor :: TK -> Type where
|
|
| 20 | + AstInt :: Int -> AstTensor (TKScalar Int)
|
|
| 21 | + AstPlus :: Foo r => AstTensor (TKScalar r) -> AstTensor (TKScalar r)
|
|
| 22 | + |
|
| 23 | +plusConcrete :: Foo r => r -> r
|
|
| 24 | +plusConcrete = (+ 1)
|
|
| 25 | + |
|
| 26 | +interpret :: AstTensor (TKScalar Int) -> Int
|
|
| 27 | +interpret v0 = case v0 of
|
|
| 28 | + AstInt n -> n
|
|
| 29 | + AstPlus u -> plusConcrete (interpret u) |
| 1 | + |
|
| \ No newline at end of file |
| ... | ... | @@ -578,3 +578,4 @@ test('T26615', [grep_errmsg(r'fEqList')], multimod_compile, ['T26615', '-O -fsp |
| 578 | 578 | |
| 579 | 579 | # T26722: there should be no reboxing in $wg
|
| 580 | 580 | test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds'])
|
| 581 | +test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques']) |