Zubin pushed to branch wip/27845 at Glasgow Haskell Compiler / GHC
Commits:
-
0689685b
by Zubin Duggal at 2026-09-30T17:00:36+05:30
9 changed files:
- + changelog.d/27845
- compiler/GHC/Types/Demand.hs
- + testsuite/tests/dmdanal/should_run/T27845.hs
- + testsuite/tests/dmdanal/should_run/T27845.stdout
- + testsuite/tests/dmdanal/should_run/T27845_Lib.hs
- + testsuite/tests/dmdanal/should_run/T27845b.hs
- + testsuite/tests/dmdanal/should_run/T27845b.stdout
- + testsuite/tests/dmdanal/should_run/T27845b_Lib.hs
- testsuite/tests/dmdanal/should_run/all.T
Changes:
| 1 | +section: compiler
|
|
| 2 | +synopsis: Fix a bug where an argument used lazily only by a function's stable
|
|
| 3 | + unfolding could be treated as strict in its fields.
|
|
| 4 | +mrs: !16746
|
|
| 5 | +issues: #27845 |
| ... | ... | @@ -924,6 +924,8 @@ maxCard (Card a) (Card b) = Card ((a .&. b .&. 0b001) .|. ((a .|. b) .&. 0b110)) |
| 924 | 924 | maxDmd :: Demand -> Demand -> Demand
|
| 925 | 925 | maxDmd BotDmd dmd2 = dmd2
|
| 926 | 926 | maxDmd dmd1 BotDmd = dmd1
|
| 927 | +maxDmd AbsDmd dmd2 = dmd2
|
|
| 928 | +maxDmd dmd1 AbsDmd = dmd1
|
|
| 927 | 929 | maxDmd (n1 :* sd1) (n2 :* sd2) =
|
| 928 | 930 | maxCard n1 n2 :* maxSubDmd sd1 sd2
|
| 929 | 931 |
| 1 | +module Main where
|
|
| 2 | +import T27845_Lib (f)
|
|
| 3 | +import System.Environment (getArgs)
|
|
| 4 | + |
|
| 5 | +{-# NOINLINE mkArg #-}
|
|
| 6 | +mkArg :: Int -> Int
|
|
| 7 | +mkArg n | n < 0 = n
|
|
| 8 | + | otherwise = error ("boom " ++ show n)
|
|
| 9 | + |
|
| 10 | +main :: IO ()
|
|
| 11 | +main = do
|
|
| 12 | + n <- length <$> getArgs
|
|
| 13 | + let x = mkArg n
|
|
| 14 | + print (length (f (x, x) n)) |
| 1 | +0 |
| 1 | +module T27845_Lib where
|
|
| 2 | + |
|
| 3 | +{-# INLINABLE [2] f #-}
|
|
| 4 | +f :: a -> Int -> [a]
|
|
| 5 | +f p x = lazyUse p x ++ lazyUse p (x + 1) ++ lazyUse p (x + 2)
|
|
| 6 | + |
|
| 7 | +{-# NOINLINE lazyUse #-}
|
|
| 8 | +lazyUse :: a -> Int -> [a]
|
|
| 9 | +lazyUse p x = p `seq` replicate x p
|
|
| 10 | + |
|
| 11 | +{-# RULES "lazyUse" [1] forall p x. lazyUse p x = [] #-} |
| 1 | +module Main where
|
|
| 2 | +import T27845b_Lib (outer)
|
|
| 3 | +import System.Environment (getArgs)
|
|
| 4 | + |
|
| 5 | +{-# NOINLINE mkArg #-}
|
|
| 6 | +mkArg :: Int -> Int
|
|
| 7 | +mkArg n | n < 0 = n
|
|
| 8 | + | otherwise = error ("boom " ++ show n)
|
|
| 9 | + |
|
| 10 | +main :: IO ()
|
|
| 11 | +main = do
|
|
| 12 | + n <- length <$> getArgs
|
|
| 13 | + let x = mkArg n
|
|
| 14 | + print (length (outer (x, x) n)) |
| 1 | +0 |
| 1 | +module T27845b_Lib where
|
|
| 2 | + |
|
| 3 | +outer :: a -> Int -> [a]
|
|
| 4 | +outer a n =
|
|
| 5 | + let {-# INLINABLE [2] g #-}
|
|
| 6 | + g x = lazyUse a (x + 0) ++ lazyUse a (x + 1) ++ lazyUse a (x + 2)
|
|
| 7 | + in g n ++ g (n + 1) ++ g (n + 2)
|
|
| 8 | +{-# NOINLINE outer #-}
|
|
| 9 | + |
|
| 10 | +{-# NOINLINE lazyUse #-}
|
|
| 11 | +lazyUse :: a -> Int -> [a]
|
|
| 12 | +lazyUse p x = p `seq` replicate x p
|
|
| 13 | + |
|
| 14 | +{-# RULES "lazyUse" [1] forall p x. lazyUse p x = [] #-} |
| ... | ... | @@ -37,3 +37,5 @@ test('T25439', normal, compile_and_run, ['']) |
| 37 | 37 | test('T26748', normal, compile_and_run, [''])
|
| 38 | 38 | test('T26416', [extra_files(['M1.hs'])], multimod_compile_and_run, ['T26416','M1.hs'])
|
| 39 | 39 | test('T27626', [extra_files(['M2.hs'])], multimod_compile_and_run, ['T27626','M2.hs'])
|
| 40 | +test('T27845', [extra_files(['T27845_Lib.hs'])], multimod_compile_and_run, ['T27845','T27845_Lib.hs'])
|
|
| 41 | +test('T27845b', [extra_files(['T27845b_Lib.hs'])], multimod_compile_and_run, ['T27845b','T27845b_Lib.hs']) |