git.iko.soy/typerep-map
on main help sign in
Update OptimalVector.hs
commite53b07441daac4f81ecc6f9f8ae7f13856e94613 authorVladislav Zavialov <vlad.z.4096@gmail.com> dateTue 19 Dec 2017, 07:58 (9 years ago) parent6f80fb1
3 files changed+28−24
compare with main
unifiedsplit
benchmark/Main.hs+6−5 benchmark/OptimalVector.hs+7−8 src/Data/TypeRep/OptimalVector.hs+15−11
benchmark/Main.hs+6−5
@@ -3,15 +3,16 @@ module Main where
33import Criterion.Main (defaultMain)
44
55import Map (benchMap, prepareBenchMap)
6−-- import OptimalVector (benchVectorOpt)
7−import Vector (benchVector, prepareBenchVector)
6+import OptimalVector (benchVectorOpt, prepareBenchVectorOpt)
7+--import Vector (benchVector, prepareBenchVector)
88
99main :: IO ()
1010main = do
1111 prepareBenchMap
12− prepareBenchVector
12+ --prepareBenchVector
13+ prepareBenchVectorOpt
1314 defaultMain
1415 [ benchMap
15− , benchVector
16−-- , benchVectorOpt
16+ -- , benchVector
17+ , benchVectorOpt
1718 ]
benchmark/OptimalVector.hs+7−8
@@ -11,12 +11,15 @@
1111
1212module OptimalVector
1313 ( benchVectorOpt
14+ , prepareBenchVectorOpt
1415 ) where
1516
1617import Criterion.Main (Benchmark, bench, bgroup, nf)
1718
1819import Prelude hiding (lookup)
1920
21+import Control.Exception
22+import Control.DeepSeq (rnf)
2023import Data.Maybe (fromJust)
2124import Data.Proxy (Proxy (..))
2225import Data.Typeable (Typeable)
@@ -44,16 +47,12 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)
4447bigMap :: TypeRepVector (Proxy :: Nat -> *)
4548bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []
4649
47−data Z
48−data S a
49−
5050buildBigMap :: forall a . (Typeable a, KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]
5151buildBigMap 1 x = (TF x :)
5252buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))
5353
54−-- rknf :: TypeRepMap f -> ()
55−-- rknf = rnf . keys
54+rknf :: TypeRepVector f -> ()
55+rknf = rnf . fingerprints
5656
57−type family BigProxy (n :: Nat) :: * where
58− BigProxy 0 = Z
59− BigProxy n = S (BigProxy (n - 1))
57+prepareBenchVectorOpt :: IO ()
58+prepareBenchVectorOpt = evaluate (rknf bigMap)
src/Data/TypeRep/OptimalVector.hs+15−11
@@ -7,6 +7,7 @@
77{-# LANGUAGE PolyKinds #-}
88{-# LANGUAGE ScopedTypeVariables #-}
99{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE MagicHash, BangPatterns #-}
1011
1112
1213module Data.TypeRep.OptimalVector
@@ -26,10 +27,11 @@ import Data.Foldable (for_)
2627import Data.Proxy (Proxy (..))
2728import Data.Typeable (Typeable, typeRep, typeRepFingerprint)
2829import Data.Word (Word64)
29−import GHC.Base (Any, liftM)
30+import GHC.Base hiding (empty)
3031import GHC.Exts (sortWith)
3132import GHC.Fingerprint (Fingerprint (..))
3233import Unsafe.Coerce (unsafeCoerce)
34+import GHC.Prim
3335
3436import qualified Data.Vector as V
3537import qualified Data.Vector.Generic as G
@@ -160,18 +162,20 @@ fromList tfs = TypeRepVect (Unboxed.fromList fps) (V.fromList ans)
160162 an :: TF f -> Any
161163 an (TF x) = unsafeCoerce x
162164
163−
164165-- | Returns the index is found.
165166binarySearch :: Fingerprint -> Unboxed.Vector Fingerprint -> Maybe Int
166167binarySearch fp fpVect =
167− let ind = binSearchHelp (-1) (Unboxed.length fpVect) in
168− if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
168+ let
169+ !(I# len) = Unboxed.length fpVect
170+ ind = I# (binSearchHelp (-1#) len)
171+ in
172+ if fp == (fpVect Unboxed.! ind) then Just ind else Nothing
169173 where
170− binSearchHelp :: Int -> Int -> Int
171− binSearchHelp l r = if l < r - 1
172− then (
173− let m = (l + r) `div` 2 in
174− if fpVect Unboxed.! m < fp
174+ binSearchHelp :: Int# -> Int# -> Int#
175+ binSearchHelp l r = case l <# (r -# 1#) of
176+ 0# -> r
177+ _ ->
178+ let m = uncheckedIShiftRA# (l +# r) 1# in
179+ if Unboxed.unsafeIndex fpVect (I# m) < fp
175180 then binSearchHelp m r
176− else binSearchHelp l m )
177− else r
181+ else binSearchHelp l m