Change in demand analysis results between 7.10.2 and RC1 (not fixed in RC2 and HEAD)

Hi all,
While working on demand analyzer today we realized that there has been some
changes in demand analysis results between GHC 7.10.2 and 8.0-rc2. Here's a
minimal example:
{-# LANGUAGE BangPatterns #-}
module Main where
data Prod a = Prod !a !a
addProd :: Prod Int -> Prod Int -> Prod Int
addProd (Prod i1 i2) (Prod i3 i4) = Prod i1 (i2 + i4)
main = return ()
Compiled with 7.10.2:
addProd :: Prod Int -> Prod Int -> Prod Int
[GblId,
Arity=2,
Caf=NoCafRefs,
Str=DmdType m,
...}}}}]
addProd =
\ (ds_dzH :: Prod Int) (ds1_dzI :: Prod Int) ->
case ds_dzH of _ [Occ=Dead] { Prod i1_an2 i2_an3 ->
case i2_an3 of _ [Occ=Dead] { GHC.Types.I# x_s2B4 ->
case ds1_dzI of _ [Occ=Dead] { Prod i3_an4 i4_an5 ->
case i4_an5 of _ [Occ=Dead] { GHC.Types.I# y_s2B7 ->
Main.Prod @ Int i1_an2 (GHC.Types.I# (GHC.Prim.+# x_s2B4 y_s2B7))
}
}
}
}
Compiled with 8.0-rc2:
-- RHS size: {terms: 20, types: 17, coercions: 0}
addProd :: Prod Int -> Prod Int -> Prod Int
[GblId,
Arity=2,
Caf=NoCafRefs,
Str=DmdType m,
...}}}}]
addProd =
\ (ds_dQL :: Prod Int) (ds1_dQM :: Prod Int) ->
case ds_dQL of _ [Occ=Dead] { Prod i1_avS i2_avT ->
case i2_avT of _ [Occ=Dead] { GHC.Types.I# x_s1vO ->
case ds1_dQM of _ [Occ=Dead] { Prod i3_avU i4_avV ->
case i4_avV of _ [Occ=Dead] { GHC.Types.I# y_s1vR ->
Main.Prod @ Int i1_avS (GHC.Types.I# (GHC.Prim.+# x_s1vO y_s1vR))
}
}
}
}
To highlight the difference,
GHC 7.10.2:
GHC 8.0-rc2:
(NOTE: Also tried with HEAD and rc1 just now, the results are the same as rc2)
The demand put on the second argument is more strict in GHC 7.10. Was that an
intentional change? Any ideas on why this might be happening?
In our case, we prefer the result in 7.10.2 of course, because that's a more
precise demand and it gives us more opportunities for optimizations. But I
guess this could potentially reveal itself in some other situations and make
some programs slower? Any ideas?
Thanks..

Hi, Am Freitag, den 26.02.2016, 22:12 -0500 schrieb Ömer Sinan Ağacan:
While working on demand analyzer today we realized that there has been some changes in demand analysis results between GHC 7.10.2 and 8.0-rc2.
a quick git log highlights this commit, as it relates to strict data
constructors: 0696fc6d4de28cb589f6c751b8491911a5baf774
commit 0696fc6d4de28cb589f6c751b8491911a5baf774
Author: Simon Peyton Jones

Thanks, but that patch looks like for CPR. In our case demands are
changed, so I don't see how that's related. Am I missing anything in
that patch?
2016-02-27 3:49 GMT-05:00 Joachim Breitner
Hi, Am Freitag, den 26.02.2016, 22:12 -0500 schrieb Ömer Sinan Ağacan:
While working on demand analyzer today we realized that there has been some changes in demand analysis results between GHC 7.10.2 and 8.0-rc2.
a quick git log highlights this commit, as it relates to strict data constructors: 0696fc6d4de28cb589f6c751b8491911a5baf774
commit 0696fc6d4de28cb589f6c751b8491911a5baf774 Author: Simon Peyton Jones
Date: Fri Jun 26 11:40:01 2015 +0100 Improve CPR behavior for strict constructors
When working on Trac #10482 I noticed that we could give constructor arguments the CPR property if they are use strictly.
This is documented carefully in Note [CPR in a product case alternative] and also Note [Initial CPR for strict binders]
There are a bunch of intersting examples in Note [CPR examples] which I have added to the test suite as T10482a.
I also added a test for #10482 itself.
I did not investigate whether this could actually have effected¹ this change.
Greetings, Joachim
¹ How do you recognize a regular xkcd reader? He uses effect as an verb. https://xkcd.com/326/
-- -- Joachim “nomeata” Breitner mail@joachim-breitner.de • https://www.joachim-breitner.de/ XMPP: nomeata@joachim-breitner.de • OpenPGP-Key: 0xF0FBF51F Debian Developer: nomeata@debian.org
_______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

See Note [Add demands for strict constructors] in DmdAnal, esp the bit that says
If the argument is not used at all in the alternative (i.e. it is
Absent), then *don't* add a 'seqDmd'. If we do, it makes it look used
and hence it'll be passed to the worker when it doesn't need to be.
Hence the isAbsDmd test in addDataConStrictness.
Why do you say
| In our case, we prefer the result in 7.10.2 of course, because that's a
| more precise demand and it gives us more opportunities for
| optimizations. But I guess this could potentially reveal itself in some
What optimisations do you have in mind?
Simon
| -----Original Message-----
| From: Ömer Sinan Ağacan [mailto:omeragacan@gmail.com]
| Sent: 27 February 2016 03:13
| To: ghc-devs m,
| ...}}}}]
| addProd =
| \ (ds_dzH :: Prod Int) (ds1_dzI :: Prod Int) ->
| case ds_dzH of _ [Occ=Dead] { Prod i1_an2 i2_an3 ->
| case i2_an3 of _ [Occ=Dead] { GHC.Types.I# x_s2B4 ->
| case ds1_dzI of _ [Occ=Dead] { Prod i3_an4 i4_an5 ->
| case i4_an5 of _ [Occ=Dead] { GHC.Types.I# y_s2B7 ->
|
| https://na01.safelinks.protection.outlook.com/?url=Main.Prod&data=01%7c
| 01%7csimonpj%40064d.mgd.microsoft.com%7c7b5d6e60d31348506eb108d33f23f6b
| f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=NfCiyeSjPwsWage0KlgkMkQR
| jWVexsdlCq0Dla%2f1I10%3d @ Int i1_an2 (GHC.Types.I# (GHC.Prim.+# x_s2B4
| y_s2B7))
| }
| }
| }
| }
|
| Compiled with 8.0-rc2:
|
| -- RHS size: {terms: 20, types: 17, coercions: 0}
| addProd :: Prod Int -> Prod Int -> Prod Int
| [GblId,
| Arity=2,
| Caf=NoCafRefs,
| Str=DmdType m,
| ...}}}}]
| addProd =
| \ (ds_dQL :: Prod Int) (ds1_dQM :: Prod Int) ->
| case ds_dQL of _ [Occ=Dead] { Prod i1_avS i2_avT ->
| case i2_avT of _ [Occ=Dead] { GHC.Types.I# x_s1vO ->
| case ds1_dQM of _ [Occ=Dead] { Prod i3_avU i4_avV ->
| case i4_avV of _ [Occ=Dead] { GHC.Types.I# y_s1vR ->
|
| https://na01.safelinks.protection.outlook.com/?url=Main.Prod&data=01%7c
| 01%7csimonpj%40064d.mgd.microsoft.com%7c7b5d6e60d31348506eb108d33f23f6b
| f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=NfCiyeSjPwsWage0KlgkMkQR
| jWVexsdlCq0Dla%2f1I10%3d @ Int i1_avS (GHC.Types.I# (GHC.Prim.+# x_s1vO
| y_s1vR))
| }
| }
| }
| }
|
| To highlight the difference,
|
| GHC 7.10.2:
| GHC 8.0-rc2:
|
| (NOTE: Also tried with HEAD and rc1 just now, the results are the same
| as rc2)
|
| The demand put on the second argument is more strict in GHC 7.10. Was
| that an intentional change? Any ideas on why this might be happening?
|
| In our case, we prefer the result in 7.10.2 of course, because that's a
| more precise demand and it gives us more opportunities for
| optimizations. But I guess this could potentially reveal itself in some
| other situations and make some programs slower? Any ideas?
|
| Thanks..

