{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ApplicativeDo #-}
{-# OPTIONS_GHC -Wall #-}

-- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the
-- same entry. See 'UniqSDFM'.
module GHC.Types.Unique.SDFM (
        -- * Unique-keyed, /shared/, deterministic mappings
        UniqSDFM,

        emptyUSDFM,
        lookupUSDFM,
        equateUSDFM, addToUSDFM,
        traverseUSDFM
    ) where

import GHC.Prelude

import GHC.Types.Unique
import GHC.Types.Unique.DFM
import GHC.Utils.Outputable

-- | Either @Indirect x@, meaning the value is represented by that of @x@, or
-- an @Entry@ containing containing the actual value it represents.
data Shared key ele
  = Indirect !key
  | Entry !ele

-- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a
-- common value of type @ele@.
-- Every such set (\"equivalence class\") has a distinct representative
-- 'Unique'. Supports merging the entries of multiple such sets in a union-find
-- like fashion.
--
-- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from
-- sets of @key@s to possibly absent entries @ele@, where the sets don't overlap.
-- Example:
-- @
--   m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)]
-- @
-- On this model we support the following main operations:
--
--   * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@,
--     @'lookupUSDFM' m u5 == Nothing@.
--   * @'equateUSDFM' m u1 u3@ is a no-op, but
--     @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to
--     @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1@.
--   * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4@.
--
-- As well as a few means for traversal/conversion to list.
newtype UniqSDFM key ele
  = USDFM { forall key ele. UniqSDFM key ele -> UniqDFM key (Shared key ele)
unUSDFM :: UniqDFM key (Shared key ele) }

emptyUSDFM :: UniqSDFM key ele
emptyUSDFM :: forall key ele. UniqSDFM key ele
emptyUSDFM = forall key ele. UniqDFM key (Shared key ele) -> UniqSDFM key ele
USDFM forall key elt. UniqDFM key elt
emptyUDFM

lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele)
lookupReprAndEntryUSDFM :: forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> (key, Maybe ele)
lookupReprAndEntryUSDFM (USDFM UniqDFM key (Shared key ele)
env) = key -> (key, Maybe ele)
go
  where
    go :: key -> (key, Maybe ele)
go key
x = case forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> Maybe elt
lookupUDFM UniqDFM key (Shared key ele)
env key
x of
      Maybe (Shared key ele)
Nothing           -> (key
x, forall a. Maybe a
Nothing)
      Just (Indirect key
y) -> key -> (key, Maybe ele)
go key
y
      Just (Entry ele
ele)  -> (key
x, forall a. a -> Maybe a
Just ele
ele)

-- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all
-- 'Indirect's until it finds a shared 'Entry'.
--
-- Examples in terms of the model (see 'UniqSDFM'):
-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1
-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing
-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing
lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele
lookupUSDFM :: forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> Maybe ele
lookupUSDFM UniqSDFM key ele
usdfm key
x = forall a b. (a, b) -> b
snd (forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> (key, Maybe ele)
lookupReprAndEntryUSDFM UniqSDFM key ele
usdfm key
x)

-- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry,
-- thereby merging @x@'s class with @y@'s.
-- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be
-- chosen as the new entry and @x@'s old entry will be returned.
--
-- Examples in terms of the model (see 'UniqSDFM'):
-- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)])
-- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)])
-- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)])
-- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)])
equateUSDFM
  :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele)
equateUSDFM :: forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele)
equateUSDFM usdfm :: UniqSDFM key ele
usdfm@(USDFM UniqDFM key (Shared key ele)
env) key
x key
y =
  case (key -> (key, Maybe ele)
lu key
x, key -> (key, Maybe ele)
lu key
y) of
    ((key
x', Maybe ele
_)    , (key
y', Maybe ele
_))
      | forall a. Uniquable a => a -> Unique
getUnique key
x' forall a. Eq a => a -> a -> Bool
== forall a. Uniquable a => a -> Unique
getUnique key
y' -> (forall a. Maybe a
Nothing, UniqSDFM key ele
usdfm) -- nothing to do
    ((key
x', Maybe ele
_)    , (key
y', Maybe ele
Nothing))     -> (forall a. Maybe a
Nothing, key -> key -> UniqSDFM key ele
set_indirect key
y' key
x')
    ((key
x', Maybe ele
mb_ex), (key
y', Maybe ele
_))           -> (Maybe ele
mb_ex,   key -> key -> UniqSDFM key ele
set_indirect key
x' key
y')
  where
    lu :: key -> (key, Maybe ele)
lu = forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> (key, Maybe ele)
lookupReprAndEntryUSDFM UniqSDFM key ele
usdfm
    set_indirect :: key -> key -> UniqSDFM key ele
set_indirect key
a key
b = forall key ele. UniqDFM key (Shared key ele) -> UniqSDFM key ele
USDFM forall a b. (a -> b) -> a -> b
$ forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM UniqDFM key (Shared key ele)
env key
a (forall key ele. key -> Shared key ele
Indirect key
b)

-- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@,
-- thereby modifying its whole equivalence class.
--
-- Examples in terms of the model (see 'UniqSDFM'):
-- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)]
-- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)]
addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele
addToUSDFM :: forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> ele -> UniqSDFM key ele
addToUSDFM usdfm :: UniqSDFM key ele
usdfm@(USDFM UniqDFM key (Shared key ele)
env) key
x ele
v =
  forall key ele. UniqDFM key (Shared key ele) -> UniqSDFM key ele
USDFM forall a b. (a -> b) -> a -> b
$ forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM UniqDFM key (Shared key ele)
env (forall a b. (a, b) -> a
fst (forall key ele.
Uniquable key =>
UniqSDFM key ele -> key -> (key, Maybe ele)
lookupReprAndEntryUSDFM UniqSDFM key ele
usdfm key
x)) (forall key ele. ele -> Shared key ele
Entry ele
v)

traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b)
traverseUSDFM :: forall key a b (f :: * -> *).
Applicative f =>
(a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b)
traverseUSDFM a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall key ele. UniqDFM key (Shared key ele) -> UniqSDFM key ele
USDFM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall elt key. [(Unique, elt)] -> UniqDFM key elt
listToUDFM_Directly) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Unique, Shared key a) -> f (Unique, Shared key b)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key elt. UniqDFM key elt -> [(Unique, elt)]
udfmToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key ele. UniqSDFM key ele -> UniqDFM key (Shared key ele)
unUSDFM
  where
    g :: (Unique, Shared key a) -> f (Unique, Shared key b)
    g :: (Unique, Shared key a) -> f (Unique, Shared key b)
g (Unique
u, Indirect key
y) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unique
u,forall key ele. key -> Shared key ele
Indirect key
y)
    g (Unique
u, Entry a
a)    = do
        b
a' <- a -> f b
f a
a
        pure (Unique
u,forall key ele. ele -> Shared key ele
Entry b
a')

instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where
  ppr :: Shared key ele -> SDoc
ppr (Indirect key
x) = forall a. Outputable a => a -> SDoc
ppr key
x
  ppr (Entry ele
a)    = forall a. Outputable a => a -> SDoc
ppr ele
a

instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where
  ppr :: UniqSDFM key ele -> SDoc
ppr (USDFM UniqDFM key (Shared key ele)
env) = forall a. Outputable a => a -> SDoc
ppr UniqDFM key (Shared key ele)
env