the nullary constructors are the troublesome ones
authorGabor Greif <ggreif@gmail.com>
Sun, 20 Aug 2017 22:19:45 +0000 (00:19 +0200)
committerGabor Greif <ggreif@gmail.com>
Mon, 16 Oct 2017 21:16:52 +0000 (23:16 +0200)
compiler/simplStg/StgCse.hs

index f1dc186..88a2c7d 100644 (file)
@@ -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