Remove Hoopl.Unique
authorMichal Terepeta <michal.terepeta@gmail.com>
Fri, 26 Jan 2018 18:09:29 +0000 (13:09 -0500)
committerBen Gamari <ben@smart-cactus.org>
Fri, 26 Jan 2018 19:37:28 +0000 (14:37 -0500)
Reasons to remove:
- It's confusing - we already have a widely used `Unique` module in
  `basicTypes/` that defines a newtype called `Unique`
- `Hoopl.Unique` is not actually used much

I've also moved the `Unique{Map,Set}` from `Hoopl.Unique` to
`Hoopl.Collections` to keep things together. But that module is also a
bit funny - it defines two type-classes that have only one instance
each. So we should probably either remove them or use them more
widely... In any case, that will be a separate change.

Signed-off-by: Michal Terepeta <michal.terepeta@gmail.com>
Test Plan: ./validate

Reviewers: bgamari, simonmar

Reviewed By: bgamari

Subscribers: kavon, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4331

compiler/cmm/BlockId.hs
compiler/cmm/Hoopl/Collections.hs
compiler/cmm/Hoopl/Label.hs
compiler/cmm/Hoopl/Unique.hs [deleted file]
compiler/ghc.cabal.in

index 73de69e..4f4e0e8 100644 (file)
@@ -16,8 +16,7 @@ import Name
 import Unique
 import UniqSupply
 
-import Hoopl.Label (Label, uniqueToLbl)
-import Hoopl.Unique (intToUnique)
+import Hoopl.Label (Label, mkHooplLabel)
 
 ----------------------------------------------------------------
 --- Block Ids, their environments, and their sets
@@ -34,7 +33,7 @@ compilation unit in which it appears.
 type BlockId = Label
 
 mkBlockId :: Unique -> BlockId
-mkBlockId unique = uniqueToLbl $ intToUnique $ getKey unique
+mkBlockId unique = mkHooplLabel $ getKey unique
 
 newBlockId :: MonadUnique m => m BlockId
 newBlockId = mkBlockId <$> getUniqueM
index be28849..9bccc66 100644 (file)
@@ -1,13 +1,20 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE TypeFamilies #-}
 module Hoopl.Collections
     ( IsSet(..)
     , setInsertList, setDeleteList, setUnions
     , IsMap(..)
     , mapInsertList, mapDeleteList, mapUnions
+    , UniqueMap, UniqueSet
     ) where
 
 import GhcPrelude
 
+import qualified Data.IntMap as M
+import qualified Data.IntSet as S
+
 import Data.List (foldl', foldl1')
 
 class IsSet set where
@@ -87,3 +94,67 @@ mapDeleteList keys map = foldl' (flip mapDelete) map keys
 mapUnions :: IsMap map => [map a] -> map a
 mapUnions [] = mapEmpty
 mapUnions maps = foldl1' mapUnion maps
+
+-----------------------------------------------------------------------------
+-- Basic instances
+-----------------------------------------------------------------------------
+
+newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show)
+
+instance IsSet UniqueSet where
+  type ElemOf UniqueSet = Int
+
+  setNull (US s) = S.null s
+  setSize (US s) = S.size s
+  setMember k (US s) = S.member k s
+
+  setEmpty = US S.empty
+  setSingleton k = US (S.singleton k)
+  setInsert k (US s) = US (S.insert k s)
+  setDelete k (US s) = US (S.delete k s)
+
+  setUnion (US x) (US y) = US (S.union x y)
+  setDifference (US x) (US y) = US (S.difference x y)
+  setIntersection (US x) (US y) = US (S.intersection x y)
+  setIsSubsetOf (US x) (US y) = S.isSubsetOf x y
+
+  setFold k z (US s) = S.foldr k z s
+
+  setElems (US s) = S.elems s
+  setFromList ks = US (S.fromList ks)
+
+newtype UniqueMap v = UM (M.IntMap v)
+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+instance IsMap UniqueMap where
+  type KeyOf UniqueMap = Int
+
+  mapNull (UM m) = M.null m
+  mapSize (UM m) = M.size m
+  mapMember k (UM m) = M.member k m
+  mapLookup k (UM m) = M.lookup k m
+  mapFindWithDefault def k (UM m) = M.findWithDefault def k m
+
+  mapEmpty = UM M.empty
+  mapSingleton k v = UM (M.singleton k v)
+  mapInsert k v (UM m) = UM (M.insert k v m)
+  mapInsertWith f k v (UM m) = UM (M.insertWith f k v m)
+  mapDelete k (UM m) = UM (M.delete k m)
+
+  mapUnion (UM x) (UM y) = UM (M.union x y)
+  mapUnionWithKey f (UM x) (UM y) = UM (M.unionWithKey f x y)
+  mapDifference (UM x) (UM y) = UM (M.difference x y)
+  mapIntersection (UM x) (UM y) = UM (M.intersection x y)
+  mapIsSubmapOf (UM x) (UM y) = M.isSubmapOf x y
+
+  mapMap f (UM m) = UM (M.map f m)
+  mapMapWithKey f (UM m) = UM (M.mapWithKey f m)
+  mapFold k z (UM m) = M.foldr k z m
+  mapFoldWithKey k z (UM m) = M.foldrWithKey k z m
+  mapFilter f (UM m) = UM (M.filter f m)
+
+  mapElems (UM m) = M.elems m
+  mapKeys (UM m) = M.keys m
+  mapToList (UM m) = M.toList m
+  mapFromList assocs = UM (M.fromList assocs)
+  mapFromListWith f assocs = UM (M.fromListWith f assocs)
index e28f92b..ddf200a 100644 (file)
@@ -8,16 +8,15 @@ module Hoopl.Label
     , LabelSet
     , FactBase
     , lookupFact
