[commit: ghc] wip/T13861: clean up (ba67d83)

[git at git.haskell.org]

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

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

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

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

    clean up


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

ba67d83a3301b053b29a08cb58a0bd7e5563b2da
 compiler/simplStg/StgCse.hs | 32 +++++---------------------------
 1 file changed, 5 insertions(+), 27 deletions(-)

diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index 23186ef..f39ef51 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]
@@ -83,16 +83,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
@@ -115,38 +114,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 }