Commit bd58e290 authored by Michal Terepeta's avatar Michal Terepeta Committed by Ben Gamari

Remove Hoopl.Unique

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's avatarMichal 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
parent cacba075
......@@ -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
......
{-# 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)
......@@ -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])
......
{-# 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)
......@@ -564,7 +564,6 @@ Library
Hoopl.Dataflow
Hoopl.Graph
Hoopl.Label
Hoopl.Unique
-- CgInfoTbls used in ghci/DebuggerUtils
-- CgHeapery mkVirtHeapOffsets used in ghci
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment