cc51bcc · typerep-map · git.iko.soy

git.iko.soy/typerep-map

on main help sign in

ByteArray#

cc51bccVladislav Zavialov9 years ago

benchmark/Map.hs+2−2

compare with main

unifiedsplit

@@ -36,8 +36,8 @@ benchMap = bgroup "map"

36 ]

38tenLookups :: TypeRepMap (Proxy :: Nat -> *)

39− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40

39+ -> ( Proxy 1000, Proxy 2000, Proxy 3000, Proxy 4000

40− , Proxy 50, Proxy 60, Proxy 70, Proxy 80

40+ , Proxy 5000, Proxy 6000, Proxy 7000, Proxy 8000

41 )

42tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

43 where

benchmark/OptimalVector.hs+5−10

@@ -18,8 +18,6 @@ import Criterion.Main (Benchmark, bench, bgroup, nf)

19import Prelude hiding (lookup)

21−import Control.Exception

22−import Control.DeepSeq (rnf)

23import Data.Maybe (fromJust)

21import Data.Maybe (fromJust)

24import Data.Proxy (Proxy (..))

22import Data.Proxy (Proxy (..))

25import Data.Typeable (Typeable)

23import Data.Typeable (Typeable)

@@ -30,13 +28,13 @@ import Data.TypeRep.OptimalVector

30benchVectorOpt :: Benchmark

28benchVectorOpt :: Benchmark

31benchVectorOpt = bgroup "vector optimal"

29benchVectorOpt = bgroup "vector optimal"

32 [ bench "lookup" $ nf tenLookups bigMap

30 [ bench "lookup" $ nf tenLookups bigMap

33− -- , bench "insert new" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 9999999999)

31+ -- , bench "insert new" $ whnf (\x -> insert x bigMap) (Proxy :: Proxy 9999999999)

34− -- , bench "update old" $ whnf (\x -> rknf $ insert x bigMap) (Proxy :: Proxy 1)

32+ -- , bench "update old" $ whnf (\x -> insert x bigMap) (Proxy :: Proxy 1)

35 ]

33 ]

37tenLookups :: TypeRepVector (Proxy :: Nat -> *)

35tenLookups :: TypeRepVector (Proxy :: Nat -> *)

38− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40

36+ -> ( Proxy 1000, Proxy 2000, Proxy 3000, Proxy 4000

39− , Proxy 50, Proxy 60, Proxy 70, Proxy 80

37+ , Proxy 5000, Proxy 6000, Proxy 7000, Proxy 8000

40 )

38 )

41tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

39tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

42 where

40 where

@@ -51,8 +49,5 @@ buildBigMap :: forall a . (Typeable a, KnownNat a) => Int -> Proxy (a :: Nat) ->

51buildBigMap 1 x = (TF x :)

49buildBigMap 1 x = (TF x :)

52buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))

50buildBigMap n x = (TF x :) . buildBigMap (n - 1) (Proxy :: Proxy (a + 1))

54−rknf :: TypeRepVector f -> ()

55−rknf tVect = rnf (fingerprintAs tVect, fingerprintBs tVect)

56−

57prepareBenchVectorOpt :: IO ()

52prepareBenchVectorOpt :: IO ()

58−prepareBenchVectorOpt = evaluate (rknf bigMap)

53+prepareBenchVectorOpt = return ()

benchmark/Vector.hs+2−2

@@ -35,8 +35,8 @@ benchVector = bgroup "vector"

35 ]

37tenLookups :: TypeRepVector (Proxy :: Nat -> *)

