75b6a57 · typerep-map · git.iko.soy

.hlint.yamlnew file+6

compare with main

unifiedsplit

@@ -0,0 +1,6 @@

1+- ignore: {name: "Use camelCase"}

2+

3+- arguments:

4+ - -XTypeApplications

5+

6+- warn: {name: "Use explicit module export list"}

README.md+26−1

@@ -1,5 +1,30 @@

1# typerep-map

2

3[![Hackage](https://img.shields.io/hackage/v/typerep-map.svg)](https://hackage.haskell.org/package/typerep-map)

4−[![Build status](https://secure.travis-ci.org/vrom911/typerep-map.svg)](https://travis-ci.org/vrom911/typerep-map)

4+[![Build status](https://secure.travis-ci.org/kowainik/typerep-map.svg)](https://travis-ci.org/kowainik/typerep-map)

5+[![Stackage LTS](http://stackage.org/package/typerep-map/badge/lts)](http://stackage.org/lts/package/typerep-map)

6+[![Stackage Nightly](http://stackage.org/package/typerep-map/badge/nightly)](http://stackage.org/nightly/package/typerep-map)

5[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/vrom911/typerep-map/blob/master/LICENSE)

7[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/vrom911/typerep-map/blob/master/LICENSE)

8+

9+`typerep-map` introduces `TypeRepMap` — data structure like [`Map`](http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#t:Map), but where types serve as keys, and values have the types specified in the corresponding key spots.

10+

11+```haskell

12+ghci> let typeRepMap = insert (Identity True) $ insert (Identity (42 :: Int)) empty

13+

14+ghci> size typeRepMap

15+2

16+

17+ghci> let res = lookup typeRepMap

18+

19+ghci> res :: Maybe (Identity Int)

20+Just (Identity 42)

21+

22+ghci> res :: Maybe (Identity Bool)

23+Just (Identity True)

24+

25+ghci> res :: Maybe (Identity String)

26+Nothing

27+

28+ghci> lookup (insert (Identity "hello") typeRepMap) :: Maybe (Identity String)

29+Just (Identity "hello")

30+```

benchmark/CacheMap.hs+5−1

@@ -46,7 +46,11 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

46bigMap :: TypeRepMap (Proxy :: Nat -> *)

47bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []

48

49−buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]

49+buildBigMap :: forall a . (KnownNat a)

50+ => Int

51+ -> Proxy (a :: Nat)

52+ -> [TF (Proxy :: Nat -> *)]

53+ -> [TF (Proxy :: Nat -> *)]

50buildBigMap 1 x = (TF x :)

54buildBigMap 1 x = (TF x :)

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

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

52

56

benchmark/OptimalVector.hs+5−1

@@ -47,7 +47,11 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

47bigMap :: TypeRepMap (Proxy :: Nat -> *)

48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []

49

50−buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]

50+buildBigMap :: forall a . (KnownNat a)

51+ => Int

52+ -> Proxy (a :: Nat)

53+ -> [TF (Proxy :: Nat -> *)]

54+ -> [TF (Proxy :: Nat -> *)]

51buildBigMap 1 x = (TF x :)

55buildBigMap 1 x = (TF x :)

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

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

53

57

benchmark/Vector.hs+5−1

@@ -47,7 +47,11 @@ tenLookups tmap = (lp, lp, lp, lp, lp, lp, lp, lp)

47bigMap :: TypeRepVector (Proxy :: Nat -> *)

48bigMap = fromList $ buildBigMap 10000 (Proxy :: Proxy 0) []

49

50−buildBigMap :: forall a . (KnownNat a) => Int -> Proxy (a :: Nat) -> [TF (Proxy :: Nat -> *)] -> [TF (Proxy :: Nat -> *)]

50+buildBigMap :: forall a . (KnownNat a)

51+ => Int

52+ -> Proxy (a :: Nat)

53+ -> [TF (Proxy :: Nat -> *)]

54+ -> [TF (Proxy :: Nat -> *)]

51buildBigMap 1 x = (TF x :)

55buildBigMap 1 x = (TF x :)

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

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

53

57

internal/Data/TypeRep/CacheMap.hs+30−15

@@ -46,15 +46,18 @@ import qualified Data.IntMap.Strict as IM

46import qualified Data.Vector as V

47import qualified Data.Vector.Unboxed as Unboxed

48

49+-- | Map-like data structure that keeps types as keys.

49data TypeRepMap (f :: k -> Type) = TypeRepMap

50data TypeRepMap (f :: k -> Type) = TypeRepMap

50 { fingerprintAs :: Unboxed.Vector Word64

51 { fingerprintAs :: Unboxed.Vector Word64

51 , fingerprintBs :: Unboxed.Vector Word64

52 , fingerprintBs :: Unboxed.Vector Word64

52 , anys :: V.Vector Any

53 , anys :: V.Vector Any

53 }

54 }

54

55

56+-- | Shows only 'Fingerprint's.

55instance Show (TypeRepMap f) where

57instance Show (TypeRepMap f) where

56 show = show . toFps

58 show = show . toFps

57

59

60+-- | Returnes the list of 'Fingerprint's from 'TypeRepMap'.

58toFps :: TypeRepMap f -> [Fingerprint]

61toFps :: TypeRepMap f -> [Fingerprint]

59toFps TypeRepMap{..} = zipWith Fingerprint

62toFps TypeRepMap{..} = zipWith Fingerprint

60 (Unboxed.toList fingerprintAs)

63 (Unboxed.toList fingerprintAs)

@@ -81,12 +84,15 @@ insert x = fromListPairs . addX . toPairList

81 addX l = pairX : filter ((/= fpX) . fst) l

84 addX l = pairX : filter ((/= fpX) . fst) l

82{-# INLINE insert #-}

85{-# INLINE insert #-}

83

86

84−-- | Looks up the value at the type.

87+{- | Looks up the value at the type.

88+

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

89+>>> let x = lookup $ insert (Identity (11 :: Int)) empty

86−-- >>> x :: Maybe Int

90+>>> x :: Maybe (Identity Int)

87−-- Just 11

91+Just (Identity 11)

88−-- >>> x :: Maybe ()

92+>>> x :: Maybe (Identity ())

89−-- Nothing

93+Nothing

94+

95+-}

90lookup :: forall a f . Typeable a => TypeRepMap f -> Maybe (f a)

96lookup :: forall a f . Typeable a => TypeRepMap f -> Maybe (f a)

91lookup tVect = fromAny . (anys tVect V.!)

97lookup tVect = fromAny . (anys tVect V.!)

92 <$> cachedBinarySearch (typeRepFingerprint $ typeRep $ Proxy @a)

98 <$> cachedBinarySearch (typeRepFingerprint $ typeRep $ Proxy @a)

@@ -97,6 +103,7 @@ lookup tVect = fromAny . (anys tVect V.!)

97-- | Returns the size of the 'TypeRepMap'.

103-- | Returns the size of the 'TypeRepMap'.

98size :: TypeRepMap f -> Int

104size :: TypeRepMap f -> Int

99size = Unboxed.length . fingerprintAs

105size = Unboxed.length . fingerprintAs

106+{-# INLINE size #-}

100

107

101-- | Binary searched based on this article

108-- | Binary searched based on this article

102-- http://bannalia.blogspot.com/2015/06/cache-friendly-binary-search.html

109-- http://bannalia.blogspot.com/2015/06/cache-friendly-binary-search.html

@@ -125,12 +132,29 @@ cachedBinarySearch (Fingerprint (W64# a) (W64# b)) fpAs fpBs = inline (go 0#)

125-- Functions for testing and benchmarking

132-- Functions for testing and benchmarking

126----------------------------------------------------------------------------

133----------------------------------------------------------------------------

127

134

135+-- | Existential wrapper around 'Typeable' indexed by @f@ type parameter.

136+-- Useful for 'TypeRepMap' structure creation form list of 'TF's.

128data TF f where

137data TF f where

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

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

130

139

131instance Show (TF f) where

140instance Show (TF f) where

132 show (TF tf) = show $ calcFp tf

141 show (TF tf) = show $ calcFp tf

133

142

143+{- | Creates 'TypeRepMap' from a list of 'TF's.

144+

145+>>> size $ fromList [TF $ Identity True, TF $ Identity 'a']

146+2

147+

148+-}

149+fromList :: forall f . [TF f] -> TypeRepMap f

150+fromList = fromListPairs . map (fp &&& an)

151+ where

152+ fp :: TF f -> Fingerprint

153+ fp (TF x) = calcFp x

154+

155+ an :: TF f -> Any

156+ an (TF x) = unsafeCoerce x

157+

134fromF :: Typeable a => f a -> Proxy a

158fromF :: Typeable a => f a -> Proxy a

135fromF _ = Proxy

159fromF _ = Proxy

136

160

@@ -143,15 +167,6 @@ fromListPairs kvs = TypeRepMap (Unboxed.fromList fpAs) (Unboxed.fromList fpBs) (

143 (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps

167 (fpAs, fpBs) = unzip $ map (\(Fingerprint a b) -> (a, b)) fps

144 (fps, ans) = unzip $ fromSortedList $ sortWith fst $ nubPairs kvs

168 (fps, ans) = unzip $ fromSortedList $ sortWith fst $ nubPairs kvs

145

169

146−fromList :: forall f . [TF f] -> TypeRepMap f

147−fromList = fromListPairs . map (fp &&& an)

148− where

149− fp :: TF f -> Fingerprint

150− fp (TF x) = calcFp x

151−

152− an :: TF f -> Any

153− an (TF x) = unsafeCoerce x

154−

155nubPairs :: (Eq a) => [(a, b)] -> [(a, b)]

170nubPairs :: (Eq a) => [(a, b)] -> [(a, b)]

156nubPairs = nubBy ((==) `on` fst)

171nubPairs = nubBy ((==) `on` fst)

157

172

internal/Data/TypeRep/OptimalVector.hs+3−6

@@ -77,12 +77,9 @@ binarySearch (Fingerprint a b) fpAs fpBs =

77 checkfpBs i =

78 case i <# len of

79 0# -> Nothing

80− _ ->

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

80+ _ | a /= Unboxed.unsafeIndex fpAs (I# i) -> Nothing

82− then Nothing

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

81+ | b == Unboxed.unsafeIndex fpBs (I# i) -> Just (I# i)

84− then Just (I# i)

85− else checkfpBs (i +# 1#)

82+ | otherwise -> checkfpBs (i +# 1#)

86 in

83 in

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

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

88 where

85 where

internal/Data/TypeRep/Vector.hs−1

@@ -2,7 +2,6 @@

2

3{-# LANGUAGE BangPatterns #-}

4{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE KindSignatures #-}

6{-# LANGUAGE MagicHash #-}

5{-# LANGUAGE MagicHash #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

8{-# LANGUAGE PolyKinds #-}

7{-# LANGUAGE PolyKinds #-}

src/Data/TypeRep/Map.hs+2

@@ -1,3 +1,5 @@

1+-- | This module introduces the 'TypeRepMap' data structure and functions to work with it.

2+

1module Data.TypeRep.Map

3module Data.TypeRep.Map

2 ( -- * Map type

4 ( -- * Map type

3 TypeRepMap (..)

5 TypeRepMap (..)

test/Test/TypeRep/CacheMap.hs+2−2

@@ -13,8 +13,8 @@ spec_insertLookup = do

13 describe "Lookup Test" $ do

14 it "returns the inserted element" $

15 lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a')

16− -- it "returns the second inserted value of the same type" $

16+ it "returns the second inserted value of the same type" $

17− -- lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')

17+ lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')

18

19 describe "Size Test" $ do

20 it "is empty" $

test/Test/TypeRep/Vector.hs+1−24

@@ -10,32 +10,9 @@ import Data.TypeRep.Vector

10

11-- Simple test for 'lookup', 'insert' and 'size' functions.

12spec_insertLookup :: Spec

13−spec_insertLookup = do

13+spec_insertLookup =

14 describe "Lookup Test" $ do

15 it "returns the inserted element" $

16 lookup (fromList [TF (Identity 'a')]) `shouldBe` Just (Identity 'a')

17 it "returns the second inserted value of the same type" $

18 lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')

19−

20−-- describe "Size Test" $ do

21−-- it "is empty" $

22−-- size empty `shouldBe` 0

23−-- it "is of size 1 when 1 element inserted" $

24−-- size (insert (Identity 'a') empty) `shouldBe` 1

25−-- it "doesn't increase size when element of the same type is added" $

26−-- size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1

27−-- it "returns 10 when 10 different types are inserted" $

28−-- size mapOf10 `shouldBe` 10

29−--

30−--

31−-- mapOf10 :: TypeRepMap Identity

32−-- mapOf10 = insert (Identity True)

33−-- $ insert (Identity [True, False])

34−-- $ insert (Identity $ Just True)

35−-- $ insert (Identity $ Just ())

36−-- $ insert (Identity [()])

37−-- $ insert (Identity ())

38−-- $ insert (Identity "aaa")

39−-- $ insert (Identity $ Just 'a')

40−-- $ insert (Identity 'a')

41−-- $ insert (Identity (11 :: Int)) empty

test/Test/TypeRep/VectorOpt.hs+1−24

@@ -10,32 +10,9 @@ import Data.TypeRep.OptimalVector (TF (..), fromList, lookup)

10

11-- Simple test for 'lookup', 'insert' and 'size' functions.

12spec_insertLookup :: Spec

13−spec_insertLookup = do

13+spec_insertLookup =

14 describe "Lookup Test" $ do

15 it "returns the inserted element" $

16 lookup (fromList [TF $ Identity 'a']) `shouldBe` Just (Identity 'a')

17 it "returns the second inserted value of the same type" $

18 lookup (fromList [TF (Identity 'b'), TF (Identity 'a')]) `shouldBe` Just (Identity 'b')

19−

20−-- describe "Size Test" $ do

21−-- it "is empty" $

22−-- size empty `shouldBe` 0

23−-- it "is of size 1 when 1 element inserted" $

24−-- size (insert (Identity 'a') empty) `shouldBe` 1

25−-- it "doesn't increase size when element of the same type is added" $

26−-- size (insert (Identity 'b') $ insert (Identity 'a') empty) `shouldBe` 1

27−-- it "returns 10 when 10 different types are inserted" $

28−-- size mapOf10 `shouldBe` 10

29−--

30−--

31−--mapOf10 :: TypeRepMap Identity

32−--mapOf10 = insert (Identity True)

33−-- $ insert (Identity [True, False])

34−-- $ insert (Identity $ Just True)

35−-- $ insert (Identity $ Just ())

36−-- $ insert (Identity [()])

37−-- $ insert (Identity ())

38−-- $ insert (Identity "aaa")

39−-- $ insert (Identity $ Just 'a')

40−-- $ insert (Identity 'a')

41−-- $ insert (Identity (11 :: Int)) empty