packages feed

primitive-containers 0.3.2 → 0.3.3

raw patch · 5 files changed

+439/−33 lines, 5 files

Files

primitive-containers.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: primitive-containers-version: 0.3.2+version: 0.3.3 synopsis: containers backed by arrays description:   Containers backed by flat arrays. Updates require rebuilding the@@ -83,6 +83,8 @@     Data.Dependent.Map.Unlifted.Lifted     Data.Dependent.Map.Unboxed.Lifted     Data.Map.Interval.DBTSLL+    Data.Map.Interval.DBTSUL+    Data.Map.Interval.DBTSUU   other-modules:     Data.Concatenation     Data.Diet.Map.Strict.Internal
src/Data/Map/Interval/DBTS/Internal.hs view
@@ -1,8 +1,12 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}  module Data.Map.Interval.DBTS.Internal   ( Map@@ -29,14 +33,18 @@   , concat   , elems   , size+  , convertKeys+  , convertKeysValues   ) where  import Prelude hiding (pure,lookup,compare,map,showsPrec,concat,traverse,foldMap)  import Control.Monad.ST (ST,runST) import Control.Monad.Primitive (PrimMonad)+import Data.Kind (Type) import Data.Primitive (PrimArray) import Data.Primitive.Contiguous (Contiguous,Element,Mutable)+import GHC.Exts (ArrayArray#) import qualified Data.Concatenation as C import qualified Data.Primitive.Contiguous as I import qualified Prelude as P@@ -51,23 +59,50 @@ --   Would be represented by the keys: --    --   > 5,17,20,65536-data Map karr varr k v = Map !(karr k) !(varr v)+data Map :: (Type -> Type) -> (Type -> Type) -> Type -> Type -> Type where+  MapInternal :: ArrayArray# -> ArrayArray# -> Map karr varr k v+  -- Map !(karr k) !(varr v) +typedArrays :: (Contiguous karr, Contiguous varr) => Map karr varr k v -> (karr k, varr v)+typedArrays (MapInternal ks vs) = (I.lift ks, I.lift vs)++typedValues :: Contiguous varr => Map karr varr k v -> (# ArrayArray#, varr v #)+typedValues (MapInternal ks vs) = (# ks, I.lift vs #)++typedKeys :: Contiguous karr => Map karr varr k v -> (# karr k, ArrayArray# #)+typedKeys (MapInternal ks vs) = (# I.lift ks, vs #)++pattern Map :: (Contiguous karr, Contiguous varr) => () => karr k -> varr v -> Map karr varr k v+pattern Map ks vs <- (typedArrays -> (ks,vs)) where+  Map xs ys = MapInternal (I.unlift xs) (I.unlift ys)++pattern MapValues :: Contiguous varr => () => ArrayArray# -> varr v -> Map karr varr k v+pattern MapValues ks vs <- (typedValues -> (# ks, vs #)) where+  MapValues xs ys = MapInternal xs (I.unlift ys)++pattern MapKeys :: Contiguous karr => () => karr k -> ArrayArray# -> Map karr varr k v+pattern MapKeys ks vs <- (typedKeys -> (# ks, vs #)) where+  MapKeys xs ys = MapInternal (I.unlift xs) ys++{-# COMPLETE Map #-}+{-# COMPLETE MapValues #-}+{-# COMPLETE MapKeys #-}+ equals :: (Contiguous karr, Element karr k, Eq k, Contiguous varr, Element varr v, Eq v) => Map karr varr k v -> Map karr varr k v -> Bool equals (Map k1 v1) (Map k2 v2) = I.equals k1 k2 && I.equals v1 v2  size :: (Contiguous varr, Element varr v)   => Map karr varr k v   -> Int-size (Map _ v) = I.size v+size (MapValues _ v) = I.size v  -- compare :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v, Ord v) => Map karr varr k v -> Map karr varr k v -> Bool -- compare (Map k1 v1) (Map k2 v2) = mappend (I.compare k1 k2) (I.compare v1 v2)  -- Note: this is only correct when the function is a bijection.-mapBijection :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w)+mapBijection :: (Contiguous varr, Element varr v, Element varr w)   => (v -> w) -> Map karr varr k v -> Map karr varr k w-mapBijection f (Map k v) = Map k (I.map f v)+mapBijection f (MapValues k v) = MapValues k (I.map f v)  -- The function does not need to be a bijection. It may cause adjacent -- keys to collapse if their values become the same.@@ -115,18 +150,18 @@           -- Note: this is only correct when the function is a bijection.-traverseP :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w, PrimMonad m)+traverseP :: (Contiguous varr, Element varr v, Element varr w, PrimMonad m)   => (v -> m w) -> Map karr varr k v -> m (Map karr varr k w)-traverseP f (Map k v) = fmap (Map k) (I.traverseP f v)+traverseP f (MapValues k v) = fmap (MapValues k) (I.traverseP f v)  -- Note: this is only correct when the function is a bijection.-traverse :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr w, Applicative m)+traverse :: (Contiguous varr, Element varr v, Element varr w, Applicative m)   => (v -> m w) -> Map karr varr k v -> m (Map karr varr k w)-traverse f (Map k v) = fmap (Map k) (I.traverse f v)+traverse f (MapValues k v) = fmap (MapValues k) (I.traverse f v) -traverse_ :: (Contiguous varr, Element varr v, Element varr w, Applicative m)+traverse_ :: (Contiguous varr, Element varr v, Applicative m)   => (v -> m w) -> Map karr varr k v -> m ()-traverse_ f (Map _ v) = I.traverse_ f v+traverse_ f (MapValues _ v) = I.traverse_ f v  pure :: (Contiguous karr, Contiguous varr, Element karr k, Element varr v, Bounded k) => v -> Map karr varr k v pure v = Map@@ -197,21 +232,31 @@       else pure v   else pure def -lookup :: forall karr varr k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v) => k -> Map karr varr k v -> v-lookup a (Map keys vals) = go 0 (I.size vals - 1) where+lookup :: forall karr varr k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)+  => k -> Map karr varr k v -> v+lookup a (Map keys vals) = go 0 (I.size vals - 1)+  where   go :: Int -> Int -> v-  go !start !end = if end == start-    then-      let !(# v #) = I.index# vals start-       in v-    else-      let !mid = div (end + start) 2-          !valHi = I.index keys mid-       in case P.compare a valHi of-            LT -> go start mid-            EQ -> case I.index# vals mid of-              (# v #) -> v-            GT -> go (mid + 1) end+  go !start !end+    -- The threshold used here could be any nonnegative number.+    -- This algorithm will be correct regardless. Switching from+    -- a divide-and-conquer approach to a simple scan when the map+    -- is small improves performance.+    | delta > 8 =+        let !mid = div (end + start) 2+            !valHi = I.index keys mid+         in case P.compare a valHi of+              LT -> go start mid+              EQ -> let !(# v #) = I.index# vals mid in v+              GT -> go (mid + 1) end+    | otherwise = finish start end+    where !delta = end - start+  finish :: Int -> Int -> v+  finish !start !end =+    let !(# val #) = I.index# keys start+     in if a > val+          then finish (start + 1) end+          else let !(# v #) = I.index# vals start in v {-# INLINEABLE lookup #-}  union :: forall karr varr k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v, Eq v, Semigroup v)@@ -346,20 +391,20 @@   -> b   -> Map karr varr k v   -> b-foldl' f b0 (Map _ vals) = I.foldl' f b0 vals+foldl' f b0 (MapValues _ vals) = I.foldl' f b0 vals  foldlM' :: (Contiguous varr, Element varr v, Monad m)   => (b -> v -> m b)   -> b   -> Map karr varr k v   -> m b-foldlM' f b0 (Map _ vals) = I.foldlM' f b0 vals+foldlM' f b0 (MapValues _ vals) = I.foldlM' f b0 vals  foldMap :: (Contiguous varr, Element varr v, Monoid m)   => (v -> m)   -> Map karr varr k v   -> m-foldMap f (Map _ vals) = I.foldMap f vals+foldMap f (MapValues _ vals) = I.foldMap f vals  toList :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Bounded k, Enum k)   => Map karr varr k v@@ -387,5 +432,18 @@   -> Map karr varr k v concat = concatWith mempty mappend -elems :: Map karr varr k v -> varr v-elems (Map _ v) = v+elems :: Contiguous varr => Map karr varr k v -> varr v+elems (MapValues _ v) = v++-- TODO: use convert instead of map once that function+-- is released in a version of contiguous.+convertKeys :: (Contiguous karr, Element karr k, Contiguous jarr, Element jarr k)+  => Map karr varr k v -> Map jarr varr k v+convertKeys (MapKeys ks vs) = MapKeys (I.map id ks) vs++-- TODO: use convert instead of map once that function+-- is released in a version of contiguous.+convertKeysValues :: (Contiguous karr, Element karr k, Contiguous jarr, Element jarr k, Contiguous varr, Element varr v, Contiguous warr, Element warr v)+  => Map karr varr k v -> Map jarr warr k v+convertKeysValues (Map ks vs) = Map (I.map id ks) (I.map id vs)+
src/Data/Map/Interval/DBTSLL.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE UnboxedTuples #-}  module Data.Map.Interval.DBTSLL-  ( Map+  ( Map(..) -- data constructor exposed as a hack   , pure   , singleton   , lookup
+ src/Data/Map/Interval/DBTSUL.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}++module Data.Map.Interval.DBTSUL+  ( Map+  , pure+  , singleton+  , lookup+  , fromList+  , unionWith+    -- * Mapping+  , map+  , mapBijection+    -- * Traversals+  , traverseBijectionP+  , traverseBijection+    -- * Folds+  , foldl'+  , foldlM'+  , foldMap+  , foldrWithKey+  , foldlWithKeyM'+  , traverse_+    -- * Properties+  , size+    -- * Conversion+  , elems+  , toList+  , fromLiftedLifted+  ) where++import Prelude hiding (lookup,map,pure,foldMap)++import Data.Semigroup (Semigroup)+import Data.Primitive.Array (Array)+import Data.Primitive (PrimArray)+import Data.Primitive.Types (Prim)+import Control.Monad.Primitive (PrimMonad)+import qualified Data.Semigroup as SG+import qualified Data.Map.Interval.DBTS.Internal as I+import qualified Data.Map.Interval.DBTSLL as DBTSLL+import qualified GHC.Exts as E++-- | A total interval map from keys @k@ to values @v@. The key type must be discrete+--   and bounded. This map is strict in the values. The key type must have a+--   'Prim' instance.+newtype Map k v = Map (I.Map PrimArray Array k v)++instance (Prim k, Eq k, Eq v) => Eq (Map k v) where+  Map x == Map y = I.equals x y++instance (Prim k, Ord k, Semigroup v, Eq v) => Semigroup (Map k v) where+  Map x <> Map y = Map (I.union x y)++-- The redundant constraint is needed for GHC < 8.4+instance (Prim k, Ord k, Bounded k, Semigroup v, Monoid v, Eq v) => Monoid (Map k v) where+  mappend = (SG.<>) +  mempty = Map I.empty+  mconcat = Map . I.concat . E.coerce++instance (Prim k, Bounded k, Enum k, Show k, Show v) => Show (Map k v) where+  showsPrec p (Map m) = I.showsPrec p m++instance (Prim k, Bounded k, Enum k, Ord k, Eq v, Monoid v) => E.IsList (Map k v) where+  type Item (Map k v) = (k,k,v)+  fromList xs = Map (I.fromList mempty xs)+  toList (Map m) = I.toList m++pure :: (Prim k, Bounded k) => v -> Map k v+pure = Map . I.pure ++singleton :: (Prim k, Bounded k, Enum k, Ord k, Eq v)+  => v -- ^ value outside of the interval+  -> k -- ^ lower bound+  -> k -- ^ upper bound+  -> v -- ^ value inside the interval+  -> Map k v+singleton def lo hi v = Map (I.singleton def lo hi v)++-- | /O(log n)/ Lookup a key. The value corresponding to the range+--   that contains this key will be returned.+lookup :: (Ord k, Prim k) => k -> Map k v -> v+lookup k (Map m) = I.lookup k m++-- | Create an interval map from a list of range-value triples. The first+--   argument is a default value used everywhere outside of the given+--   ranges. In the case of overlapping ranges, the leftmost value is+--   used.+fromList :: (Prim k, Bounded k, Ord k, Enum k, Eq v)+  => v -- ^ value outside of the ranges+  -> [(k,k,v)] -- ^ low-high inclusive ranges with their corresponding values+  -> Map k v+fromList def xs = Map (I.fromList def xs)++-- | This only provides a correct result when the effectful mapping+--   is a bijection.+traverseBijectionP :: PrimMonad m+  => (v -> m w) -> Map k v -> m (Map k w)+traverseBijectionP f (Map m) = fmap Map (I.traverseP f m)++-- | This only provides a correct result when the effectful mapping+--   is a bijection.+traverseBijection :: Applicative m+  => (v -> m w) -> Map k v -> m (Map k w)+traverseBijection f (Map m) = fmap Map (I.traverse f m)++traverse_ :: Applicative m => (v -> m w) -> Map k v -> m ()+traverse_ f (Map m) = I.traverse_ f m++mapBijection :: (v -> w) -> Map k v -> Map k w+mapBijection f (Map m) = Map (I.mapBijection f m)++map :: (Prim k, Eq w) => (v -> w) -> Map k v -> Map k w+map f (Map m) = Map (I.map f m)++foldl' :: Prim k+  => (b -> v -> b)+  -> b+  -> Map k v+  -> b+foldl' f b0 (Map m) = I.foldl' f b0 m++foldlM' :: (Monad m, Prim k)+  => (b -> v -> m b)+  -> b+  -> Map k v+  -> m b+foldlM' f b0 (Map m) = I.foldlM' f b0 m++foldMap :: (Monoid m, Prim k)+  => (v -> m)+  -> Map k v+  -> m+foldMap f (Map m) = I.foldMap f m++unionWith :: (Ord k, Eq c, Prim k)+  => (a -> b -> c)+  -> Map k a+  -> Map k b+  -> Map k c+unionWith f (Map a) (Map b) = Map (I.unionWith f a b)++foldrWithKey :: (Bounded k, Enum k, Prim k)+  => (k -> k -> v -> b -> b)+  -> b+  -> Map k v+  -> b+foldrWithKey f z (Map m) = I.foldrWithKey f z m++foldlWithKeyM' :: (Bounded k, Enum k, Monad m, Prim k)+  => (b -> k -> k -> v -> m b)+  -> b+  -> Map k v+  -> m b+foldlWithKeyM' f z (Map m) = I.foldlWithKeyM' f z m++-- | The number of values in the interval map. Also the number of+--   contiguous key ranges in the map.+size :: Map k v -> Int+size (Map m) = I.size m++elems :: Map k v -> Array v+elems (Map m) = I.elems m++toList :: (Bounded k, Enum k, Prim k) => Map k v -> [(k,k,v)]+toList (Map m) = I.toList m++fromLiftedLifted :: Prim k => DBTSLL.Map k v -> Map k v+fromLiftedLifted (DBTSLL.Map m) = Map (I.convertKeys m)
+ src/Data/Map/Interval/DBTSUU.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}++module Data.Map.Interval.DBTSUU+  ( Map+  , pure+  , singleton+  , lookup+  , fromList+  , unionWith+    -- * Mapping+  , map+  , mapBijection+    -- * Traversals+  , traverseBijectionP+  , traverseBijection+    -- * Folds+  , foldl'+  , foldlM'+  , foldMap+  , foldrWithKey+  , foldlWithKeyM'+  , traverse_+    -- * Properties+  , size+    -- * Conversion+  , elems+  , toList+  , fromLiftedLifted+  ) where++import Prelude hiding (lookup,map,pure,foldMap)++import Data.Semigroup (Semigroup)+import Data.Primitive.Array (Array)+import Data.Primitive (PrimArray)+import Data.Primitive.Types (Prim)+import Control.Monad.Primitive (PrimMonad)+import qualified Data.Semigroup as SG+import qualified Data.Map.Interval.DBTS.Internal as I+import qualified Data.Map.Interval.DBTSLL as DBTSLL+import qualified GHC.Exts as E++-- | A total interval map from keys @k@ to values @v@. The key type must be discrete+--   and bounded. This map is strict in the values. The key type and the value type+--   must both have 'Prim' instances.+newtype Map k v = Map (I.Map PrimArray PrimArray k v)++instance (Prim k, Prim v, Eq k, Eq v) => Eq (Map k v) where+  Map x == Map y = I.equals x y++instance (Prim k, Prim v, Ord k, Semigroup v, Eq v) => Semigroup (Map k v) where+  Map x <> Map y = Map (I.union x y)++-- The redundant constraint is needed for GHC < 8.4+instance (Prim k, Ord k, Bounded k, Prim v, Semigroup v, Monoid v, Eq v) => Monoid (Map k v) where+  mappend = (SG.<>) +  mempty = Map I.empty+  mconcat = Map . I.concat . E.coerce++instance (Prim k, Bounded k, Enum k, Show k, Prim v, Show v) => Show (Map k v) where+  showsPrec p (Map m) = I.showsPrec p m++instance (Prim k, Bounded k, Enum k, Ord k, Prim v, Eq v, Monoid v) => E.IsList (Map k v) where+  type Item (Map k v) = (k,k,v)+  fromList xs = Map (I.fromList mempty xs)+  toList (Map m) = I.toList m++pure :: (Prim k, Bounded k, Prim v) => v -> Map k v+pure = Map . I.pure ++singleton :: (Prim k, Bounded k, Enum k, Ord k, Prim v, Eq v)+  => v -- ^ value outside of the interval+  -> k -- ^ lower bound+  -> k -- ^ upper bound+  -> v -- ^ value inside the interval+  -> Map k v+singleton def lo hi v = Map (I.singleton def lo hi v)++-- | /O(log n)/ Lookup a key. The value corresponding to the range+--   that contains this key will be returned.+lookup :: (Ord k, Prim k, Prim v) => k -> Map k v -> v+lookup k (Map m) = I.lookup k m++-- | Create an interval map from a list of range-value triples. The first+--   argument is a default value used everywhere outside of the given+--   ranges. In the case of overlapping ranges, the leftmost value is+--   used.+fromList :: (Prim k, Bounded k, Ord k, Enum k, Prim v, Eq v)+  => v -- ^ value outside of the ranges+  -> [(k,k,v)] -- ^ low-high inclusive ranges with their corresponding values+  -> Map k v+fromList def xs = Map (I.fromList def xs)++-- | This only provides a correct result when the effectful mapping+--   is a bijection.+traverseBijectionP :: (PrimMonad m, Prim v, Prim w)+  => (v -> m w) -> Map k v -> m (Map k w)+traverseBijectionP f (Map m) = fmap Map (I.traverseP f m)++-- | This only provides a correct result when the effectful mapping+--   is a bijection.+traverseBijection :: (Applicative m, Prim v, Prim w)+  => (v -> m w) -> Map k v -> m (Map k w)+traverseBijection f (Map m) = fmap Map (I.traverse f m)++traverse_ :: (Applicative m, Prim v) => (v -> m w) -> Map k v -> m ()+traverse_ f (Map m) = I.traverse_ f m++mapBijection :: (Prim v, Prim w) => (v -> w) -> Map k v -> Map k w+mapBijection f (Map m) = Map (I.mapBijection f m)++map :: (Prim k, Prim v, Prim w, Eq w) => (v -> w) -> Map k v -> Map k w+map f (Map m) = Map (I.map f m)++foldl' :: (Prim k, Prim v)+  => (b -> v -> b)+  -> b+  -> Map k v+  -> b+foldl' f b0 (Map m) = I.foldl' f b0 m++foldlM' :: (Monad m, Prim k, Prim v)+  => (b -> v -> m b)+  -> b+  -> Map k v+  -> m b+foldlM' f b0 (Map m) = I.foldlM' f b0 m++foldMap :: (Monoid m, Prim k, Prim v)+  => (v -> m)+  -> Map k v+  -> m+foldMap f (Map m) = I.foldMap f m++unionWith :: (Ord k, Eq c, Prim k, Prim a, Prim b, Prim c)+  => (a -> b -> c)+  -> Map k a+  -> Map k b+  -> Map k c+unionWith f (Map a) (Map b) = Map (I.unionWith f a b)++foldrWithKey :: (Bounded k, Enum k, Prim k, Prim v)+  => (k -> k -> v -> b -> b)+  -> b+  -> Map k v+  -> b+foldrWithKey f z (Map m) = I.foldrWithKey f z m++foldlWithKeyM' :: (Bounded k, Enum k, Monad m, Prim k, Prim v)+  => (b -> k -> k -> v -> m b)+  -> b+  -> Map k v+  -> m b+foldlWithKeyM' f z (Map m) = I.foldlWithKeyM' f z m++-- | The number of values in the interval map. Also the number of+--   contiguous key ranges in the map.+size :: Prim v => Map k v -> Int+size (Map m) = I.size m++elems :: Map k v -> PrimArray v+elems (Map m) = I.elems m++toList :: (Bounded k, Enum k, Prim k, Prim v) => Map k v -> [(k,k,v)]+toList (Map m) = I.toList m++fromLiftedLifted :: (Prim k, Prim v) => DBTSLL.Map k v -> Map k v+fromLiftedLifted (DBTSLL.Map m) = Map (I.convertKeysValues m)