travis compilation
authorGabor Greif <ggreif@gmail.com>
Fri, 22 Dec 2017 00:50:44 +0000 (01:50 +0100)
committerGabor Greif <ggreif@gmail.com>
Fri, 22 Dec 2017 00:50:44 +0000 (01:50 +0100)
compiler/simplStg/StgCse.hs

index 02b3891..670a3ad 100644 (file)
@@ -91,7 +91,7 @@ import Data.Maybe (fromMaybe)
 import TrieMap
 import NameEnv
 import Control.Monad( (>=>) )
 import TrieMap
 import NameEnv
 import Control.Monad( (>=>) )
-import Name (NamedThing (..), mkFCallName, nameUnique)
+import Name (NamedThing (..), mkFCallName)
 import Unique (mkUniqueGrimily, getKey, getUnique)
 import TyCon (tyConFamilySize)
 
 import Unique (mkUniqueGrimily, getKey, getUnique)
 import TyCon (tyConFamilySize)
 
@@ -135,21 +135,12 @@ instance NamedThing LaxDataCon where
 instance TrieMap ConAppMap where
     type Key ConAppMap = (LaxDataCon, [StgArg])
     emptyTM  = CAM emptyTM
 instance TrieMap ConAppMap where
     type Key ConAppMap = (LaxDataCon, [StgArg])
     emptyTM  = CAM emptyTM
-    --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 }
     foldTM k = un_cam >.> foldTM (foldTM k)
     mapTM f  = un_cam >.> mapTM (mapTM f) >.> CAM
 
     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 }
     foldTM k = un_cam >.> foldTM (foldTM k)
     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 #-}
 
 -----------------
 -- The CSE Env --
 
 -----------------
 -- The CSE Env --
@@ -341,7 +332,7 @@ stgCseExpr env (StgCase scrut bndr ty alts)
 
 -- A constructor application.
 -- To be removed by a variable use when found in the CSE environment
 
 -- A constructor application.
 -- To be removed by a variable use when found in the CSE environment
-stgCseExpr env orig@(StgConApp dataCon args tys)
+stgCseExpr env (StgConApp dataCon args tys)
     | Just bndr' <- envLookup dc args' env
     = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon)) <+> (text . show $ tyConFamilySize (dataConTyCon dataCon))) else id) $ StgApp bndr' []
     | otherwise
     | Just bndr' <- envLookup dc args' env
     = (if getKey u < 0 then pprTrace "stgCseExpr" (ppr dataCon <+> text (show $ length (dataConOrigArgTys dataCon)) <+> (text . show $ tyConFamilySize (dataConTyCon dataCon))) else id) $ StgApp bndr' []
     | otherwise