on 92b6021 help sign in
typerep-map/benchmark/OptimalVector.hs
62 lines 2.0 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 OptimalVector
13 ( benchVectorOpt
14 , prepareBenchVectorOpt
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.OptimalVector (TF (..), TypeRepMap (..), fromList, lookup)
30benchVectorOpt :: Benchmark
31benchVectorOpt = bgroup "vector optimal"
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)
51 => Int
52 -> Proxy (a :: Nat)
53 -> [TF (Proxy :: Nat -> *)]
54 -> [TF (Proxy :: Nat -> *)]
55buildBigMap 1 x = (TF x :)
56buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
58rknf :: TypeRepMap f -> ()
59rknf tVect = rnf (fingerprintAs tVect, fingerprintBs tVect)
61prepareBenchVectorOpt :: IO ()
62prepareBenchVectorOpt = evaluate (rknf bigMap)