git.iko.soy/typerep-map
on cc51bcc help sign in
typerep-map/benchmark/Map.hs
59 lines 1.9 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE ExplicitForAll #-}
3{-# LANGUAGE ExplicitNamespaces #-}
4{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE PolyKinds #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeOperators #-}
9{-# LANGUAGE UndecidableInstances #-}
11{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
13module Map
14 ( benchMap
15 , prepareBenchMap
16 ) where
18import Criterion.Main (Benchmark, bench, bgroup, nf)
20import Prelude hiding (lookup)
22import Control.Exception
23import Control.DeepSeq (rnf)
24import Data.Maybe (fromJust)
25import Data.Proxy (Proxy (..))
26import Data.Typeable (Typeable)
27import GHC.TypeLits
29import Data.TypeRep.Map (TypeRepMap (..), empty, insert, lookup, keys)
31benchMap :: Benchmark
32benchMap = bgroup "map"
33 [ bench "lookup" $ nf tenLookups bigMap
34 --, bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
35 --, bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
36 ]
38tenLookups :: TypeRepMap (Proxy :: Nat -> *)
39 -> ( Proxy 1000, Proxy 2000, Proxy 3000, Proxy 4000
40 , Proxy 5000, Proxy 6000, Proxy 7000, Proxy 8000
41 )
42tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
43 where
44 lp :: forall (a::Nat). Typeable a => Proxy a
45 lp = fromJust $ lookup tmap
47-- TypeRepMap of 10000 elements
48bigMap :: TypeRepMap (Proxy :: Nat -> *)
49bigMap = buildBigMap 10000 (Proxy :: Proxy 0) empty
51buildBigMap :: forall a . (Typeable a, KnownNat a) => Int -> Proxy (a :: Nat) -> TypeRepMap (Proxy :: Nat -> *) -> TypeRepMap (Proxy :: Nat -> *)
52buildBigMap 1 x = insert x
53buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
55rknf :: TypeRepMap f -> ()
56rknf = rnf . keys
58prepareBenchMap :: IO ()
59prepareBenchMap = evaluate (rknf bigMap)