git.iko.soy/typerep-map
on 73e7201 help sign in
typerep-map/benchmark/Vector.hs
63 lines 1.9 kB history raw
1{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE UndecidableInstances #-}
10module Vector
11 ( benchVector
12 , prepareBenchVector
13 ) where
15import Prelude hiding (lookup)
17import Control.DeepSeq (rnf)
18import Control.Exception (evaluate)
19import Criterion.Main (Benchmark, bench, bgroup, nf)
20import Data.Kind (Type)
21import Data.Maybe (fromJust)
22import Data.Proxy (Proxy (..))
23import Data.Typeable (Typeable)
24import GHC.TypeLits (type (+), KnownNat, Nat)
26import Data.TypeRep.Vector (TF (..), TypeRepVector, fingerprints, fromList, lookup)
29benchVector :: Benchmark
30benchVector = bgroup "vector"
31 [ bench "lookup" $ nf tenLookups bigMap
32 -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
33 -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
34 ]
36tenLookups
37 :: TypeRepVector (Proxy :: Nat -> Type)
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 -> Type)
48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
50buildBigMap
51 :: forall a . (KnownNat a)
52 => Int
53 -> Proxy (a :: Nat)
54 -> [TF (Proxy :: Nat -> Type)]
55 -> [TF (Proxy :: Nat -> Type)]
56buildBigMap 1 x = (TF x :)
57buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
59rknf :: TypeRepVector f -> ()
60rknf = rnf . fingerprints
62prepareBenchVector :: IO ()
63prepareBenchVector = evaluate (rknf bigMap)