benchmark/CacheMap.hs · typerep-map

git.iko.soy/typerep-map

on 92b6021 help sign in

53 lines 1.7 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 CacheMap

12 ( benchCacheMap

13 ) where

15import Criterion.Main (Benchmark, bench, bgroup, nf)

17import Prelude hiding (lookup)

19import Data.Maybe (fromJust)

20import Data.Proxy (Proxy (..))

21import Data.Typeable (Typeable)

22import GHC.Exts (fromList)

23import GHC.TypeLits

25import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), lookup)

27benchCacheMap :: Benchmark

28benchCacheMap = bgroup "vector optimal cache"

29 [ bench "lookup" $ nf tenLookups bigMap

30 -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)

31 -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)

32 ]

34tenLookups :: TypeRepMap (Proxy :: Nat -> *)

35 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40

36 , Proxy 50, Proxy 60, Proxy 70, Proxy 80

37 )

38tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

39 where

40 lp :: forall (a::Nat). Typeable a => Proxy a

41 lp = fromJust $ lookup tmap

43-- TypeRepMap of 10000 elements

44bigMap :: TypeRepMap (Proxy :: Nat -> *)

45bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []

47buildBigMap :: forall a . (KnownNat a)

48 => Int

49 -> Proxy (a :: Nat)

50 -> [WrapTypeable (Proxy :: Nat -> *)]

51 -> [WrapTypeable (Proxy :: Nat -> *)]

52buildBigMap 1 x = (WrapTypeable x :)

53buildBigMap n x = (WrapTypeable x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))