Why do you say
| In our case, we prefer the result in 7.10.2 of course, because that's a | more precise demand and it gives us more opportunities for | optimizations. But I guess this could potentially reveal itself in some
What optimisations do you have in mind?
I just had worker/wrapper in mind. I just realized that
See Note [Add demands for strict constructors] in DmdAnal, esp the bit that says If the argument is not used at all in the alternative (i.e. it is Absent), then *don't* add a 'seqDmd'. If we do, it makes it look used and hence it'll be passed to the worker when it doesn't need to be. Hence the isAbsDmd test in addDataConStrictness.
Why do you say
| In our case, we prefer the result in 7.10.2 of course, because that's a | more precise demand and it gives us more opportunities for | optimizations. But I guess this could potentially reveal itself in some
What optimisations do you have in mind?
Simon
| -----Original Message----- | From: Ömer Sinan Ağacan [mailto:omeragacan@gmail.com] | Sent: 27 February 2016 03:13 | To: ghc-devs
; Simon Peyton Jones | | Cc: Jose Calderon | Subject: Change in demand analysis results between 7.10.2 and RC1 (not | fixed in RC2 and HEAD) | | Hi all, | | While working on demand analyzer today we realized that there has been | some changes in demand analysis results between GHC 7.10.2 and 8.0-rc2. | Here's a minimal example: | | {-# LANGUAGE BangPatterns #-} | | module Main where | | data Prod a = Prod !a !a | | addProd :: Prod Int -> Prod Int -> Prod Int | addProd (Prod i1 i2) (Prod i3 i4) = Prod i1 (i2 + i4) | | main = return () | | Compiled with 7.10.2: | | addProd :: Prod Int -> Prod Int -> Prod Int | [GblId, | Arity=2, | Caf=NoCafRefs, | Str=DmdType m, | ...}}}}] | addProd = | \ (ds_dzH :: Prod Int) (ds1_dzI :: Prod Int) -> | case ds_dzH of _ [Occ=Dead] { Prod i1_an2 i2_an3 -> | case i2_an3 of _ [Occ=Dead] { GHC.Types.I# x_s2B4 -> | case ds1_dzI of _ [Occ=Dead] { Prod i3_an4 i4_an5 -> | case i4_an5 of _ [Occ=Dead] { GHC.Types.I# y_s2B7 -> | | https://na01.safelinks.protection.outlook.com/?url=Main.Prod&data=01%7c | 01%7csimonpj%40064d.mgd.microsoft.com%7c7b5d6e60d31348506eb108d33f23f6b | f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=NfCiyeSjPwsWage0KlgkMkQR | jWVexsdlCq0Dla%2f1I10%3d @ Int i1_an2 (GHC.Types.I# (GHC.Prim.+# x_s2B4 | y_s2B7)) | } | } | } | } | | Compiled with 8.0-rc2: | | -- RHS size: {terms: 20, types: 17, coercions: 0} | addProd :: Prod Int -> Prod Int -> Prod Int | [GblId, | Arity=2, | Caf=NoCafRefs, | Str=DmdTypem, | ...}}}}] | addProd = | \ (ds_dQL :: Prod Int) (ds1_dQM :: Prod Int) -> | case ds_dQL of _ [Occ=Dead] { Prod i1_avS i2_avT -> | case i2_avT of _ [Occ=Dead] { GHC.Types.I# x_s1vO -> | case ds1_dQM of _ [Occ=Dead] { Prod i3_avU i4_avV -> | case i4_avV of _ [Occ=Dead] { GHC.Types.I# y_s1vR -> | | https://na01.safelinks.protection.outlook.com/?url=Main.Prod&data=01%7c | 01%7csimonpj%40064d.mgd.microsoft.com%7c7b5d6e60d31348506eb108d33f23f6b | f%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=NfCiyeSjPwsWage0KlgkMkQR | jWVexsdlCq0Dla%2f1I10%3d @ Int i1_avS (GHC.Types.I# (GHC.Prim.+# x_s1vO | y_s1vR)) | } | } | } | } | | To highlight the difference, | | GHC 7.10.2:| GHC 8.0-rc2:| | (NOTE: Also tried with HEAD and rc1 just now, the results are the same | as rc2) | | The demand put on the second argument is more strict in GHC 7.10. Was | that an intentional change? Any ideas on why this might be happening? | | In our case, we prefer the result in 7.10.2 of course, because that's a | more precise demand and it gives us more opportunities for | optimizations. But I guess this could potentially reveal itself in some | other situations and make some programs slower? Any ideas? | | Thanks..
participants (3)
-
Joachim Breitner
-
Simon Peyton Jones
-
Ömer Sinan Ağacan