git.iko.soy/typerep-map
on main help sign in
Improve benchmarks. (#61)
35cb971Alexander Vershilov
benchmark/CMap.hs+34−21
compare with main
unifiedsplit
@@ -9,29 +9,38 @@
9{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
9{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10
10
11module CMap
11module CMap
12− ( benchMap
12+ ( spec
13− , prepareBenchMap
14 ) where
13 ) where
15
14
16−import Criterion.Main (Benchmark, bench, bgroup, nf)
15+import Criterion.Main (bench, nf, env, whnf)
17
16
18import Prelude hiding (lookup)
17import Prelude hiding (lookup)
19
18
20−import Control.DeepSeq (rnf)
19+import Spec
21−import Control.Exception
22import Data.Maybe (fromJust)
20import Data.Maybe (fromJust)
23import Data.Proxy (Proxy (..))
21import Data.Proxy (Proxy (..))
24import Data.Typeable (Typeable)
22import Data.Typeable (Typeable)
25import GHC.TypeLits
23import GHC.TypeLits
26
24
27−import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, keys, lookup)
25+import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, lookup)
28
26
29−benchMap :: Benchmark
27+spec :: BenchSpec
30−benchMap = bgroup "map"
28+spec = BenchSpec
29+ { benchLookup = Just $ \name ->
30+ env (mkMap 10000) $ \ ~bigMap ->
31− [ bench "lookup" $ nf tenLookups bigMap
31+ bench name $ nf tenLookups bigMap
32− --, bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
32+ , benchInsertSmall = Just $ \name ->
33− --, bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
33+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
34− ]
34+ , benchInsertBig = Just $ \name ->
35+ env (mkMap 10000) $ \ ~(bigMap) ->
36+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
37+ , benchUpdateSmall = Just $ \name ->
38+ env (mkMap 10) $ \ ~(smallMap) ->
39+ bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
40+ , benchUpdateBig = Just $ \name ->
41+ env (mkMap 10000) $ \ ~(bigMap) ->
42+ bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
43+ }
35
44
36tenLookups :: TypeRepMap (Proxy :: Nat -> *)
45tenLookups :: TypeRepMap (Proxy :: Nat -> *)
37 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
46 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
@@ -42,16 +51,20 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
42 lp :: forall (a::Nat). Typeable a => Proxy a
51 lp :: forall (a::Nat). Typeable a => Proxy a
43 lp = fromJust $ lookup tmap
52 lp = fromJust $ lookup tmap
44
53
54+inserts :: forall a . (KnownNat a)
45−-- TypeRepMap of 10000 elements
55+ => TypeRepMap (Proxy :: Nat -> *)
56+ -> Int
57+ -> Proxy (a :: Nat)
58+ -> TypeRepMap (Proxy :: Nat -> *)
59+inserts !c 0 _ = c
60+inserts !c n x = inserts
61+ (insert x c)
62+ (n-1)
63+ (Proxy :: Proxy (a+1))
64+
46−bigMap :: TypeRepMap (Proxy :: Nat -> *)
65+mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> *))
47−bigMap = buildBigMap 10000 (Proxy :: Proxy 0) empty
66+mkMap n = pure $ buildBigMap n (Proxy :: Proxy 0) empty
48
67
49buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> TypeRepMap (Proxy :: Nat -> *) -> TypeRepMap (Proxy :: Nat -> *)
68buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> TypeRepMap (Proxy :: Nat -> *) -> TypeRepMap (Proxy :: Nat -> *)
50buildBigMap 1 x = insert x
69buildBigMap 1 x = insert x
51buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
70buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
52−
53−rknf :: TypeRepMap f -> ()
54−rknf = rnf . keys
55−
56−prepareBenchMap :: IO ()
57−prepareBenchMap = evaluate (rknf bigMap)
benchmark/CacheMap.hs+35−12
@@ -9,10 +9,11 @@
9{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
9{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10
10
11module CacheMap
11module CacheMap
12− ( benchCacheMap
12+ ( spec
13 ) where
13 ) where
14
14
15−import Criterion.Main (Benchmark, bench, bgroup, nf)
15+import Criterion.Main (bench, nf, whnf, env)
16+import Spec
16
17
17import Prelude hiding (lookup)
18import Prelude hiding (lookup)
18
19
@@ -22,14 +23,25 @@ import Data.Typeable (Typeable)
22import GHC.Exts (fromList)
23import GHC.Exts (fromList)
23import GHC.TypeLits
24import GHC.TypeLits
24
25
25−import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), lookup)
26+import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), lookup, insert, empty)
26
27
27−benchCacheMap :: Benchmark
28+spec :: BenchSpec
28−benchCacheMap = bgroup "vector optimal cache"
29+spec = BenchSpec
30+ { benchLookup = Just $ \name ->
31+ env (mkMap 10000) $ \ ~bigMap ->
29− [ bench "lookup" $ nf tenLookups bigMap
32+ bench name $ nf tenLookups bigMap
30− -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
33+ , benchInsertSmall = Just $ \name ->
31− -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
34+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
32− ]
35+ , benchInsertBig = Just $ \name ->
36+ env (mkMap 10000) $ \ ~(bigMap) ->
37+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
38+ , benchUpdateSmall = Just $ \name ->
39+ env (mkMap 10) $ \ ~(smallMap) ->
40+ bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
41+ , benchUpdateBig = Just $ \name ->
42+ env (mkMap 10000) $ \ ~(bigMap) ->
43+ bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
44+ }
33
45
34tenLookups :: TypeRepMap (Proxy :: Nat -> *)
46tenLookups :: TypeRepMap (Proxy :: Nat -> *)
35 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
47 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
@@ -40,9 +52,20 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
40 lp :: forall (a::Nat). Typeable a => Proxy a
52 lp :: forall (a::Nat). Typeable a => Proxy a
41 lp = fromJust $ lookup tmap
53 lp = fromJust $ lookup tmap
42
54
55+inserts :: forall a . (KnownNat a)
43−-- TypeRepMap of 10000 elements
56+ => TypeRepMap (Proxy :: Nat -> *)
57+ -> Int
58+ -> Proxy (a :: Nat)
59+ -> TypeRepMap (Proxy :: Nat -> *)
60+inserts !c 0 _ = c
61+inserts !c n x = inserts
62+ (insert x c)
63+ (n-1)
64+ (Proxy :: Proxy (a+1))
65+
44−bigMap :: TypeRepMap (Proxy :: Nat -> *)
66+mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> *))
45−bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
67+mkMap n = pure $ fromList $ buildBigMap n (Proxy :: Proxy 0) []
68+
46
69
47buildBigMap :: forall a . (KnownNat a)
70buildBigMap :: forall a . (KnownNat a)
48 => Int
71 => Int
benchmark/DMap.hs+36−17
@@ -11,16 +11,15 @@
11{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver -fno-warn-orphans #-}
11{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver -fno-warn-orphans #-}
12
12
13module DMap
13module DMap
14− ( benchDMap
14+ ( spec
15− , prepareBenchDMap
16 ) where
15 ) where
17
16
18−import Criterion.Main (Benchmark, bench, bgroup, nf)
17+import Criterion.Main (bench, nf, whnf, env)
19
18
20import Prelude hiding (lookup)
19import Prelude hiding (lookup)
21
20
22−import Control.DeepSeq (rnf)
21+import Spec
23−import Control.Exception
22+import Control.DeepSeq (NFData(..))
24import Data.Maybe (fromJust)
23import Data.Maybe (fromJust)
25import Data.Proxy (Proxy (..))
24import Data.Proxy (Proxy (..))
26import Data.Type.Equality ((:~:) (..))
25import Data.Type.Equality ((:~:) (..))
@@ -35,12 +34,20 @@ import Data.Some (Some (This))
35
34
36type TypeRepMap = DMap TypeRep
35type TypeRepMap = DMap TypeRep
37
36
38−benchDMap :: Benchmark
37+
39−benchDMap = bgroup "dependent map"
38+spec :: BenchSpec
39+spec = BenchSpec
40+ { benchLookup = Just $ \name ->
41+ env mkBigMap $ \ ~(DMapNF bigMap) ->
40− [ bench "lookup" $ nf tenLookups bigMap
42+ bench name $ nf tenLookups bigMap
41− -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
43+ , benchInsertSmall = Just $ \name ->
42− -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
44+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
43− ]
45+ , benchInsertBig = Just $ \name ->
46+ env mkBigMap $ \ ~(DMapNF bigMap) ->
47+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
48+ , benchUpdateSmall = Nothing -- Not implemented
49+ , benchUpdateBig = Nothing -- Not implemented
50+ }
44
51
45tenLookups :: TypeRepMap (Proxy :: Nat -> *)
52tenLookups :: TypeRepMap (Proxy :: Nat -> *)
46 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
53 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
@@ -51,9 +58,20 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
51 lp :: forall (a :: Nat) . Typeable a => Proxy a
58 lp :: forall (a :: Nat) . Typeable a => Proxy a
52 lp = fromJust $ lookup (typeRep @a) tmap
59 lp = fromJust $ lookup (typeRep @a) tmap
53
60
61+inserts :: forall a . (KnownNat a)
62+ => TypeRepMap (Proxy :: Nat -> *)
63+ -> Int
64+ -> Proxy (a :: Nat)
65+ -> TypeRepMap (Proxy :: Nat -> *)
66+inserts !c 0 _ = c
67+inserts !c n x = inserts
68+ (insert (typeRep @ a) x c)
69+ (n-1)
70+ (Proxy :: Proxy (a+1))
71+
54-- TypeRepMap of 10000 elements
72-- TypeRepMap of 10000 elements
55−bigMap :: TypeRepMap (Proxy :: Nat -> *)
73+mkBigMap :: IO (DMapNF (Proxy :: Nat -> *))
56−bigMap = buildBigMap 10000 (Proxy :: Proxy 0) empty
74+mkBigMap = pure . DMapNF $ buildBigMap 10000 (Proxy :: Proxy 0) empty
57
75
58buildBigMap :: forall a . (KnownNat a)
76buildBigMap :: forall a . (KnownNat a)
59 => Int
77 => Int
@@ -64,11 +82,12 @@ buildBigMap 1 x = insert (typeRep @a) x
64buildBigMap n x = insert (typeRep @a) x
82buildBigMap n x = insert (typeRep @a) x
65 . buildBigMap (n - 1) (Proxy @(a + 1))
83 . buildBigMap (n - 1) (Proxy @(a + 1))
66
84
67−rknf :: TypeRepMap f -> ()
85+-- | Wrapper that provides NFData instance to the 'DMap' structure.
68−rknf = rnf . map (\(This t) -> typeRepFingerprint t) . keys
86+newtype DMapNF f = DMapNF (TypeRepMap f)
69
87
70−prepareBenchDMap :: IO ()
88+instance NFData (DMapNF f) where
71−prepareBenchDMap = evaluate (rknf bigMap)
89+ rnf (DMapNF x) =
90+ rnf . map (\(This t) -> typeRepFingerprint t) $ keys x
72
91
73instance GEq TypeRep where
92instance GEq TypeRep where
74 geq :: TypeRep a -> TypeRep b -> Maybe (a :~: b)
93 geq :: TypeRep a -> TypeRep b -> Maybe (a :~: b)
benchmark/Main.hs+34−18
@@ -2,30 +2,46 @@
2
2
3module Main where
3module Main where
4
4
5−import Criterion.Main (defaultMain)
5+import Criterion.Main (defaultMain, bgroup)
6
6
7−import CacheMap (benchCacheMap)
7+import Spec
8−import CMap (benchMap, prepareBenchMap)
8+import qualified CMap
9+import qualified CacheMap
9#if ( __GLASGOW_HASKELL__ >= 802 )
10#if ( __GLASGOW_HASKELL__ >= 802 )
10−import DMap (benchDMap, prepareBenchDMap)
11+import qualified DMap
11#endif
12#endif
12−import OptimalVector (benchVectorOpt, prepareBenchVectorOpt)
13+import qualified OptimalVector as OptVec
13−--import Vector (benchVector, prepareBenchVector)
14
14
15main :: IO ()
15main :: IO ()
16main = do
16main = do
17− prepareBenchMap
17+ let specs = [("CMap", CMap.spec)
18− --prepareBenchVector
18+ ,("CacheMap", CacheMap.spec)
19− prepareBenchVectorOpt
20#if ( __GLASGOW_HASKELL__ >= 802 )
19#if ( __GLASGOW_HASKELL__ >= 802 )
21− prepareBenchDMap
20+ , ("DMap", DMap.spec)
22#endif
21#endif
22+ , ("OptVec", OptVec.spec)
23+ ]
24+ -- This code creates a benchmark group. Given a getter
25+ -- (that is test description) it gets a benchmark generation
26+ -- function from each module spec. Benchmark generation
27+ -- function takes a label and generate benchmarks. It's
28+ -- possible to introduce parameters passing in the same way.
29+ mkGroup getBenchmark =
30+ [ mkBenchmark label
31+ | (label, spec) <- specs
32+ -- Here we use pure to force pattern matching in List
33+ -- then in case of pattern match failure `mzero` will
34+ -- be called, so benchmark will be ignored.
35+ , Just mkBenchmark <- pure $ getBenchmark spec
36+ ]
23 defaultMain
37 defaultMain
24− [ benchMap
38+ [ bgroup "lookup" $ mkGroup benchLookup
25− -- , benchVector
39+ , bgroup "insert"
26− , benchCacheMap
40+ [ bgroup "10 elements to empty" $ mkGroup benchInsertSmall
27− , benchVectorOpt
41+ , bgroup "1 element to big map" $ mkGroup benchInsertBig
28−#if ( __GLASGOW_HASKELL__ >= 802 )
42+ ]
29− , benchDMap
43+ , bgroup "update"
30−#endif
44+ [ bgroup "10 elements to empty" $ mkGroup benchUpdateSmall
45+ , bgroup "1 element to big map" $ mkGroup benchUpdateBig
46+ ]
31− ]
47+ ]
benchmark/OptimalVector.hs+16−19
@@ -10,16 +10,14 @@
10{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11
11
12module OptimalVector
12module OptimalVector
13− ( benchVectorOpt
13+ ( spec
14− , prepareBenchVectorOpt
15 ) where
14 ) where
16
15
16+import Spec
17−import Criterion.Main (Benchmark, bench, bgroup, nf)
17+import Criterion.Main (bench, nf, env)
18
18
19import Prelude hiding (lookup)
19import Prelude hiding (lookup)
20
20
21−import Control.DeepSeq (rnf)
22−import Control.Exception
23import Data.Maybe (fromJust)
21import Data.Maybe (fromJust)
24import Data.Proxy (Proxy (..))
22import Data.Proxy (Proxy (..))
25import Data.Typeable (Typeable)
23import Data.Typeable (Typeable)
@@ -27,13 +25,17 @@ import GHC.TypeLits
27
25
28import Data.TypeRep.OptimalVector (TF (..), TypeRepMap (..), fromList, lookup)
26import Data.TypeRep.OptimalVector (TF (..), TypeRepMap (..), fromList, lookup)
29
27
30−benchVectorOpt :: Benchmark
28+spec :: BenchSpec
31−benchVectorOpt = bgroup "vector optimal"
29+spec = BenchSpec
30+ { benchLookup = Just $ \name ->
31+ env mkBigMap $ \ ~bigMap ->
32− [ bench "lookup" $ nf tenLookups bigMap
32+ bench name $ nf tenLookups bigMap
33− -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)
33+ , benchInsertSmall = Nothing -- Not implemented
34− -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
34+ , benchInsertBig = Nothing -- Not implemented
35− ]
35+ , benchUpdateSmall = Nothing -- Not implemented
36−
36+ , benchUpdateBig = Nothing -- Not implemented
37+ }
38+
37tenLookups :: TypeRepMap (Proxy :: Nat -> *)
39tenLookups :: TypeRepMap (Proxy :: Nat -> *)
38 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
40 -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
39 , Proxy 50, Proxy 60, Proxy 70, Proxy 80
41 , Proxy 50, Proxy 60, Proxy 70, Proxy 80
@@ -44,8 +46,8 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
44 lp = fromJust $ lookup tmap
46 lp = fromJust $ lookup tmap
45
47
46-- TypeRepMap of 10000 elements
48-- TypeRepMap of 10000 elements
47−bigMap :: TypeRepMap (Proxy :: Nat -> *)
49+mkBigMap :: IO (TypeRepMap (Proxy :: Nat -> *))
48−bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
50+mkBigMap = pure $ fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
49
51
50buildBigMap :: forall a . (KnownNat a)
52buildBigMap :: forall a . (KnownNat a)
51 => Int
53 => Int
@@ -55,8 +57,3 @@ buildBigMap :: forall a . (KnownNat a)
55buildBigMap 1 x = (TF x :)
57buildBigMap 1 x = (TF x :)
56buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
58buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
57
59
58−rknf :: TypeRepMap f -> ()
59−rknf tVect = rnf (fingerprintAs tVect, fingerprintBs tVect)
60−
61−prepareBenchVectorOpt :: IO ()
62−prepareBenchVectorOpt = evaluate (rknf bigMap)
benchmark/Spec.hsnew file+53
@@ -0,0 +1,53 @@
1+-- | Specification of the benchmarks.
2+-- This module keeps a list of all bencharks, this way
3+-- we can group benchmark by the interesting function, not
4+-- by the implementation.
5+module Spec
6+ ( BenchSpec(..)
7+ ) where
8+
9+import Criterion
10+
11+-- | List of benchmarks that each module should provide.
12+-- If implementation can express the benchmark then it
13+-- can return @Nothing@ in that benchmark.
14+--
15+-- Map should contain elements from @1@ to @size of map@
16+-- inserted in ascending order (later that requirement may
17+-- change).
18+data BenchSpec = BenchSpec
19+ { benchLookup :: Maybe (String -> Benchmark)
20+ -- ^ Basic lookup we look 10 values inside 10k map.
21+ --
22+ -- Implementation may look like:
23+ -- @
24+ -- tenLookups :: TypeRepMap (Proxy :: Nat -> *)
25+ -- -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
26+ -- , Proxy 50, Proxy 60, Proxy 70, Proxy 80
27+ -- )
28+ -- tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
29+ -- @
30+ , benchInsertSmall :: Maybe (String -> Benchmark)
31+ -- ^ Insert 10 elements into an empty map.
32+ --
33+ -- Implementation may look like:
34+ -- @
35+ -- inserts :: forall a . (KnownNat a)
36+ -- => TypeRepMap (Proxy :: Nat -> *)
37+ -- -> Int
38+ -- -> Proxy (a :: Nat)
39+ -- -> TypeRepMap (Proxy :: Nat -> *)
40+ -- inserts !c 0 _ = c
41+ -- inserts !c n x = inserts (insert x c) (n-1) (Proxy :: Proxy (a+1))
42+ -- @
43+ , benchInsertBig :: Maybe (String -> Benchmark)
44+ -- ^ Insert 10 elements into a big map. Implementation is like
45+ -- a small map, but should insert values into 10k elements map.
46+ , benchUpdateSmall :: Maybe (String -> Benchmark)
47+ -- ^ Insert 10 elements into map of 10 elements, where each key
48+ -- was already inserted in the map
49+ , benchUpdateBig :: Maybe (String -> Benchmark)
50+ -- ^ Insert 10 elements into map of 10k elements, where each key
51+ -- was already inserted in the map
52+ }
53+
src/Data/TypeRepMap/Internal.hs+4
@@ -25,6 +25,7 @@ import Prelude hiding (lookup)
25
25
26import Control.Monad.ST (ST, runST)
26import Control.Monad.ST (ST, runST)
27import Control.Monad.Zip (mzip)
27import Control.Monad.Zip (mzip)
28+import Control.DeepSeq
28import Data.Function (on)
29import Data.Function (on)
29import Data.Kind (Type)
30import Data.Kind (Type)
30import Data.List (intercalate, nubBy)
31import Data.List (intercalate, nubBy)
@@ -74,6 +75,9 @@ data TypeRepMap (f :: k -> Type) =
74 }
75 }
75 -- ^ an unsafe constructor for 'TypeRepMap'
76 -- ^ an unsafe constructor for 'TypeRepMap'
76
77
78+instance NFData (TypeRepMap f) where
79+ rnf x = rnf (keys x) `seq` ()
80+
77-- | Shows only keys.
81-- | Shows only keys.
78instance Show (TypeRepMap f) where
82instance Show (TypeRepMap f) where
79 show TypeRepMap{..} = "TypeRepMap [" ++ showKeys ++ "]"
83 show TypeRepMap{..} = "TypeRepMap [" ++ showKeys ++ "]"
typerep-extra-impls/Data/TypeRep/CMap.hs+4
@@ -12,6 +12,7 @@ module Data.TypeRep.CMap
12
12
13import Prelude hiding (lookup)
13import Prelude hiding (lookup)
14
14
15+import Control.DeepSeq
15import Data.Proxy (Proxy (..))
16import Data.Proxy (Proxy (..))
16import Data.Typeable (TypeRep, Typeable, typeRep)
17import Data.Typeable (TypeRep, Typeable, typeRep)
17import GHC.Base (Any)
18import GHC.Base (Any)
@@ -24,6 +25,9 @@ newtype TypeRepMap (f :: k -> *) = TypeRepMap
24 { unMap :: LMap.Map TypeRep Any
25 { unMap :: LMap.Map TypeRep Any
25 }
26 }
26
27
28+instance NFData (TypeRepMap f) where
29+ rnf x = rnf (keys x) `seq` ()
30+
27-- | Empty structure.
31-- | Empty structure.
28empty :: TypeRepMap f
32empty :: TypeRepMap f
29empty = TypeRepMap mempty
33empty = TypeRepMap mempty
typerep-extra-impls/Data/TypeRep/OptimalVector.hs+4
@@ -23,6 +23,7 @@ module Data.TypeRep.OptimalVector
23import Prelude hiding (lookup)
23import Prelude hiding (lookup)
24
24
25import Control.Arrow ((&&&))
25import Control.Arrow ((&&&))
26+import Control.DeepSeq
26import Data.Kind (Type)
27import Data.Kind (Type)
27import Data.Proxy (Proxy (..))
28import Data.Proxy (Proxy (..))
28import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
29import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
@@ -41,6 +42,9 @@ data TypeRepMap (f :: k -> Type) = TypeRepMap
41 , anys :: V.Vector Any
42 , anys :: V.Vector Any
42 }
43 }
43
44
45+instance NFData (TypeRepMap f) where
46+ rnf x = x `seq` ()
47+
44fromAny :: Any -> f a
48fromAny :: Any -> f a
45fromAny = unsafeCoerce
49fromAny = unsafeCoerce
46
50
typerep-map.cabal+4
@@ -45,6 +45,7 @@ library
45 , containers >= 0.5.10.2 && < 0.7
45 , containers >= 0.5.10.2 && < 0.7
46 , ghc-prim ^>= 0.5.1.1
46 , ghc-prim ^>= 0.5.1.1
47 , primitive ^>= 0.6.4
47 , primitive ^>= 0.6.4
48+ , deepseq ^>= 1.4
48 default-extensions: OverloadedStrings
49 default-extensions: OverloadedStrings
49 RecordWildCards
50 RecordWildCards
50 ScopedTypeVariables
51 ScopedTypeVariables
@@ -60,6 +61,7 @@ library typerep-extra-impls
60 build-depends: base >= 4.10 && < 5
61 build-depends: base >= 4.10 && < 5
61 , containers >= 0.5.10.2 && < 0.7
62 , containers >= 0.5.10.2 && < 0.7
62 , vector ^>= 0.12.0.1
63 , vector ^>= 0.12.0.1
64+ , deepseq ^>= 1.4
63 default-extensions: OverloadedStrings
65 default-extensions: OverloadedStrings
64 RecordWildCards
66 RecordWildCards
65 ScopedTypeVariables
67 ScopedTypeVariables
@@ -101,6 +103,7 @@ benchmark typerep-map-benchmark
101 main-is: Main.hs
103 main-is: Main.hs
102 other-modules: CMap
104 other-modules: CMap
103 , CacheMap
105 , CacheMap
106+ , Spec
104 , Vector
107 , Vector
105 , OptimalVector
108 , OptimalVector
106 build-depends: base >= 4.10 && < 5
109 build-depends: base >= 4.10 && < 5
@@ -115,5 +118,6 @@ benchmark typerep-map-benchmark
115 RecordWildCards
118 RecordWildCards
116 ScopedTypeVariables
119 ScopedTypeVariables
117 TypeApplications
120 TypeApplications
121+ BangPatterns
118 if impl(ghc >= 8.2.2)
122 if impl(ghc >= 8.2.2)
119 other-modules: DMap
123 other-modules: DMap