@@ -12,33 +12,13 @@
1212
1313-- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-}
1414
15−-- | This module introduces the 'TypeRepMap' data structure and functions to work with it.
16−
17−module Data.TypeRep.Map
18− ( -- * Map type
19− TypeRepMap (..)
20−
21− -- * Construction
22− , empty
23− , one
24−
25− -- * Modification
26− , insert
27− , delete
28− , hoist
29− , unionWith
30− , union
31−
32− -- * Query
33− , lookup
34− , member
35− , size
36−
37− -- * Helpful testing functions
38− , TF (..)
39− , fromList
40− , toFingerprints
41− ) where
15+-- | Internal API for 'TypeRepMap' and operations on it. The functions here do
16+-- not have any stability guarantees and can change between minor versions.
17+--
18+-- If you need to use this module for purposes other than tests,
19+-- create an issue.
20+--
21+module Data.TypeRepMap.Internal where
4222
4323import Prelude hiding (lookup)
4424
@@ -64,12 +44,34 @@ import qualified Data.IntMap.Strict as IM
6444import qualified Data.Map.Strict as Map
6545import qualified GHC.Exts as GHC (fromList, toList)
6646
67−-- | Map-like data structure that keeps types as keys.
68−data TypeRepMap (f :: k -> Type) = TypeRepMap
69− { fingerprintAs :: {-# UNPACK #-} !(PrimArray Word64)
70− , fingerprintBs :: {-# UNPACK #-} !(PrimArray Word64)
71− , anys :: {-# UNPACK #-} !(Array Any)
47+{- |
48+
49+'TypeRepMap' is a heterogeneous data structure similar in its essence to
50+'Data.Map.Map' with types as keys, where each value has the type of its key. In
51+addition to that, each value is wrapped in an interpretation @f@.
52+
53+Here is an example of using 'Prelude.Maybe' as an interpretation, with a
54+comparison to 'Data.Map.Map':
55+
56+@
57+ 'Data.Map.Map' 'Prelude.String' ('Prelude.Maybe' 'Prelude.String') 'TypeRepMap' 'Prelude.Maybe'
58+--------------------------- ---------------------
59+ \"Int\" -> Just \"5\" 'Prelude.Int' -> Just 5
60+ \"Bool\" -> Just \"True\" 'Prelude.Bool' -> Just 'Prelude.True'
61+ \"Char\" -> Nothing 'Prelude.Char' -> Nothing
62+@
63+
64+The runtime representation of 'TypeRepMap' is an array, not a tree. This makes
65+'lookup' significantly more efficient.
66+
67+-}
68+data TypeRepMap (f :: k -> Type) =
69+ TypeRepMap
70+ { fingerprintAs :: {-# UNPACK #-} !(PrimArray Word64) -- ^ first components of key fingerprints
71+ , fingerprintBs :: {-# UNPACK #-} !(PrimArray Word64) -- ^ second components of key fingerprints
72+ , anys :: {-# UNPACK #-} !(Array Any) -- ^ values stored in the map
7273 }
74+ -- ^ an unsafe constructor for 'TypeRepMap'
7375
7476-- | Shows only 'Fingerprint's.
7577instance Show (TypeRepMap f) where
@@ -92,17 +94,38 @@ toFingerprints :: TypeRepMap f -> [Fingerprint]
9294toFingerprints TypeRepMap{..} =
9395 zipWith Fingerprint (GHC.toList fingerprintAs) (GHC.toList fingerprintBs)
9496
95−-- | Empty structure.
97+{- |
98+
99+A 'TypeRepMap' with no values stored in it.
100+
101+prop> size empty == 0
102+prop> member @a empty == False
103+
104+-}
96105empty :: TypeRepMap f
97106empty = mempty
98107{-# INLINE empty #-}
99108
100−-- | Construct a 'TypeRepMap' with a single element.
109+{- |
110+
111+Construct a 'TypeRepMap' with a single element.
112+
113+prop> size (one x) == 1
114+prop> member @a (one (x :: f a)) == True
115+
116+-}
101117one :: forall a f . Typeable a => f a -> TypeRepMap f
102118one x = insert x empty
103119{-# INLINE one #-}
104120
105−-- | Inserts the value with its type as a key.
121+{- |
122+
123+Insert a value into a 'TypeRepMap'.
124+
125+prop> size (insert v tm) >= size tm
126+prop> member @a (insert (x :: f a) tm) == True
127+
128+-}
106129insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
107130insert x = fromListPairs . addX . toPairList
108131 where
@@ -113,41 +136,45 @@ insert x = fromListPairs . addX . toPairList
113136 addX l = pairX : deleteByFst fpX l
114137{-# INLINE insert #-}
115138
116−-- Helper type to workaround some issues with types
139+-- Extract the kind of a type. We use it to work around lack of syntax for
140+-- inferred type variables (which are not subject to type applications).
117141type KindOf (a :: k) = k
118142
119−{- | Deletes value from list.
143+{- | Delete a value from a 'TypeRepMap'.
144+
145+prop> size (delete @a tm) <= size tm
146+prop> member @a (delete @a tm) == False
120147
121−>>> let trMap = delete @Bool $ insert (Identity True) $ one (Identity 'a')
122−>>> size trMap
148+>>> tm = delete @Bool $ insert (Just True) $ one (Just 'a')
149+>>> size tm
1231501
124−>>> member @Bool trMap
151+>>> member @Bool tm
125152False
126−>>> member @Char trMap
153+>>> member @Char tm
127154True
128155-}
129156delete :: forall a (f :: KindOf a -> Type) . Typeable a => TypeRepMap f -> TypeRepMap f
130157delete = fromListPairs . deleteByFst (typeFp @a) . toPairList
131158{-# INLINE delete #-}
132159
133−{- | Map over elements.
160+{- | Map over the elements of a 'TypeRepMap'.
134161
135−>>> let trMap = insert (Identity True) $ one (Identity 'a')
136−>>> lookup @Bool trMap
162+>>> tm = insert (Identity True) $ one (Identity 'a')
163+>>> lookup @Bool tm
137164Just (Identity True)
138−>>> lookup @Char trMap
165+>>> lookup @Char tm
139166Just (Identity 'a')
140−>>> let trMap2 = hoist ((:[]) . runIdentity) trMap
141−>>> lookup @Bool trMap2
167+>>> tm2 = hoist ((:[]) . runIdentity) tm
168+>>> lookup @Bool tm2
142169Just [True]
143−>>> lookup @Char trMap2
170+>>> lookup @Char tm2
144171Just "a"
145172-}
146173hoist :: (forall x. f x -> g x) -> TypeRepMap f -> TypeRepMap g
147174hoist f (TypeRepMap as bs ans) = TypeRepMap as bs $ mapArray' (toAny . f . fromAny) ans
148175{-# INLINE hoist #-}
149176
150−-- | The union with a combining function.
177+-- | The union of two 'TypeRepMap's using a combining function.
151178unionWith :: (forall x. f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f
152179unionWith f m1 m2 = fromListPairs
153180 $ Map.toList
@@ -159,13 +186,13 @@ unionWith f m1 m2 = fromListPairs
159186 combine a b = toAny $ f (fromAny a) (fromAny b)
160187{-# INLINE unionWith #-}
161188
162−-- | The (left-biased) union of two maps. It prefers the first map when
189+-- | The (left-biased) union of two 'TypeRepMap's. It prefers the first map when
163190-- duplicate keys are encountered, i.e. @'union' == 'unionWith' const@.
164191union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f
165192union = unionWith const
166193{-# INLINE union #-}
167194
168−{- | Returns 'True' if there exist value of given type.
195+{- | Check if a value of the given type is present in a 'TypeRepMap'.
169196
170197>>> member @Char $ one (Identity 'a')
171198True
@@ -173,14 +200,14 @@ True
173200False
174201-}
175202member :: forall a (f :: KindOf a -> Type) . Typeable a => TypeRepMap f -> Bool
176−member trMap = case lookup @a trMap of
203+member tm = case lookup @a tm of
177204 Nothing -> False
178205 Just _ -> True
179206{-# INLINE member #-}
180207
181−{- | Looks up the value at the type.
208+{- | Lookup a value of the given type in a 'TypeRepMap'.
182209
183−>>> let x = lookup $ insert (Identity (11 :: Int)) empty
210+>>> x = lookup $ insert (Identity (11 :: Int)) empty
184211>>> x :: Maybe (Identity Int)
185212Just (Identity 11)
186213>>> x :: Maybe (Identity ())
@@ -193,7 +220,7 @@ lookup tVect = fromAny . (anys tVect `indexArray`)
193220 (fingerprintBs tVect)
194221{-# INLINE lookup #-}
195222
196−-- | Returns the size of the 'TypeRepMap'.
223+-- | Get the amount of elements in a 'TypeRepMap'.
197224size :: TypeRepMap f -> Int
198225size = sizeofPrimArray . fingerprintAs
199226{-# INLINE size #-}
@@ -236,7 +263,7 @@ typeFp = typeRepFingerprint $ typeRep $ Proxy @a
236263{-# INLINE typeFp #-}
237264
238265toPairList :: TypeRepMap f -> [(Fingerprint, Any)]
239−toPairList trMap = zip (toFingerprints trMap) (GHC.toList $ anys trMap)
266+toPairList tm = zip (toFingerprints tm) (GHC.toList $ anys tm)
240267
241268deleteByFst :: Eq a => a -> [(a, b)] -> [(a, b)]
242269deleteByFst x = filter ((/= x) . fst)