git.iko.soy/typerep-map
on 71aa479 help sign in
typerep-map/benchmark/CacheMap.hs
58 lines 1.9 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE ExplicitNamespaces #-}
3{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE UndecidableInstances #-}
10{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
12module CacheMap
13 ( benchCacheMap
14 , prepareBenchCacheMap
15 ) where
17import Criterion.Main (Benchmark, bench, bgroup, nf)
19import Prelude hiding (lookup)
21import Control.DeepSeq (rnf)
22import Control.Exception
23import Data.Maybe (fromJust)
24import Data.Proxy (Proxy (..))
25import Data.Typeable (Typeable)
26import GHC.TypeLits
28import Data.TypeRep.Map (TF (..), TypeRepMap (..), fromList, lookup)
30benchCacheMap :: Benchmark
31benchCacheMap = bgroup "vector optimal cache"
32 [ bench "lookup" $ nf tenLookups bigMap
33 -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
34 -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
35 ]
37tenLookups :: TypeRepMap (Proxy :: Nat -> *)
38 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
39 , Proxy 50, Proxy 60, Proxy 70, Proxy 80
40 )
41tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
42 where
43 lp :: forall (a::Nat). Typeable a => Proxy a
44 lp = fromJust $ lookup tmap
46-- TypeRepMap of 10000 elements
47bigMap :: TypeRepMap (Proxy :: Nat -> *)
48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
50buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]
51buildBigMap 1 x = (TF x :)
52buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
54rknf :: TypeRepMap f -> ()
55rknf tVect = rnf (fingerprintAs tVect, fingerprintBs tVect)
57prepareBenchCacheMap :: IO ()
58prepareBenchCacheMap = evaluate (rknf bigMap)