git.iko.soy/typerep-map
on main help sign in
Update OptimalVector.hs
284ca80Vladislav Zavialov
benchmark/Main.hs+6−5
compare with main
unifiedsplit
@@ -3,15 +3,16 @@ module Main where
3import Criterion.Main (defaultMain)
3import Criterion.Main (defaultMain)
4
4
5import Map (benchMap, prepareBenchMap)
5import Map (benchMap, prepareBenchMap)
6−-- import OptimalVector (benchVectorOpt)
6+import OptimalVector (benchVectorOpt, prepareBenchVectorOpt)
7−import Vector (benchVector, prepareBenchVector)
7+--import Vector (benchVector, prepareBenchVector)
8
8
9main :: IO ()
9main :: IO ()
10main = do
10main = do
11 prepareBenchMap
11 prepareBenchMap
12− prepareBenchVector
12+ --prepareBenchVector
13+ prepareBenchVectorOpt
13 defaultMain
14 defaultMain
14 [ benchMap
15 [ benchMap
15− , benchVector
16+ -- , benchVector
16−-- , benchVectorOpt
17+ , benchVectorOpt
17 ]
18 ]
benchmark/OptimalVector.hs+7−8
@@ -11,12 +11,15 @@
11
11
12module OptimalVector
12module OptimalVector
13 ( benchVectorOpt
13 ( benchVectorOpt
14+ , prepareBenchVectorOpt
14 ) where
15 ) where
15
16
16import Criterion.Main (Benchmark, bench, bgroup, nf)
17import Criterion.Main (Benchmark, bench, bgroup, nf)
17
18
18import Prelude hiding (lookup)
19import Prelude hiding (lookup)
19
20
21+import Control.Exception
22+import Control.DeepSeq (rnf)
20import Data.Maybe (fromJust)
23import Data.Maybe (fromJust)
21import Data.Proxy (Proxy (..))
24import Data.Proxy (Proxy (..))
22import Data.Typeable (Typeable)
25import Data.Typeable (Typeable)
@@ -44,16 +47,12 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
44bigMap :: TypeRepVector (Proxy :: Nat -> *)
47bigMap :: TypeRepVector (Proxy :: Nat -> *)
45bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
46
49
47−data Z
48−data S a
49−
50buildBigMap :: forall a . (Typeable a, KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]
50buildBigMap :: forall a . (Typeable a, KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]
51buildBigMap 1 x = (TF x :)
51buildBigMap 1 x = (TF x :)
52buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
52buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
53
53
54−-- rknf :: TypeRepMap f -> ()
54+rknf :: TypeRepVector f -> ()
55−-- rknf = rnf . keys
55+rknf = rnf . fingerprints
56
56
57−type family BigProxy (n :: Nat) :: * where
57+prepareBenchVectorOpt :: IO ()
58− BigProxy 0 = Z
58+prepareBenchVectorOpt = evaluate (rknf bigMap)
59− BigProxy n = S (BigProxy (n - 1))
src/Data/TypeRep/OptimalVector.hs+15−11
@@ -7,6 +7,7 @@
7{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE PolyKinds #-}
8{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE MagicHash, BangPatterns #-}
10
11
11
12
12module Data.TypeRep.OptimalVector
13module Data.TypeRep.OptimalVector
@@ -26,10 +27,11 @@ import Data.Foldable (for_)
26import Data.Proxy (Proxy (..))
27import Data.Proxy (Proxy (..))
27import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
28import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
28import Data.Word (Word64)
29import Data.Word (Word64)
29−import GHC.Base (Any, liftM)
30+import GHC.Base hiding (empty)
30import GHC.Exts (sortWith)
31import GHC.Exts (sortWith)
31import GHC.Fingerprint (Fingerprint (..))
32import GHC.Fingerprint (Fingerprint (..))
32import Unsafe.Coerce (unsafeCoerce)
33import Unsafe.Coerce (unsafeCoerce)
34+import GHC.Prim
33
35
34import qualified Data.Vector as V
36import qualified Data.Vector as V
35import qualified Data.Vector.Generic as G
37import qualified Data.Vector.Generic as G
@@ -160,18 +162,20 @@ fromList tfs = TypeRepVect (Unboxed.fromList fps) (V.fromList ans)
160 an :: TF f -> Any
162 an :: TF f -> Any
161 an (TF x) = unsafeCoerce x
163 an (TF x) = unsafeCoerce x
162
164
163−
164-- | Returns the index is found.
165-- | Returns the index is found.
165binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
166binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
166binarySearch fp fpVect =
167binarySearch fp fpVect =
168+ let
169+ !(I# len) = Unboxed.length fpVect
167− let ind = binSearchHelp (-1) (Unboxed.length fpVect) in
170+ ind = I# (binSearchHelp (-1#) len)
171+ in
168− if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
172+ if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
169 where
173 where
170− binSearchHelp :: Int -> Int -> Int
174+ binSearchHelp :: Int# -> Int# -> Int#
171− binSearchHelp l r = if l < r - 1
175+ binSearchHelp l r = case l <# (r -# 1#) of
172− then (
176+ 0# -> r
177+ _ ->
173− let m = (l + r) `div` 2 in
178+ let m = uncheckedIShiftRA# (l +# r) 1# in
174− if fpVect Unboxed.! m < fp
179+ if Unboxed.unsafeIndex fpVect (I# m) < fp
175 then binSearchHelp m r
180 then binSearchHelp m r
176− else binSearchHelp l m )
181+ else binSearchHelp l m
177− else r