[commit: ghc] master: Fix cardinality change of fields in addDataConStrictness (c5b477c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c5b477c29127d8375b3f23d37f877278b52547f6/ghc

>---------------------------------------------------------------

commit c5b477c29127d8375b3f23d37f877278b52547f6
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Mon Oct 15 13:48:53 2018 -0400

    Fix cardinality change of fields in addDataConStrictness
    
    Test Plan: This validates
    
    Reviewers: simonpj, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, carter
    
    Differential Revision: https://phabricator.haskell.org/D5225


>---------------------------------------------------------------

c5b477c29127d8375b3f23d37f877278b52547f6
 compiler/basicTypes/Demand.hs | 6 +++++-
 compiler/stranal/DmdAnal.hs   | 2 +-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 0719453..4707be7 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -56,7 +56,7 @@ module Demand (
         useCount, isUsedOnce, reuseEnv,
         killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig,
         zapUsedOnceDemand, zapUsedOnceSig,
-        strictifyDictDmd
+        strictifyDictDmd, strictifyDmd
 
      ) where
 
@@ -2033,6 +2033,10 @@ strictifyDictDmd ty dmd = case getUseDmd dmd of
              -- the superclass dicts are always a prefix
   _ -> dmd -- unused or not a dictionary
 
+strictifyDmd :: Demand -> Demand
+strictifyDmd dmd@(JD { sd = str })
+  = dmd { sd = str `bothArgStr` Str VanStr HeadStr }
+
 {-
 Note [HyperStr and Use demands]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index b606804..9959119 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -1222,7 +1222,7 @@ addDataConStrictness con ds
   where
     strs = dataConRepStrictness con
     add dmd str | isMarkedStrict str
-                , not (isAbsDmd dmd) = dmd `bothDmd` seqDmd
+                , not (isAbsDmd dmd) = strictifyDmd dmd
                 | otherwise          = dmd
 
 findBndrsDmds :: AnalEnv -> DmdType -> [Var] -> (DmdType, [Demand])