git.iko.soy/typerep-map
on main help sign in
[#90] Check more ghc warnings through ghc-options (#91)
22af858Veronika Romashkina
benchmark/CMap.hs+46−39
compare with main
unifiedsplit
@@ -1,70 +1,77 @@
1+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
2+
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE UndecidableInstances #-}
7{-# LANGUAGE UndecidableInstances #-}
8
8
9−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10−
11module CMap
9module CMap
12− ( spec
10+ ( spec
13− ) where
11+ ) where
14−
15−import Criterion.Main (bench, nf, env, whnf)
16
12
17import Prelude hiding (lookup)
13import Prelude hiding (lookup)
18
14
19−import Spec
15+import Criterion.Main (bench, env, nf, whnf)
16+import Data.Kind (Type)
20import Data.Maybe (fromJust)
17import Data.Maybe (fromJust)
21import Data.Proxy (Proxy (..))
18import Data.Proxy (Proxy (..))
22import Data.Typeable (Typeable)
19import Data.Typeable (Typeable)
23−import GHC.TypeLits
20+import GHC.TypeLits (type (+), KnownNat, Nat)
24
21
25import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, lookup)
22import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, lookup)
26
23
24+import Spec (BenchSpec (..))
25+
26+
27spec :: BenchSpec
27spec :: BenchSpec
28spec = BenchSpec
28spec = BenchSpec
29− { benchLookup = Just $ \name ->
29+ { benchLookup = Just $ \name ->
30− env (mkMap 10000) $ \ ~bigMap ->
30+ env (mkMap 10000) $ \ ~bigMap ->
31− bench name $ nf tenLookups bigMap
31+ bench name $ nf tenLookups bigMap
32− , benchInsertSmall = Just $ \name ->
32+ , benchInsertSmall = Just $ \name ->
33− bench name $ whnf (inserts empty 10) (Proxy @ 99999)
33+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
34− , benchInsertBig = Just $ \name ->
34+ , benchInsertBig = Just $ \name ->
35− env (mkMap 10000) $ \ ~(bigMap) ->
35+ env (mkMap 10000) $ \ ~bigMap ->
36− bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
36+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
37− , benchUpdateSmall = Just $ \name ->
37+ , benchUpdateSmall = Just $ \name ->
38− env (mkMap 10) $ \ ~(smallMap) ->
38+ env (mkMap 10) $ \ ~smallMap ->
39− bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
39+ bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
40− , benchUpdateBig = Just $ \name ->
40+ , benchUpdateBig = Just $ \name ->
41− env (mkMap 10000) $ \ ~(bigMap) ->
41+ env (mkMap 10000) $ \ ~bigMap ->
42− bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
42+ bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
43− }
43+ }
44
44
45+tenLookups
45−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
46+ :: TypeRepMap (Proxy :: Nat -> Type)
46− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
47+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
47− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
48+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
48− )
49+ )
49tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
50tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
50 where
51 where
51 lp :: forall (a::Nat). Typeable a => Proxy a
52 lp :: forall (a::Nat). Typeable a => Proxy a
52 lp = fromJust $ lookup tmap
53 lp = fromJust $ lookup tmap
53
54
55+inserts
54−inserts :: forall a . (KnownNat a)
56+ :: forall a . (KnownNat a)
55− => TypeRepMap (Proxy :: Nat -> *)
57+ => TypeRepMap (Proxy :: Nat -> Type)
56− -> Int
58+ -> Int
57− -> Proxy (a :: Nat)
59+ -> Proxy (a :: Nat)
58− -> TypeRepMap (Proxy :: Nat -> *)
60+ -> TypeRepMap (Proxy :: Nat -> Type)
59inserts !c 0 _ = c
61inserts !c 0 _ = c
60inserts !c n x = inserts
62inserts !c n x = inserts
61− (insert x c)
63+ (insert x c)
62− (n-1)
64+ (n-1)
63− (Proxy :: Proxy (a+1))
65+ (Proxy :: Proxy (a+1))
64
66
65−mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> *))
67+mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
66mkMap n = pure $ buildBigMap n (Proxy :: Proxy 0) empty
68mkMap n = pure $ buildBigMap n (Proxy :: Proxy 0) empty
67
69
68−buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> TypeRepMap (Proxy :: Nat -> *) -> TypeRepMap (Proxy :: Nat -> *)
70+buildBigMap
71+ :: forall a . (KnownNat a)
72+ => Int
73+ -> Proxy (a :: Nat)
74+ -> TypeRepMap (Proxy :: Nat -> Type)
75+ -> TypeRepMap (Proxy :: Nat -> Type)
69buildBigMap 1 x = insert x
76buildBigMap 1 x = insert x
70buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
77buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
benchmark/CacheMap.hs+48−45
@@ -1,76 +1,79 @@
1+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
2+
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE UndecidableInstances #-}
7{-# LANGUAGE UndecidableInstances #-}
8
8
9−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10−
11module CacheMap
9module CacheMap
12− ( spec
10+ ( spec
13− ) where
11+ ) where
14−
15−import Criterion.Main (bench, nf, whnf, env)
16−import Spec
17
12
18import Prelude hiding (lookup)
13import Prelude hiding (lookup)
19
14
15+import Criterion.Main (bench, env, nf, whnf)
16+import Data.Kind (Type)
20import Data.Maybe (fromJust)
17import Data.Maybe (fromJust)
21import Data.Proxy (Proxy (..))
18import Data.Proxy (Proxy (..))
22import Data.Typeable (Typeable)
19import Data.Typeable (Typeable)
23import GHC.Exts (fromList)
20import GHC.Exts (fromList)
24−import GHC.TypeLits
21+import GHC.TypeLits (type (+), KnownNat, Nat)
22+
23+import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), empty, insert, lookup)
24+
25+import Spec (BenchSpec (..))
25
26
26−import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), lookup, insert, empty)
27
27
28spec :: BenchSpec
28spec :: BenchSpec
29spec = BenchSpec
29spec = BenchSpec
30− { benchLookup = Just $ \name ->
30+ { benchLookup = Just $ \name ->
31− env (mkMap 10000) $ \ ~bigMap ->
31+ env (mkMap 10000) $ \ ~bigMap ->
32− bench name $ nf tenLookups bigMap
32+ bench name $ nf tenLookups bigMap
33− , benchInsertSmall = Just $ \name ->
33+ , benchInsertSmall = Just $ \name ->
34− bench name $ whnf (inserts empty 10) (Proxy @ 99999)
34+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
35− , benchInsertBig = Just $ \name ->
35+ , benchInsertBig = Just $ \name ->
36− env (mkMap 10000) $ \ ~(bigMap) ->
36+ env (mkMap 10000) $ \ ~bigMap ->
37− bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
37+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
38− , benchUpdateSmall = Just $ \name ->
38+ , benchUpdateSmall = Just $ \name ->
39− env (mkMap 10) $ \ ~(smallMap) ->
39+ env (mkMap 10) $ \ ~smallMap ->
40− bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
40+ bench name $ whnf (inserts smallMap 10) (Proxy @ 0)
41− , benchUpdateBig = Just $ \name ->
41+ , benchUpdateBig = Just $ \name ->
42− env (mkMap 10000) $ \ ~(bigMap) ->
42+ env (mkMap 10000) $ \ ~bigMap ->
43− bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
43+ bench name $ whnf (inserts bigMap 10) (Proxy @ 0)
44− }
44+ }
45
45
46+tenLookups
46−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
47+ :: TypeRepMap (Proxy :: Nat -> Type)
47− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
48+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
48− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
49+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
49− )
50+ )
50tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
51tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
51 where
52 where
52− lp :: forall (a::Nat). Typeable a => Proxy a
53+ lp :: forall (a :: Nat) . Typeable a => Proxy a
53 lp = fromJust $ lookup tmap
54 lp = fromJust $ lookup tmap
54
55
56+inserts
55−inserts :: forall a . (KnownNat a)
57+ :: forall a . (KnownNat a)
56− => TypeRepMap (Proxy :: Nat -> *)
58+ => TypeRepMap (Proxy :: Nat -> Type)
57− -> Int
59+ -> Int
58− -> Proxy (a :: Nat)
60+ -> Proxy (a :: Nat)
59− -> TypeRepMap (Proxy :: Nat -> *)
61+ -> TypeRepMap (Proxy :: Nat -> Type)
60inserts !c 0 _ = c
62inserts !c 0 _ = c
61inserts !c n x = inserts
63inserts !c n x = inserts
62− (insert x c)
64+ (insert x c)
63− (n-1)
65+ (n-1)
64− (Proxy :: Proxy (a+1))
66+ (Proxy :: Proxy (a + 1))
65
67
66−mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> *))
68+mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
67mkMap n = pure $ fromList $ buildBigMap n (Proxy :: Proxy 0) []
69mkMap n = pure $ fromList $ buildBigMap n (Proxy :: Proxy 0) []
68
70
69
71
72+buildBigMap
70−buildBigMap :: forall a . (KnownNat a)
73+ :: forall a . (KnownNat a)
71− => Int
74+ => Int
72− -> Proxy (a :: Nat)
75+ -> Proxy (a :: Nat)
73− -> [WrapTypeable (Proxy :: Nat -> *)]
76+ -> [WrapTypeable (Proxy :: Nat -> Type)]
74− -> [WrapTypeable (Proxy :: Nat -> *)]
77+ -> [WrapTypeable (Proxy :: Nat -> Type)]
75buildBigMap 1 x = (WrapTypeable x :)
78buildBigMap 1 x = (WrapTypeable x :)
76buildBigMap n x = (WrapTypeable x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
79buildBigMap n x = (WrapTypeable x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
benchmark/DMap.hs+45−42
@@ -1,79 +1,81 @@
1+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
2+
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3{-# LANGUAGE InstanceSigs #-}
4{-# LANGUAGE InstanceSigs #-}
4−{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE PolyKinds #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE UndecidableInstances #-}
8{-# LANGUAGE UndecidableInstances #-}
9
9
10−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11−
12module DMap
10module DMap
13− ( spec
11+ ( spec
14− ) where
12+ ) where
15−
16−import Criterion.Main (bench, env, nf, whnf)
17
13
18import Prelude hiding (lookup)
14import Prelude hiding (lookup)
19
15
20import Control.DeepSeq (NFData (..))
16import Control.DeepSeq (NFData (..))
17+import Criterion.Main (bench, env, nf, whnf)
18+import Data.Kind (Type)
21import Data.Maybe (fromJust)
19import Data.Maybe (fromJust)
22import Data.Proxy (Proxy (..))
20import Data.Proxy (Proxy (..))
23−import GHC.TypeLits
21+import GHC.TypeLits (type (+), KnownNat, Nat)
24−import Spec
25import Type.Reflection (TypeRep, Typeable, typeRep)
22import Type.Reflection (TypeRep, Typeable, typeRep)
26import Type.Reflection.Unsafe (typeRepFingerprint)
23import Type.Reflection.Unsafe (typeRepFingerprint)
27
24
28import Data.Dependent.Map (DMap, empty, insert, keys, lookup)
25import Data.Dependent.Map (DMap, empty, insert, keys, lookup)
29import Data.Some (Some (Some))
26import Data.Some (Some (Some))
30
27
31−type TypeRepMap = DMap TypeRep
28+import Spec (BenchSpec (..))
32
29
33
30
31+type TypeRepMap = DMap TypeRep
32+
34spec :: BenchSpec
33spec :: BenchSpec
35spec = BenchSpec
34spec = BenchSpec
36− { benchLookup = Just $ \name ->
35+ { benchLookup = Just $ \name ->
37− env mkBigMap $ \ ~(DMapNF bigMap) ->
36+ env mkBigMap $ \ ~(DMapNF bigMap) ->
38− bench name $ nf tenLookups bigMap
37+ bench name $ nf tenLookups bigMap
39− , benchInsertSmall = Just $ \name ->
38+ , benchInsertSmall = Just $ \name ->
40− bench name $ whnf (inserts empty 10) (Proxy @ 99999)
39+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
41− , benchInsertBig = Just $ \name ->
40+ , benchInsertBig = Just $ \name ->
42− env mkBigMap $ \ ~(DMapNF bigMap) ->
41+ env mkBigMap $ \ ~(DMapNF bigMap) ->
43− bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
42+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
44− , benchUpdateSmall = Nothing -- Not implemented
43+ , benchUpdateSmall = Nothing -- Not implemented
45− , benchUpdateBig = Nothing -- Not implemented
44+ , benchUpdateBig = Nothing -- Not implemented
46− }
45+ }
47
46
47+tenLookups
48−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
48+ :: TypeRepMap (Proxy :: Nat -> Type)
49− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
49+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
50− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
50+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
51− )
51+ )
52tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
52tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
53 where
53 where
54 lp :: forall (a :: Nat) . Typeable a => Proxy a
54 lp :: forall (a :: Nat) . Typeable a => Proxy a
55 lp = fromJust $ lookup (typeRep @a) tmap
55 lp = fromJust $ lookup (typeRep @a) tmap
56
56
57+inserts
57−inserts :: forall a . (KnownNat a)
58+ :: forall a . (KnownNat a)
58− => TypeRepMap (Proxy :: Nat -> *)
59+ => TypeRepMap (Proxy :: Nat -> Type)
59− -> Int
60+ -> Int
60− -> Proxy (a :: Nat)
61+ -> Proxy (a :: Nat)
61− -> TypeRepMap (Proxy :: Nat -> *)
62+ -> TypeRepMap (Proxy :: Nat -> Type)
62inserts !c 0 _ = c
63inserts !c 0 _ = c
63inserts !c n x = inserts
64inserts !c n x = inserts
64− (insert (typeRep @ a) x c)
65+ (insert (typeRep @ a) x c)
65− (n-1)
66+ (n-1)
66− (Proxy :: Proxy (a+1))
67+ (Proxy :: Proxy (a+1))
67
68
68-- TypeRepMap of 10000 elements
69-- TypeRepMap of 10000 elements
69−mkBigMap :: IO (DMapNF (Proxy :: Nat -> *))
70+mkBigMap :: IO (DMapNF (Proxy :: Nat -> Type))
70mkBigMap = pure . DMapNF $ buildBigMap 10000 (Proxy :: Proxy 0) empty
71mkBigMap = pure . DMapNF $ buildBigMap 10000 (Proxy :: Proxy 0) empty
71
72
73+buildBigMap
72−buildBigMap :: forall a . (KnownNat a)
74+ :: forall a . (KnownNat a)
73− => Int
75+ => Int
74− -> Proxy (a :: Nat)
76+ -> Proxy (a :: Nat)
75− -> TypeRepMap (Proxy :: Nat -> *)
77+ -> TypeRepMap (Proxy :: Nat -> Type)
76− -> TypeRepMap (Proxy :: Nat -> *)
78+ -> TypeRepMap (Proxy :: Nat -> Type)
77buildBigMap 1 x = insert (typeRep @a) x
79buildBigMap 1 x = insert (typeRep @a) x
78buildBigMap n x = insert (typeRep @a) x
80buildBigMap n x = insert (typeRep @a) x
79 . buildBigMap (n - 1) (Proxy @(a + 1))
81 . buildBigMap (n - 1) (Proxy @(a + 1))
@@ -82,5 +84,6 @@ buildBigMap n x = insert (typeRep @a) x
82newtype DMapNF f = DMapNF (TypeRepMap f)
84newtype DMapNF f = DMapNF (TypeRepMap f)
83
85
84instance NFData (DMapNF f) where
86instance NFData (DMapNF f) where
87+ rnf :: DMapNF f -> ()
85− rnf (DMapNF x) =
88+ rnf (DMapNF x) =
86− rnf . map (\(Some t) -> typeRepFingerprint t) $ keys x
89+ rnf . map (\(Some t) -> typeRepFingerprint t) $ keys x
benchmark/Main.hs+37−32
@@ -1,47 +1,52 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2
2
3−module Main where
3+module Main
4+ ( main
5+ ) where
4
6
5−import Criterion.Main (defaultMain, bgroup)
7+import Criterion.Main (bgroup, defaultMain)
8+
9+import Spec (BenchSpec (..))
6
10
7−import Spec
8−import qualified CMap
9import qualified CacheMap
11import qualified CacheMap
12+import qualified CMap
10#if ( __GLASGOW_HASKELL__ >= 802 )
13#if ( __GLASGOW_HASKELL__ >= 802 )
11import qualified DMap
14import qualified DMap
12#endif
15#endif
13import qualified OptimalVector as OptVec
16import qualified OptimalVector as OptVec
14
17
18+
15main :: IO ()
19main :: IO ()
16main = do
20main = do
17− let specs = [("CMap", CMap.spec)
21+ let specs = [("CMap", CMap.spec)
18− ,("CacheMap", CacheMap.spec)
22+ ,("CacheMap", CacheMap.spec)
19#if ( __GLASGOW_HASKELL__ >= 802 )
23#if ( __GLASGOW_HASKELL__ >= 802 )
20− , ("DMap", DMap.spec)
24+ , ("DMap", DMap.spec)
21#endif
25#endif
22− , ("OptVec", OptVec.spec)
26+ , ("OptVec", OptVec.spec)
23− ]
27+ ]
24− -- This code creates a benchmark group. Given a getter
28+ {- This code creates a benchmark group. Given a getter
25− -- (that is test description) it gets a benchmark generation
29+ (that is test description) it gets a benchmark generation
26− -- function from each module spec. Benchmark generation
30+ function from each module spec. Benchmark generation
27− -- function takes a label and generate benchmarks. It's
31+ function takes a label and generate benchmarks. It's
28− -- possible to introduce parameters passing in the same way.
32+ possible to introduce parameters passing in the same way.
33+ --}
29− mkGroup getBenchmark =
34+ let mkGroup getBenchmark =
30− [ mkBenchmark label
35+ [ mkBenchmark label
31− | (label, spec) <- specs
36+ | (label, spec) <- specs
32− -- Here we use pure to force pattern matching in List
37+ -- Here we use pure to force pattern matching in List
33− -- then in case of pattern match failure `mzero` will
38+ -- then in case of pattern match failure `mzero` will
34− -- be called, so benchmark will be ignored.
39+ -- be called, so benchmark will be ignored.
35− , Just mkBenchmark <- pure $ getBenchmark spec
40+ , Just mkBenchmark <- pure $ getBenchmark spec
41+ ]
42+ defaultMain
43+ [ bgroup "lookup" $ mkGroup benchLookup
44+ , bgroup "insert"
45+ [ bgroup "10 elements to empty" $ mkGroup benchInsertSmall
46+ , bgroup "1 element to big map" $ mkGroup benchInsertBig
47+ ]
48+ , bgroup "update"
49+ [ bgroup "10 elements to empty" $ mkGroup benchUpdateSmall
50+ , bgroup "1 element to big map" $ mkGroup benchUpdateBig
51+ ]
36 ]
52 ]
37− defaultMain
38− [ bgroup "lookup" $ mkGroup benchLookup
39− , bgroup "insert"
40− [ bgroup "10 elements to empty" $ mkGroup benchInsertSmall
41− , bgroup "1 element to big map" $ mkGroup benchInsertBig
42− ]
43− , bgroup "update"
44− [ bgroup "10 elements to empty" $ mkGroup benchUpdateSmall
45− , bgroup "1 element to big map" $ mkGroup benchUpdateBig
46− ]
47− ]
benchmark/OptimalVector.hs+29−28
@@ -1,59 +1,60 @@
1+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
2+
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE UndecidableInstances #-}
8{-# LANGUAGE UndecidableInstances #-}
9
9
10−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11−
12module OptimalVector
10module OptimalVector
13 ( spec
11 ( spec
14 ) where
12 ) where
15
13
16−import Spec
17−import Criterion.Main (bench, nf, env)
18−
19import Prelude hiding (lookup)
14import Prelude hiding (lookup)
20
15
16+import Criterion.Main (bench, env, nf)
17+import Data.Kind (Type)
21import Data.Maybe (fromJust)
18import Data.Maybe (fromJust)
22import Data.Proxy (Proxy (..))
19import Data.Proxy (Proxy (..))
23import Data.Typeable (Typeable)
20import Data.Typeable (Typeable)
24−import GHC.TypeLits
21+import GHC.TypeLits (type (+), KnownNat, Nat)
25
22
26import Data.TypeRep.OptimalVector (TF (..), TypeRepMap (..), fromList, lookup)
23import Data.TypeRep.OptimalVector (TF (..), TypeRepMap (..), fromList, lookup)
27
24
25+import Spec (BenchSpec (..))
26+
27+
28spec :: BenchSpec
28spec :: BenchSpec
29spec = BenchSpec
29spec = BenchSpec
30− { benchLookup = Just $ \name ->
30+ { benchLookup = Just $ \name ->
31− env mkBigMap $ \ ~bigMap ->
31+ env mkBigMap $ \ ~bigMap ->
32− bench name $ nf tenLookups bigMap
32+ bench name $ nf tenLookups bigMap
33− , benchInsertSmall = Nothing -- Not implemented
33+ , benchInsertSmall = Nothing -- Not implemented
34− , benchInsertBig = Nothing -- Not implemented
34+ , benchInsertBig = Nothing -- Not implemented
35− , benchUpdateSmall = Nothing -- Not implemented
35+ , benchUpdateSmall = Nothing -- Not implemented
36− , benchUpdateBig = Nothing -- Not implemented
36+ , benchUpdateBig = Nothing -- Not implemented
37− }
37+ }
38−
38+
39+tenLookups
39−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
40+ :: TypeRepMap (Proxy :: Nat -> Type)
40− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
41+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
41− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
42+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
42− )
43+ )
43tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
44tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
44 where
45 where
45 lp :: forall (a::Nat). Typeable a => Proxy a
46 lp :: forall (a::Nat). Typeable a => Proxy a
46 lp = fromJust $ lookup tmap
47 lp = fromJust $ lookup tmap
47
48
48-- TypeRepMap of 10000 elements
49-- TypeRepMap of 10000 elements
49−mkBigMap :: IO (TypeRepMap (Proxy :: Nat -> *))
50+mkBigMap :: IO (TypeRepMap (Proxy :: Nat -> Type))
50mkBigMap = pure $ fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
51mkBigMap = pure $ fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
51
52
53+buildBigMap
52−buildBigMap :: forall a . (KnownNat a)
54+ :: forall a . (KnownNat a)
53− => Int
55+ => Int
54− -> Proxy (a :: Nat)
56+ -> Proxy (a :: Nat)
55− -> [TF (Proxy :: Nat -> *)]
57+ -> [TF (Proxy :: Nat -> Type)]
56− -> [TF (Proxy :: Nat -> *)]
58+ -> [TF (Proxy :: Nat -> Type)]
57buildBigMap 1 x = (TF x :)
59buildBigMap 1 x = (TF x :)
58buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
60buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
59−
benchmark/Spec.hs+61−50
@@ -1,53 +1,64 @@
1−-- | Specification of the benchmarks.
1+{- | Specification of the benchmarks.
2+
2−-- This module keeps a list of all bencharks, this way
3+This module keeps a list of all bencharks, this way
3−-- we can group benchmark by the interesting function, not
4+we can group benchmark by the interesting function, not
4−-- by the implementation.
5+by the implementation.
6+-}
5module Spec
7module Spec
6− ( BenchSpec(..)
8+ ( BenchSpec(..)
7− ) where
9+ ) where
8−
10+
9−import Criterion
11+import Criterion (Benchmark)
10−
12+
13+
11−-- | List of benchmarks that each module should provide.
14+{- | List of benchmarks that each module should provide.
12−-- If implementation can express the benchmark then it
15+If implementation can express the benchmark then it
13−-- can return @Nothing@ in that benchmark.
16+can return @Nothing@ in that benchmark.
14−--
17+
15−-- Map should contain elements from @1@ to @size of map@
18+Map should contain elements from @1@ to @size of map@
16−-- inserted in ascending order (later that requirement may
19+inserted in ascending order (later that requirement may
17−-- change).
20+change).
21+-}
18data BenchSpec = BenchSpec
22data BenchSpec = BenchSpec
19− { benchLookup :: Maybe (String -> Benchmark)
20− -- ^ Basic lookup we look 10 values inside 10k map.
23+ { {- | Basic lookup we look 10 values inside 10k map.
21− --
24+
22− -- Implementation may look like:
25+ Implementation may look like:
26+
23− -- @
27+ @
24− -- tenLookups :: TypeRepMap (Proxy :: Nat -> *)
28+ tenLookups :: TypeRepMap (Proxy :: Nat -> *)
25− -- -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
29+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
26− -- , Proxy 50, Proxy 60, Proxy 70, Proxy 80
30+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
27− -- )
31+ )
28− -- tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
32+ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
29− -- @
33+ @
34+ -}
30− , benchInsertSmall :: Maybe (String -> Benchmark)
35+ benchLookup :: Maybe (String -> Benchmark)
31− -- ^ Insert 10 elements into an empty map.
36+ {- ^ Insert 10 elements into an empty map.
32− --
37+
33− -- Implementation may look like:
38+ 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
39
40+ @
41+ inserts
42+ :: forall a . (KnownNat a)
43+ => TypeRepMap (Proxy :: Nat -> *)
44+ -> Int
45+ -> Proxy (a :: Nat)
46+ -> TypeRepMap (Proxy :: Nat -> *)
47+ inserts !c 0 _ = c
48+ inserts !c n x = inserts (insert x c) (n-1) (Proxy :: Proxy (a+1))
49+ @
50+ -}
51+ , benchInsertSmall :: Maybe (String -> Benchmark)
52+ {- ^ Insert 10 elements into a big map. Implementation is like
53+ a small map, but should insert values into 10k elements map.
54+ -}
55+ , benchInsertBig :: Maybe (String -> Benchmark)
56+ {- ^ Insert 10 elements into map of 10 elements, where each key
57+ was already inserted in the map
58+ -}
59+ , benchUpdateSmall :: Maybe (String -> Benchmark)
60+ {- ^ Insert 10 elements into map of 10k elements, where each key
61+ was already inserted in the map
62+ -}
63+ , benchUpdateBig :: Maybe (String -> Benchmark)
64+ }
benchmark/Vector.hs+23−22
@@ -1,31 +1,30 @@
1+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
2+
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE UndecidableInstances #-}
8{-# LANGUAGE UndecidableInstances #-}
9
9
10−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11−
12module Vector
10module Vector
13− ( benchVector
11+ ( benchVector
14− , prepareBenchVector
12+ , prepareBenchVector
15− ) where
13+ ) where
16−
17−import Criterion.Main (Benchmark, bench, bgroup, nf)
18
14
19import Prelude hiding (lookup)
15import Prelude hiding (lookup)
20
16
21import Control.DeepSeq (rnf)
17import Control.DeepSeq (rnf)
22−import Control.Exception
18+import Control.Exception (evaluate)
19+import Criterion.Main (Benchmark, bench, bgroup, nf)
20+import Data.Kind (Type)
23import Data.Maybe (fromJust)
21import Data.Maybe (fromJust)
24import Data.Proxy (Proxy (..))
22import Data.Proxy (Proxy (..))
25import Data.Typeable (Typeable)
23import Data.Typeable (Typeable)
26−import GHC.TypeLits
24+import GHC.TypeLits (type (+), KnownNat, Nat)
25+
26+import Data.TypeRep.Vector (TF (..), TypeRepVector, fingerprints, fromList, lookup)
27
27
28−import Data.TypeRep.Vector
29
28
30benchVector :: Benchmark
29benchVector :: Benchmark
31benchVector = bgroup "vector"
30benchVector = bgroup "vector"
@@ -34,24 +33,26 @@ benchVector = bgroup "vector"
34 -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
33 -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
35 ]
34 ]
36
35
36+tenLookups
37−tenLookups :: TypeRepVector (Proxy :: Nat -> *)
37+ :: TypeRepVector (Proxy :: Nat -> Type)
38− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
38+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
39− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
39+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
40− )
40+ )
41tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
41tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
42 where
42 where
43 lp :: forall (a::Nat). Typeable a => Proxy a
43 lp :: forall (a::Nat). Typeable a => Proxy a
44 lp = fromJust $ lookup tmap
44 lp = fromJust $ lookup tmap
45
45
46-- TypeRepMap of 10000 elements
46-- TypeRepMap of 10000 elements
47−bigMap :: TypeRepVector (Proxy :: Nat -> *)
47+bigMap :: TypeRepVector (Proxy :: Nat -> Type)
48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
49
49
50+buildBigMap
50−buildBigMap :: forall a . (KnownNat a)
51+ :: forall a . (KnownNat a)
51− => Int
52+ => Int
52− -> Proxy (a :: Nat)
53+ -> Proxy (a :: Nat)
53− -> [TF (Proxy :: Nat -> *)]
54+ -> [TF (Proxy :: Nat -> Type)]
54− -> [TF (Proxy :: Nat -> *)]
55+ -> [TF (Proxy :: Nat -> Type)]
55buildBigMap 1 x = (TF x :)
56buildBigMap 1 x = (TF x :)
56buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
57buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
57
58
src/Data/TMap.hs+1−1
@@ -170,5 +170,5 @@ adjust :: Typeable a => (a -> a) -> TMap -> TMap
170adjust f = F.adjust (liftToIdentity f)
170adjust f = F.adjust (liftToIdentity f)
171{-# INLINE adjust #-}
171{-# INLINE adjust #-}
172
172
173−liftToIdentity :: forall a. Typeable a => (a -> a) -> Identity a -> Identity a
173+liftToIdentity :: forall a. (a -> a) -> Identity a -> Identity a
174liftToIdentity = coerce
174liftToIdentity = coerce
src/Data/TypeRepMap/Internal.hs+2−1
@@ -1,10 +1,11 @@
1+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
2+
1{-# LANGUAGE AllowAmbiguousTypes #-}
3{-# LANGUAGE AllowAmbiguousTypes #-}
2{-# LANGUAGE BangPatterns #-}
4{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE CPP #-}
5{-# LANGUAGE CPP #-}
4{-# LANGUAGE DataKinds #-}
6{-# LANGUAGE DataKinds #-}
5{-# LANGUAGE GADTs #-}
7{-# LANGUAGE GADTs #-}
6{-# LANGUAGE InstanceSigs #-}
8{-# LANGUAGE InstanceSigs #-}
7−{-# LANGUAGE KindSignatures #-}
8{-# LANGUAGE MagicHash #-}
9{-# LANGUAGE MagicHash #-}
9{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE Rank2Types #-}
11{-# LANGUAGE Rank2Types #-}
test/Test/TypeRep/TypeRepMapProperty.hs+1−3
@@ -1,7 +1,6 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE PolyKinds #-}
6
5
7{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
6{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
@@ -15,9 +14,8 @@ import Prelude hiding (lookup)
15import Data.Proxy (Proxy (..))
14import Data.Proxy (Proxy (..))
16import Data.Semigroup (Semigroup (..))
15import Data.Semigroup (Semigroup (..))
17import GHC.Exts (fromList)
16import GHC.Exts (fromList)
18−import GHC.Stack (HasCallStack)
19import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
17import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
20−import Hedgehog (MonadGen, PropertyT, assert, forAll, property, (===))
18+import Hedgehog (MonadGen, assert, forAll, (===))
21import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)
19import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)
22import Test.Hspec.Hedgehog (hedgehog)
20import Test.Hspec.Hedgehog (hedgehog)
23
21
typerep-extra-impls/Data/TypeRep/CMap.hs+3−3
@@ -1,5 +1,4 @@
1−{-# LANGUAGE KindSignatures #-}
2−{-# LANGUAGE PolyKinds #-}
1+{-# LANGUAGE PolyKinds #-}
3
2
4{- |
3{- |
5Copyright: (c) 2017-2020 Kowainik
4Copyright: (c) 2017-2020 Kowainik
@@ -21,6 +20,7 @@ module Data.TypeRep.CMap
21import Prelude hiding (lookup)
20import Prelude hiding (lookup)
22
21
23import Control.DeepSeq
22import Control.DeepSeq
23+import Data.Kind (Type)
24import Data.Proxy (Proxy (..))
24import Data.Proxy (Proxy (..))
25import Data.Typeable (TypeRep, Typeable, typeRep)
25import Data.Typeable (TypeRep, Typeable, typeRep)
26import GHC.Base (Any)
26import GHC.Base (Any)
@@ -30,7 +30,7 @@ import qualified Data.Map.Lazy as LMap
30
30
31
31
32-- | Map-like data structure with types served as the keys.
32-- | Map-like data structure with types served as the keys.
33−newtype TypeRepMap (f :: k -> *) = TypeRepMap
33+newtype TypeRepMap (f :: k -> Type) = TypeRepMap
34 { unMap :: LMap.Map TypeRep Any
34 { unMap :: LMap.Map TypeRep Any
35 }
35 }
36
36
typerep-extra-impls/Data/TypeRep/OptimalVector.hs+7−8
@@ -1,9 +1,8 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE KindSignatures #-}
4−{-# LANGUAGE MagicHash #-}
3+{-# LANGUAGE MagicHash #-}
5−{-# LANGUAGE PolyKinds #-}
4+{-# LANGUAGE PolyKinds #-}
6−{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE TypeFamilies #-}
7
6
8{- |
7{- |
9Copyright: (c) 2017-2020 Kowainik
8Copyright: (c) 2017-2020 Kowainik
@@ -62,7 +61,7 @@ empty :: TypeRepMap f
62empty = TypeRepMap mempty mempty mempty
61empty = TypeRepMap mempty mempty mempty
63
62
64-- | Inserts the value with its type as a key.
63-- | Inserts the value with its type as a key.
65−insert :: forall a f . Typeable a => a -> TypeRepMap f -> TypeRepMap f
64+insert :: forall a f . a -> TypeRepMap f -> TypeRepMap f
66insert = undefined
65insert = undefined
67
66
68-- | Looks up the value at the type.
67-- | Looks up the value at the type.
@@ -112,7 +111,7 @@ binarySearch (Fingerprint a b) fpAs fpBs =
112data TF f where
111data TF f where
113 TF :: Typeable a => f a -> TF f
112 TF :: Typeable a => f a -> TF f
114
113
115−fromF :: Typeable a => f a -> Proxy a
114+fromF :: f a -> Proxy a
116fromF _ = Proxy
115fromF _ = Proxy
117
116
118fromList :: forall f . [TF f] -> TypeRepMap f
117fromList :: forall f . [TF f] -> TypeRepMap f
typerep-extra-impls/Data/TypeRep/Vector.hs+2−2
@@ -144,7 +144,7 @@ empty :: TypeRepVector f
144empty = TypeRepVect mempty mempty
144empty = TypeRepVect mempty mempty
145
145
146-- | Inserts the value with its type as a key.
146-- | Inserts the value with its type as a key.
147−insert :: forall a f . Typeable a => a -> TypeRepVector f -> TypeRepVector f
147+insert :: forall a f . a -> TypeRepVector f -> TypeRepVector f
148insert = undefined
148insert = undefined
149
149
150-- | Looks up the value at the type.
150-- | Looks up the value at the type.
@@ -164,7 +164,7 @@ size = Unboxed.length . fingerprints
164data TF f where
164data TF f where
165 TF :: Typeable a => f a -> TF f
165 TF :: Typeable a => f a -> TF f
166
166
167−fromF :: Typeable a => f a -> Proxy a
167+fromF :: f a -> Proxy a
168fromF _ = Proxy
168fromF _ = Proxy
169
169
170fromList :: forall f . [TF f] -> TypeRepVector f
170fromList :: forall f . [TF f] -> TypeRepVector f
typerep-map.cabal+16−1
@@ -48,8 +48,23 @@ common common-options
48 RecordWildCards
48 RecordWildCards
49 ScopedTypeVariables
49 ScopedTypeVariables
50 TypeApplications
50 TypeApplications
51+ ghc-options: -Wall
52+ -Wcompat
53+ -Widentities
54+ -Wincomplete-uni-patterns
55+ -Wincomplete-record-updates
56+ if impl(ghc >= 8.0)
57+ ghc-options: -Wredundant-constraints
58+ if impl(ghc >= 8.2)
59+ ghc-options: -fhide-source-paths
51− if impl(ghc >= 8.8.1)
60+ if impl(ghc >= 8.4)
61+ ghc-options: -Wmissing-export-lists
62+ -Wpartial-fields
63+ if impl(ghc >= 8.8)
52 ghc-options: -Wmissing-deriving-strategies
64 ghc-options: -Wmissing-deriving-strategies
65+ -Werror=missing-deriving-strategies
66+ if impl(ghc >= 8.10)
67+ ghc-options: -Wunused-packages
53
68
54library
69library
55 import: common-options
70 import: common-options