git.iko.soy/typerep-map
on main help sign in
[#90] Check more ghc warnings through ghc-options (#91)

* [#90] Check more ghc warnings through ghc-options Resolves #90 * Clean up LANGUAGE extensions

commit22af85834199e41ec7edefe48a6f45dc3abde751 authorVeronika Romashkina <vrom911@gmail.com> dateSat 18 Apr 2020, 19:51 (6 years ago) parent497e182
14 files changed+321−277
compare with main
unifiedsplit
benchmark/CMap.hs+46−39 benchmark/CacheMap.hs+48−45 benchmark/DMap.hs+45−42 benchmark/Main.hs+37−32 benchmark/OptimalVector.hs+29−28 benchmark/Spec.hs+61−50 benchmark/Vector.hs+23−22 src/Data/TMap.hs+1−1 src/Data/TypeRepMap/Internal.hs+2−1 test/Test/TypeRep/TypeRepMapProperty.hs+1−3 typerep-extra-impls/Data/TypeRep/CMap.hs+3−3 typerep-extra-impls/Data/TypeRep/OptimalVector.hs+7−8 typerep-extra-impls/Data/TypeRep/Vector.hs+2−2 typerep-map.cabal+16−1
benchmark/CMap.hs+46−39
@@ -1,70 +1,77 @@
1+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
2+
13{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
44{-# LANGUAGE PolyKinds #-}
55{-# LANGUAGE TypeFamilies #-}
66{-# LANGUAGE TypeOperators #-}
77{-# LANGUAGE UndecidableInstances #-}
88
9−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10−
119module CMap
12− ( spec
13− ) where
14−
15−import Criterion.Main (bench, nf, env, whnf)
10+ ( spec
11+ ) where
1612
1713import Prelude hiding (lookup)
1814
19−import Spec
15+import Criterion.Main (bench, env, nf, whnf)
16+import Data.Kind (Type)
2017import Data.Maybe (fromJust)
2118import Data.Proxy (Proxy (..))
2219import Data.Typeable (Typeable)
23−import GHC.TypeLits
20+import GHC.TypeLits (type (+), KnownNat, Nat)
2421
2522import Data.TypeRep.CMap (TypeRepMap (..), empty, insert, lookup)
2623
24+import Spec (BenchSpec (..))
25+
26+
2727spec :: BenchSpec
2828spec = BenchSpec
29− { benchLookup = Just $ \name ->
30− env (mkMap 10000) $ \ ~bigMap ->
31− bench name $ nf tenLookups bigMap
32− , benchInsertSmall = Just $ \name ->
33− bench name $ whnf (inserts empty 10) (Proxy @ 99999)
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− }
29+ { benchLookup = Just $ \name ->
30+ env (mkMap 10000) $ \ ~bigMap ->
31+ bench name $ nf tenLookups bigMap
32+ , benchInsertSmall = Just $ \name ->
33+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
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+ }
4444
45−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
46− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
47− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
48− )
45+tenLookups
46+ :: TypeRepMap (Proxy :: Nat -> Type)
47+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
48+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
49+ )
4950tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
5051 where
5152 lp :: forall (a::Nat). Typeable a => Proxy a
5253 lp = fromJust $ lookup tmap
5354
54−inserts :: forall a . (KnownNat a)
55− => TypeRepMap (Proxy :: Nat -> *)
56− -> Int
57− -> Proxy (a :: Nat)
58− -> TypeRepMap (Proxy :: Nat -> *)
55+inserts
56+ :: forall a . (KnownNat a)
57+ => TypeRepMap (Proxy :: Nat -> Type)
58+ -> Int
59+ -> Proxy (a :: Nat)
60+ -> TypeRepMap (Proxy :: Nat -> Type)
5961inserts !c 0 _ = c
6062inserts !c n x = inserts
61− (insert x c)
62− (n-1)
63− (Proxy :: Proxy (a+1))
63+ (insert x c)
64+ (n-1)
65+ (Proxy :: Proxy (a+1))
6466
65−mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> *))
67+mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
6668mkMap n = pure $ buildBigMap n (Proxy :: Proxy 0) empty
6769
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)
6976buildBigMap 1 x = insert x
7077buildBigMap 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+
13{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
44{-# LANGUAGE PolyKinds #-}
55{-# LANGUAGE TypeFamilies #-}
66{-# LANGUAGE TypeOperators #-}
77{-# LANGUAGE UndecidableInstances #-}
88
9−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
10−
119module CacheMap
12− ( spec
13− ) where
14−
15−import Criterion.Main (bench, nf, whnf, env)
16−import Spec
10+ ( spec
11+ ) where
1712
1813import Prelude hiding (lookup)
1914
15+import Criterion.Main (bench, env, nf, whnf)
16+import Data.Kind (Type)
2017import Data.Maybe (fromJust)
2118import Data.Proxy (Proxy (..))
2219import Data.Typeable (Typeable)
2320import 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 (..))
2526
26−import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), lookup, insert, empty)
2727
2828spec :: BenchSpec
2929spec = BenchSpec
30− { benchLookup = Just $ \name ->
31− env (mkMap 10000) $ \ ~bigMap ->
32− bench name $ nf tenLookups bigMap
33− , benchInsertSmall = Just $ \name ->
34− bench name $ whnf (inserts empty 10) (Proxy @ 99999)
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− }
30+ { benchLookup = Just $ \name ->
31+ env (mkMap 10000) $ \ ~bigMap ->
32+ bench name $ nf tenLookups bigMap
33+ , benchInsertSmall = Just $ \name ->
34+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
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+ }
4545
46−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
47− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
48− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
49− )
46+tenLookups
47+ :: TypeRepMap (Proxy :: Nat -> Type)
48+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
49+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
50+ )
5051tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
5152 where
52− lp :: forall (a::Nat). Typeable a => Proxy a
53+ lp :: forall (a :: Nat) . Typeable a => Proxy a
5354 lp = fromJust $ lookup tmap
5455
55−inserts :: forall a . (KnownNat a)
56− => TypeRepMap (Proxy :: Nat -> *)
57− -> Int
58− -> Proxy (a :: Nat)
59− -> TypeRepMap (Proxy :: Nat -> *)
56+inserts
57+ :: forall a . (KnownNat a)
58+ => TypeRepMap (Proxy :: Nat -> Type)
59+ -> Int
60+ -> Proxy (a :: Nat)
61+ -> TypeRepMap (Proxy :: Nat -> Type)
6062inserts !c 0 _ = c
6163inserts !c n x = inserts
62− (insert x c)
63− (n-1)
64− (Proxy :: Proxy (a+1))
64+ (insert x c)
65+ (n-1)
66+ (Proxy :: Proxy (a + 1))
6567
66−mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> *))
68+mkMap :: Int -> IO (TypeRepMap (Proxy :: Nat -> Type))
6769mkMap n = pure $ fromList $ buildBigMap n (Proxy :: Proxy 0) []
6870
6971
70−buildBigMap :: forall a . (KnownNat a)
71− => Int
72− -> Proxy (a :: Nat)
73− -> [WrapTypeable (Proxy :: Nat -> *)]
74− -> [WrapTypeable (Proxy :: Nat -> *)]
72+buildBigMap
73+ :: forall a . (KnownNat a)
74+ => Int
75+ -> Proxy (a :: Nat)
76+ -> [WrapTypeable (Proxy :: Nat -> Type)]
77+ -> [WrapTypeable (Proxy :: Nat -> Type)]
7578buildBigMap 1 x = (WrapTypeable x :)
7679buildBigMap 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+
13{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
34{-# LANGUAGE InstanceSigs #-}
4−{-# LANGUAGE KindSignatures #-}
55{-# LANGUAGE PolyKinds #-}
66{-# LANGUAGE TypeFamilies #-}
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE UndecidableInstances #-}
99
10−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11−
1210module DMap
13− ( spec
14− ) where
15−
16−import Criterion.Main (bench, env, nf, whnf)
11+ ( spec
12+ ) where
1713
1814import Prelude hiding (lookup)
1915
2016import Control.DeepSeq (NFData (..))
17+import Criterion.Main (bench, env, nf, whnf)
18+import Data.Kind (Type)
2119import Data.Maybe (fromJust)
2220import Data.Proxy (Proxy (..))
23−import GHC.TypeLits
24−import Spec
21+import GHC.TypeLits (type (+), KnownNat, Nat)
2522import Type.Reflection (TypeRep, Typeable, typeRep)
2623import Type.Reflection.Unsafe (typeRepFingerprint)
2724
2825import Data.Dependent.Map (DMap, empty, insert, keys, lookup)
2926import Data.Some (Some (Some))
3027
31−type TypeRepMap = DMap TypeRep
28+import Spec (BenchSpec (..))
3229
3330
31+type TypeRepMap = DMap TypeRep
32+
3433spec :: BenchSpec
3534spec = BenchSpec
36− { benchLookup = Just $ \name ->
37− env mkBigMap $ \ ~(DMapNF bigMap) ->
38− bench name $ nf tenLookups bigMap
39− , benchInsertSmall = Just $ \name ->
40− bench name $ whnf (inserts empty 10) (Proxy @ 99999)
41− , benchInsertBig = Just $ \name ->
42− env mkBigMap $ \ ~(DMapNF bigMap) ->
43− bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
44− , benchUpdateSmall = Nothing -- Not implemented
45− , benchUpdateBig = Nothing -- Not implemented
46− }
35+ { benchLookup = Just $ \name ->
36+ env mkBigMap $ \ ~(DMapNF bigMap) ->
37+ bench name $ nf tenLookups bigMap
38+ , benchInsertSmall = Just $ \name ->
39+ bench name $ whnf (inserts empty 10) (Proxy @ 99999)
40+ , benchInsertBig = Just $ \name ->
41+ env mkBigMap $ \ ~(DMapNF bigMap) ->
42+ bench name $ whnf (inserts bigMap 1) (Proxy @ 99999)
43+ , benchUpdateSmall = Nothing -- Not implemented
44+ , benchUpdateBig = Nothing -- Not implemented
45+ }
4746
48−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
49− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
50− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
51− )
47+tenLookups
48+ :: TypeRepMap (Proxy :: Nat -> Type)
49+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
50+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
51+ )
5252tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
5353 where
5454 lp :: forall (a :: Nat) . Typeable a => Proxy a
5555 lp = fromJust $ lookup (typeRep @a) tmap
5656
57−inserts :: forall a . (KnownNat a)
58− => TypeRepMap (Proxy :: Nat -> *)
59− -> Int
60− -> Proxy (a :: Nat)
61− -> TypeRepMap (Proxy :: Nat -> *)
57+inserts
58+ :: forall a . (KnownNat a)
59+ => TypeRepMap (Proxy :: Nat -> Type)
60+ -> Int
61+ -> Proxy (a :: Nat)
62+ -> TypeRepMap (Proxy :: Nat -> Type)
6263inserts !c 0 _ = c
6364inserts !c n x = inserts
64− (insert (typeRep @ a) x c)
65− (n-1)
66− (Proxy :: Proxy (a+1))
65+ (insert (typeRep @ a) x c)
66+ (n-1)
67+ (Proxy :: Proxy (a+1))
6768
6869-- TypeRepMap of 10000 elements
69−mkBigMap :: IO (DMapNF (Proxy :: Nat -> *))
70+mkBigMap :: IO (DMapNF (Proxy :: Nat -> Type))
7071mkBigMap = pure . DMapNF $ buildBigMap 10000 (Proxy :: Proxy 0) empty
7172
72−buildBigMap :: forall a . (KnownNat a)
73− => Int
74− -> Proxy (a :: Nat)
75− -> TypeRepMap (Proxy :: Nat -> *)
76− -> TypeRepMap (Proxy :: Nat -> *)
73+buildBigMap
74+ :: forall a . (KnownNat a)
75+ => Int
76+ -> Proxy (a :: Nat)
77+ -> TypeRepMap (Proxy :: Nat -> Type)
78+ -> TypeRepMap (Proxy :: Nat -> Type)
7779buildBigMap 1 x = insert (typeRep @a) x
7880buildBigMap n x = insert (typeRep @a) x
7981 . buildBigMap (n - 1) (Proxy @(a + 1))
@@ -82,5 +84,6 @@ buildBigMap n x = insert (typeRep @a) x
8284newtype DMapNF f = DMapNF (TypeRepMap f)
8385
8486instance NFData (DMapNF f) where
85− rnf (DMapNF x) =
86− rnf . map (\(Some t) -> typeRepFingerprint t) $ keys x
87+ rnf :: DMapNF f -> ()
88+ rnf (DMapNF x) =
89+ rnf . map (\(Some t) -> typeRepFingerprint t) $ keys x
benchmark/Main.hs+37−32
@@ -1,47 +1,52 @@
11{-# LANGUAGE CPP #-}
22
3−module Main where
3+module Main
4+ ( main
5+ ) where
46
5−import Criterion.Main (defaultMain, bgroup)
7+import Criterion.Main (bgroup, defaultMain)
8+
9+import Spec (BenchSpec (..))
610
7−import Spec
8−import qualified CMap
911import qualified CacheMap
12+import qualified CMap
1013#if ( __GLASGOW_HASKELL__ >= 802 )
1114import qualified DMap
1215#endif
1316import qualified OptimalVector as OptVec
1417
18+
1519main :: IO ()
1620main = do
17− let specs = [("CMap", CMap.spec)
18− ,("CacheMap", CacheMap.spec)
21+ let specs = [("CMap", CMap.spec)
22+ ,("CacheMap", CacheMap.spec)
1923#if ( __GLASGOW_HASKELL__ >= 802 )
20− , ("DMap", DMap.spec)
24+ , ("DMap", DMap.spec)
2125#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
26+ , ("OptVec", OptVec.spec)
27+ ]
28+ {- This code creates a benchmark group. Given a getter
29+ (that is test description) it gets a benchmark generation
30+ function from each module spec. Benchmark generation
31+ function takes a label and generate benchmarks. It's
32+ possible to introduce parameters passing in the same way.
33+ --}
34+ let mkGroup getBenchmark =
35+ [ mkBenchmark label
36+ | (label, spec) <- specs
37+ -- Here we use pure to force pattern matching in List
38+ -- then in case of pattern match failure `mzero` will
39+ -- be called, so benchmark will be ignored.
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+ ]
3652 ]
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+
13{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
44{-# LANGUAGE PolyKinds #-}
55{-# LANGUAGE ScopedTypeVariables #-}
66{-# LANGUAGE TypeFamilies #-}
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE UndecidableInstances #-}
99
10−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11−
1210module OptimalVector
1311 ( spec
1412 ) where
1513
16−import Spec
17−import Criterion.Main (bench, nf, env)
18−
1914import Prelude hiding (lookup)
2015
16+import Criterion.Main (bench, env, nf)
17+import Data.Kind (Type)
2118import Data.Maybe (fromJust)
2219import Data.Proxy (Proxy (..))
2320import Data.Typeable (Typeable)
24−import GHC.TypeLits
21+import GHC.TypeLits (type (+), KnownNat, Nat)
2522
2623import Data.TypeRep.OptimalVector (TF (..), TypeRepMap (..), fromList, lookup)
2724
25+import Spec (BenchSpec (..))
26+
27+
2828spec :: BenchSpec
2929spec = BenchSpec
30− { benchLookup = Just $ \name ->
31− env mkBigMap $ \ ~bigMap ->
32− bench name $ nf tenLookups bigMap
33− , benchInsertSmall = Nothing -- Not implemented
34− , benchInsertBig = Nothing -- Not implemented
35− , benchUpdateSmall = Nothing -- Not implemented
36− , benchUpdateBig = Nothing -- Not implemented
37− }
38−
39−tenLookups :: TypeRepMap (Proxy :: Nat -> *)
40− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
41− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
42− )
30+ { benchLookup = Just $ \name ->
31+ env mkBigMap $ \ ~bigMap ->
32+ bench name $ nf tenLookups bigMap
33+ , benchInsertSmall = Nothing -- Not implemented
34+ , benchInsertBig = Nothing -- Not implemented
35+ , benchUpdateSmall = Nothing -- Not implemented
36+ , benchUpdateBig = Nothing -- Not implemented
37+ }
38+
39+tenLookups
40+ :: TypeRepMap (Proxy :: Nat -> Type)
41+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
42+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
43+ )
4344tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
4445 where
4546 lp :: forall (a::Nat). Typeable a => Proxy a
4647 lp = fromJust $ lookup tmap
4748
4849-- TypeRepMap of 10000 elements
49−mkBigMap :: IO (TypeRepMap (Proxy :: Nat -> *))
50+mkBigMap :: IO (TypeRepMap (Proxy :: Nat -> Type))
5051mkBigMap = pure $ fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
5152
52−buildBigMap :: forall a . (KnownNat a)
53− => Int
54− -> Proxy (a :: Nat)
55− -> [TF (Proxy :: Nat -> *)]
56− -> [TF (Proxy :: Nat -> *)]
53+buildBigMap
54+ :: forall a . (KnownNat a)
55+ => Int
56+ -> Proxy (a :: Nat)
57+ -> [TF (Proxy :: Nat -> Type)]
58+ -> [TF (Proxy :: Nat -> Type)]
5759buildBigMap 1 x = (TF x :)
5860buildBigMap 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.
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.
1+{- | Specification of the benchmarks.
2+
3+This module keeps a list of all bencharks, this way
4+we can group benchmark by the interesting function, not
5+by the implementation.
6+-}
57module 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).
8+ ( BenchSpec(..)
9+ ) where
10+
11+import Criterion (Benchmark)
12+
13+
14+{- | List of benchmarks that each module should provide.
15+If implementation can express the benchmark then it
16+can return @Nothing@ in that benchmark.
17+
18+Map should contain elements from @1@ to @size of map@
19+inserted in ascending order (later that requirement may
20+change).
21+-}
1822data 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− }
23+ { {- | Basic lookup we look 10 values inside 10k map.
24+
25+ Implementation may look like:
26+
27+ @
28+ tenLookups :: TypeRepMap (Proxy :: Nat -> *)
29+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
30+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
31+ )
32+ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
33+ @
34+ -}
35+ benchLookup :: Maybe (String -> Benchmark)
36+ {- ^ Insert 10 elements into an empty map.
37+
38+ Implementation may look like:
5339
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+
13{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExplicitNamespaces #-}
3−{-# LANGUAGE KindSignatures #-}
44{-# LANGUAGE PolyKinds #-}
55{-# LANGUAGE ScopedTypeVariables #-}
66{-# LANGUAGE TypeFamilies #-}
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE UndecidableInstances #-}
99
10−{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
11−
1210module Vector
13− ( benchVector
14− , prepareBenchVector
15− ) where
16−
17−import Criterion.Main (Benchmark, bench, bgroup, nf)
11+ ( benchVector
12+ , prepareBenchVector
13+ ) where
1814
1915import Prelude hiding (lookup)
2016
2117import 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)
2321import Data.Maybe (fromJust)
2422import Data.Proxy (Proxy (..))
2523import 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)
2727
28−import Data.TypeRep.Vector
2928
3029benchVector :: Benchmark
3130benchVector = bgroup "vector"
@@ -34,24 +33,26 @@ benchVector = bgroup "vector"
3433 -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)
3534 ]
3635
37−tenLookups :: TypeRepVector (Proxy :: Nat -> *)
38− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
39− , Proxy 50, Proxy 60, Proxy 70, Proxy 80
40− )
36+tenLookups
37+ :: TypeRepVector (Proxy :: Nat -> Type)
38+ -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40
39+ , Proxy 50, Proxy 60, Proxy 70, Proxy 80
40+ )
4141tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
4242 where
4343 lp :: forall (a::Nat). Typeable a => Proxy a
4444 lp = fromJust $ lookup tmap
4545
4646-- TypeRepMap of 10000 elements
47−bigMap :: TypeRepVector (Proxy :: Nat -> *)
47+bigMap :: TypeRepVector (Proxy :: Nat -> Type)
4848bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
4949
50−buildBigMap :: forall a . (KnownNat a)
51− => Int
52− -> Proxy (a :: Nat)
53− -> [TF (Proxy :: Nat -> *)]
54− -> [TF (Proxy :: Nat -> *)]
50+buildBigMap
51+ :: forall a . (KnownNat a)
52+ => Int
53+ -> Proxy (a :: Nat)
54+ -> [TF (Proxy :: Nat -> Type)]
55+ -> [TF (Proxy :: Nat -> Type)]
5556buildBigMap 1 x = (TF x :)
5657buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
5758
src/Data/TMap.hs+1−1
@@ -170,5 +170,5 @@ adjust :: Typeable a => (a -> a) -> TMap -> TMap
170170adjust f = F.adjust (liftToIdentity f)
171171{-# INLINE adjust #-}
172172
173−liftToIdentity :: forall a. Typeable a => (a -> a) -> Identity a -> Identity a
173+liftToIdentity :: forall a. (a -> a) -> Identity a -> Identity a
174174liftToIdentity = coerce
src/Data/TypeRepMap/Internal.hs+2−1
@@ -1,10 +1,11 @@
1+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
2+
13{-# LANGUAGE AllowAmbiguousTypes #-}
24{-# LANGUAGE BangPatterns #-}
35{-# LANGUAGE CPP #-}
46{-# LANGUAGE DataKinds #-}
57{-# LANGUAGE GADTs #-}
68{-# LANGUAGE InstanceSigs #-}
7−{-# LANGUAGE KindSignatures #-}
89{-# LANGUAGE MagicHash #-}
910{-# LANGUAGE PolyKinds #-}
1011{-# LANGUAGE Rank2Types #-}
test/Test/TypeRep/TypeRepMapProperty.hs+1−3
@@ -1,7 +1,6 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE KindSignatures #-}
54{-# LANGUAGE PolyKinds #-}
65
76{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
@@ -15,9 +14,8 @@ import Prelude hiding (lookup)
1514import Data.Proxy (Proxy (..))
1615import Data.Semigroup (Semigroup (..))
1716import GHC.Exts (fromList)
18−import GHC.Stack (HasCallStack)
1917import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
20−import Hedgehog (MonadGen, PropertyT, assert, forAll, property, (===))
18+import Hedgehog (MonadGen, assert, forAll, (===))
2119import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)
2220import Test.Hspec.Hedgehog (hedgehog)
2321
typerep-extra-impls/Data/TypeRep/CMap.hs+3−3
@@ -1,5 +1,4 @@
1−{-# LANGUAGE KindSignatures #-}
2−{-# LANGUAGE PolyKinds #-}
1+{-# LANGUAGE PolyKinds #-}
32
43{- |
54Copyright: (c) 2017-2020 Kowainik
@@ -21,6 +20,7 @@ module Data.TypeRep.CMap
2120import Prelude hiding (lookup)
2221
2322import Control.DeepSeq
23+import Data.Kind (Type)
2424import Data.Proxy (Proxy (..))
2525import Data.Typeable (TypeRep, Typeable, typeRep)
2626import GHC.Base (Any)
@@ -30,7 +30,7 @@ import qualified Data.Map.Lazy as LMap
3030
3131
3232-- | Map-like data structure with types served as the keys.
33−newtype TypeRepMap (f :: k -> *) = TypeRepMap
33+newtype TypeRepMap (f :: k -> Type) = TypeRepMap
3434 { unMap :: LMap.Map TypeRep Any
3535 }
3636
typerep-extra-impls/Data/TypeRep/OptimalVector.hs+7−8
@@ -1,9 +1,8 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE KindSignatures #-}
4−{-# LANGUAGE MagicHash #-}
5−{-# LANGUAGE PolyKinds #-}
6−{-# LANGUAGE TypeFamilies #-}
1+{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE GADTs #-}
3+{-# LANGUAGE MagicHash #-}
4+{-# LANGUAGE PolyKinds #-}
5+{-# LANGUAGE TypeFamilies #-}
76
87{- |
98Copyright: (c) 2017-2020 Kowainik
@@ -62,7 +61,7 @@ empty :: TypeRepMap f
6261empty = TypeRepMap mempty mempty mempty
6362
6463-- | 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
6665insert = undefined
6766
6867-- | Looks up the value at the type.
@@ -112,7 +111,7 @@ binarySearch (Fingerprint a b) fpAs fpBs =
112111data TF f where
113112 TF :: Typeable a => f a -> TF f
114113
115−fromF :: Typeable a => f a -> Proxy a
114+fromF :: f a -> Proxy a
116115fromF _ = Proxy
117116
118117fromList :: forall f . [TF f] -> TypeRepMap f
typerep-extra-impls/Data/TypeRep/Vector.hs+2−2
@@ -144,7 +144,7 @@ empty :: TypeRepVector f
144144empty = TypeRepVect mempty mempty
145145
146146-- | 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
148148insert = undefined
149149
150150-- | Looks up the value at the type.
@@ -164,7 +164,7 @@ size = Unboxed.length . fingerprints
164164data TF f where
165165 TF :: Typeable a => f a -> TF f
166166
167−fromF :: Typeable a => f a -> Proxy a
167+fromF :: f a -> Proxy a
168168fromF _ = Proxy
169169
170170fromList :: forall f . [TF f] -> TypeRepVector f
typerep-map.cabal+16−1
@@ -48,8 +48,23 @@ common common-options
4848 RecordWildCards
4949 ScopedTypeVariables
5050 TypeApplications
51− if impl(ghc >= 8.8.1)
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
60+ if impl(ghc >= 8.4)
61+ ghc-options: -Wmissing-export-lists
62+ -Wpartial-fields
63+ if impl(ghc >= 8.8)
5264 ghc-options: -Wmissing-deriving-strategies
65+ -Werror=missing-deriving-strategies
66+ if impl(ghc >= 8.10)
67+ ghc-options: -Wunused-packages
5368
5469library
5570 import: common-options