-    , uniqueToLbl
+    , mkHooplLabel
     ) where
 
 import GhcPrelude
 
 import Outputable
 
-import Hoopl.Collections
 -- TODO: This should really just use GHC's Unique and Uniq{Set,FM}
-import Hoopl.Unique
+import Hoopl.Collections
 
 import Unique (Uniquable(..))
 
@@ -25,11 +24,11 @@ import Unique (Uniquable(..))
 --              Label
 -----------------------------------------------------------------------------
 
-newtype Label = Label { lblToUnique :: Unique }
+newtype Label = Label { lblToUnique :: Int }
   deriving (Eq, Ord)
 
-uniqueToLbl :: Unique -> Label
-uniqueToLbl = Label
+mkHooplLabel :: Int -> Label
+mkHooplLabel = Label
 
 instance Show Label where
   show (Label n) = "L" ++ show n
@@ -62,9 +61,9 @@ instance IsSet LabelSet where
   setIntersection (LS x) (LS y) = LS (setIntersection x y)
   setIsSubsetOf (LS x) (LS y) = setIsSubsetOf x y
 
-  setFold k z (LS s) = setFold (k . uniqueToLbl) z s
+  setFold k z (LS s) = setFold (k . mkHooplLabel) z s
 
-  setElems (LS s) = map uniqueToLbl (setElems s)
+  setElems (LS s) = map mkHooplLabel (setElems s)
   setFromList ks = LS (setFromList (map lblToUnique ks))
 
 -----------------------------------------------------------------------------
@@ -89,20 +88,20 @@ instance IsMap LabelMap where
   mapDelete (Label k) (LM m) = LM (mapDelete k m)
 
   mapUnion (LM x) (LM y) = LM (mapUnion x y)
-  mapUnionWithKey f (LM x) (LM y) = LM (mapUnionWithKey (f . uniqueToLbl) x y)
+  mapUnionWithKey f (LM x) (LM y) = LM (mapUnionWithKey (f . mkHooplLabel) x y)
   mapDifference (LM x) (LM y) = LM (mapDifference x y)
   mapIntersection (LM x) (LM y) = LM (mapIntersection x y)
   mapIsSubmapOf (LM x) (LM y) = mapIsSubmapOf x y
 
   mapMap f (LM m) = LM (mapMap f m)
-  mapMapWithKey f (LM m) = LM (mapMapWithKey (f . uniqueToLbl) m)
+  mapMapWithKey f (LM m) = LM (mapMapWithKey (f . mkHooplLabel) m)
   mapFold k z (LM m) = mapFold k z m
-  mapFoldWithKey k z (LM m) = mapFoldWithKey (k . uniqueToLbl) z m
+  mapFoldWithKey k z (LM m) = mapFoldWithKey (k . mkHooplLabel) z m
   mapFilter f (LM m) = LM (mapFilter f m)
 
   mapElems (LM m) = mapElems m
