git.iko.soy/typerep-map
on 73e7201 help sign in
typerep-map/benchmark/CacheMap.hs
79 lines 2.3 kB history raw
1{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE UndecidableInstances #-}
9module CacheMap
10 ( spec
11 ) where
13import Prelude hiding (lookup)
15import Criterion.Main (bench, env, nf, whnf)
16import Data.Kind (Type)
17import Data.Maybe (fromJust)
18import Data.Proxy (Proxy (..))
19import Data.Typeable (Typeable)
20import GHC.Exts (fromList)
21import GHC.TypeLits (type (+), KnownNat, Nat)
23import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), empty, insert, lookup)
25import Spec (BenchSpec (..))
28spec :: BenchSpec
29spec = BenchSpec
30 { benchLookup = Just $ \name ->
31 env (mkMap 10000) $ \ ~bigMap ->
32 bench name $ nf tenLookups bigMap
33 , benchInsertSmall = Just $ \name ->
34 bench name $ whnf (inserts empty 10) (Proxy @ 99999)
35 , benchInsertBig = Just $ \name ->
36 env (mkMap 10000) $ \ ~bigMap ->
37 bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
38 , benchUpdateSmall = Just $ \name ->
39 env (mkMap 10) $ \ ~smallMap ->
40 bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
41 , benchUpdateBig = Just $ \name ->
42 env (mkMap 10000) $ \ ~bigMap ->
43 bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
44 }
46tenLookups
47 :: TypeRepMap (Proxy :: Nat -> Type)
48 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
49 , Proxy 50, Proxy 60, Proxy 70, Proxy 80
50 )
51tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
52 where
53 lp :: forall (a :: Nat) . Typeable a => Proxy a
54 lp = fromJust $ lookup tmap
56inserts
57 :: forall a . (KnownNat a)
58 => TypeRepMap (Proxy :: Nat -> Type)
59 -> Int
60 -> Proxy (a :: Nat)
61 -> TypeRepMap (Proxy :: Nat -> Type)
62inserts !c 0 _ = c
63inserts !c n x = inserts
64 (insert x c)
65 (n-1)
66 (Proxy :: Proxy (a + 1))
68mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
69mkMap n = pure $ fromList $ buildBigMap n (Proxy :: Proxy 0) []
72buildBigMap
73 :: forall a . (KnownNat a)
74 => Int
75 -> Proxy (a :: Nat)
76 -> [WrapTypeable (Proxy :: Nat -> Type)]
77 -> [WrapTypeable (Proxy :: Nat -> Type)]
78buildBigMap 1 x = (WrapTypeable x :)
79buildBigMap n x = (WrapTypeable x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))