38− -> ( Proxy 10, Proxy 20, Proxy 30, Proxy 40

38+ -> ( Proxy 1000, Proxy 2000, Proxy 3000, Proxy 4000

39− , Proxy 50, Proxy 60, Proxy 70, Proxy 80

39+ , Proxy 5000, Proxy 6000, Proxy 7000, Proxy 8000

40 )

41tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

42 where

src/Data/TypeRep/OptimalVector.hs+34−29

@@ -9,6 +9,7 @@

9{-# LANGUAGE PolyKinds #-}

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeFamilies #-}

12+{-# LANGUAGE RecordWildCards #-}

14module Data.TypeRep.OptimalVector

15module Data.TypeRep.OptimalVector

@@ -26,32 +27,30 @@ import Prelude hiding (lookup)

26import Control.Arrow ((&&&))

27import Control.Arrow ((&&&))

27import Data.Proxy (Proxy (..))

28import Data.Proxy (Proxy (..))

28import Data.Typeable (Typeable, typeRep, typeRepFingerprint)

29import Data.Typeable (Typeable, typeRep, typeRepFingerprint)

29−import Data.Word (Word64)

30import GHC.Base hiding (empty)

31import GHC.Exts (sortWith)

32import GHC.Fingerprint (Fingerprint (..))

33import Unsafe.Coerce (unsafeCoerce)

34−import Debug.Trace

36import qualified Data.Vector as V

35import qualified Data.Vector as V

37−import qualified Data.Vector.Unboxed as Unboxed

36+import qualified Data.Vector.Primitive as P

38+import Data.Primitive.ByteArray

39+import GHC.Word

40+

39−data TypeRepVector f = TypeRepVect

41+data TypeRepVector (f :: k -> *) = TypeRepVect

40− { fingerprintAs :: Unboxed.Vector Word64

42+ { fingerprintAs :: ByteArray#

41− , fingerprintBs :: Unboxed.Vector Word64

43+ , fingerprintBs :: ByteArray#

42 , anys :: V.Vector Any

44 , anys :: V.Vector Any

43 }

45 }

45−fromAny :: Any -> f a

46−fromAny = unsafeCoerce

47−

48-- | Empty structure.

47-- | Empty structure.

49empty :: TypeRepVector f

48empty :: TypeRepVector f

50−empty = TypeRepVect mempty mempty mempty

49+empty = fromList []

52-- | Inserts the value with its type as a key.

51-- | Inserts the value with its type as a key.

53insert :: forall a f . Typeable a => a -> TypeRepVector f -> TypeRepVector f

52insert :: forall a f . Typeable a => a -> TypeRepVector f -> TypeRepVector f

54−insert = undefined

53+insert _ = id

56-- | Looks up the value at the type.

55-- | Looks up the value at the type.

57-- >>> let x = lookup $ insert (11 :: Int) empty

56-- >>> let x = lookup $ insert (11 :: Int) empty

@@ -60,12 +59,15 @@ insert = undefined

60-- >>> x :: Maybe ()

59-- >>> x :: Maybe ()

61-- Nothing

60-- Nothing

62lookup :: forall a f . Typeable a => TypeRepVector f -> Maybe (f a)

61lookup :: forall a f . Typeable a => TypeRepVector f -> Maybe (f a)

63−lookup tVect = fromAny . (anys tVect V.!)

62+lookup TypeRepVect{..} =

63+ fromAny (binarySearch anys fp fingerprintAs fingerprintBs)

64+ where

64− <$> binarySearch (typeRepFingerprint (typeRep (Proxy :: Proxy a))) (fingerprintAs tVect) (fingerprintBs tVect)

65+ fp = typeRepFingerprint (typeRep (Proxy :: Proxy a))

66+ fromAny = unsafeCoerce :: Maybe Any -> Maybe (f a)

66-- | Returns the size of the 'TypeRepVect'.

68-- | Returns the size of the 'TypeRepVect'.

67size :: TypeRepVector f -> Int

69size :: TypeRepVector f -> Int

68−size = Unboxed.length . fingerprintAs

70+size = V.length . anys

70data TF f where

72data TF f where

71 TF :: Typeable a => f a -> TF f

73 TF :: Typeable a => f a -> TF f

@@ -74,8 +76,10 @@ fromF :: Typeable a => f a -> Proxy a

74fromF _ = Proxy

76fromF _ = Proxy

76fromList :: forall f . [TF f] -> TypeRepVector f

78fromList :: forall f . [TF f] -> TypeRepVector f

77−fromList tfs = TypeRepVect (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fromList ans)

79+fromList tfs = TypeRepVect fpAs' fpBs' (V.fromList ans)

78 where

80 where

81+ !(P.Vector _ _ (ByteArray fpAs')) = P.fromList fpAs

82+ !(P.Vector _ _ (ByteArray fpBs')) = P.fromList fpBs

79 (fpAs, fpBs) = unzip $ fmap (\(Fingerprint a b) -> (a, b)) fps

83 (fpAs, fpBs) = unzip $ fmap (\(Fingerprint a b) -> (a, b)) fps

80 (fps, ans) = unzip $ sortWith fst $ map (fp &&& an) tfs

84 (fps, ans) = unzip $ sortWith fst $ map (fp &&& an) tfs

@@ -86,29 +90,30 @@ fromList tfs = TypeRepVect (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (V.fr

86 an (TF x) = unsafeCoerce x

90 an (TF x) = unsafeCoerce x

88-- | Returns the index is found.

92-- | Returns the index is found.

89−binarySearch :: Fingerprint -> Unboxed.Vector Word64 -> Unboxed.Vector Word64 -> Maybe Int

93+binarySearch :: forall a. V.Vector a -> Fingerprint -> ByteArray# -> ByteArray# -> Maybe a

90−binarySearch (Fingerprint a b) fpAs fpBs =

94+binarySearch !anys !(Fingerprint (W64# a) (W64# b)) !fpAs !fpBs =

91 let

95 let

92− !(I# len) = Unboxed.length fpAs

96+ !(I# len) = V.length anys

93− checkfpBs :: Int# -> Maybe Int

97+ checkfpBs :: Int# -> Maybe a

94− checkfpBs i =

98+ checkfpBs !i =

95 case i <# len of

99 case i <# len of

96 0# -> Nothing

100 0# -> Nothing

97 _ ->

101 _ ->

98− if a /= Unboxed.unsafeIndex fpAs (I# i)

102+ case eqWord# a (indexWord64Array# fpAs i) of

99− then Nothing

103+ 0# -> Nothing

100− else if b == Unboxed.unsafeIndex fpBs (I# i)

104+ _ ->

101− then Just (I# i)

105+ case eqWord# b (indexWord64Array# fpBs i) of

102− else checkfpBs (i +# 1#)

106+ 0# -> checkfpBs (i +# 1#)

107+ _ -> Just (V.unsafeIndex anys (I# i))

103 in

108 in

104 inline (checkfpBs (binSearchHelp (-1#) len))

109 inline (checkfpBs (binSearchHelp (-1#) len))

105 where

110 where

106 binSearchHelp :: Int# -> Int# -> Int#

111 binSearchHelp :: Int# -> Int# -> Int#

107− binSearchHelp l r = case l <# (r -# 1#) of

112+ binSearchHelp !l !r = case l <# (r -# 1#) of

108 0# -> r

113 0# -> r

109 _ ->

114 _ ->

110 let m = uncheckedIShiftRA# (l +# r) 1# in

115 let m = uncheckedIShiftRA# (l +# r) 1# in

111− if Unboxed.unsafeIndex fpAs (I# m) < a

116+ case ltWord# (indexWord64Array# fpAs m) a of

117+ 0# -> binSearchHelp l m

112− then binSearchHelp m r

118+ _ -> binSearchHelp m r

113− else binSearchHelp l m

114

119

typerep-map.cabal+1

@@ -24,6 +24,7 @@ library

24 , containers

25 , vector

26 , ghc-prim

27+ , primitive

27 default-language: Haskell2010

28 default-language: Haskell2010

29test-suite typerep-map-test

30test-suite typerep-map-test