dependent-map 0.3 → 0.3.1.0

raw patch · 7 files changed

+146/−133 lines, 7 filesdep ~basedep ~containersdep ~dependent-sumnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers, dependent-sum

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• README.md +25/−21
• dependent-map.cabal +9/−8
• src/Data/Dependent/Map.hs +64/−32
• src/Data/Dependent/Map/Internal.hs +33/−41
• src/Data/Dependent/Map/Lens.hs +2/−6
• src/Data/Dependent/Map/PtrEquality.hs +4/−25

@@ -1,5 +1,14 @@ # Revision history for dependent-map +## 0.3.1.0 - 2020-03-24++* Drop support for non-GHC compilers.+* Drop support for GHC < 8.+* Update maintainer and GitHub links.+* Support `dependent-sum` 0.7.+* Add `ffor`, `fforWithKey`, `forWithKey`, `forWithKey_`, and `traverseWithKey_` to `Data.Dependent.Map`.+* Enable `PolyKinds` for `Data.Dependent.Map.Lens`.+ ## 0.3 - 2019-03-21  * Change instances of Eq, Ord, Read, Show to use Has' from constraints-extras instead of *Tag classes.

@@ -1,30 +1,34 @@-dependent-map [![Build Status](https://travis-ci.org/mokus0/dependent-map.svg)](https://travis-ci.org/mokus0/dependent-map)+dependent-map [![Build Status](https://travis-ci.org/obsidiansystems/dependent-map.svg)](https://travis-ci.org/obsidiansystems/dependent-map) [![Hackage](https://img.shields.io/hackage/v/dependent-map.svg)](http://hackage.haskell.org/package/dependent-map) ==============  This library defines a dependently-typed finite map type.  It is derived from Data.Map.Map in the containers package, but rather than (conceptually) storing pairs indexed by the first component, it stores `DSum`s (from the `dependent-sum` package) indexed by tag.  For example (using the types from the `dependent-sum` package's `FooGADT` example): -    {-# LANGUAGE GADTs #-}-    import FooGADT-    import Data.Dependent.Map-    -    x = fromList [Foo :=> pi, Baz :=> "hello there"]-    y = singleton Bar 42-    z = union y (read "fromList [Foo :=> (-1.1415926535897931)]")-    -    addFoo :: Foo v -> v -> v -> v-    addFoo Foo x y = x + y-    addFoo _   x _ = x-    -    main = mapM_ print-        [ x, y, z-        , unionWithKey addFoo x z-        ]+```haskell+{-# LANGUAGE GADTs #-}+import FooGADT+import Data.Dependent.Map +x = fromList [Foo :=> pi, Baz :=> "hello there"]+y = singleton Bar 42+z = union y (read "fromList [Foo :=> (-1.1415926535897931)]")++addFoo :: Foo v -> v -> v -> v+addFoo Foo x y = x + y+addFoo _   x _ = x++main = mapM_ print+  [ x, y, z+  , unionWithKey addFoo x z+  ]+```+ Which prints: -    fromList [Foo :=> 3.141592653589793,Baz :=> "hello there"]-    fromList [Bar :=> 42]-    fromList [Foo :=> -1.1415926535897931,Bar :=> 42]-    fromList [Foo :=> 2.0,Bar :=> 42,Baz :=> "hello there"]+```haskell+fromList [Foo :=> 3.141592653589793,Baz :=> "hello there"]+fromList [Bar :=> 42]+fromList [Foo :=> -1.1415926535897931,Bar :=> 42]+fromList [Foo :=> 2.0,Bar :=> 42,Baz :=> "hello there"]+```  This library can be found on Hackage: https://hackage.haskell.org/package/dependent-map

@@ -1,15 +1,15 @@ name:                   dependent-map-version:                0.3+version:                0.3.1.0 stability:              provisional  cabal-version:          >= 1.6 build-type:             Simple  author:                 James Cook <mokus@deepbondi.net>-maintainer:             James Cook <mokus@deepbondi.net>+maintainer:             Obsidian Systems, LLC <maintainer@obsidian.systems> license:                OtherLicense license-file:           LICENSE-homepage:               https://github.com/mokus0/dependent-map+homepage:               https://github.com/obsidiansystems/dependent-map  category:               Data, Dependent Types synopsis:               Dependent finite maps (partial dependent products)@@ -23,11 +23,12 @@ tested-with:            GHC == 8.0.2,                         GHC == 8.2.2,                         GHC == 8.4.4,-                        GHC == 8.6.4+                        GHC == 8.6.5,+                        GHC == 8.8.3  source-repository head   type:     git-  location: git://github.com/mokus0/dependent-map.git+  location: https://github.com/obsidiansystems/dependent-map  Library   hs-source-dirs:       src@@ -36,7 +37,7 @@                         Data.Dependent.Map.Lens,                         Data.Dependent.Map.Internal   other-modules:        Data.Dependent.Map.PtrEquality-  build-depends:        base >= 3 && < 5,-                        containers >= 0.6 && <0.7,-                        dependent-sum >= 0.6.1 && < 0.7,+  build-depends:        base >= 4.9 && < 5,+                        containers >= 0.5.7.1 && <0.7,+                        dependent-sum >= 0.6.1 && < 0.8,                         constraints-extras >= 0.2.3.0 && < 0.4

@@ -1,18 +1,14 @@-{-# LANGUAGE GADTs, RankNTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}--#endif module Data.Dependent.Map     ( DMap     , DSum(..), Some(..)@@ -72,8 +68,13 @@     -- * Traversal     -- ** Map     , map+    , ffor     , mapWithKey+    , fforWithKey+    , traverseWithKey_+    , forWithKey_     , traverseWithKey+    , forWithKey     , mapAccumLWithKey     , mapAccumRWithKey     , mapKeysWith@@ -146,27 +147,23 @@  import Prelude hiding (null, lookup, map) import qualified Prelude-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative(..), (<$>))-#endif-import Data.Dependent.Map.Internal-#if !MIN_VERSION_base(4,7,0)-import Data.Dependent.Map.Typeable ({- instance Typeable ... -})-#endif--import Data.Dependent.Sum-import Data.Constraint.Extras-import Data.GADT.Compare-import Data.GADT.Show+import Data.Constraint.Extras (Has', has')+import Data.Dependent.Sum (DSum((:=>)))+import Data.GADT.Compare (GCompare, GEq, GOrdering(..), gcompare, geq)+import Data.GADT.Show (GRead, GShow) import Data.Maybe (isJust)-#if !MIN_VERSION_base(4,8,0)-import Data.Monoid+import Data.Some (Some(..), mkSome)+import Data.Typeable ((:~:)(Refl))+import Text.Read (Lexeme(Ident), lexP, parens, prec, readListPrec,+                  readListPrecDefault, readPrec)++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup, (<>)) #endif-import Data.Semigroup-import Data.Some-import Text.Read-import Data.Dependent.Map.PtrEquality +import Data.Dependent.Map.Internal+import Data.Dependent.Map.PtrEquality (ptrEq)+ instance (GCompare k) => Monoid (DMap k f) where     mempty  = empty     mappend = union@@ -465,7 +462,7 @@                        Just x' -> Bin sx kx x' l r                        Nothing -> glue l r --- | Works the same as 'alter' except the new value is return in some 'Functor' @f@.+-- | Works the same as 'alter' except the new value is returned in some 'Functor' @f@. -- In short : @(\v' -> alter (const v') k dm) <$> f (lookup k dm)@ alterF :: forall k f v g. (GCompare  k, Functor f) => k v -> (Maybe (g v) -> f (Maybe (g v))) -> DMap k g -> f (DMap k g) alterF k f = go@@ -839,6 +836,12 @@     go Tip = Tip     go (Bin sx kx x l r) = Bin sx kx (f x) (go l) (go r) +-- | /O(n)/.+-- @'ffor' == 'flip' 'map'@ except we cannot actually use+-- 'flip' because of the lack of impredicative types.+ffor :: DMap k f -> (forall v. f v -> g v) -> DMap k g+ffor m f = map f m+ -- | /O(n)/. Map a function over all values in the map. mapWithKey :: (forall v. k v -> f v -> g v) -> DMap k f -> DMap k g mapWithKey f = go@@ -847,9 +850,32 @@     go (Bin sx kx x l r) = Bin sx kx (f kx x) (go l) (go r)  -- | /O(n)/.+-- @'fforWithKey' == 'flip' 'mapWithKey'@ except we cannot actually use+-- 'flip' because of the lack of impredicative types.+fforWithKey :: DMap k f -> (forall v. k v -> f v -> g v) -> DMap k g+fforWithKey m f = mapWithKey f m++-- | /O(n)/. -- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ -- That is, behaves exactly like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value.+traverseWithKey_ :: Applicative t => (forall v. k v -> f v -> t ()) -> DMap k f -> t ()+traverseWithKey_ f = go+  where+    go Tip = pure ()+    go (Bin 1 k v _ _) = f k v+    go (Bin s k v l r) = go l *> f k v *> go r++-- | /O(n)/.+-- @'forWithKey' == 'flip' 'traverseWithKey'@ except we cannot actually use+-- 'flip' because of the lack of impredicative types.+forWithKey_ :: Applicative t => DMap k f -> (forall v. k v -> f v -> t ()) -> t ()+forWithKey_ m f = traverseWithKey_ f m++-- | /O(n)/.+-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@+-- That is, behaves exactly like a regular 'traverse' except that the traversing+-- function also has access to the key associated with a value. traverseWithKey :: Applicative t => (forall v. k v -> f v -> t (g v)) -> DMap k f -> t (DMap k g) traverseWithKey f = go   where@@ -857,8 +883,14 @@     go (Bin 1 k v _ _) = (\v' -> Bin 1 k v' Tip Tip) <$> f k v     go (Bin s k v l r) = flip (Bin s k) <$> go l <*> f k v <*> go r +-- | /O(n)/.+-- @'forWithKey' == 'flip' 'traverseWithKey'@ except we cannot actually use+-- 'flip' because of the lack of impredicative types.+forWithKey :: Applicative t => DMap k f -> (forall v. k v -> f v -> t (g v)) -> t (DMap k g)+forWithKey m f = traverseWithKey f m+ -- | /O(n)/. The function 'mapAccumLWithKey' threads an accumulating--- argument throught the map in ascending order of keys.+-- argument through the map in ascending order of keys. mapAccumLWithKey :: (forall v. a -> k v -> f v -> (a, g v)) -> a -> DMap k f -> (a, DMap k g) mapAccumLWithKey f = go   where@@ -959,7 +991,7 @@  keys  :: DMap k f -> [Some k] keys m-  = [This k | (k :=> _) <- assocs m]+  = [mkSome k | (k :=> _) <- assocs m]  -- | /O(n)/. Return all key\/value pairs in the map in ascending key order. assocs :: DMap k f -> [DSum k f]@@ -1234,7 +1266,7 @@     bounded lo hi t'       = case t' of           Tip              -> True-          Bin _ kx _ l r  -> (lo (This kx)) && (hi (This kx)) && bounded lo (< This kx) l && bounded (> This kx) hi r+          Bin _ kx _ l r  -> lo (mkSome kx) && hi (mkSome kx) && bounded lo (< mkSome kx) l && bounded (> mkSome kx) hi r  -- | Exported only for "Debug.QuickCheck" balanced :: DMap k f -> Bool

@@ -1,28 +1,21 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Safe #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE PolyKinds #-}-#endif module Data.Dependent.Map.Internal where -import Data.Dependent.Sum-import Data.GADT.Compare-import Data.Some-#if MIN_VERSION_base(4,7,0)+import Data.Dependent.Sum (DSum((:=>)))+import Data.GADT.Compare (GCompare, GOrdering(..), gcompare)+import Data.Some (Some, mkSome, withSome) import Data.Typeable (Typeable)-#endif --- |Dependent maps: 'k' is a GADT-like thing with a facility for +-- |Dependent maps: 'k' is a GADT-like thing with a facility for -- rediscovering its type parameter, elements of which function as identifiers -- tagged with the type of the thing they identify.  Real GADTs are one--- useful instantiation of @k@, as are 'Tag's from "Data.Unique.Tag" in the +-- useful instantiation of @k@, as are 'Tag's from "Data.Unique.Tag" in the -- 'prim-uniq' package. -- -- Semantically, @'DMap' k f@ is equivalent to a set of @'DSum' k f@ where no two@@ -39,9 +32,7 @@         -> {- left  -} !(DMap k f)         -> {- right -} !(DMap k f)         -> DMap k f-#if MIN_VERSION_base(4,7,0)     deriving Typeable-#endif  {--------------------------------------------------------------------   Construction@@ -84,15 +75,15 @@     where         go :: DMap k f -> Maybe (f v)         go Tip = Nothing-        go (Bin _ kx x l r) = +        go (Bin _ kx x l r) =             case gcompare k kx of                 GLT -> go l                 GGT -> go r                 GEQ -> Just x  lookupAssoc :: forall k f v. GCompare k => Some k -> DMap k f -> Maybe (DSum k f)-lookupAssoc (This k) = k `seq` go-  where+lookupAssoc sk = withSome sk $ \k ->+  let     go :: DMap k f -> Maybe (DSum k f)     go Tip = Nothing     go (Bin _ kx x l r) =@@ -100,12 +91,13 @@             GLT -> go l             GGT -> go r             GEQ -> Just (kx :=> x)+  in k `seq` go  {--------------------------------------------------------------------   Utility functions that maintain the balance properties of the tree.   All constructors assume that all values in [l] < [k] and all values   in [r] > [k], and that [l] and [r] are valid trees.-  +   In order of sophistication:     [Bin sz k x l r]  The type constructor.     [bin k x l r]     Maintains the correct size, assumes that both [l]@@ -113,7 +105,7 @@     [balance k x l r] Restores the balance and size.                       Assumes that the original tree was balanced and                       that [l] or [r] has changed by at most one element.-    [combine k x l r] Restores balance and size. +    [combine k x l r] Restores balance and size.    Furthermore, we can construct a new tree from two trees. Both operations   assume that all values in [l] < all values in [r] and that [l] and [r]@@ -123,10 +115,10 @@     [merge l r]       Merges two trees and restores balance.    Note: in contrast to Adam's paper, we use (<=) comparisons instead-  of (<) comparisons in [combine], [merge] and [balance]. -  Quickcheck (on [difference]) showed that this was necessary in order -  to maintain the invariants. It is quite unsatisfactory that I haven't -  been able to find out why this is actually the case! Fortunately, it +  of (<) comparisons in [combine], [merge] and [balance].+  Quickcheck (on [difference]) showed that this was necessary in order+  to maintain the invariants. It is quite unsatisfactory that I haven't+  been able to find out why this is actually the case! Fortunately, it   doesn't hurt to be a bit more conservative. --------------------------------------------------------------------} @@ -149,13 +141,13 @@       Tip -> singleton kx x       Bin _ ky y l r           -> balance ky y l (insertMax kx x r)-             + insertMin kx x t   = case t of       Tip -> singleton kx x       Bin _ ky y l r           -> balance ky y (insertMin kx x l) r-             + {--------------------------------------------------------------------   [merge l r]: merges two trees. --------------------------------------------------------------------}@@ -174,13 +166,13 @@ glue :: DMap k f -> DMap k f -> DMap k f glue Tip r = r glue l Tip = l-glue l r   +glue l r   | size l > size r = case deleteFindMax l of (km :=> m,l') -> balance km m l' r   | otherwise       = case deleteFindMin r of (km :=> m,r') -> balance km m l r'  -- | /O(log n)/. Delete and find the minimal element. ----- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")]) +-- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")]) -- > deleteFindMin                                            Error: can not return the minimal element of an empty map  deleteFindMin :: DMap k f -> (DSum k f, DMap k f)@@ -251,13 +243,13 @@   [ratio] is the ratio between an outer and inner sibling of the           heavier subtree in an unbalanced setting. It determines           whether a double or single rotation should be performed-          to restore balance. It is correspondes with the inverse+          to restore balance. It corresponds with the inverse           of $\alpha$ in Adam's article.    Note that:   - [delta] should be larger than 4.646 with a [ratio] of 2.   - [delta] should be larger than 3.745 with a [ratio] of 1.534.-  +   - A lower [delta] leads to a more 'perfectly' balanced tree.   - A higher [delta] performs less rebalancing. @@ -267,7 +259,7 @@     [delta] may perform better than smaller one.    Note: in contrast to Adam's paper, we use a ratio of (at least) [2]-  to decide whether a single or double rotation is needed. Allthough+  to decide whether a single or double rotation is needed. Although   he actually proves that this ratio is needed to maintain the   invariants, his implementation uses an invalid ratio of [1]. --------------------------------------------------------------------}@@ -344,17 +336,17 @@ trim :: (Some k -> Ordering) -> (Some k -> Ordering) -> DMap k f -> DMap k f trim _     _     Tip = Tip trim cmplo cmphi t@(Bin _ kx _ l r)-  = case cmplo (This kx) of-      LT -> case cmphi (This kx) of+  = case cmplo (mkSome kx) of+      LT -> case cmphi (mkSome kx) of               GT -> t               _  -> trim cmplo cmphi l       _  -> trim cmplo cmphi r-              + trimLookupLo :: GCompare k => Some k -> (Some k -> Ordering) -> DMap k f -> (Maybe (DSum k f), DMap k f) trimLookupLo _  _     Tip = (Nothing,Tip) trimLookupLo lo cmphi t@(Bin _ kx x l r)-  = case compare lo (This kx) of-      LT -> case cmphi (This kx) of+  = case compare lo (mkSome kx) of+      LT -> case cmphi (mkSome kx) of               GT -> (lookupAssoc lo t, t)               _  -> trimLookupLo lo cmphi l       GT -> trimLookupLo lo cmphi r@@ -369,7 +361,7 @@ filterGt cmp = go   where     go Tip              = Tip-    go (Bin _ kx x l r) = case cmp (This kx) of+    go (Bin _ kx x l r) = case cmp (mkSome kx) of               LT -> combine kx x (go l) r               GT -> go r               EQ -> r@@ -378,7 +370,7 @@ filterLt cmp = go   where     go Tip              = Tip-    go (Bin _ kx x l r) = case cmp (This kx) of+    go (Bin _ kx x l r) = case cmp (mkSome kx) of           LT -> go l           GT -> combine kx x l (go r)           EQ -> l

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-} -- | -- Some functions for using lenses with 'DMap'. module Data.Dependent.Map.Lens@@ -11,17 +11,13 @@  import           Prelude             hiding (lookup) -#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative (Applicative (pure))-#endif- import           Data.Dependent.Map  (DMap, alterF, insert, lookup)  import           Data.GADT.Compare   (GCompare)  -- | -- These functions have been specialised for use with 'DMap' but without any of the--- specific 'lens' types used so that we have compatilibity without needing the+-- specific 'lens' types used so that we have compatibility without needing the -- dependency just for these functions. -- 

@@ -1,7 +1,4 @@-{-# LANGUAGE CPP #-}-#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash #-}-#endif  {-# OPTIONS_HADDOCK hide #-} @@ -13,7 +10,7 @@ -- -- The Package Versioning Policy __does not apply__. ----- This contents of this module may change __in any way whatsoever__+-- The contents of this module may change __in any way whatsoever__ -- and __without any warning__ between minor versions of this package. -- -- Authors importing this module are expected to track development@@ -21,16 +18,10 @@  module Data.Dependent.Map.PtrEquality (ptrEq, hetPtrEq) where -#ifdef __GLASGOW_HASKELL__-import GHC.Exts ( reallyUnsafePtrEquality# )-import Unsafe.Coerce ( unsafeCoerce )-#if __GLASGOW_HASKELL__ < 707-import GHC.Exts ( (==#) )-#else-import GHC.Exts ( isTrue# )-#endif-#endif+import Unsafe.Coerce (unsafeCoerce)+import GHC.Exts (isTrue#, reallyUnsafePtrEquality#) + -- | Checks if two pointers are equal. Yes means yes; -- no means maybe. The values should be forced to at least -- WHNF before comparison to get moderately reliable results.@@ -42,20 +33,8 @@ -- reliable results. hetPtrEq :: a -> b -> Bool -#ifdef __GLASGOW_HASKELL__-#if __GLASGOW_HASKELL__ < 707-ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#-hetPtrEq x y = unsafeCoerce reallyUnsafePtrEquality# x y ==# 1#-#else ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y) hetPtrEq x y = isTrue# (unsafeCoerce reallyUnsafePtrEquality# x y)-#endif--#else--- Not GHC-ptrEq _ _ = False-hetPtrEq _ _ = False-#endif  {-# INLINE ptrEq #-} {-# INLINE hetPtrEq #-}