typerep-map 0.3.1 → 0.3.2
raw patch · 6 files changed
+95/−60 lines, 6 filesdep ~dependent-sumdep ~primitive
Dependency ranges changed: dependent-sum, primitive
Files
- CHANGELOG.md +13/−7
- benchmark/DMap.hs +8/−27
- src/Data/TMap.hs +2/−2
- src/Data/TypeRepMap/Internal.hs +56/−21
- test/Test/TypeRep/MapProperty.hs +13/−0
- typerep-map.cabal +3/−3
CHANGELOG.md view
@@ -1,16 +1,22 @@-Change log-==========+# Changelog `typerep-map` uses [PVP Versioning][1].-The change log is available [on GitHub][2].+The changelog is available [on GitHub][2]. -# 0.3.1+## 0.3.2 — Mar 27, 2019 +* [#47](https://github.com/kowainik/typerep-map/issues/47):+ Add `Eq` instance for `TypeRepMap` using `-XQuantifiedConstraints`.+* [#70](https://github.com/kowainik/typerep-map/issues/70):+ Bump up to `dependent-sum-0.5`.++## 0.3.1+ * [#64](https://github.com/kowainik/typerep-map/issues/64): Fix segfault in `toList`. * Support GHC 8.4.4 and 8.6.3. -# 0.3.0+## 0.3.0 * [#46](https://github.com/kowainik/typerep-map/issues/46): Make `Show` instance for `TypeRepMap` show keys.@@ -22,7 +28,7 @@ instead of `IntMap`. -# 0.2.0+## 0.2.0 * [#43](https://github.com/kowainik/typerep-map/issues/43): Implement `IsList` instance for `TypeRepMap`.@@ -32,7 +38,7 @@ Add `map` function for `TMap`. * Drop support for `ghc-8.0.2`. -# 0.1.0+## 0.1.0 * Initially created.
benchmark/DMap.hs view
@@ -6,31 +6,27 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver -fno-warn-orphans #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} module DMap ( spec ) where -import Criterion.Main (bench, nf, whnf, env)+import Criterion.Main (bench, env, nf, whnf) import Prelude hiding (lookup) -import Spec-import Control.DeepSeq (NFData(..))+import Control.DeepSeq (NFData (..)) import Data.Maybe (fromJust) import Data.Proxy (Proxy (..))-import Data.Type.Equality ((:~:) (..)) import GHC.TypeLits+import Spec import Type.Reflection (TypeRep, Typeable, typeRep) import Type.Reflection.Unsafe (typeRepFingerprint)-import Unsafe.Coerce (unsafeCoerce) import Data.Dependent.Map (DMap, empty, insert, keys, lookup)-import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))-import Data.Some (Some (This))+import Data.Some (Some (Some)) type TypeRepMap = DMap TypeRep @@ -40,7 +36,7 @@ { benchLookup = Just $ \name -> env mkBigMap $ \ ~(DMapNF bigMap) -> bench name $ nf tenLookups bigMap- , benchInsertSmall = Just $ \name -> + , benchInsertSmall = Just $ \name -> bench name $ whnf (inserts empty 10) (Proxy @ 99999) , benchInsertBig = Just $ \name -> env mkBigMap $ \ ~(DMapNF bigMap) ->@@ -86,20 +82,5 @@ newtype DMapNF f = DMapNF (TypeRepMap f) instance NFData (DMapNF f) where- rnf (DMapNF x) = - rnf . map (\(This t) -> typeRepFingerprint t) $ keys x--instance GEq TypeRep where- geq :: TypeRep a -> TypeRep b -> Maybe (a :~: b)- geq (typeRepFingerprint -> a) (typeRepFingerprint -> b) =- if a == b- then Just $ unsafeCoerce Refl- else Nothing--instance GCompare TypeRep where- gcompare :: TypeRep a -> TypeRep b -> GOrdering a b- gcompare (typeRepFingerprint -> a) (typeRepFingerprint -> b) =- case compare a b of- EQ -> unsafeCoerce GEQ- LT -> GLT- GT -> GGT+ rnf (DMapNF x) =+ rnf . map (\(Some t) -> typeRepFingerprint t) $ keys x
src/Data/TMap.hs view
@@ -110,10 +110,10 @@ {-# INLINE delete #-} -- | The union of two 'TMap's using a combining function.-unionWith :: (forall x. x -> x -> x) -> TMap -> TMap -> TMap+unionWith :: (forall x. Typeable x => x -> x -> x) -> TMap -> TMap -> TMap unionWith f = F.unionWith fId where- fId :: forall y . Identity y -> Identity y -> Identity y+ fId :: forall y . Typeable y => Identity y -> Identity y -> Identity y fId y1 y2 = Identity $ f (coerce y1) (coerce y2) {-# INLINE unionWith #-}
src/Data/TypeRepMap/Internal.hs view
@@ -1,33 +1,40 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#endif+ -- {-# OPTIONS_GHC -ddump-simpl -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes #-} --- | Internal API for 'TypeRepMap' and operations on it. The functions here do--- not have any stability guarantees and can change between minor versions.------ If you need to use this module for purposes other than tests,--- create an issue.---+{- | Internal API for 'TypeRepMap' and operations on it. The functions here do+not have any stability guarantees and can change between minor versions.++If you need to use this module for purposes other than tests,+create an issue.+-}+ module Data.TypeRepMap.Internal where import Prelude hiding (lookup) +import Control.DeepSeq import Control.Monad.ST (ST, runST) import Control.Monad.Zip (mzip)-import Control.DeepSeq import Data.Function (on) import Data.Kind (Type)+import Data.Type.Equality ((:~:) (..), TestEquality (..)) import Data.List (intercalate, nubBy) import Data.Primitive.Array (Array, MutableArray, indexArray, mapArray', readArray, sizeofArray, thawArray, unsafeFreezeArray, writeArray)@@ -97,6 +104,31 @@ {-# INLINE mempty #-} {-# INLINE mappend #-} +#if __GLASGOW_HASKELL__ >= 806+instance (forall a. Typeable a => Eq (f a)) => Eq (TypeRepMap f) where+ tm1 == tm2 = size tm1 == size tm2 && go 0+ where+ go :: Int -> Bool+ go i+ | i == size tm1 = True+ | otherwise = case testEquality tr1i tr2i of+ Nothing -> False+ Just Refl -> repEq tr1i (fromAny tv1i) (fromAny tv2i) && go (i + 1)+ where+ tr1i :: TypeRep x+ tr1i = anyToTypeRep $ indexArray (trKeys tm1) i++ tr2i :: TypeRep y+ tr2i = anyToTypeRep $ indexArray (trKeys tm2) i++ tv1i, tv2i :: Any+ tv1i = indexArray (trAnys tm1) i+ tv2i = indexArray (trAnys tm2) i++ repEq :: TypeRep x -> f x -> f x -> Bool+ repEq tr = withTypeable tr (==)+#endif+ -- | Returns the list of 'Fingerprint's from 'TypeRepMap'. toFingerprints :: TypeRepMap f -> [Fingerprint] toFingerprints TypeRepMap{..} =@@ -220,15 +252,18 @@ {-# INLINE hoistWithKey #-} -- | The union of two 'TypeRepMap's using a combining function.-unionWith :: (forall x. f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f+unionWith :: forall f. (forall x. Typeable x => f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f unionWith f m1 m2 = fromTriples $ toTripleList $ Map.unionWith combine (fromTripleList $ toTriples m1) (fromTripleList $ toTriples m2) where+ f' :: forall x. TypeRep x -> f x -> f x -> f x+ f' tr = withTypeable tr f+ combine :: (Any, Any) -> (Any, Any) -> (Any, Any)- combine (av, ak) (bv, _) = (toAny $ f (fromAny av) (fromAny bv), ak)+ combine (av, ak) (bv, _) = (toAny $ f' (fromAny ak) (fromAny av) (fromAny bv), ak) fromTripleList :: Ord a => [(a, b, c)] -> Map.Map a (b, c) fromTripleList = Map.fromList . map (\(a, b, c) -> (a, (b, c)))
test/Test/TypeRep/MapProperty.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-}@@ -65,6 +66,7 @@ -- Semigroup and Monoid laws ---------------------------------------------------------------------------- +#if __GLASGOW_HASKELL__ < 806 -- This newtype is used to compare 'TypeRepMap's using only 'Fingerprint's. It's -- not a good idea to write such `Eq` instance for `TypeRepMap` itself because -- it doesn't compare values so it's not true equality. But this should be@@ -75,18 +77,29 @@ instance Eq (FpMap f) where FpMap (TypeRepMap as1 bs1 _ _) == FpMap (TypeRepMap as2 bs2 _ _) = as1 == as2 && bs1 == bs2+#endif test_SemigroupAssoc :: PropertyTest test_SemigroupAssoc = prop "x <> (y <> z) == (x <> y) <> z" $ do+#if __GLASGOW_HASKELL__ >= 806+ x <- forAll genMap+ y <- forAll genMap+ z <- forAll genMap+#else x <- FpMap <$> forAll genMap y <- FpMap <$> forAll genMap z <- FpMap <$> forAll genMap+#endif (x <> (y <> z)) === ((x <> y) <> z) test_MonoidIdentity :: PropertyTest test_MonoidIdentity = prop "x <> mempty == mempty <> x == x" $ do+#if __GLASGOW_HASKELL__ >= 806+ x <- forAll genMap+#else x <- FpMap <$> forAll genMap+#endif x <> mempty === x mempty <> x === x
typerep-map.cabal view
@@ -1,5 +1,5 @@ name: typerep-map-version: 0.3.1+version: 0.3.2 synopsis: Efficient implementation of a dependent map with types as keys description: A dependent map from type representations to values of these types.@@ -22,7 +22,7 @@ license-file: LICENSE author: Kowainik, Vladislav Zavialov maintainer: xrom.xkov@gmail.com-copyright: 2017-present Kowainik+copyright: 2017-2019 Kowainik category: Data, Data Structures, Types build-type: Simple extra-doc-files: README.md@@ -111,7 +111,7 @@ , criterion >= 1.4.1.0 && < 1.6 , deepseq ^>= 1.4.3.0 , dependent-map >= 0.2.4.0 && < 0.5- , dependent-sum ^>= 0.4+ , dependent-sum ^>= 0.5 , ghc-typelits-knownnat >= 0.4.2 && < 0.7 , typerep-map , typerep-extra-impls