-  mapKeys (LM m) = map uniqueToLbl (mapKeys m)
-  mapToList (LM m) = [(uniqueToLbl k, v) | (k, v) <- mapToList m]
+  mapKeys (LM m) = map mkHooplLabel (mapKeys m)
+  mapToList (LM m) = [(mkHooplLabel k, v) | (k, v) <- mapToList m]
   mapFromList assocs = LM (mapFromList [(lblToUnique k, v) | (k, v) <- assocs])
   mapFromListWith f assocs = LM (mapFromListWith f [(lblToUnique k, v) | (k, v) <- assocs])
 
diff --git a/compiler/cmm/Hoopl/Unique.hs b/compiler/cmm/Hoopl/Unique.hs
deleted file mode 100644 (file)
index f6fff98..0000000
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE TypeFamilies #-}
-module Hoopl.Unique
-    ( Unique
-    , UniqueMap
-    , UniqueSet
-    , intToUnique
-    ) where
-
-import GhcPrelude
-
-import qualified Data.IntMap as M
-import qualified Data.IntSet as S
-
-import Hoopl.Collections
-
-
------------------------------------------------------------------------------
---              Unique
------------------------------------------------------------------------------
-
-type Unique = Int
-
-intToUnique :: Int -> Unique
-intToUnique = id
-
------------------------------------------------------------------------------
--- UniqueSet
-
-newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show)
-
-instance IsSet UniqueSet where
-  type ElemOf UniqueSet = Unique
-
-  setNull (US s) = S.null s
-  setSize (US s) = S.size s
-  setMember k (US s) = S.member k s
-
-  setEmpty = US S.empty
-  setSingleton k = US (S.singleton k)
-  setInsert k (US s) = US (S.insert k s)
-  setDelete k (US s) = US (S.delete k s)
-
-  setUnion (US x) (US y) = US (S.union x y)
-  setDifference (US x) (US y) = US (S.difference x y)
-  setIntersection (US x) (US y) = US (S.intersection x y)
-  setIsSubsetOf (US x) (US y) = S.isSubsetOf x y
-
-  setFold k z (US s) = S.foldr k z s
-
-  setElems (US s) = S.elems s
-  setFromList ks = US (S.fromList ks)
-
------------------------------------------------------------------------------
--- UniqueMap
-
-newtype UniqueMap v = UM (M.IntMap v)
-  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
-
-instance IsMap UniqueMap where
-  type KeyOf UniqueMap = Unique
-
-  mapNull (UM m) = M.null m
-  mapSize (UM m) = M.size m
-  mapMember k (UM m) = M.member k m
-  mapLookup k (UM m) = M.lookup k m
-  mapFindWithDefault def k (UM m) = M.findWithDefault def k m
-
-  mapEmpty = UM M.empty
-  mapSingleton k v = UM (M.singleton k v)
-  mapInsert k v (UM m) = UM (M.insert k v m)
-  mapInsertWith f k v (UM m) = UM (M.insertWith f k v m)
-  mapDelete k (UM m) = UM (M.delete k m)
-
-  mapUnion (UM x) (UM y) = UM (M.union x y)
-  mapUnionWithKey f (UM x) (UM y) = UM (M.unionWithKey (f . intToUnique) x y)
-  mapDifference (UM x) (UM y) = UM (M.difference x y)
-  mapIntersection (UM x) (UM y) = UM (M.intersection x y)
-  mapIsSubmapOf (UM x) (UM y) = M.isSubmapOf x y
-
-  mapMap f (UM m) = UM (M.map f m)
-  mapMapWithKey f (UM m) = UM (M.mapWithKey (f . intToUnique) m)
-  mapFold k z (UM m) = M.foldr k z m
-  mapFoldWithKey k z (UM m) = M.foldrWithKey (k . intToUnique) z m
-  mapFilter f (UM m) = UM (M.filter f m)
-
-  mapElems (UM m) = M.elems m
-  mapKeys (UM m) = M.keys m
-  mapToList (UM m) = M.toList m
-  mapFromList assocs = UM (M.fromList assocs)
-  mapFromListWith f assocs = UM (M.fromListWith f assocs)
index d4387cb..d6d55bf 100644 (file)
@@ -564,7 +564,6 @@ Library
         Hoopl.Dataflow
         Hoopl.Graph
         Hoopl.Label
-        Hoopl.Unique
 --        CgInfoTbls used in ghci/DebuggerUtils
 --        CgHeapery  mkVirtHeapOffsets used in ghci