Magnus pushed to branch wip/mangoiv/9.12.5-rc4 at Glasgow Haskell Compiler / GHC
Commits:
-
14a1087a
by mangoiv at 2026-09-17T15:32:09+02:00
3 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- + testsuite/tests/simplCore/should_compile/T27766.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
| ... | ... | @@ -24,7 +24,7 @@ import GHC.Core.Opt.Simplify.Env |
| 24 | 24 | import GHC.Core.Opt.Simplify.Inline
|
| 25 | 25 | import GHC.Core.Opt.Simplify.Utils
|
| 26 | 26 | import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) )
|
| 27 | -import GHC.Core.Make ( FloatBind, mkImpossibleExpr )
|
|
| 27 | +import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr )
|
|
| 28 | 28 | import qualified GHC.Core.Make
|
| 29 | 29 | import GHC.Core.Coercion hiding ( substCo, substCoVar )
|
| 30 | 30 | import GHC.Core.Reduction
|
| ... | ... | @@ -2293,6 +2293,7 @@ rebuildCall :: SimplEnv -> ArgInfo -> SimplCont |
| 2293 | 2293 | |
| 2294 | 2294 | ---------- Bottoming applications --------------
|
| 2295 | 2295 | rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont
|
| 2296 | + | not (contIsTrivial cont)
|
|
| 2296 | 2297 | -- When we run out of demands, it means that the call is definitely bottom.
|
| 2297 | 2298 | -- See (TC2) in Note [Trimming the continuation for bottoming functions]
|
| 2298 | 2299 | = rebuild env (argInfoExpr fun rev_args) (mkBottomCont env cont)
|
| 1 | +module Repro019_minimal where
|
|
| 2 | + |
|
| 3 | +unpack :: Int -> [Int]
|
|
| 4 | +unpack b = unpackGo b
|
|
| 5 | +{-# NOINLINE unpack #-}
|
|
| 6 | + |
|
| 7 | +unpackGo :: Int -> [Int]
|
|
| 8 | +unpackGo len = go len
|
|
| 9 | + where go i = if i == 0 then [] else i : go (i - 1)
|
|
| 10 | +{-# INLINE unpackGo #-}
|
|
| 11 | + |
|
| 12 | +{-# RULES "unpack/late" [0] forall b. unpack b = unpackGo b #-}
|
|
| 13 | + |
|
| 14 | +conv :: [Int] -> Int
|
|
| 15 | +conv input = case unpack (length input) of
|
|
| 16 | + [] -> undefined
|
|
| 17 | + _ -> 0
|
|
| 18 | + |
|
| 19 | +opaque :: Int -> Bool
|
|
| 20 | +opaque x = x > 0
|
|
| 21 | +{-# NOINLINE opaque #-}
|
|
| 22 | + |
|
| 23 | +getUnchecked :: Int -> IO (Int, Maybe Int)
|
|
| 24 | +getUnchecked x = get x >>= maybe undefined pure
|
|
| 25 | + |
|
| 26 | +get :: Int -> IO (Maybe (Int, Maybe Int))
|
|
| 27 | +get x = do
|
|
| 28 | + a <- ((if opaque x then pure Nothing else pure (Just 0)) >>= \r -> case r of
|
|
| 29 | + Just _ -> pure (Just (1 :: Int))
|
|
| 30 | + _ -> pure Nothing)
|
|
| 31 | + b <- (if opaque x then pure Nothing else pure (Just 0))
|
|
| 32 | + pure ((,) <$> a <*> Just (fmap (conv . unpack) b))
|
|
| 33 | +{-# INLINE get #-}
|
|
| 34 | + |
|
| 35 | +top :: IO ()
|
|
| 36 | +top = () <$ getUnchecked (undefined :: Int)
|
|
| 37 | + |
| ... | ... | @@ -542,3 +542,4 @@ test('T26681', normal, compile, ['-O']) |
| 542 | 542 | test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all'])
|
| 543 | 543 | test('T26682', normal, multimod_compile, ['T26682', '-O -v0'])
|
| 544 | 544 | test('T27261', [extra_files(['T27261_aux.hs'])], multimod_compile, ['T27261', '-v0 -O'])
|
| 545 | +test('T27766', normal, compile, ['-O2 -flate-specialise']) |