[commit: ghc] wip/T13861: more debugging (00f8f41)

[git at git.haskell.org]

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

On branch  : wip/T13861
Link       : http://ghc.haskell.org/trac/ghc/changeset/00f8f41bb5e3ac3caa562b07cc642350944992a5/ghc

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

commit 00f8f41bb5e3ac3caa562b07cc642350944992a5
Author: Gabor Greif <ggreif at gmail.com>
Date:   Mon Aug 14 17:46:24 2017 +0200

    more debugging


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

00f8f41bb5e3ac3caa562b07cc642350944992a5
 compiler/simplStg/StgCse.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index 65b5cb8..f1dc186 100644
--- a/compiler/simplStg/StgCse.hs
+++ b/compiler/simplStg/StgCse.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TypeFamilies, LambdaCase #-}
+{-# OPTIONS -Wno-error=unused-imports -Wno-error=unused-top-binds #-}
 
 {-|
 Note [CSE for Stg]
@@ -126,14 +127,14 @@ 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) > 2
+          long = length (dataConOrigArgTys dc) > 1
   getName (Lax dc) = getName dc
 
 
 instance TrieMap ConAppMap where
     type Key ConAppMap = (LaxDataCon, [StgArg])
     emptyTM  = CAM emptyTM
-    lookupTM (dataCon, _) | traceLookup dataCon = undefined
+    --lookupTM (dataCon, _) | traceLookup dataCon = undefined
     lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args
     alterTM  (dataCon, args) f m =
         m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f }
@@ -141,9 +142,12 @@ instance TrieMap ConAppMap where
     mapTM f  = un_cam >.> mapTM (mapTM f) >.> CAM
 
 traceLookup :: LaxDataCon -> Bool
+traceLookup _ = False
+{-
 traceLookup l@(Lax dc) = pprTrace "lookupTM" (ppr dc <> (if getKey u < 0 then text " -" else text " ") <> ppr u') False
   where u = nameUnique . getName $ l
         u' = mkUniqueGrimily (abs(getKey u))
+-}
 {-# NOINLINE traceLookup #-}
 
 -----------------