never executed always true always false
1 {-# LANGUAGE ScopedTypeVariables #-}
2 {-# LANGUAGE ApplicativeDo #-}
3 {-# OPTIONS_GHC -Wall #-}
4
5 -- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the
6 -- same entry. See 'UniqSDFM'.
7 module GHC.Types.Unique.SDFM (
8 -- * Unique-keyed, /shared/, deterministic mappings
9 UniqSDFM,
10
11 emptyUSDFM,
12 lookupUSDFM,
13 equateUSDFM, addToUSDFM,
14 traverseUSDFM
15 ) where
16
17 import GHC.Prelude
18
19 import GHC.Types.Unique
20 import GHC.Types.Unique.DFM
21 import GHC.Utils.Outputable
22
23 -- | Either @Indirect x@, meaning the value is represented by that of @x@, or
24 -- an @Entry@ containing containing the actual value it represents.
25 data Shared key ele
26 = Indirect !key
27 | Entry !ele
28
29 -- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a
30 -- common value of type @ele@.
31 -- Every such set (\"equivalence class\") has a distinct representative
32 -- 'Unique'. Supports merging the entries of multiple such sets in a union-find
33 -- like fashion.
34 --
35 -- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from
36 -- sets of @key@s to possibly absent entries @ele@, where the sets don't overlap.
37 -- Example:
38 -- @
39 -- m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)]
40 -- @
41 -- On this model we support the following main operations:
42 --
43 -- * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@,
44 -- @'lookupUSDFM' m u5 == Nothing@.
45 -- * @'equateUSDFM' m u1 u3@ is a no-op, but
46 -- @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to
47 -- @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1@.
48 -- * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4@.
49 --
50 -- As well as a few means for traversal/conversion to list.
51 newtype UniqSDFM key ele
52 = USDFM { unUSDFM :: UniqDFM key (Shared key ele) }
53
54 emptyUSDFM :: UniqSDFM key ele
55 emptyUSDFM = USDFM emptyUDFM
56
57 lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele)
58 lookupReprAndEntryUSDFM (USDFM env) = go
59 where
60 go x = case lookupUDFM env x of
61 Nothing -> (x, Nothing)
62 Just (Indirect y) -> go y
63 Just (Entry ele) -> (x, Just ele)
64
65 -- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all
66 -- 'Indirect's until it finds a shared 'Entry'.
67 --
68 -- Examples in terms of the model (see 'UniqSDFM'):
69 -- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1
70 -- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing
71 -- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing
72 lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele
73 lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x)
74
75 -- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry,
76 -- thereby merging @x@'s class with @y@'s.
77 -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be
78 -- chosen as the new entry and @x@'s old entry will be returned.
79 --
80 -- Examples in terms of the model (see 'UniqSDFM'):
81 -- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)])
82 -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)])
83 -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)])
84 -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)])
85 equateUSDFM
86 :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele)
87 equateUSDFM usdfm@(USDFM env) x y =
88 case (lu x, lu y) of
89 ((x', _) , (y', _))
90 | getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do
91 ((x', _) , (y', Nothing)) -> (Nothing, set_indirect y' x')
92 ((x', mb_ex), (y', _)) -> (mb_ex, set_indirect x' y')
93 where
94 lu = lookupReprAndEntryUSDFM usdfm
95 set_indirect a b = USDFM $ addToUDFM env a (Indirect b)
96
97 -- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@,
98 -- thereby modifying its whole equivalence class.
99 --
100 -- Examples in terms of the model (see 'UniqSDFM'):
101 -- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)]
102 -- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)]
103 addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele
104 addToUSDFM usdfm@(USDFM env) x v =
105 USDFM $ addToUDFM env (fst (lookupReprAndEntryUSDFM usdfm x)) (Entry v)
106
107 traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b)
108 traverseUSDFM f = fmap (USDFM . listToUDFM_Directly) . traverse g . udfmToList . unUSDFM
109 where
110 g :: (Unique, Shared key a) -> f (Unique, Shared key b)
111 g (u, Indirect y) = pure (u,Indirect y)
112 g (u, Entry a) = do
113 a' <- f a
114 pure (u,Entry a')
115
116 instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where
117 ppr (Indirect x) = ppr x
118 ppr (Entry a) = ppr a
119
120 instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where
121 ppr (USDFM env) = ppr env