git.iko.soy/typerep-map
on main help sign in
Use type-level Nat
5de021dVladislav Zavialov
benchmark/Main.hs+15−17
compare with main
unifiedsplit
@@ -1,4 +1,5 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE ExplicitForAll #-}
3{-# LANGUAGE ExplicitForAll #-}
3{-# LANGUAGE ExplicitNamespaces #-}
4{-# LANGUAGE ExplicitNamespaces #-}
4{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE KindSignatures #-}
@@ -7,6 +8,8 @@
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE UndecidableInstances #-}
9{-# LANGUAGE UndecidableInstances #-}
9
10
11+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
12+
10import Criterion.Main (bench, defaultMain, nf, whnf)
13import Criterion.Main (bench, defaultMain, nf, whnf)
11
14
12import Prelude hiding (lookup)
15import Prelude hiding (lookup)
@@ -16,7 +19,7 @@ import Control.Exception.Base (evaluate)
16import Data.Maybe (fromJust)
19import Data.Maybe (fromJust)
17import Data.Proxy (Proxy (..))
20import Data.Proxy (Proxy (..))
18import Data.Typeable (Typeable)
21import Data.Typeable (Typeable)
19−import GHC.TypeLits (type (-), Nat)
22+import GHC.TypeLits
20
23
21import Data.TypeRep.Map (TypeRepMap (..), empty, insert, keys, lookup, size)
24import Data.TypeRep.Map (TypeRepMap (..), empty, insert, keys, lookup, size)
22
25
@@ -26,31 +29,29 @@ main = do
26 evaluate $ rknf bigMap
29 evaluate $ rknf bigMap
27 defaultMain
30 defaultMain
28 [ bench "lookup" $ nf tenLookups bigMap
31 [ bench "lookup" $ nf tenLookups bigMap
29− , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (proxy (111 :: Int))
32+ , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
30− , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (proxy 'b')
33+ , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
31 ]
34 ]
32
35
33−tenLookups :: TypeRepMap Proxy
36+tenLookups :: TypeRepMap (Proxy :: Nat -> *)
34− -> ( Proxy (BigProxy 10), Proxy (BigProxy 20)
37+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
35− , Proxy (BigProxy 30), Proxy (BigProxy 40)
36− , Proxy (BigProxy 50), Proxy (BigProxy 60)
38+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
37− , Proxy (BigProxy 70), Proxy (BigProxy 80)
38 )
39 )
39tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
40tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
40 where
41 where
41− lp :: Typeable a => Proxy a
42+ lp :: forall (a::Nat). Typeable a => Proxy a
42 lp = fromJust $ lookup tmap
43 lp = fromJust $ lookup tmap
43
44
44-- TypeRepMap of 10000 elements
45-- TypeRepMap of 10000 elements
45−bigMap :: TypeRepMap Proxy
46+bigMap :: TypeRepMap (Proxy :: Nat -> *)
46−bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
47+bigMap = buildBigMap 10000 (Proxy :: Proxy 0) empty
47
48
48data Z
49data Z
49data S a
50data S a
50
51
51−buildBigMap :: forall a . Typeable a => Int -> Proxy a -> TypeRepMap Proxy -> TypeRepMap Proxy
52+buildBigMap :: forall a . (Typeable a, KnownNat a) => Int -> Proxy (a :: Nat) -> TypeRepMap (Proxy :: Nat -> *) -> TypeRepMap (Proxy :: Nat -> *)
52−buildBigMap 1 x = insert (proxy 'a') . insert x
53+buildBigMap 1 x = insert x
53−buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (S a))
54+buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
54
55
55rknf :: TypeRepMap f -> ()
56rknf :: TypeRepMap f -> ()
56rknf = rnf . keys
57rknf = rnf . keys
@@ -58,6 +59,3 @@ rknf = rnf . keys
58type family BigProxy (n :: Nat) :: * where
59type family BigProxy (n :: Nat) :: * where
59 BigProxy 0 = Z
60 BigProxy 0 = Z
60 BigProxy n = S (BigProxy (n - 1))
61 BigProxy n = S (BigProxy (n - 1))
61−
62−proxy :: a -> Proxy a
63−proxy _ = Proxy
typerep-map.cabal+1
@@ -45,6 +45,7 @@ benchmark typerep-map-benchmark
45 , criterion
45 , criterion
46 , typerep-map
46 , typerep-map
47 , deepseq
47 , deepseq
48+ , ghc-typelits-knownnat
48
49
49source-repository head
50source-repository head
50 type: git
51 type: git