git.iko.soy/typerep-map
on main help sign in
[#7] Implement insert for CachedMap (#13)
71aa479Dmitrii Kovanikov
internal/Data/TypeRep/CacheMap.hs+26−7
compare with main
unifiedsplit
@@ -53,8 +53,21 @@ empty :: TypeRepMap f
53empty = TypeRepMap mempty mempty mempty
53empty = TypeRepMap mempty mempty mempty
54
54
55-- | Inserts the value with its type as a key.
55-- | Inserts the value with its type as a key.
56−insert :: forall a f . Typeable a => a -> TypeRepMap f -> TypeRepMap f
56+insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
57−insert = undefined
57+insert x = fromListPairs . addX . toPairList
58+ where
59+ toPairList :: TypeRepMap f -> [(Fingerprint, Any)]
60+ toPairList (TypeRepMap as bs ans) = zip (zipWith Fingerprint
61+ (Unboxed.toList as)
62+ (Unboxed.toList bs))
63+ (V.toList ans)
64+
65+ pairX :: (Fingerprint, Any)
66+ pairX@(fpX, _) = (calcFp x, unsafeCoerce x)
67+
68+ addX :: [(Fingerprint, Any)] -> [(Fingerprint, Any)]
69+ addX l = pairX : filter ((/= fpX) . fst) l
70+{-# INLINE insert #-}
58
71
59-- | Looks up the value at the type.
72-- | Looks up the value at the type.
60-- >>> let x = lookup $ insert (11 :: Int) empty
73-- >>> let x = lookup $ insert (11 :: Int) empty
@@ -106,14 +119,20 @@ data TF f where
106fromF :: Typeable a => f a -> Proxy a
119fromF :: Typeable a => f a -> Proxy a
107fromF _ = Proxy
120fromF _ = Proxy
108
121
109−fromList :: forall f . [TF f] -> TypeRepMap f
122+calcFp :: Typeable a => f a -> Fingerprint
123+calcFp = typeRepFingerprint . typeRep . fromF
124+
125+fromListPairs :: [(Fingerprint, Any)] -> TypeRepMap f
110−fromList tfs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)
126+fromListPairs kvs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)
111 where
127 where
112− (fpAs, fpBs) = unzip $ fmap (\(Fingerprint a b) -> (a, b)) fps
128+ (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps
113− (fps, ans) = unzip $ breadthFirst $ fromListToTree $ sortWith fst $ map (fp &&& an) tfs
129+ (fps, ans) = unzip $ breadthFirst $ fromListToTree $ sortWith fst kvs
114
130
131+fromList :: forall f . [TF f] -> TypeRepMap f
132+fromList = fromListPairs . map (fp &&& an)
133+ where
115 fp :: TF f -> Fingerprint
134 fp :: TF f -> Fingerprint
116− fp (TF x) = typeRepFingerprint $ typeRep $ fromF x
135+ fp (TF x) = calcFp x
117
136
118 an :: TF f -> Any
137 an :: TF f -> Any
119 an (TF x) = unsafeCoerce x
138 an (TF x) = unsafeCoerce x
test/Test/TypeRep/CacheMap.hs+24−25
@@ -3,10 +3,9 @@ module Test.TypeRep.CacheMap where
3import Prelude hiding (lookup)
3import Prelude hiding (lookup)
4
4
5import Data.Functor.Identity (Identity (..))
5import Data.Functor.Identity (Identity (..))
6+import Test.Tasty.Hspec (Spec, describe, it, shouldBe)
6
7
7−import Test.Tasty.Hspec
8−
9−import Data.TypeRep.CacheMap (TF (..), fromList, lookup)
8+import Data.TypeRep.CacheMap (TF (..), TypeRepMap, empty, fromList, insert, lookup, size)
10
9
11-- Simple test for 'lookup', 'insert' and 'size' functions.
10-- Simple test for 'lookup', 'insert' and 'size' functions.
12spec_insertLookup :: Spec
11spec_insertLookup :: Spec
@@ -17,25 +16,25 @@ spec_insertLookup = do
17 -- it "returns the second inserted value of the same type" $
16 -- it "returns the second inserted value of the same type" $
18 -- lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')
17 -- lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')
19
18
20−-- describe "Size Test" $ do
19+ describe "Size Test" $ do
21−-- it "is empty" $
20+ it "is empty" $
22−-- size empty `shouldBe` 0
21+ size empty `shouldBe` 0
23−-- it "is of size 1 when 1 element inserted" $
22+ it "is of size 1 when 1 element inserted" $
24−-- size (insert (Identity 'a') empty) `shouldBe` 1
23+ size (insert (Identity 'a') empty) `shouldBe` 1
25−-- it "doesn't increase size when element of the same type is added" $
24+ it "doesn't increase size when element of the same type is added" $
26−-- size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1
25+ size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1
27−-- it "returns 10 when 10 different types are inserted" $
26+ it "returns 10 when 10 different types are inserted" $
28−-- size mapOf10 `shouldBe` 10
27+ size mapOf10 `shouldBe` 10
29−--
28+
30−--
29+
31−--mapOf10 :: TypeRepMap Identity
30+mapOf10 :: TypeRepMap Identity
32−--mapOf10 = insert (Identity True)
31+mapOf10 = insert (Identity True)
33−-- $ insert (Identity [True, False])
32+ $ insert (Identity [True, False])
34−-- $ insert (Identity $ Just True)
33+ $ insert (Identity $ Just True)
35−-- $ insert (Identity $ Just ())
34+ $ insert (Identity $ Just ())
36−-- $ insert (Identity [()])
35+ $ insert (Identity [()])
37−-- $ insert (Identity ())
36+ $ insert (Identity ())
38−-- $ insert (Identity "aaa")
37+ $ insert (Identity "aaa")
39−-- $ insert (Identity $ Just 'a')
38+ $ insert (Identity $ Just 'a')
40−-- $ insert (Identity 'a')
39+ $ insert (Identity 'a')
41−-- $ insert (Identity (11 :: Int)) empty
40+ $ insert (Identity (11 :: Int)) empty
typerep-map.cabal+1−1
@@ -21,7 +21,7 @@ library
21 exposed-modules: Data.TypeRep.Map
21 exposed-modules: Data.TypeRep.Map
22 ghc-options: -Wall
22 ghc-options: -Wall
23 build-depends: base
23 build-depends: base
24− , typerep-map-internal -any
24+ , typerep-map-internal
25 default-extensions: OverloadedStrings
25 default-extensions: OverloadedStrings
26 RecordWildCards
26 RecordWildCards
27 ScopedTypeVariables
27 ScopedTypeVariables