[commit: ghc] wip/T13861: the nullary constructors are the troublesome ones (9fee1f0)

[git at git.haskell.org]

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

On branch  : wip/T13861
Link       : http://ghc.haskell.org/trac/ghc/changeset/9fee1f0af82d5d7aa3cd85785b9e7711e3a02a08/ghc

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

commit 9fee1f0af82d5d7aa3cd85785b9e7711e3a02a08
Author: Gabor Greif <ggreif at gmail.com>
Date:   Mon Aug 21 00:19:45 2017 +0200

    the nullary constructors are the troublesome ones


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

9fee1f0af82d5d7aa3cd85785b9e7711e3a02a08
 compiler/simplStg/StgCse.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index f1dc186..88a2c7d 100644
--- a/compiler/simplStg/StgCse.hs
+++ b/compiler/simplStg/StgCse.hs
@@ -92,7 +92,7 @@ import TrieMap
 import NameEnv
 import Control.Monad( (>=>) )
 import Name (NamedThing (..), mkFCallName, nameUnique)
-import Unique (mkUniqueGrimily, getKey)
+import Unique (mkUniqueGrimily, getKey, getUnique)
 
 --------------
 -- The Trie --
@@ -127,7 +127,7 @@ instance NamedThing LaxDataCon where
     where uniq = mkUniqueGrimily . negate $ dataConTag dc * 1048576 + length (dataConOrigArgTys dc) -- FIXME
           hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc)
           unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc
-          long = length (dataConOrigArgTys dc) > 1
+          long = True -- length (dataConOrigArgTys dc) > 0
   getName (Lax dc) = getName dc
 
 
@@ -341,11 +341,13 @@ stgCseExpr env (StgCase scrut bndr ty alts)
 -- A constructor application.
 -- To be removed by a variable use when found in the CSE environment
 stgCseExpr env (StgConApp dataCon args tys)
-    | Just bndr' <- envLookup (Lax dataCon) args' env
-    = StgApp bndr' []
+    | Just bndr' <- envLookup dc args' env
+    = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon) else id) $ StgApp bndr' []
     | otherwise
     = StgConApp dataCon args' tys
   where args' = substArgs env args
+        dc = Lax dataCon
+        u = getUnique (getName dc)
 
 -- Let bindings
 -- The binding might be removed due to CSE (we do not want trivial bindings on