git.iko.soy/typerep-map
on main help sign in
Change TypeRepMap to TypeRepMap f (k -> *)
commitbac9009df18f8aaffc39f19b8754c90cb4c502ca authorvrom911 <vrom911@gmail.com> dateSun 17 Dec 2017, 00:08 (9 years ago) parente9fa41d
3 files changed+37−25
compare with main
unifiedsplit
benchmark/Main.hs+10−8 src/Data/TypeRep/Map.hs+10−8 test/Test/TypeRep/Map.hs+17−9
benchmark/Main.hs+10−8
@@ -26,16 +26,15 @@ main = do
2626 evaluate $ rknf bigMap
2727 defaultMain
2828 [ bench "lookup" $ nf tenLookups bigMap
29− , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (111 :: Int)
30− , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) 'b'
29+ , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (proxy (111 :: Int))
30+ , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (proxy 'b')
3131 ]
3232
33−tenLookups :: TypeRepMap
33+tenLookups :: TypeRepMap Proxy
3434 -> ( Proxy (BigProxy 10), Proxy (BigProxy 20)
3535 , Proxy (BigProxy 30), Proxy (BigProxy 40)
3636 , Proxy (BigProxy 50), Proxy (BigProxy 60)
3737 , Proxy (BigProxy 70), Proxy (BigProxy 80)
38− -- , Proxy (BigProxy 9000), Proxy (BigProxy 10000)
3938 )
4039tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
4140 where
@@ -43,19 +42,22 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
4342 lp = fromJust $ lookup tmap
4443
4544-- TypeRepMap of 10000 elements
46−bigMap :: TypeRepMap
45+bigMap :: TypeRepMap Proxy
4746bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
4847
4948data Z
5049data S a
5150
52−buildBigMap :: forall a . Typeable a => Int -> Proxy a -> TypeRepMap -> TypeRepMap
53−buildBigMap 1 x = insert 'a' . insert x
51+buildBigMap :: forall a . Typeable a => Int -> Proxy a -> TypeRepMap Proxy -> TypeRepMap Proxy
52+buildBigMap 1 x = insert (proxy 'a') . insert x
5453buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (S a))
5554
56−rknf :: TypeRepMap -> ()
55+rknf :: TypeRepMap f -> ()
5756rknf = rnf . keys
5857
5958type family BigProxy (n :: Nat) :: * where
6059 BigProxy 0 = Z
6160 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 @@
11{-# LANGUAGE ExplicitForAll #-}
2+{-# LANGUAGE KindSignatures #-}
3+{-# LANGUAGE PolyKinds #-}
24{-# LANGUAGE ScopedTypeVariables #-}
35
46module Data.TypeRep.Map
@@ -13,24 +15,24 @@ module Data.TypeRep.Map
1315import Prelude hiding (lookup)
1416
1517import Data.Proxy (Proxy (..))
16−import Data.Typeable (TypeRep, Typeable, typeOf, typeRep)
18+import Data.Typeable (TypeRep, Typeable, typeRep)
1719import GHC.Base (Any)
1820import Unsafe.Coerce (unsafeCoerce)
1921
2022import qualified Data.Map.Lazy as LMap
2123
2224-- | Map-like data structure with types served as the keys.
23−newtype TypeRepMap = TypeRepMap
25+newtype TypeRepMap (f :: k -> *) = TypeRepMap
2426 { unMap :: LMap.Map TypeRep Any
2527 }
2628
2729-- | Empty structure.
28−empty :: TypeRepMap
30+empty :: TypeRepMap f
2931empty = TypeRepMap mempty
3032
3133-- | Inserts the value with its type as a key.
32−insert :: Typeable a => a -> TypeRepMap -> TypeRepMap
33−insert val = TypeRepMap . LMap.insert (typeOf val) (unsafeCoerce val) . unMap
34+insert :: forall a f . Typeable a => f a -> TypeRepMap f -> TypeRepMap f
35+insert val = TypeRepMap . LMap.insert (typeRep (Proxy :: Proxy a)) (unsafeCoerce val) . unMap
3436
3537-- | Looks up the value at the type.
3638-- >>> let x = lookup $ insert (11 :: Int) empty
@@ -38,11 +40,11 @@ insert val = TypeRepMap . LMap.insert (typeOf val) (unsafeCoerce val) . unMap
3840-- Just 11
3941-- >>> x :: Maybe ()
4042-- Nothing
41−lookup :: forall a . Typeable a => TypeRepMap -> Maybe a
43+lookup :: forall a f . Typeable a => TypeRepMap f -> Maybe (f a)
4244lookup = fmap unsafeCoerce . LMap.lookup (typeRep (Proxy :: Proxy a)) . unMap
4345
44−size :: TypeRepMap -> Int
46+size :: TypeRepMap f -> Int
4547size = LMap.size . unMap
4648
47−keys :: TypeRepMap -> [TypeRep]
49+keys :: TypeRepMap f -> [TypeRep]
4850keys = LMap.keys . unMap
test/Test/TypeRep/Map.hs+17−9
@@ -2,6 +2,8 @@ module Test.TypeRep.Map where
22
33import Prelude hiding (lookup)
44
5+import Data.Functor.Identity (Identity (..))
6+
57import Test.Tasty.Hspec
68
79import Data.TypeRep.Map
@@ -11,23 +13,29 @@ spec_insertLookup :: Spec
1113spec_insertLookup = do
1214 describe "Lookup Test" $ do
1315 it "returns the inserted element" $
14− lookup (insert 'a' empty) `shouldBe` Just 'a'
16+ lookup (insert (Identity 'a') empty) `shouldBe` Just (Identity 'a')
1517 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')
1719
1820 describe "Size Test" $ do
1921 it "is empty" $
2022 size empty `shouldBe` 0
2123 it "is of size 1 when 1 element inserted" $
22− size (insert 'a' empty) `shouldBe` 1
24+ size (insert (Identity 'a') empty) `shouldBe` 1
2325 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
2527 it "returns 10 when 10 different types are inserted" $
2628 size mapOf10 `shouldBe` 10
2729
2830
29−mapOf10 :: TypeRepMap
30−mapOf10 = insert True $ insert [True, False] $ insert (Just True)
31− $ insert (Just ()) $ insert [()] $ insert ()
32− $ insert "aaa" $ insert (Just 'a') $ insert 'a'
33− $ insert (11 :: Int) empty
31+mapOf10 :: TypeRepMap Identity
32+mapOf10 = insert (Identity True)
33+ $ insert (Identity [True, False])
34+ $ insert (Identity $ Just True)
35+ $ insert (Identity $ Just ())
36+ $ insert (Identity [()])
37+ $ insert (Identity ())
38+ $ insert (Identity "aaa")
39+ $ insert (Identity $ Just 'a')
40+ $ insert (Identity 'a')
41+ $ insert (Identity (11 :: Int)) empty