{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Clash.Unique
  ( -- * Unique
    Unique
  , Uniquable (..)
    -- * UniqMap
  , UniqMap
    -- ** Accessors
    -- *** Size information
  , nullUniqMap
    -- *** Indexing
  , lookupUniqMap
  , lookupUniqMap'
    -- ** Construction
  , emptyUniqMap
  , unitUniqMap
    -- ** Modification
  , extendUniqMap
  , extendUniqMapWith
  , extendListUniqMap
  , delUniqMap
  , delListUniqMap
  , unionUniqMap
  , unionUniqMapWith
  , differenceUniqMap
    -- ** Element-wise operations
    -- *** Mapping
  , mapUniqMap
  , mapMaybeUniqMap
    -- ** Working with predicates
    -- *** Filtering
  , filterUniqMap
    -- *** Searching
  , elemUniqMap
  , notElemUniqMap
  , elemUniqMapDirectly
    -- ** Folding
  , foldrWithUnique
  , foldlWithUnique'
    -- ** Conversions
    -- *** Lists
  , eltsUniqMap
  , keysUniqMap
  , listToUniqMap
  , toListUniqMap
    -- *** UniqSet
  , uniqMapToUniqSet
    -- * UniqSet
  , UniqSet
    -- ** Accessors
    -- *** Indexing
  , lookupUniqSet
    -- ** Construction
  , emptyUniqSet
  , unitUniqSet
    -- ** Modifications
  , extendUniqSet
  , unionUniqSet
  , delUniqSetDirectly
    -- ** Working with predicates
    -- *** Searching
  , elemUniqSet
  , notElemUniqSet
  , elemUniqSetDirectly
    -- *** Misc
  , subsetUniqSet
    -- ** Conversions
    -- *** Lists
  , mkUniqSet
  , eltsUniqSet
  )
where

import           Control.DeepSeq (NFData)
import           Data.Binary (Binary)
import           Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.List   as List
import           Data.Text.Prettyprint.Doc
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif
import           GHC.Stack

import           Clash.Pretty

type Unique = Int

class Uniquable a where
  getUnique :: a -> Unique
  setUnique :: a -> Unique -> a

instance Uniquable Int where
  getUnique :: Int -> Int
getUnique Int
i = Int
i
  setUnique :: Int -> Int -> Int
setUnique Int
_i0 Int
i1 = Int
i1

-- | Map indexed by a 'Uniquable' key
newtype UniqMap a = UniqMap (IntMap a)
  deriving (a -> UniqMap b -> UniqMap a
(a -> b) -> UniqMap a -> UniqMap b
(forall a b. (a -> b) -> UniqMap a -> UniqMap b)
-> (forall a b. a -> UniqMap b -> UniqMap a) -> Functor UniqMap
forall a b. a -> UniqMap b -> UniqMap a
forall a b. (a -> b) -> UniqMap a -> UniqMap b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UniqMap b -> UniqMap a
$c<$ :: forall a b. a -> UniqMap b -> UniqMap a
fmap :: (a -> b) -> UniqMap a -> UniqMap b
$cfmap :: forall a b. (a -> b) -> UniqMap a -> UniqMap b
Functor, a -> UniqMap a -> Bool
UniqMap m -> m
UniqMap a -> [a]
UniqMap a -> Bool
UniqMap a -> Int
UniqMap a -> a
UniqMap a -> a
UniqMap a -> a
UniqMap a -> a
(a -> m) -> UniqMap a -> m
(a -> m) -> UniqMap a -> m
(a -> b -> b) -> b -> UniqMap a -> b
(a -> b -> b) -> b -> UniqMap a -> b
(b -> a -> b) -> b -> UniqMap a -> b
(b -> a -> b) -> b -> UniqMap a -> b
(a -> a -> a) -> UniqMap a -> a
(a -> a -> a) -> UniqMap a -> a
(forall m. Monoid m => UniqMap m -> m)
-> (forall m a. Monoid m => (a -> m) -> UniqMap a -> m)
-> (forall m a. Monoid m => (a -> m) -> UniqMap a -> m)
-> (forall a b. (a -> b -> b) -> b -> UniqMap a -> b)
-> (forall a b. (a -> b -> b) -> b -> UniqMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> UniqMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> UniqMap a -> b)
-> (forall a. (a -> a -> a) -> UniqMap a -> a)
-> (forall a. (a -> a -> a) -> UniqMap a -> a)
-> (forall a. UniqMap a -> [a])
-> (forall a. UniqMap a -> Bool)
-> (forall a. UniqMap a -> Int)
-> (forall a. Eq a => a -> UniqMap a -> Bool)
-> (forall a. Ord a => UniqMap a -> a)
-> (forall a. Ord a => UniqMap a -> a)
-> (forall a. Num a => UniqMap a -> a)
-> (forall a. Num a => UniqMap a -> a)
-> Foldable UniqMap
forall a. Eq a => a -> UniqMap a -> Bool
forall a. Num a => UniqMap a -> a
forall a. Ord a => UniqMap a -> a
forall m. Monoid m => UniqMap m -> m
forall a. UniqMap a -> Bool
forall a. UniqMap a -> Int
forall a. UniqMap a -> [a]
forall a. (a -> a -> a) -> UniqMap a -> a
forall m a. Monoid m => (a -> m) -> UniqMap a -> m
forall b a. (b -> a -> b) -> b -> UniqMap a -> b
forall a b. (a -> b -> b) -> b -> UniqMap a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: UniqMap a -> a
$cproduct :: forall a. Num a => UniqMap a -> a
sum :: UniqMap a -> a
$csum :: forall a. Num a => UniqMap a -> a
minimum :: UniqMap a -> a
$cminimum :: forall a. Ord a => UniqMap a -> a
maximum :: UniqMap a -> a
$cmaximum :: forall a. Ord a => UniqMap a -> a
elem :: a -> UniqMap a -> Bool
$celem :: forall a. Eq a => a -> UniqMap a -> Bool
length :: UniqMap a -> Int
$clength :: forall a. UniqMap a -> Int
null :: UniqMap a -> Bool
$cnull :: forall a. UniqMap a -> Bool
toList :: UniqMap a -> [a]
$ctoList :: forall a. UniqMap a -> [a]
foldl1 :: (a -> a -> a) -> UniqMap a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UniqMap a -> a
foldr1 :: (a -> a -> a) -> UniqMap a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> UniqMap a -> a
foldl' :: (b -> a -> b) -> b -> UniqMap a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UniqMap a -> b
foldl :: (b -> a -> b) -> b -> UniqMap a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UniqMap a -> b
foldr' :: (a -> b -> b) -> b -> UniqMap a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UniqMap a -> b
foldr :: (a -> b -> b) -> b -> UniqMap a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> UniqMap a -> b
foldMap' :: (a -> m) -> UniqMap a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UniqMap a -> m
foldMap :: (a -> m) -> UniqMap a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UniqMap a -> m
fold :: UniqMap m -> m
$cfold :: forall m. Monoid m => UniqMap m -> m
Foldable, Functor UniqMap
Foldable UniqMap
Functor UniqMap
-> Foldable UniqMap
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> UniqMap a -> f (UniqMap b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    UniqMap (f a) -> f (UniqMap a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> UniqMap a -> m (UniqMap b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    UniqMap (m a) -> m (UniqMap a))
-> Traversable UniqMap
(a -> f b) -> UniqMap a -> f (UniqMap b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
UniqMap (m a) -> m (UniqMap a)
forall (f :: Type -> Type) a.
Applicative f =>
UniqMap (f a) -> f (UniqMap a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> UniqMap a -> m (UniqMap b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> UniqMap a -> f (UniqMap b)
sequence :: UniqMap (m a) -> m (UniqMap a)
$csequence :: forall (m :: Type -> Type) a.
Monad m =>
UniqMap (m a) -> m (UniqMap a)
mapM :: (a -> m b) -> UniqMap a -> m (UniqMap b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> UniqMap a -> m (UniqMap b)
sequenceA :: UniqMap (f a) -> f (UniqMap a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
UniqMap (f a) -> f (UniqMap a)
traverse :: (a -> f b) -> UniqMap a -> f (UniqMap b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> UniqMap a -> f (UniqMap b)
$cp2Traversable :: Foldable UniqMap
$cp1Traversable :: Functor UniqMap
Traversable, b -> UniqMap a -> UniqMap a
NonEmpty (UniqMap a) -> UniqMap a
UniqMap a -> UniqMap a -> UniqMap a
(UniqMap a -> UniqMap a -> UniqMap a)
-> (NonEmpty (UniqMap a) -> UniqMap a)
-> (forall b. Integral b => b -> UniqMap a -> UniqMap a)
-> Semigroup (UniqMap a)
forall b. Integral b => b -> UniqMap a -> UniqMap a
forall a. NonEmpty (UniqMap a) -> UniqMap a
forall a. UniqMap a -> UniqMap a -> UniqMap a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> UniqMap a -> UniqMap a
stimes :: b -> UniqMap a -> UniqMap a
$cstimes :: forall a b. Integral b => b -> UniqMap a -> UniqMap a
sconcat :: NonEmpty (UniqMap a) -> UniqMap a
$csconcat :: forall a. NonEmpty (UniqMap a) -> UniqMap a
<> :: UniqMap a -> UniqMap a -> UniqMap a
$c<> :: forall a. UniqMap a -> UniqMap a -> UniqMap a
Semigroup, Semigroup (UniqMap a)
UniqMap a
Semigroup (UniqMap a)
-> UniqMap a
-> (UniqMap a -> UniqMap a -> UniqMap a)
-> ([UniqMap a] -> UniqMap a)
-> Monoid (UniqMap a)
[UniqMap a] -> UniqMap a
UniqMap a -> UniqMap a -> UniqMap a
forall a. Semigroup (UniqMap a)
forall a. UniqMap a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [UniqMap a] -> UniqMap a
forall a. UniqMap a -> UniqMap a -> UniqMap a
mconcat :: [UniqMap a] -> UniqMap a
$cmconcat :: forall a. [UniqMap a] -> UniqMap a
mappend :: UniqMap a -> UniqMap a -> UniqMap a
$cmappend :: forall a. UniqMap a -> UniqMap a -> UniqMap a
mempty :: UniqMap a
$cmempty :: forall a. UniqMap a
$cp1Monoid :: forall a. Semigroup (UniqMap a)
Monoid, UniqMap a -> ()
(UniqMap a -> ()) -> NFData (UniqMap a)
forall a. NFData a => UniqMap a -> ()
forall a. (a -> ()) -> NFData a
rnf :: UniqMap a -> ()
$crnf :: forall a. NFData a => UniqMap a -> ()
NFData, Get (UniqMap a)
[UniqMap a] -> Put
UniqMap a -> Put
(UniqMap a -> Put)
-> Get (UniqMap a) -> ([UniqMap a] -> Put) -> Binary (UniqMap a)
forall a. Binary a => Get (UniqMap a)
forall a. Binary a => [UniqMap a] -> Put
forall a. Binary a => UniqMap a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [UniqMap a] -> Put
$cputList :: forall a. Binary a => [UniqMap a] -> Put
get :: Get (UniqMap a)
$cget :: forall a. Binary a => Get (UniqMap a)
put :: UniqMap a -> Put
$cput :: forall a. Binary a => UniqMap a -> Put
Binary)

instance ClashPretty a => ClashPretty (UniqMap a) where
  clashPretty :: UniqMap a -> Doc ()
clashPretty (UniqMap IntMap a
env) =
    Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
brackets (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ Doc () -> [Doc ()] -> [Doc ()]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ()
forall ann. Doc ann
comma ([Doc ()] -> [Doc ()]) -> [Doc ()] -> [Doc ()]
forall a b. (a -> b) -> a -> b
$
      [ Int -> Doc ()
forall a. Pretty a => a -> Doc ()
fromPretty Int
uq Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
":->" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ()
forall a. ClashPretty a => a -> Doc ()
clashPretty a
elt
      | (Int
uq,a
elt) <- IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap a
env
      ]

instance ClashPretty a => Show (UniqMap a) where
  show :: UniqMap a -> String
show = Doc () -> String
forall ann. Doc ann -> String
showDoc (Doc () -> String) -> (UniqMap a -> Doc ()) -> UniqMap a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap a -> Doc ()
forall a. ClashPretty a => a -> Doc ()
clashPretty

-- | The empty map
emptyUniqMap
  :: UniqMap a
emptyUniqMap :: UniqMap a
emptyUniqMap = IntMap a -> UniqMap a
forall a. IntMap a -> UniqMap a
UniqMap IntMap a
forall a. IntMap a
IntMap.empty

-- | Map with a single key-value pair
unitUniqMap
  :: Uniquable a
  => a
  -> b
  -> UniqMap b
unitUniqMap :: a -> b -> UniqMap b
unitUniqMap a
k b
v = IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap (Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
IntMap.singleton (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) b
v)

-- | Check whether the map is empty
nullUniqMap
  :: UniqMap a
  -> Bool
nullUniqMap :: UniqMap a -> Bool
nullUniqMap (UniqMap IntMap a
m) = IntMap a -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap a
m

-- | Extend the map with a new key-value pair. If the key already exists in the
-- associated value will be overwritten
extendUniqMap
  :: Uniquable a
  => a
  -> b
  -> UniqMap b
  -> UniqMap b
extendUniqMap :: a -> b -> UniqMap b -> UniqMap b
extendUniqMap a
k b
x (UniqMap IntMap b
m) = IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap (Int -> b -> IntMap b -> IntMap b
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) b
x IntMap b
m)

-- | Extend the map with a new key-value pair. If the key already exists in the
-- associated value will be combined with the new value using the function
-- provided
extendUniqMapWith
  :: Uniquable a
  => a
  -> b
  -> (b -> b -> b)
  -> UniqMap b
  -> UniqMap b
extendUniqMapWith :: a -> b -> (b -> b -> b) -> UniqMap b -> UniqMap b
extendUniqMapWith a
k b
x b -> b -> b
f (UniqMap IntMap b
m) =
  IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((b -> b -> b) -> Int -> b -> IntMap b -> IntMap b
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith b -> b -> b
f (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) b
x IntMap b
m)

-- | Extend the map with a list of key-value pairs. Positions with existing
-- keys will be overwritten with the new values
extendListUniqMap
  :: Uniquable a
  => UniqMap b
  -> [(a, b)]
  -> UniqMap b
extendListUniqMap :: UniqMap b -> [(a, b)] -> UniqMap b
extendListUniqMap (UniqMap IntMap b
env) [(a, b)]
xs =
  IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((IntMap b -> (a, b) -> IntMap b)
-> IntMap b -> [(a, b)] -> IntMap b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\IntMap b
m (a
k, b
v) -> Int -> b -> IntMap b -> IntMap b
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) b
v IntMap b
m) IntMap b
env [(a, b)]
xs)

-- | Look up a value in the map
lookupUniqMap
  :: Uniquable a
  => a
  -> UniqMap b
  -> Maybe b
lookupUniqMap :: a -> UniqMap b -> Maybe b
lookupUniqMap a
k (UniqMap IntMap b
m) = Int -> IntMap b -> Maybe b
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) IntMap b
m

-- | Like 'lookupUniqMap'', but errors out when the key is not present
lookupUniqMap'
  :: (HasCallStack, Uniquable a)
  => UniqMap b
  -> a
  -> b
lookupUniqMap' :: UniqMap b -> a -> b
lookupUniqMap' (UniqMap IntMap b
m) a
k =
  b -> Int -> IntMap b -> b
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault b
forall a. a
d Int
k' IntMap b
m
 where
  k' :: Int
k' = a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k
  d :: a
d  = String -> a
forall a. HasCallStack => String -> a
error (String
"lookupUniqMap': key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not an element of the map")

-- | Check whether a key is in the map
elemUniqMap
  :: Uniquable a
  => a
  -> UniqMap b
  -> Bool
elemUniqMap :: a -> UniqMap b -> Bool
elemUniqMap a
k = Int -> UniqMap b -> Bool
forall b. Int -> UniqMap b -> Bool
elemUniqMapDirectly (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k)

-- | Check whether an element exists in the uniqmap based on a given `Unique`
elemUniqMapDirectly
  :: Unique
  -> UniqMap b
  -> Bool
elemUniqMapDirectly :: Int -> UniqMap b -> Bool
elemUniqMapDirectly Int
k (UniqMap IntMap b
m) = Int
k Int -> IntMap b -> Bool
forall a. Int -> IntMap a -> Bool
`IntMap.member` IntMap b
m
{-# INLINE elemUniqMapDirectly #-}

-- | Check whether a key is not in the map
notElemUniqMap
  :: Uniquable a
  => a
  -> UniqMap b
  -> Bool
notElemUniqMap :: a -> UniqMap b -> Bool
notElemUniqMap a
k (UniqMap IntMap b
m) = Int -> IntMap b -> Bool
forall a. Int -> IntMap a -> Bool
IntMap.notMember (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) IntMap b
m

-- | Derive a map where all the elements adhere to the predicate
filterUniqMap
  :: (b -> Bool)
  -> UniqMap b
  -> UniqMap b
filterUniqMap :: (b -> Bool) -> UniqMap b -> UniqMap b
filterUniqMap b -> Bool
f (UniqMap IntMap b
m) = IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((b -> Bool) -> IntMap b -> IntMap b
forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter b -> Bool
f IntMap b
m)

-- | Remove a key-value pair from the map
delUniqMap
  :: Uniquable a
  => UniqMap b
  -> a
  -> UniqMap b
delUniqMap :: UniqMap b -> a -> UniqMap b
delUniqMap (UniqMap IntMap b
env) a
v = IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap (Int -> IntMap b -> IntMap b
forall a. Int -> IntMap a -> IntMap a
IntMap.delete (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
v) IntMap b
env)

-- | Remove a list of key-value pairs from the map
delListUniqMap
  :: Uniquable a
  => UniqMap b
  -> [a]
  -> UniqMap b
delListUniqMap :: UniqMap b -> [a] -> UniqMap b
delListUniqMap (UniqMap IntMap b
env) [a]
vs =
  IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((IntMap b -> a -> IntMap b) -> IntMap b -> [a] -> IntMap b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\IntMap b
m a
v -> Int -> IntMap b -> IntMap b
forall a. Int -> IntMap a -> IntMap a
IntMap.delete (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
v) IntMap b
m) IntMap b
env [a]
vs)

-- | A (left-biased) union of two maps
unionUniqMap
  :: UniqMap a
  -> UniqMap a
  -> UniqMap a
unionUniqMap :: UniqMap a -> UniqMap a -> UniqMap a
unionUniqMap (UniqMap IntMap a
m1) (UniqMap IntMap a
m2) = IntMap a -> UniqMap a
forall a. IntMap a -> UniqMap a
UniqMap (IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union IntMap a
m1 IntMap a
m2)

-- | A union of two maps, key-value pairs with the same key will be merged using
-- the given function
unionUniqMapWith
  :: (a -> a -> a)
  -> UniqMap a
  -> UniqMap a
  -> UniqMap a
unionUniqMapWith :: (a -> a -> a) -> UniqMap a -> UniqMap a -> UniqMap a
unionUniqMapWith a -> a -> a
f (UniqMap IntMap a
m1) (UniqMap IntMap a
m2) = IntMap a -> UniqMap a
forall a. IntMap a -> UniqMap a
UniqMap ((a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith a -> a -> a
f IntMap a
m1 IntMap a
m2)

-- | Get the difference between two maps
differenceUniqMap
  :: UniqMap a
  -> UniqMap a
  -> UniqMap a
differenceUniqMap :: UniqMap a -> UniqMap a -> UniqMap a
differenceUniqMap (UniqMap IntMap a
m1) (UniqMap IntMap a
m2) = IntMap a -> UniqMap a
forall a. IntMap a -> UniqMap a
UniqMap (IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference IntMap a
m1 IntMap a
m2)

-- | Convert a list of key-value pairs to a map
listToUniqMap
  :: Uniquable a
  => [(a,b)]
  -> UniqMap b
listToUniqMap :: [(a, b)] -> UniqMap b
listToUniqMap [(a, b)]
xs =
  IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((IntMap b -> (a, b) -> IntMap b)
-> IntMap b -> [(a, b)] -> IntMap b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\IntMap b
m (a
k, b
v) -> Int -> b -> IntMap b -> IntMap b
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
k) b
v IntMap b
m) IntMap b
forall a. IntMap a
IntMap.empty [(a, b)]
xs)

-- | Convert a map to a list of key-value pairs
toListUniqMap
  :: UniqMap a
  -> [(Unique,a)]
toListUniqMap :: UniqMap a -> [(Int, a)]
toListUniqMap (UniqMap IntMap a
m) = IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap a
m

-- | Extract the elements of a map into a list
eltsUniqMap
  :: UniqMap a
  -> [a]
eltsUniqMap :: UniqMap a -> [a]
eltsUniqMap (UniqMap IntMap a
m) = IntMap a -> [a]
forall a. IntMap a -> [a]
IntMap.elems IntMap a
m

-- | Apply a function to every element in the map
mapUniqMap
  :: (a -> b)
  -> UniqMap a
  -> UniqMap b
mapUniqMap :: (a -> b) -> UniqMap a -> UniqMap b
mapUniqMap a -> b
f (UniqMap IntMap a
m) = IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((a -> b) -> IntMap a -> IntMap b
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map a -> b
f IntMap a
m)

-- | Extract the keys of a map into a list
keysUniqMap
  :: UniqMap a
  -> [Unique]
keysUniqMap :: UniqMap a -> [Int]
keysUniqMap (UniqMap IntMap a
m) = IntMap a -> [Int]
forall a. IntMap a -> [Int]
IntMap.keys IntMap a
m

-- | Apply a function to every element in the map. When the function returns
-- 'Nothing', the key-value pair will be removed
mapMaybeUniqMap
  :: (a -> Maybe b)
  -> UniqMap a
  -> UniqMap b
mapMaybeUniqMap :: (a -> Maybe b) -> UniqMap a -> UniqMap b
mapMaybeUniqMap a -> Maybe b
f (UniqMap IntMap a
m) = IntMap b -> UniqMap b
forall a. IntMap a -> UniqMap a
UniqMap ((a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe a -> Maybe b
f IntMap a
m)

-- | Right-fold over a map using both the key and value
foldrWithUnique
  :: (Unique -> a -> b -> b)
  -> b
  -> UniqMap a
  -> b
foldrWithUnique :: (Int -> a -> b -> b) -> b -> UniqMap a -> b
foldrWithUnique Int -> a -> b -> b
f b
s (UniqMap IntMap a
m) = (Int -> a -> b -> b) -> b -> IntMap a -> b
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey Int -> a -> b -> b
f b
s IntMap a
m

-- | Strict left-fold over a map using both the key and the value
foldlWithUnique'
  :: (a -> Unique -> b -> a)
  -> a
  -> UniqMap b
  -> a
foldlWithUnique' :: (a -> Int -> b -> a) -> a -> UniqMap b -> a
foldlWithUnique' a -> Int -> b -> a
f a
s (UniqMap IntMap b
m) = (a -> Int -> b -> a) -> a -> IntMap b -> a
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IntMap.foldlWithKey' a -> Int -> b -> a
f a
s IntMap b
m

-- | Set of things that have a 'Unique'
--
-- Invariant: they keys in the map are the uniques of the values
newtype UniqSet a = UniqSet (IntMap a)
  deriving (a -> UniqSet a -> Bool
UniqSet m -> m
UniqSet a -> [a]
UniqSet a -> Bool
UniqSet a -> Int
UniqSet a -> a
UniqSet a -> a
UniqSet a -> a
UniqSet a -> a
(a -> m) -> UniqSet a -> m
(a -> m) -> UniqSet a -> m
(a -> b -> b) -> b -> UniqSet a -> b
(a -> b -> b) -> b -> UniqSet a -> b
(b -> a -> b) -> b -> UniqSet a -> b
(b -> a -> b) -> b -> UniqSet a -> b
(a -> a -> a) -> UniqSet a -> a
(a -> a -> a) -> UniqSet a -> a
(forall m. Monoid m => UniqSet m -> m)
-> (forall m a. Monoid m => (a -> m) -> UniqSet a -> m)
-> (forall m a. Monoid m => (a -> m) -> UniqSet a -> m)
-> (forall a b. (a -> b -> b) -> b -> UniqSet a -> b)
-> (forall a b. (a -> b -> b) -> b -> UniqSet a -> b)
-> (forall b a. (b -> a -> b) -> b -> UniqSet a -> b)
-> (forall b a. (b -> a -> b) -> b -> UniqSet a -> b)
-> (forall a. (a -> a -> a) -> UniqSet a -> a)
-> (forall a. (a -> a -> a) -> UniqSet a -> a)
-> (forall a. UniqSet a -> [a])
-> (forall a. UniqSet a -> Bool)
-> (forall a. UniqSet a -> Int)
-> (forall a. Eq a => a -> UniqSet a -> Bool)
-> (forall a. Ord a => UniqSet a -> a)
-> (forall a. Ord a => UniqSet a -> a)
-> (forall a. Num a => UniqSet a -> a)
-> (forall a. Num a => UniqSet a -> a)
-> Foldable UniqSet
forall a. Eq a => a -> UniqSet a -> Bool
forall a. Num a => UniqSet a -> a
forall a. Ord a => UniqSet a -> a
forall m. Monoid m => UniqSet m -> m
forall a. UniqSet a -> Bool
forall a. UniqSet a -> Int
forall a. UniqSet a -> [a]
forall a. (a -> a -> a) -> UniqSet a -> a
forall m a. Monoid m => (a -> m) -> UniqSet a -> m
forall b a. (b -> a -> b) -> b -> UniqSet a -> b
forall a b. (a -> b -> b) -> b -> UniqSet a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: UniqSet a -> a
$cproduct :: forall a. Num a => UniqSet a -> a
sum :: UniqSet a -> a
$csum :: forall a. Num a => UniqSet a -> a
minimum :: UniqSet a -> a
$cminimum :: forall a. Ord a => UniqSet a -> a
maximum :: UniqSet a -> a
$cmaximum :: forall a. Ord a => UniqSet a -> a
elem :: a -> UniqSet a -> Bool
$celem :: forall a. Eq a => a -> UniqSet a -> Bool
length :: UniqSet a -> Int
$clength :: forall a. UniqSet a -> Int
null :: UniqSet a -> Bool
$cnull :: forall a. UniqSet a -> Bool
toList :: UniqSet a -> [a]
$ctoList :: forall a. UniqSet a -> [a]
foldl1 :: (a -> a -> a) -> UniqSet a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UniqSet a -> a
foldr1 :: (a -> a -> a) -> UniqSet a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> UniqSet a -> a
foldl' :: (b -> a -> b) -> b -> UniqSet a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UniqSet a -> b
foldl :: (b -> a -> b) -> b -> UniqSet a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UniqSet a -> b
foldr' :: (a -> b -> b) -> b -> UniqSet a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UniqSet a -> b
foldr :: (a -> b -> b) -> b -> UniqSet a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> UniqSet a -> b
foldMap' :: (a -> m) -> UniqSet a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UniqSet a -> m
foldMap :: (a -> m) -> UniqSet a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UniqSet a -> m
fold :: UniqSet m -> m
$cfold :: forall m. Monoid m => UniqSet m -> m
Foldable, b -> UniqSet a -> UniqSet a
NonEmpty (UniqSet a) -> UniqSet a
UniqSet a -> UniqSet a -> UniqSet a
(UniqSet a -> UniqSet a -> UniqSet a)
-> (NonEmpty (UniqSet a) -> UniqSet a)
-> (forall b. Integral b => b -> UniqSet a -> UniqSet a)
-> Semigroup (UniqSet a)
forall b. Integral b => b -> UniqSet a -> UniqSet a
forall a. NonEmpty (UniqSet a) -> UniqSet a
forall a. UniqSet a -> UniqSet a -> UniqSet a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> UniqSet a -> UniqSet a
stimes :: b -> UniqSet a -> UniqSet a
$cstimes :: forall a b. Integral b => b -> UniqSet a -> UniqSet a
sconcat :: NonEmpty (UniqSet a) -> UniqSet a
$csconcat :: forall a. NonEmpty (UniqSet a) -> UniqSet a
<> :: UniqSet a -> UniqSet a -> UniqSet a
$c<> :: forall a. UniqSet a -> UniqSet a -> UniqSet a
Semigroup, Semigroup (UniqSet a)
UniqSet a
Semigroup (UniqSet a)
-> UniqSet a
-> (UniqSet a -> UniqSet a -> UniqSet a)
-> ([UniqSet a] -> UniqSet a)
-> Monoid (UniqSet a)
[UniqSet a] -> UniqSet a
UniqSet a -> UniqSet a -> UniqSet a
forall a. Semigroup (UniqSet a)
forall a. UniqSet a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [UniqSet a] -> UniqSet a
forall a. UniqSet a -> UniqSet a -> UniqSet a
mconcat :: [UniqSet a] -> UniqSet a
$cmconcat :: forall a. [UniqSet a] -> UniqSet a
mappend :: UniqSet a -> UniqSet a -> UniqSet a
$cmappend :: forall a. UniqSet a -> UniqSet a -> UniqSet a
mempty :: UniqSet a
$cmempty :: forall a. UniqSet a
$cp1Monoid :: forall a. Semigroup (UniqSet a)
Monoid, Get (UniqSet a)
[UniqSet a] -> Put
UniqSet a -> Put
(UniqSet a -> Put)
-> Get (UniqSet a) -> ([UniqSet a] -> Put) -> Binary (UniqSet a)
forall a. Binary a => Get (UniqSet a)
forall a. Binary a => [UniqSet a] -> Put
forall a. Binary a => UniqSet a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [UniqSet a] -> Put
$cputList :: forall a. Binary a => [UniqSet a] -> Put
get :: Get (UniqSet a)
$cget :: forall a. Binary a => Get (UniqSet a)
put :: UniqSet a -> Put
$cput :: forall a. Binary a => UniqSet a -> Put
Binary)

instance ClashPretty a => ClashPretty (UniqSet a) where
  clashPretty :: UniqSet a -> Doc ()
clashPretty (UniqSet IntMap a
env) =
    Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
braces ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
fillSep ((a -> Doc ()) -> [a] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ()
forall a. ClashPretty a => a -> Doc ()
clashPretty (IntMap a -> [a]
forall a. IntMap a -> [a]
IntMap.elems IntMap a
env)))

-- | The empty set
emptyUniqSet
  :: UniqSet a
emptyUniqSet :: UniqSet a
emptyUniqSet = IntMap a -> UniqSet a
forall a. IntMap a -> UniqSet a
UniqSet IntMap a
forall a. IntMap a
IntMap.empty

-- | Set with a single element
unitUniqSet
  :: Uniquable a
  => a
  -> UniqSet a
unitUniqSet :: a -> UniqSet a
unitUniqSet a
a = IntMap a -> UniqSet a
forall a. IntMap a -> UniqSet a
UniqSet (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
IntMap.singleton (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
a) a
a)

-- | Add an element to the set
extendUniqSet
  :: Uniquable a
  => UniqSet a
  -> a
  -> UniqSet a
extendUniqSet :: UniqSet a -> a -> UniqSet a
extendUniqSet (UniqSet IntMap a
env) a
a = IntMap a -> UniqSet a
forall a. IntMap a -> UniqSet a
UniqSet (Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
a) a
a IntMap a
env)

-- | Union two sets
unionUniqSet
  :: UniqSet a
  -> UniqSet a
  -> UniqSet a
unionUniqSet :: UniqSet a -> UniqSet a -> UniqSet a
unionUniqSet (UniqSet IntMap a
env1) (UniqSet IntMap a
env2) = IntMap a -> UniqSet a
forall a. IntMap a -> UniqSet a
UniqSet (IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union IntMap a
env1 IntMap a
env2)

-- | Check whether an element exists in the set
elemUniqSet
  :: Uniquable a
  => a
  -> UniqSet a
  -> Bool
elemUniqSet :: a -> UniqSet a -> Bool
elemUniqSet a
a (UniqSet IntMap a
env) = Int -> IntMap a -> Bool
forall a. Int -> IntMap a -> Bool
IntMap.member (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
a) IntMap a
env

-- | Check whether an element does not exist in the set
notElemUniqSet
  :: Uniquable a
  => a
  -> UniqSet a
  -> Bool
notElemUniqSet :: a -> UniqSet a -> Bool
notElemUniqSet a
a (UniqSet IntMap a
env) = Int -> IntMap a -> Bool
forall a. Int -> IntMap a -> Bool
IntMap.notMember (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
a) IntMap a
env

-- | Check whether an element exists in the set based on the `Unique` contained
-- in that element
elemUniqSetDirectly
  :: Unique
  -> UniqSet a
  -> Bool
elemUniqSetDirectly :: Int -> UniqSet a -> Bool
elemUniqSetDirectly Int
k (UniqSet IntMap a
m) = Int
k Int -> IntMap a -> Bool
forall a. Int -> IntMap a -> Bool
`IntMap.member` IntMap a
m

-- | Look up an element in the set, returns it if it exists
lookupUniqSet
  :: Uniquable a
  => a
  -> UniqSet b
  -> Maybe b
lookupUniqSet :: a -> UniqSet b -> Maybe b
lookupUniqSet a
a (UniqSet IntMap b
env) = Int -> IntMap b -> Maybe b
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
a) IntMap b
env

-- | Remove an element based on the `Unique` it contains
delUniqSetDirectly
  :: Unique
  -> UniqSet b
  -> UniqSet b
delUniqSetDirectly :: Int -> UniqSet b -> UniqSet b
delUniqSetDirectly Int
k (UniqSet IntMap b
env) = IntMap b -> UniqSet b
forall a. IntMap a -> UniqSet a
UniqSet (Int -> IntMap b -> IntMap b
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
k IntMap b
env)

-- | Get the elements of the set as a list
eltsUniqSet
  :: UniqSet a
  -> [a]
eltsUniqSet :: UniqSet a -> [a]
eltsUniqSet (UniqSet IntMap a
env) = IntMap a -> [a]
forall a. IntMap a -> [a]
IntMap.elems IntMap a
env

-- | Create a set out of a list of elements that contain a 'Unique'
mkUniqSet
  :: Uniquable a
  => [a]
  -> UniqSet a
mkUniqSet :: [a] -> UniqSet a
mkUniqSet [a]
m = IntMap a -> UniqSet a
forall a. IntMap a -> UniqSet a
UniqSet ([(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ((a -> (Int, a)) -> [a] -> [(Int, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a -> Int
forall a. Uniquable a => a -> Int
getUnique a
x,a
x)) [a]
m))

-- | Convert a 'UniqMap' to a 'UniqSet'
uniqMapToUniqSet
  :: UniqMap a
  -> UniqSet a
uniqMapToUniqSet :: UniqMap a -> UniqSet a
uniqMapToUniqSet (UniqMap IntMap a
m) = IntMap a -> UniqSet a
forall a. IntMap a -> UniqSet a
UniqSet IntMap a
m

-- | Check whether a A is a subset of B
subsetUniqSet
  :: UniqSet a
  -- ^ Set A
  -> UniqSet a
  -- ^ Set B
  -> Bool
subsetUniqSet :: UniqSet a -> UniqSet a -> Bool
subsetUniqSet (UniqSet IntMap a
e1) (UniqSet IntMap a
e2) = IntMap a -> Bool
forall a. IntMap a -> Bool
IntMap.null (IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference IntMap a
e1 IntMap a
e2)