on 71aa479 help sign in
57 lines 1.8 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE ExplicitNamespaces #-}
3{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE UndecidableInstances #-}
9{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11module CMap
12 ( benchMap
13 , prepareBenchMap
14 ) where
16import Criterion.Main (Benchmark, bench, bgroup, nf)
18import Prelude hiding (lookup)
20import Control.DeepSeq (rnf)
21import Control.Exception
22import Data.Maybe (fromJust)
23import Data.Proxy (Proxy (..))
24import Data.Typeable (Typeable)
25import GHC.TypeLits
27import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, keys, lookup)
29benchMap :: Benchmark
30benchMap = bgroup "map"
31 [ bench "lookup" $ nf tenLookups bigMap
32 --, bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
33 --, bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
34 ]
36tenLookups :: TypeRepMap (Proxy :: Nat -> *)
37 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
38 , Proxy 50, Proxy 60, Proxy 70, Proxy 80
39 )
40tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
41 where
42 lp :: forall (a::Nat). Typeable a => Proxy a
43 lp = fromJust $ lookup tmap
45-- TypeRepMap of 10000 elements
46bigMap :: TypeRepMap (Proxy :: Nat -> *)
47bigMap = buildBigMap 10000 (Proxy :: Proxy 0) empty
49buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> TypeRepMap (Proxy :: Nat -> *) -> TypeRepMap (Proxy :: Nat -> *)
50buildBigMap 1 x = insert x
51buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
53rknf :: TypeRepMap f -> ()
54rknf = rnf . keys
56prepareBenchMap :: IO ()
57prepareBenchMap = evaluate (rknf bigMap)