[commit: ghc] wip/cross-constr-cse: clean up (649c50a)

[git at git.haskell.org]

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

On branch  : wip/cross-constr-cse
Link       : http://ghc.haskell.org/trac/ghc/changeset/649c50aef03497d636fd07d2c6ac5a4ee9d13816/ghc

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

commit 649c50aef03497d636fd07d2c6ac5a4ee9d13816
Author: Gabor Greif <ggreif at gmail.com>
Date:   Sat Jul 29 22:21:53 2017 +0200

    clean up


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

649c50aef03497d636fd07d2c6ac5a4ee9d13816
 compiler/simplStg/StgCse.hs | 34 ++++++----------------------------
 1 file changed, 6 insertions(+), 28 deletions(-)

diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index 38b7262..c1ec54b 100644
--- a/compiler/simplStg/StgCse.hs
+++ b/compiler/simplStg/StgCse.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, ViewPatterns, LambdaCase #-}
+{-# LANGUAGE TypeFamilies, LambdaCase #-}
 
 {-|
 Note [CSE for Stg]
@@ -16,7 +16,7 @@ note [Case 2: CSEing case binders] below.
 
 Note [Case 1: CSEing allocated closures]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The fist kind of CSE opportunity we aim for is generated by this Haskell code:
+The first kind of CSE opportunity we aim for is generated by this Haskell code:
 
     bar :: a -> (Either Int a, Either Bool a)
     bar x = (Right x, Right x)
@@ -81,16 +81,15 @@ import Data.Maybe (fromMaybe)
 import TrieMap
 import NameEnv
 import Control.Monad( (>=>) )
-import Data.Function (on)
-import Name (NamedThing (..), getOccString, mkFCallName)
-import Unique(Uniquable(..), mkUniqueGrimily)
+import Name (NamedThing (..), mkFCallName)
+import Unique (mkUniqueGrimily)
 
 --------------
 -- The Trie --
 --------------
 
 -- A lookup trie for data constructor applications, i.e.
--- keys of type `(DataCon, [StgArg])`, following the patterns in TrieMap.
+-- keys of type `(LaxDataCon, [StgArg])`, following the patterns in TrieMap.
 
 data StgArgMap a = SAM
     { sam_var :: DVarEnv a
@@ -113,38 +112,17 @@ newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) }
 
 newtype LaxDataCon = Lax DataCon
 
-unLax (Lax dc) = dc
-{-
-instance Eq LaxDataCon where
---  (==) = (==) `on` dataConTag . unLax
-  Lax dcl == Lax dcr | dcl == dcr = True
-                     | True {- ((==) `on` dataConTag) dcl dcr
-                     && ((&&) `on` isVanillaDataCon) dcl dcr
-                     && ((==) `on` length {- FIXME? -} . dataConOrigArgTys) dcl dcr -}
-                         = error $ show (getOccString dcl, getOccString dcr) -- True
-                     | otherwise = False
--}
-{-
-instance Ord LaxDataCon where
-  l@(Lax dcl) `compare` r@(Lax dcr) = if l == r then EQ else dcl `compare` dcr
--}
-
 instance NamedThing LaxDataCon where
-  --getName = getName . unLax
-  getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "%%%HALLO"
+  getName (Lax dc) | isVanillaDataCon dc && not hasStrict && not unpacked = mkFCallName uniq "%%%HALLO" -- FIXME
     where uniq = mkUniqueGrimily . negate $ dataConTag dc * 10000 + length (dataConOrigArgTys dc)
           hasStrict = any (\case HsLazy -> False; _ -> True) (dataConImplBangs dc)
           unpacked = isUnboxedTupleCon dc || isUnboxedSumCon dc
   getName (Lax dc) = getName dc
 
-instance Uniquable LaxDataCon where
-  getUnique = error "Uniquable" -- mkUniqueGrimily . dataConTag . unLax
-
 
 instance TrieMap ConAppMap where
     type Key ConAppMap = (LaxDataCon, [StgArg])
     emptyTM  = CAM emptyTM
-    --lookupTM ((getOccString -> "Just"), args) = error (show ("args", length args))
     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 }