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 fixup! Trim the continuation in mkDupableContWithDmds - - - - - 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: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline import GHC.Core.Opt.Simplify.Utils import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) ) -import GHC.Core.Make ( FloatBind, mkImpossibleExpr ) +import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) import GHC.Core.Reduction @@ -2293,6 +2293,7 @@ rebuildCall :: SimplEnv -> ArgInfo -> SimplCont ---------- Bottoming applications -------------- rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont + | not (contIsTrivial cont) -- When we run out of demands, it means that the call is definitely bottom. -- See (TC2) in Note [Trimming the continuation for bottoming functions] = rebuild env (argInfoExpr fun rev_args) (mkBottomCont env cont) ===================================== testsuite/tests/simplCore/should_compile/T27766.hs ===================================== @@ -0,0 +1,37 @@ +module Repro019_minimal where + +unpack :: Int -> [Int] +unpack b = unpackGo b +{-# NOINLINE unpack #-} + +unpackGo :: Int -> [Int] +unpackGo len = go len + where go i = if i == 0 then [] else i : go (i - 1) +{-# INLINE unpackGo #-} + +{-# RULES "unpack/late" [0] forall b. unpack b = unpackGo b #-} + +conv :: [Int] -> Int +conv input = case unpack (length input) of + [] -> undefined + _ -> 0 + +opaque :: Int -> Bool +opaque x = x > 0 +{-# NOINLINE opaque #-} + +getUnchecked :: Int -> IO (Int, Maybe Int) +getUnchecked x = get x >>= maybe undefined pure + +get :: Int -> IO (Maybe (Int, Maybe Int)) +get x = do + a <- ((if opaque x then pure Nothing else pure (Just 0)) >>= \r -> case r of + Just _ -> pure (Just (1 :: Int)) + _ -> pure Nothing) + b <- (if opaque x then pure Nothing else pure (Just 0)) + pure ((,) <$> a <*> Just (fmap (conv . unpack) b)) +{-# INLINE get #-} + +top :: IO () +top = () <$ getUnchecked (undefined :: Int) + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -542,3 +542,4 @@ test('T26681', normal, compile, ['-O']) test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all']) test('T26682', normal, multimod_compile, ['T26682', '-O -v0']) test('T27261', [extra_files(['T27261_aux.hs'])], multimod_compile, ['T27261', '-v0 -O']) +test('T27766', normal, compile, ['-O2 -flate-specialise']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14a1087a1b0a57fb66f696a03e5df048... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14a1087a1b0a57fb66f696a03e5df048... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help