on 92b6021 help sign in
62 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 Vector
13 ( benchVector
14 , prepareBenchVector
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.Vector
30benchVector :: Benchmark
31benchVector = bgroup "vector"
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 :: TypeRepVector (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 :: TypeRepVector (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 :: TypeRepVector f -> ()
59rknf = rnf . fingerprints
61prepareBenchVector :: IO ()
62prepareBenchVector = evaluate (rknf bigMap)