git.iko.soy/typerep-map
on main help sign in
Change TypeRepMap to TypeRepMap f (k -> *)
bac9009vrom911
benchmark/Main.hs+10−8
compare with main
unifiedsplit
@@ -26,16 +26,15 @@ main = do
26 evaluate $ rknf bigMap
26 evaluate $ rknf bigMap
27 defaultMain
27 defaultMain
28 [ bench "lookup" $ nf tenLookups bigMap
28 [ bench "lookup" $ nf tenLookups bigMap
29− , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (111 :: Int)
29+ , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (proxy (111 :: Int))
30− , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) 'b'
30+ , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (proxy 'b')
31 ]
31 ]
32
32
33−tenLookups :: TypeRepMap
33+tenLookups :: TypeRepMap Proxy
34 -> ( Proxy (BigProxy 10), Proxy (BigProxy 20)
34 -> ( Proxy (BigProxy 10), Proxy (BigProxy 20)
35 , Proxy (BigProxy 30), Proxy (BigProxy 40)
35 , Proxy (BigProxy 30), Proxy (BigProxy 40)
36 , Proxy (BigProxy 50), Proxy (BigProxy 60)
36 , Proxy (BigProxy 50), Proxy (BigProxy 60)
37 , Proxy (BigProxy 70), Proxy (BigProxy 80)
37 , Proxy (BigProxy 70), Proxy (BigProxy 80)
38− -- , Proxy (BigProxy 9000), Proxy (BigProxy 10000)
39 )
38 )
40tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
39tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
41 where
40 where
@@ -43,19 +42,22 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
43 lp = fromJust $ lookup tmap
42 lp = fromJust $ lookup tmap
44
43
45-- TypeRepMap of 10000 elements
44-- TypeRepMap of 10000 elements
46−bigMap :: TypeRepMap
45+bigMap :: TypeRepMap Proxy
47bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
46bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
48
47
49data Z
48data Z
50data S a
49data S a
51
50
52−buildBigMap :: forall a . Typeable a => Int -> Proxy a -> TypeRepMap -> TypeRepMap
51+buildBigMap :: forall a . Typeable a => Int -> Proxy a -> TypeRepMap Proxy -> TypeRepMap Proxy
53−buildBigMap 1 x = insert 'a' . insert x
52+buildBigMap 1 x = insert (proxy 'a') . insert x
54buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (S a))
53buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (S a))
55
54
56−rknf :: TypeRepMap -> ()
55+rknf :: TypeRepMap f -> ()
57rknf = rnf . keys
56rknf = rnf . keys
58
57
59type family BigProxy (n :: Nat) :: * where
58type family BigProxy (n :: Nat) :: * where
60 BigProxy 0 = Z
59 BigProxy 0 = Z
61 BigProxy n = S (BigProxy (n - 1))
60 BigProxy n = S (BigProxy (n - 1))
61+
62+proxy :: a -> Proxy a
63+proxy _ = Proxy
src/Data/TypeRep/Map.hs+10−8
@@ -1,4 +1,6 @@
1{-# LANGUAGE ExplicitForAll #-}
1{-# LANGUAGE ExplicitForAll #-}
2+{-# LANGUAGE KindSignatures #-}
3+{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
3
5
4module Data.TypeRep.Map
6module Data.TypeRep.Map
@@ -13,24 +15,24 @@ module Data.TypeRep.Map
13import Prelude hiding (lookup)
15import Prelude hiding (lookup)
14
16
15import Data.Proxy (Proxy (..))
17import Data.Proxy (Proxy (..))
16−import Data.Typeable (TypeRep, Typeable, typeOf, typeRep)
18+import Data.Typeable (TypeRep, Typeable, typeRep)
17import GHC.Base (Any)
19import GHC.Base (Any)
18import Unsafe.Coerce (unsafeCoerce)
20import Unsafe.Coerce (unsafeCoerce)
19
21
20import qualified Data.Map.Lazy as LMap
22import qualified Data.Map.Lazy as LMap
21
23
22-- | Map-like data structure with types served as the keys.
24-- | Map-like data structure with types served as the keys.
23−newtype TypeRepMap = TypeRepMap
25+newtype TypeRepMap (f :: k -> *) = TypeRepMap
24 { unMap :: LMap.Map TypeRep Any
26 { unMap :: LMap.Map TypeRep Any
25 }
27 }
26
28
27-- | Empty structure.
29-- | Empty structure.
28−empty :: TypeRepMap
30+empty :: TypeRepMap f
29empty = TypeRepMap mempty
31empty = TypeRepMap mempty
30
32
31-- | Inserts the value with its type as a key.
33-- | Inserts the value with its type as a key.
32−insert :: Typeable a => a -> TypeRepMap -> TypeRepMap
34+insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
33−insert val = TypeRepMap . LMap.insert (typeOf val) (unsafeCoerce val) . unMap
35+insert val = TypeRepMap . LMap.insert (typeRep (Proxy :: Proxy a)) (unsafeCoerce val) . unMap
34
36
35-- | Looks up the value at the type.
37-- | Looks up the value at the type.
36-- >>> let x = lookup $ insert (11 :: Int) empty
38-- >>> let x = lookup $ insert (11 :: Int) empty
@@ -38,11 +40,11 @@ insert val = TypeRepMap . LMap.insert (typeOf val) (unsafeCoerce val) . unMap
38-- Just 11
40-- Just 11
39-- >>> x :: Maybe ()
41-- >>> x :: Maybe ()
40-- Nothing
42-- Nothing
41−lookup :: forall a . Typeable a => TypeRepMap -> Maybe a
43+lookup :: forall a f . Typeable a => TypeRepMap f -> Maybe (f a)
42lookup = fmap unsafeCoerce . LMap.lookup (typeRep (Proxy :: Proxy a)) . unMap
44lookup = fmap unsafeCoerce . LMap.lookup (typeRep (Proxy :: Proxy a)) . unMap
43
45
44−size :: TypeRepMap -> Int
46+size :: TypeRepMap f -> Int
45size = LMap.size . unMap
47size = LMap.size . unMap
46
48
47−keys :: TypeRepMap -> [TypeRep]
49+keys :: TypeRepMap f -> [TypeRep]
48keys = LMap.keys . unMap
50keys = LMap.keys . unMap
test/Test/TypeRep/Map.hs+17−9
@@ -2,6 +2,8 @@ module Test.TypeRep.Map where
2
2
3import Prelude hiding (lookup)
3import Prelude hiding (lookup)
4
4
5+import Data.Functor.Identity (Identity (..))
6+
5import Test.Tasty.Hspec
7import Test.Tasty.Hspec
6
8
7import Data.TypeRep.Map
9import Data.TypeRep.Map
@@ -11,23 +13,29 @@ spec_insertLookup :: Spec
11spec_insertLookup = do
13spec_insertLookup = do
12 describe "Lookup Test" $ do
14 describe "Lookup Test" $ do
13 it "returns the inserted element" $
15 it "returns the inserted element" $
14− lookup (insert 'a' empty) `shouldBe` Just 'a'
16+ lookup (insert (Identity 'a') empty) `shouldBe` Just (Identity 'a')
15 it "returns the second inserted value of the same type" $
17 it "returns the second inserted value of the same type" $
16− lookup (insert 'b' $ insert 'a' empty) `shouldBe` Just 'b'
18+ lookup (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` Just (Identity 'b')
17
19
18 describe "Size Test" $ do
20 describe "Size Test" $ do
19 it "is empty" $
21 it "is empty" $
20 size empty `shouldBe` 0
22 size empty `shouldBe` 0
21 it "is of size 1 when 1 element inserted" $
23 it "is of size 1 when 1 element inserted" $
22− size (insert 'a' empty) `shouldBe` 1
24+ size (insert (Identity 'a') empty) `shouldBe` 1
23 it "doesn't increase size when element of the same type is added" $
25 it "doesn't increase size when element of the same type is added" $
24− size (insert 'b' $ insert 'a' empty) `shouldBe` 1
26+ size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1
25 it "returns 10 when 10 different types are inserted" $
27 it "returns 10 when 10 different types are inserted" $
26 size mapOf10 `shouldBe` 10
28 size mapOf10 `shouldBe` 10
27
29
28
30
29−mapOf10 :: TypeRepMap
31+mapOf10 :: TypeRepMap Identity
30−mapOf10 = insert True $ insert [True, False] $ insert (Just True)
32+mapOf10 = insert (Identity True)
33+ $ insert (Identity [True, False])
34+ $ insert (Identity $ Just True)
31− $ insert (Just ()) $ insert [()] $ insert ()
35+ $ insert (Identity $ Just ())
36+ $ insert (Identity [()])
37+ $ insert (Identity ())
38+ $ insert (Identity "aaa")
32− $ insert "aaa" $ insert (Just 'a') $ insert 'a'
39+ $ insert (Identity $ Just 'a')
40+ $ insert (Identity 'a')
33− $ insert (11 :: Int) empty
41+ $ insert (Identity (11 :: Int)) empty