on main help sign in
Benchmark with BigProxy types
e9fa41dvrom911
benchmark/Main.hs+30−6
@@ -1,14 +1,22 @@
1+{-# LANGUAGE DataKinds #-}
1−{-# LANGUAGE ExplicitForAll #-}
2+{-# LANGUAGE ExplicitForAll #-}
3+{-# LANGUAGE ExplicitNamespaces #-}
4+{-# LANGUAGE KindSignatures #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE TypeOperators #-}
8+{-# LANGUAGE UndecidableInstances #-}
3
9
4−import Criterion.Main (bench, defaultMain, whnf)
10+import Criterion.Main (bench, defaultMain, nf, whnf)
5
11
6import Prelude hiding (lookup)
12import Prelude hiding (lookup)
7
13
8import Control.DeepSeq (rnf)
14import Control.DeepSeq (rnf)
9import Control.Exception.Base (evaluate)
15import Control.Exception.Base (evaluate)
16+import Data.Maybe (fromJust)
10import Data.Proxy (Proxy (..))
17import Data.Proxy (Proxy (..))
11import Data.Typeable (Typeable)
18import Data.Typeable (Typeable)
19+import GHC.TypeLits (type (-), Nat)
12
20
13import Data.TypeRep.Map (TypeRepMap (..), empty, insert, keys, lookup, size)
21import Data.TypeRep.Map (TypeRepMap (..), empty, insert, keys, lookup, size)
14
22
@@ -17,11 +25,23 @@ main = do
17 putStrLn $ "size: " ++ (show $ size bigMap)
25 putStrLn $ "size: " ++ (show $ size bigMap)
18 evaluate $ rknf bigMap
26 evaluate $ rknf bigMap
19 defaultMain
27 defaultMain
20− [ bench "lookup" $ whnf (lookup :: TypeRepMap -> Maybe Char) bigMap
28+ [ bench "lookup" $ nf tenLookups bigMap
21− , bench "insert new" $ whnf (\x -> insert x bigMap) (111 :: Int)
29+ , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (111 :: Int)
22− , bench "update old" $ whnf (\x -> insert x bigMap) 'b'
30+ , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) 'b'
23 ]
31 ]
24
32
33+tenLookups :: TypeRepMap
34+ -> ( Proxy (BigProxy 10), Proxy (BigProxy 20)
35+ , Proxy (BigProxy 30), Proxy (BigProxy 40)
36+ , Proxy (BigProxy 50), Proxy (BigProxy 60)
37+ , Proxy (BigProxy 70), Proxy (BigProxy 80)
38+ -- , Proxy (BigProxy 9000), Proxy (BigProxy 10000)
39+ )
40+tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
41+ where
42+ lp :: Typeable a => Proxy a
43+ lp = fromJust $ lookup tmap
44+
25-- TypeRepMap of 10000 elements
45-- TypeRepMap of 10000 elements
26bigMap :: TypeRepMap
46bigMap :: TypeRepMap
27bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
47bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
@@ -35,3 +55,7 @@ buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (S a))
35
55
36rknf :: TypeRepMap -> ()
56rknf :: TypeRepMap -> ()
37rknf = rnf . keys
57rknf = rnf . keys
58+
59+type family BigProxy (n :: Nat) :: * where
60+ BigProxy 0 = Z
61+ BigProxy n = S (BigProxy (n - 1))
typerep-map.cabal+1−1
@@ -38,7 +38,7 @@ test-suite typerep-map-test
38benchmark typerep-map-benchmark
38benchmark typerep-map-benchmark
39 type: exitcode-stdio-1.0
39 type: exitcode-stdio-1.0
40 default-language: Haskell2010
40 default-language: Haskell2010
41− ghc-options: -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N
41+ ghc-options: -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N -freduction-depth=0
42 hs-source-dirs: benchmark
42 hs-source-dirs: benchmark
43 main-is: Main.hs
43 main-is: Main.hs
44 build-depends: base
44 build-depends: base