@@ -1,14 +1,22 @@
1−{-# LANGUAGE ExplicitForAll #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE ExplicitForAll #-}
3+{-# LANGUAGE ExplicitNamespaces #-}
4+{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE TypeOperators #-}
8+{-# LANGUAGE UndecidableInstances #-}
39
4−import Criterion.Main (bench, defaultMain, whnf)
10+import Criterion.Main (bench, defaultMain, nf, whnf)
511
612import Prelude hiding (lookup)
713
814import Control.DeepSeq (rnf)
915import Control.Exception.Base (evaluate)
16+import Data.Maybe (fromJust)
1017import Data.Proxy (Proxy (..))
1118import Data.Typeable (Typeable)
19+import GHC.TypeLits (type (-), Nat)
1220
1321import Data.TypeRep.Map (TypeRepMap (..), empty, insert, keys, lookup, size)
1422
@@ -17,11 +25,23 @@ main = do
1725 putStrLn $ "size: " ++ (show $ size bigMap)
1826 evaluate $ rknf bigMap
1927 defaultMain
20− [ bench "lookup" $ whnf (lookup :: TypeRepMap -> Maybe Char) bigMap
21− , bench "insert new" $ whnf (\x -> insert x bigMap) (111 :: Int)
22− , bench "update old" $ whnf (\x -> insert x bigMap) 'b'
28+ [ bench "lookup" $ nf tenLookups bigMap
29+ , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (111 :: Int)
30+ , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) 'b'
2331 ]
2432
33+tenLookups :: TypeRepMap
34+ -> ( Proxy (BigProxy 10), Proxy (BigProxy 20)
35+ , Proxy (BigProxy 30), Proxy (BigProxy 40)
36+ , Proxy (BigProxy 50), Proxy (BigProxy 60)
37+ , Proxy (BigProxy 70), Proxy (BigProxy 80)
38+ -- , Proxy (BigProxy 9000), Proxy (BigProxy 10000)
39+ )
40+tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
41+ where
42+ lp :: Typeable a => Proxy a
43+ lp = fromJust $ lookup tmap
44+
2545-- TypeRepMap of 10000 elements
2646bigMap :: TypeRepMap
2747bigMap = buildBigMap 10000 (Proxy :: Proxy Z) empty
@@ -35,3 +55,7 @@ buildBigMap n x = insert x . buildBigMap (n - 1) (Proxy :: Proxy (S a))
3555
3656rknf :: TypeRepMap -> ()
3757rknf = rnf . keys
58+
59+type family BigProxy (n :: Nat) :: * where
60+ BigProxy 0 = Z
61+ BigProxy n = S (BigProxy (n - 1))