Matthew Craven pushed to branch wip/T26748 at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • compiler/GHC/Types/Id/Make.hs
    ... ... @@ -825,9 +825,10 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
    825 825
                                                           -- LFInfo stores post-unarisation arity
    
    826 826
     
    
    827 827
                  wrap_arg_dmds =
    
    828
    -               replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
    
    828
    +               replicate (length stupid_theta + length theta) topDmd
    
    829
    +                 ++ map mk_dmd arg_ibangs
    
    829 830
                    -- Don't forget the dictionary arguments when building
    
    830
    -               -- the strictness signature (#14290).
    
    831
    +               -- the strictness signature (#14290, #26748).
    
    831 832
     
    
    832 833
                  mk_dmd str | isBanged str = evalDmd
    
    833 834
                             | otherwise    = topDmd
    

  • testsuite/tests/dmdanal/should_run/T26748.hs
    1
    +{-# LANGUAGE Haskell98 #-}
    
    2
    +module Main (main, x) where
    
    3
    +
    
    4
    +data Eq a => D a = MkD { lazy_field :: a, strict_field :: !a }
    
    5
    +
    
    6
    +x :: D ()
    
    7
    +{-# INLINABLE x #-}
    
    8
    +x = MkD { lazy_field = error "urk", strict_field = () }
    
    9
    +
    
    10
    +main :: IO ()
    
    11
    +main = print (strict_field x)

  • testsuite/tests/dmdanal/should_run/T26748.stdout
    1
    +()

  • testsuite/tests/dmdanal/should_run/all.T
    ... ... @@ -34,3 +34,4 @@ test('T22475b', normal, compile_and_run, [''])
    34 34
     test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
    
    35 35
     test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])
    
    36 36
     test('T25439', normal, compile_and_run, [''])
    
    37
    +test('T26748', normal, compile_and_run, [''])