[commit: ghc] wip/T13861: WIP: debugging, we can get the family size! (63c09d3)

[git at git.haskell.org]

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

On branch  : wip/T13861
Link       : http://ghc.haskell.org/trac/ghc/changeset/63c09d399684598e52f6596ab62f7860a1b1cbd8/ghc

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

commit 63c09d399684598e52f6596ab62f7860a1b1cbd8
Author: Gabor Greif <ggreif at gmail.com>
Date:   Tue Oct 17 02:00:26 2017 +0200

    WIP: debugging, we can get the family size!


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

63c09d399684598e52f6596ab62f7860a1b1cbd8
 compiler/simplStg/StgCse.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index e777e3a..02b3891 100644
--- a/compiler/simplStg/StgCse.hs
+++ b/compiler/simplStg/StgCse.hs
@@ -93,6 +93,7 @@ import NameEnv
 import Control.Monad( (>=>) )
 import Name (NamedThing (..), mkFCallName, nameUnique)
 import Unique (mkUniqueGrimily, getKey, getUnique)
+import TyCon (tyConFamilySize)
 
 --------------
 -- The Trie --
@@ -127,7 +128,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 = null $ dataConOrigArgTys dc -- True -- length (dataConOrigArgTys dc) > 0
+          long = dataConTag dc < 7 && (null $ dataConOrigArgTys dc) -- True -- length (dataConOrigArgTys dc) > 0
   getName (Lax dc) = getName dc
 
 
@@ -342,7 +343,7 @@ stgCseExpr env (StgCase scrut bndr ty alts)
 -- To be removed by a variable use when found in the CSE environment
 stgCseExpr env orig@(StgConApp dataCon args tys)
     | Just bndr' <- envLookup dc args' env
-    = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon))) else id) $ StgApp bndr' []
+    = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon)) <+> (text . show $ tyConFamilySize (dataConTyCon dataCon))) else id) $ StgApp bndr' []
     | otherwise
     = StgConApp dataCon args' tys
   where args' = substArgs env args