strict-containers 0.1 → 0.2
raw patch · 45 files changed
+2420/−2575 lines, 45 filesdep +nothunksdep −semigroupsdep −test-frameworkdep −test-framework-hunitdep ~QuickCheckdep ~basedep ~containers
Dependencies added: nothunks
Dependencies removed: semigroups, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: QuickCheck, base, containers, deepseq, hashable, primitive, strict, transformers, unordered-containers, vector, vector-binary-instances
Files
- CHANGELOG.md +5/−0
- include/containers.h +7/−18
- include/vector.h +8/−0
- src/Data/Strict/ContainersUtils/Autogen/BitQueue.hs +1/−14
- src/Data/Strict/ContainersUtils/Autogen/BitUtil.hs +1/−32
- src/Data/Strict/ContainersUtils/Autogen/Coercions.hs +3/−3
- src/Data/Strict/ContainersUtils/Autogen/PtrEquality.hs +2/−11
- src/Data/Strict/ContainersUtils/Autogen/State.hs +6/−7
- src/Data/Strict/ContainersUtils/Autogen/StrictMaybe.hs +0/−5
- src/Data/Strict/ContainersUtils/Autogen/TypeError.hs +3/−11
- src/Data/Strict/HashMap/Autogen/Internal.hs +471/−323
- src/Data/Strict/HashMap/Autogen/Internal/Array.hs +128/−137
- src/Data/Strict/HashMap/Autogen/Internal/List.hs +6/−4
- src/Data/Strict/HashMap/Autogen/Internal/Strict.hs +130/−134
- src/Data/Strict/HashMap/Autogen/Internal/Unsafe.hs +0/−55
- src/Data/Strict/HashMap/Autogen/Strict.hs +6/−3
- src/Data/Strict/IntMap/Autogen/Internal.hs +134/−198
- src/Data/Strict/IntMap/Autogen/Merge/Strict.hs +0/−15
- src/Data/Strict/IntMap/Autogen/Strict.hs +4/−5
- src/Data/Strict/IntMap/Autogen/Strict/Internal.hs +52/−57
- src/Data/Strict/Map/Autogen/Internal.hs +173/−212
- src/Data/Strict/Map/Autogen/Internal/Debug.hs +3/−3
- src/Data/Strict/Map/Autogen/Merge/Strict.hs +1/−14
- src/Data/Strict/Map/Autogen/Strict.hs +3/−1
- src/Data/Strict/Map/Autogen/Strict/Internal.hs +68/−67
- src/Data/Strict/Sequence.hs +27/−0
- src/Data/Strict/Sequence/Autogen.hs +2/−2
- src/Data/Strict/Sequence/Autogen/Internal.hs +82/−88
- src/Data/Strict/Vector/Autogen.hs +476/−256
- src/Data/Strict/Vector/Autogen/Internal/Check.hs +152/−0
- src/Data/Strict/Vector/Autogen/Mutable.hs +113/−48
- strict-containers.cabal +65/−102
- tests/HashMapProperties.hs +0/−591
- tests/IntMapValidity.hs +1/−1
- tests/Tests/Bundle.hs +6/−10
- tests/Tests/Vector/Boxed.hs +7/−2
- tests/Tests/Vector/Property.hs +65/−38
- tests/Tests/Vector/UnitTests.hs +32/−8
- tests/Utilities.hs +3/−3
- tests/Utils/NoThunks.hs +15/−0
- tests/intmap-properties.hs +15/−28
- tests/intmap-strictness.hs +33/−15
- tests/map-properties.hs +29/−7
- tests/map-strictness.hs +47/−14
- tests/seq-properties.hs +35/−33
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for strict-containers +## 0.2 -- 2022-12-12++- Update to containers v0.6.6, unordered-containers v0.2.19.1, vector+ v0.13.0.0. Includes support for GHC 9.4.+ ## 0.1 -- 2021-04-20 - Initial release, defining strict versions of `Data.HashMap`, `Data.IntMap`,
include/containers.h view
@@ -12,30 +12,19 @@ #include "MachDeps.h" #endif -/*- * Define INSTANCE_TYPEABLE[0-2]- */-#if __GLASGOW_HASKELL__ >= 707-#define INSTANCE_TYPEABLE0(tycon) deriving instance Typeable tycon-#define INSTANCE_TYPEABLE1(tycon) deriving instance Typeable tycon-#define INSTANCE_TYPEABLE2(tycon) deriving instance Typeable tycon-#elif defined(__GLASGOW_HASKELL__)-#define INSTANCE_TYPEABLE0(tycon) deriving instance Typeable tycon-#define INSTANCE_TYPEABLE1(tycon) deriving instance Typeable1 tycon-#define INSTANCE_TYPEABLE2(tycon) deriving instance Typeable2 tycon-#else-#define INSTANCE_TYPEABLE0(tycon)-#define INSTANCE_TYPEABLE1(tycon)-#define INSTANCE_TYPEABLE2(tycon)-#endif--#if __GLASGOW_HASKELL__ >= 800+#ifdef __GLASGOW_HASKELL__ #define DEFINE_PATTERN_SYNONYMS 1 #endif #ifdef __GLASGOW_HASKELL__ # define USE_ST_MONAD 1+#ifndef WORDS_BIGENDIAN+/*+ * Unboxed arrays are broken on big-endian architectures.+ * See https://gitlab.haskell.org/ghc/ghc/-/issues/16998+ */ # define USE_UNBOXED_ARRAYS 1+#endif #endif #endif
+ include/vector.h view
@@ -0,0 +1,8 @@+#define PHASE_FUSED [1]+#define PHASE_INNER [0]++#define INLINE_FUSED INLINE PHASE_FUSED+#define INLINE_INNER INLINE PHASE_INNER++#define PHASE_STREAM Please use "PHASE_FUSED" instead+#define INLINE_STREAM Please use "INLINE_FUSED" instead
src/Data/Strict/ContainersUtils/Autogen/BitQueue.hs view
@@ -44,23 +44,10 @@ , toListQ ) where -#if !MIN_VERSION_base(4,8,0)-import Data.Word (Word)-#endif import Data.Strict.ContainersUtils.Autogen.BitUtil (shiftLL, shiftRL, wordSize) import Data.Bits ((.|.), (.&.), testBit)-#if MIN_VERSION_base(4,8,0) import Data.Bits (countTrailingZeros)-#else-import Data.Bits (popCount)-#endif -#if !MIN_VERSION_base(4,8,0)-countTrailingZeros :: Word -> Int-countTrailingZeros x = popCount ((x .&. (-x)) - 1)-{-# INLINE countTrailingZeros #-}-#endif- -- A bit queue builder. We represent a double word using two words -- because we don't currently have access to proper double words. data BitQueueB = BQB {-# UNPACK #-} !Word@@ -109,7 +96,7 @@ lo' = (lo1 `shiftRL` zeros) .|. (hi1 `shiftLL` (wordSize - zeros)) hi' = hi1 `shiftRL` zeros --- Test if the queue is empty, which occurs when theres+-- Test if the queue is empty, which occurs when there's -- nothing left but a guard bit in the least significant -- place. nullQ :: BitQueue -> Bool
src/Data/Strict/ContainersUtils/Autogen/BitUtil.hs view
@@ -38,23 +38,10 @@ , wordSize ) where -#if !MIN_VERSION_base(4,8,0)-import Data.Bits ((.|.), xor)-#endif import Data.Bits (popCount, unsafeShiftL, unsafeShiftR-#if MIN_VERSION_base(4,8,0)- , countLeadingZeros-#endif+ , countLeadingZeros, finiteBitSize )-#if MIN_VERSION_base(4,7,0)-import Data.Bits (finiteBitSize)-#else-import Data.Bits (bitSize)-#endif -#if !MIN_VERSION_base (4,8,0)-import Data.Word (Word)-#endif {---------------------------------------------------------------------- [bitcount] as posted by David F. Place to haskell-cafe on April 11, 2006,@@ -78,21 +65,7 @@ -- | Return a word where only the highest bit is set. highestBitMask :: Word -> Word-#if MIN_VERSION_base(4,8,0) highestBitMask w = shiftLL 1 (wordSize - 1 - countLeadingZeros w)-#else-highestBitMask x1 = let x2 = x1 .|. x1 `shiftRL` 1- x3 = x2 .|. x2 `shiftRL` 2- x4 = x3 .|. x3 `shiftRL` 4- x5 = x4 .|. x4 `shiftRL` 8- x6 = x5 .|. x5 `shiftRL` 16-#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32)- x7 = x6 .|. x6 `shiftRL` 32- in x7 `xor` (x7 `shiftRL` 1)-#else- in x6 `xor` (x6 `shiftRL` 1)-#endif-#endif {-# INLINE highestBitMask #-} -- Right and left logical shifts.@@ -102,8 +75,4 @@ {-# INLINE wordSize #-} wordSize :: Int-#if MIN_VERSION_base(4,7,0) wordSize = finiteBitSize (0 :: Word)-#else-wordSize = bitSize (0 :: Word)-#endif
src/Data/Strict/ContainersUtils/Autogen/Coercions.hs view
@@ -5,12 +5,12 @@ module Data.Strict.ContainersUtils.Autogen.Coercions where -#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ import Data.Coerce #endif infixl 8 .#-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ (.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c (.#) f _ = coerce f #else@@ -34,7 +34,7 @@ -- @ -- foldl f b . fmap g = foldl (f .^# g) b -- @-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ (.^#) :: Coercible c b => (a -> c -> d) -> (b -> c) -> (a -> b -> d) (.^#) f _ = coerce f #else
src/Data/Strict/ContainersUtils/Autogen/PtrEquality.hs view
@@ -11,11 +11,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts ( reallyUnsafePtrEquality# ) import Unsafe.Coerce ( unsafeCoerce )-#if __GLASGOW_HASKELL__ < 707-import GHC.Exts ( (==#) )-#else-import GHC.Exts ( isTrue# )-#endif+import GHC.Exts ( Int#, isTrue# ) #endif -- | Checks if two pointers are equal. Yes means yes;@@ -30,13 +26,8 @@ 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+hetPtrEq x y = isTrue# (unsafeCoerce (reallyUnsafePtrEquality# :: x -> x -> Int#) x y) #else -- Not GHC
src/Data/Strict/ContainersUtils/Autogen/State.hs view
@@ -5,13 +5,7 @@ -- | A clone of Control.Monad.State.Strict. module Data.Strict.ContainersUtils.Autogen.State where -import Prelude hiding (-#if MIN_VERSION_base(4,8,0)- Applicative-#endif- )--import Control.Monad (ap)+import Control.Monad (ap, liftM2) import Control.Applicative (Applicative(..), liftA) newtype State s a = State {runState :: s -> (s, a)}@@ -30,6 +24,11 @@ {-# INLINE pure #-} pure x = State $ \ s -> (s, x) (<*>) = ap+ m *> n = State $ \s -> case runState m s of+ (s', _) -> runState n s'+#if MIN_VERSION_base(4,10,0)+ liftA2 = liftM2+#endif execState :: State s a -> s -> a execState m x = snd (runState m x)
src/Data/Strict/ContainersUtils/Autogen/StrictMaybe.hs view
@@ -7,11 +7,6 @@ module Data.Strict.ContainersUtils.Autogen.StrictMaybe (MaybeS (..), maybeS, toMaybe, toMaybeS) where -#if !MIN_VERSION_base(4,8,0)-import Data.Foldable (Foldable (..))-import Data.Monoid (Monoid (..))-#endif- data MaybeS a = NothingS | JustS !a instance Foldable MaybeS where
src/Data/Strict/ContainersUtils/Autogen/TypeError.hs view
@@ -2,23 +2,17 @@ KindSignatures, TypeFamilies, CPP #-} #if !defined(TESTING)-# if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE Safe #-}-# else-{-# LANGUAGE Trustworthy #-} #endif-#endif -- | Unsatisfiable constraints for functions being removed. module Data.Strict.ContainersUtils.Autogen.TypeError where import GHC.TypeLits --- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s@.--- Under GHC 8.0 and above, trying to use a function with a @Whoops s@--- constraint will lead to a pretty type error explaining how to fix--- the problem. Under earlier GHC versions, it will produce an extremely--- ugly type error within which the desired message is buried.+-- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s@. Trying+-- to use a function with a @Whoops s@ constraint will lead to a pretty type+-- error explaining how to fix the problem. -- -- ==== Example --@@ -28,9 +22,7 @@ -- @ class Whoops (a :: Symbol) -#if __GLASGOW_HASKELL__ >= 800 instance TypeError ('Text a) => Whoops a-#endif -- Why don't we just use --
src/Data/Strict/HashMap/Autogen/Internal.hs view
@@ -1,14 +1,17 @@-{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE LambdaCase #-}-#if __GLASGOW_HASKELL__ >= 802-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE UnboxedSums #-}-#endif+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UnboxedSums #-}+{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -67,6 +70,7 @@ , map , mapWithKey , traverseWithKey+ , mapKeys -- * Difference and intersection , difference@@ -74,6 +78,7 @@ , intersection , intersectionWith , intersectionWithKey+ , intersectionWithKey# -- * Folds , foldr'@@ -115,10 +120,9 @@ , sparseIndex , two , unionArrayBy- , update16- , update16M- , update16With'- , updateOrConcatWith+ , update32+ , update32M+ , update32With' , updateOrConcatWithKey , filterMapAux , equalKeys@@ -136,56 +140,37 @@ , adjust# ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((<$>), Applicative(pure))-import Data.Monoid (Monoid(mempty, mappend))-import Data.Traversable (Traversable(..))-import Data.Word (Word)-#endif-#if __GLASGOW_HASKELL__ >= 711-import Data.Semigroup (Semigroup((<>)))-#endif-import Control.DeepSeq (NFData(rnf))-import Control.Monad.ST (ST)-import Data.Bits ((.&.), (.|.), complement, popCount, unsafeShiftL, unsafeShiftR)-import Data.Data hiding (Typeable)-import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0)-import Data.Bifoldable-#endif-import qualified Data.List as L-import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, inline)-import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred)-import Text.Read hiding (step)--import qualified Data.Strict.HashMap.Autogen.Internal.Array as A-import qualified Data.Hashable as H-import Data.Hashable (Hashable)-import Data.Strict.HashMap.Autogen.Internal.Unsafe (runST)+import Control.Applicative (Const (..))+import Control.DeepSeq (NFData (..), NFData1 (..), NFData2 (..))+import Control.Monad.ST (ST, runST)+import Data.Bifoldable (Bifoldable (..))+import Data.Bits (complement, countTrailingZeros, popCount,+ shiftL, unsafeShiftL, unsafeShiftR, (.&.),+ (.|.))+import Data.Coerce (coerce)+import Data.Data (Constr, Data (..), DataType)+import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..),+ Read1 (..), Show1 (..), Show2 (..))+import Data.Functor.Identity (Identity (..))+import Data.Hashable (Hashable)+import Data.Hashable.Lifted (Hashable1, Hashable2) import Data.Strict.HashMap.Autogen.Internal.List (isPermutationBy, unorderedCompare)-import Data.Typeable (Typeable)--import GHC.Exts (isTrue#)-import qualified GHC.Exts as Exts--#if MIN_VERSION_base(4,9,0)-import Data.Functor.Classes-import GHC.Stack-#endif--#if MIN_VERSION_hashable(1,2,5)-import qualified Data.Hashable.Lifted as H-#endif--#if __GLASGOW_HASKELL__ >= 802-import GHC.Exts (TYPE, Int (..), Int#)-#endif+import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid)+import GHC.Exts (Int (..), Int#, TYPE, (==#))+import GHC.Stack (HasCallStack)+import Prelude hiding (filter, foldl, foldr, lookup, map,+ null, pred)+import Text.Read hiding (step) -#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity (Identity (..))-#endif-import Control.Applicative (Const (..))-import Data.Coerce (coerce)+import qualified Data.Data as Data+import qualified Data.Foldable as Foldable+import qualified Data.Functor.Classes as FC+import qualified Data.Hashable as H+import qualified Data.Hashable.Lifted as H+import qualified Data.Strict.HashMap.Autogen.Internal.Array as A+import qualified Data.List as List+import qualified GHC.Exts as Exts+import qualified Language.Haskell.TH.Syntax as TH -- | A set of values. A set cannot contain duplicate values. ------------------------------------------------------------------------@@ -200,6 +185,22 @@ instance (NFData k, NFData v) => NFData (Leaf k v) where rnf (L k v) = rnf k `seq` rnf v +-- | @since 0.2.17.0+instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where+#if MIN_VERSION_template_haskell(2,16,0)+ liftTyped (L k v) = [|| L k $! v ||]+#else+ lift (L k v) = [| L k $! v |]+#endif++-- | @since 0.2.14.0+instance NFData k => NFData1 (Leaf k) where+ liftRnf = liftRnf2 rnf++-- | @since 0.2.14.0+instance NFData2 Leaf where+ liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v+ -- Invariant: The length of the 1st argument to 'Full' is -- 2^bitsPerSubkey @@ -211,10 +212,12 @@ | Leaf !Hash !(Leaf k v) | Full !(A.Array (HashMap k v)) | Collision !Hash !(A.Array (Leaf k v))- deriving (Typeable) type role HashMap nominal representational +-- | @since 0.2.17.0+deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)+ instance (NFData k, NFData v) => NFData (HashMap k v) where rnf Empty = () rnf (BitmapIndexed _ ary) = rnf ary@@ -222,6 +225,18 @@ rnf (Full ary) = rnf ary rnf (Collision _ ary) = rnf ary +-- | @since 0.2.14.0+instance NFData k => NFData1 (HashMap k) where+ liftRnf = liftRnf2 rnf++-- | @since 0.2.14.0+instance NFData2 HashMap where+ liftRnf2 _ _ Empty = ()+ liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary+ liftRnf2 rnf1 rnf2 (Leaf _ l) = liftRnf2 rnf1 rnf2 l+ liftRnf2 rnf1 rnf2 (Full ary) = liftRnf (liftRnf2 rnf1 rnf2) ary+ liftRnf2 rnf1 rnf2 (Collision _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary+ instance Functor (HashMap k) where fmap = map @@ -236,14 +251,11 @@ {-# INLINE foldr' #-} foldl' = foldl' {-# INLINE foldl' #-}-#if MIN_VERSION_base(4,8,0) null = null {-# INLINE null #-} length = size {-# INLINE length #-}-#endif -#if MIN_VERSION_base(4,10,0) -- | @since 0.2.11 instance Bifoldable HashMap where bifoldMap f g = foldMapWithKey (\ k v -> f k `mappend` g v)@@ -252,9 +264,7 @@ {-# INLINE bifoldr #-} bifoldl f g = foldlWithKey (\ acc k v -> (acc `f` k) `g` v) {-# INLINE bifoldl #-}-#endif -#if __GLASGOW_HASKELL__ >= 711 -- | '<>' = 'union' -- -- If a key occurs in both maps, the mapping from the first will be the mapping in the result.@@ -266,7 +276,8 @@ instance (Eq k, Hashable k) => Semigroup (HashMap k v) where (<>) = union {-# INLINE (<>) #-}-#endif+ stimes = stimesIdempotentMonoid+ {-# INLINE stimes #-} -- | 'mempty' = 'empty' --@@ -281,36 +292,44 @@ instance (Eq k, Hashable k) => Monoid (HashMap k v) where mempty = empty {-# INLINE mempty #-}-#if __GLASGOW_HASKELL__ >= 711 mappend = (<>)-#else- mappend = union-#endif {-# INLINE mappend #-} instance (Data k, Data v, Eq k, Hashable k) => Data (HashMap k v) where gfoldl f z m = z fromList `f` toList m toConstr _ = fromListConstr- gunfold k z c = case constrIndex c of+ gunfold k z c = case Data.constrIndex c of 1 -> k (z fromList) _ -> error "gunfold" dataTypeOf _ = hashMapDataType- dataCast2 f = gcast2 f+ dataCast1 f = Data.gcast1 f+ dataCast2 f = Data.gcast2 f fromListConstr :: Constr-fromListConstr = mkConstr hashMapDataType "fromList" [] Prefix+fromListConstr = Data.mkConstr hashMapDataType "fromList" [] Data.Prefix hashMapDataType :: DataType-hashMapDataType = mkDataType "Data.Strict.HashMap.Autogen.Internal.HashMap" [fromListConstr]+hashMapDataType = Data.mkDataType "Data.Strict.HashMap.Autogen.Internal.HashMap" [fromListConstr] +-- | This type is used to store the hash of a key, as produced with 'hash'. type Hash = Word++-- | A bitmap as contained by a 'BitmapIndexed' node, or a 'fullNodeMask'+-- corresponding to a 'Full' node.+--+-- Only the lower 'maxChildren' bits are used. The remaining bits must be zeros. type Bitmap = Word++-- | 'Shift' values correspond to the level of the tree that we're currently+-- operating at. At the root level the 'Shift' is @0@. For the subsequent+-- levels the 'Shift' values are 'bitsPerSubkey', @2*'bitsPerSubkey'@ etc.+--+-- Valid values are non-negative and less than @bitSize (0 :: Word)@. type Shift = Int -#if MIN_VERSION_base(4,9,0) instance Show2 HashMap where liftShowsPrec2 spk slk spv slv d m =- showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)+ FC.showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m) where sp = liftShowsPrec2 spk slk spv slv sl = liftShowList2 spk slk spv slv@@ -319,18 +338,16 @@ liftShowsPrec = liftShowsPrec2 showsPrec showList instance (Eq k, Hashable k, Read k) => Read1 (HashMap k) where- liftReadsPrec rp rl = readsData $- readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList+ liftReadsPrec rp rl = FC.readsData $+ FC.readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl-#endif instance (Eq k, Hashable k, Read k, Read e) => Read (HashMap k e) where readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP- xs <- readPrec- return (fromList xs)+ fromList <$> readPrec readListPrec = readListPrecDefault @@ -342,13 +359,11 @@ traverse f = traverseWithKey (const f) {-# INLINABLE traverse #-} -#if MIN_VERSION_base(4,9,0) instance Eq2 HashMap where liftEq2 = equal2 instance Eq k => Eq1 (HashMap k) where liftEq = equal1-#endif -- | Note that, in the presence of hash collisions, equal @HashMap@s may -- behave differently, i.e. substitutivity may be violated:@@ -392,7 +407,7 @@ equal2 :: (k -> k' -> Bool) -> (v -> v' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool-equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])+equal2 eqk eqv t1 t2 = go (leavesAndCollisions t1 []) (leavesAndCollisions t2 []) where -- If the two trees are the same, then their lists of 'Leaf's and -- 'Collision's read from left to right should be the same (modulo the@@ -412,13 +427,11 @@ leafEq (L k v) (L k' v') = eqk k k' && eqv v v' -#if MIN_VERSION_base(4,9,0) instance Ord2 HashMap where liftCompare2 = cmp instance Ord k => Ord1 (HashMap k) where liftCompare = cmp compare-#endif -- | The ordering is total and consistent with the `Eq` instance. However, -- nothing else about the ordering is specified, and it may change from@@ -428,7 +441,7 @@ cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering) -> HashMap k v -> HashMap k' v' -> Ordering-cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])+cmp cmpk cmpv t1 t2 = go (leavesAndCollisions t1 []) (leavesAndCollisions t2 []) where go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2) = compare k1 k2 `mappend`@@ -444,13 +457,13 @@ go [] [] = EQ go [] _ = LT go _ [] = GT- go _ _ = error "cmp: Should never happen, toList' includes non Leaf / Collision"+ go _ _ = error "cmp: Should never happen, leavesAndCollisions includes non Leaf / Collision" leafCompare (L k v) (L k' v') = cmpk k k' `mappend` cmpv v v' --- Same as 'equal' but doesn't compare the values.+-- Same as 'equal2' but doesn't compare the values. equalKeys1 :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool-equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])+equalKeys1 eq t1 t2 = go (leavesAndCollisions t1 []) (leavesAndCollisions t2 []) where go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2) | k1 == k2 && leafEq l1 l2@@ -480,9 +493,8 @@ leafEq (L k1 _) (L k2 _) = k1 == k2 -#if MIN_VERSION_hashable(1,2,5)-instance H.Hashable2 HashMap where- liftHashWithSalt2 hk hv salt hm = go salt (toList' hm [])+instance Hashable2 HashMap where+ liftHashWithSalt2 hk hv salt hm = go salt (leavesAndCollisions hm []) where -- go :: Int -> [HashMap k v] -> Int go s [] = s@@ -499,14 +511,13 @@ -- hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int hashCollisionWithSalt s- = L.foldl' H.hashWithSalt s . arrayHashesSorted s+ = List.foldl' H.hashWithSalt s . arrayHashesSorted s -- arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]- arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList+ arrayHashesSorted s = List.sort . List.map (hashLeafWithSalt s) . A.toList -instance (Hashable k) => H.Hashable1 (HashMap k) where+instance (Hashable k) => Hashable1 (HashMap k) where liftHashWithSalt = H.liftHashWithSalt2 H.hashWithSalt-#endif instance (Hashable k, Hashable v) => Hashable (HashMap k v) where hashWithSalt salt hm = go salt hm@@ -527,20 +538,20 @@ hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int hashCollisionWithSalt s- = L.foldl' H.hashWithSalt s . arrayHashesSorted s+ = List.foldl' H.hashWithSalt s . arrayHashesSorted s arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]- arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList+ arrayHashesSorted s = List.sort . List.map (hashLeafWithSalt s) . A.toList - -- Helper to get 'Leaf's and 'Collision's as a list.-toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]-toList' (BitmapIndexed _ ary) a = A.foldr toList' a ary-toList' (Full ary) a = A.foldr toList' a ary-toList' l@(Leaf _ _) a = l : a-toList' c@(Collision _ _) a = c : a-toList' Empty a = a+-- | Helper to get 'Leaf's and 'Collision's as a list.+leavesAndCollisions :: HashMap k v -> [HashMap k v] -> [HashMap k v]+leavesAndCollisions (BitmapIndexed _ ary) a = A.foldr leavesAndCollisions a ary+leavesAndCollisions (Full ary) a = A.foldr leavesAndCollisions a ary+leavesAndCollisions l@(Leaf _ _) a = l : a+leavesAndCollisions c@(Collision _ _) a = c : a+leavesAndCollisions Empty a = a --- Helper function to detect 'Leaf's and 'Collision's.+-- | Helper function to detect 'Leaf's and 'Collision's. isLeafOrCollision :: HashMap k v -> Bool isLeafOrCollision (Leaf _ _) = True isLeafOrCollision (Collision _ _) = True@@ -549,23 +560,23 @@ ------------------------------------------------------------------------ -- * Construction --- | /O(1)/ Construct an empty map.+-- | \(O(1)\) Construct an empty map. empty :: HashMap k v empty = Empty --- | /O(1)/ Construct a map with a single element.+-- | \(O(1)\) Construct a map with a single element. singleton :: (Hashable k) => k -> v -> HashMap k v singleton k v = Leaf (hash k) (L k v) ------------------------------------------------------------------------ -- * Basic interface --- | /O(1)/ Return 'True' if this map is empty, 'False' otherwise.+-- | \(O(1)\) Return 'True' if this map is empty, 'False' otherwise. null :: HashMap k v -> Bool null Empty = True null _ = False --- | /O(n)/ Return the number of key-value mappings in this map.+-- | \(O(n)\) Return the number of key-value mappings in this map. size :: HashMap k v -> Int size t = go t 0 where@@ -575,7 +586,7 @@ go (Full ary) n = A.foldl' (flip go) n ary go (Collision _ ary) n = n + A.length ary --- | /O(log n)/ Return 'True' if the specified key is present in the+-- | \(O(\log n)\) Return 'True' if the specified key is present in the -- map, 'False' otherwise. member :: (Eq k, Hashable k) => k -> HashMap k a -> Bool member k m = case lookup k m of@@ -583,10 +594,9 @@ Just _ -> True {-# INLINABLE member #-} --- | /O(log n)/ Return the value to which the specified key is mapped,+-- | \(O(\log n)\) Return the value to which the specified key is mapped, -- or 'Nothing' if this map contains no mapping for the key. lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v-#if __GLASGOW_HASKELL__ >= 802 -- GHC does not yet perform a worker-wrapper transformation on -- unboxed sums automatically. That seems likely to happen at some -- point (possibly as early as GHC 8.6) but for now we do it manually.@@ -599,16 +609,9 @@ lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v _i -> (# | v #)) (hash k) k 0 m {-# INLINABLE lookup# #-} -#else--lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hash k) k 0 m-{-# INLINABLE lookup #-}-#endif- -- | lookup' is a version of lookup that takes the hash separately. -- It is used to implement alterF. lookup' :: Eq k => Hash -> k -> HashMap k v -> Maybe v-#if __GLASGOW_HASKELL__ >= 802 -- GHC does not yet perform a worker-wrapper transformation on -- unboxed sums automatically. That seems likely to happen at some -- point (possibly as early as GHC 8.6) but for now we do it manually.@@ -619,10 +622,6 @@ (# (# #) | #) -> Nothing (# | (# a, _i #) #) -> Just a {-# INLINE lookup' #-}-#else-lookup' h k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h k 0 m-{-# INLINABLE lookup' #-}-#endif -- The result of a lookup, keeping track of if a hash collision occured. -- If a collision did not occur then it will have the Int value (-1).@@ -642,7 +641,6 @@ -- Key in map, no collision => Present v (-1) -- Key in map, collision => Present v position lookupRecordCollision :: Eq k => Hash -> k -> HashMap k v -> LookupRes v-#if __GLASGOW_HASKELL__ >= 802 lookupRecordCollision h k m = case lookupRecordCollision# h k m of (# (# #) | #) -> Absent (# | (# a, i #) #) -> Present a (I# i) -- GHC will eliminate the I#@@ -659,12 +657,6 @@ -- INLINABLE to specialize to the Eq instance. {-# INLINABLE lookupRecordCollision# #-} -#else /* GHC < 8.2 so there are no unboxed sums */--lookupRecordCollision h k m = lookupCont (\_ -> Absent) Present h k 0 m-{-# INLINABLE lookupRecordCollision #-}-#endif- -- A two-continuation version of lookupRecordCollision. This lets us -- share source code between lookup and lookupRecordCollision without -- risking any performance degradation.@@ -678,11 +670,7 @@ -- keys at the top-level of a hashmap, the offset should be 0. When looking up -- keys at level @n@ of a hashmap, the offset should be @n * bitsPerSubkey@. lookupCont ::-#if __GLASGOW_HASKELL__ >= 802 forall rep (r :: TYPE rep) k v.-#else- forall r k v.-#endif Eq k => ((# #) -> r) -- Absent continuation -> (v -> Int -> r) -- Present continuation@@ -709,7 +697,7 @@ | otherwise = absent (# #) {-# INLINE lookupCont #-} --- | /O(log n)/ Return the value to which the specified key is mapped,+-- | \(O(\log n)\) Return the value to which the specified key is mapped, -- or 'Nothing' if this map contains no mapping for the key. -- -- This is a flipped version of 'lookup'.@@ -720,7 +708,7 @@ {-# INLINE (!?) #-} --- | /O(log n)/ Return the value to which the specified key is mapped,+-- | \(O(\log n)\) Return the value to which the specified key is mapped, -- or the default value if this map contains no mapping for the key. -- -- @since 0.2.11@@ -733,7 +721,7 @@ {-# INLINABLE findWithDefault #-} --- | /O(log n)/ Return the value to which the specified key is mapped,+-- | \(O(\log n)\) Return the value to which the specified key is mapped, -- or the default value if this map contains no mapping for the key. -- -- DEPRECATED: lookupDefault is deprecated as of version 0.2.11, replaced@@ -741,16 +729,12 @@ lookupDefault :: (Eq k, Hashable k) => v -- ^ Default value to return. -> k -> HashMap k v -> v-lookupDefault def k t = findWithDefault def k t+lookupDefault = findWithDefault {-# INLINE lookupDefault #-} --- | /O(log n)/ Return the value to which the specified key is mapped.+-- | \(O(\log n)\) Return the value to which the specified key is mapped. -- Calls 'error' if this map contains no mapping for the key.-#if MIN_VERSION_base(4,9,0) (!) :: (Eq k, Hashable k, HasCallStack) => HashMap k v -> k -> v-#else-(!) :: (Eq k, Hashable k) => HashMap k v -> k -> v-#endif (!) m k = case lookup k m of Just v -> v Nothing -> error "Data.Strict.HashMap.Autogen.Internal.(!): key not found"@@ -769,12 +753,15 @@ -- | Create a 'BitmapIndexed' or 'Full' node. bitmapIndexedOrFull :: Bitmap -> A.Array (HashMap k v) -> HashMap k v-bitmapIndexedOrFull b ary+-- The strictness in @ary@ helps achieve a nice code size reduction in+-- @unionWith[Key]@ with GHC 9.2.2. See the Core diffs in+-- https://github.com/haskell-unordered-containers/unordered-containers/pull/376.+bitmapIndexedOrFull b !ary | b == fullNodeMask = Full ary | otherwise = BitmapIndexed b ary {-# INLINE bitmapIndexedOrFull #-} --- | /O(log n)/ Associate the specified value with the specified+-- | \(O(\log n)\) Associate the specified value with the specified -- key in this map. If this map previously contained a mapping for -- the key, the old value is replaced. insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v@@ -809,7 +796,7 @@ !st' = go h k x (s+bitsPerSubkey) st in if st' `ptrEq` st then t- else Full (update16 ary i st')+ else Full (update32 ary i st') where i = index h s go h k x s t@(Collision hy v) | h == hy = Collision h (updateOrSnocWith (\a _ -> (# a #)) k x v)@@ -843,20 +830,12 @@ go h k x s (Full ary) = let !st = A.index ary i !st' = go h k x (s+bitsPerSubkey) st- in Full (update16 ary i st')+ in Full (update32 ary i st') where i = index h s go h k x s t@(Collision hy v)- | h == hy = Collision h (snocNewLeaf (L k x) v)+ | h == hy = Collision h (A.snoc v (L k x)) | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)- where- snocNewLeaf :: Leaf k v -> A.Array (Leaf k v) -> A.Array (Leaf k v)- snocNewLeaf leaf ary = A.run $ do- let n = A.length ary- mary <- A.new_ (n + 1)- A.copy ary 0 mary 0 n- A.write mary n leaf- return mary {-# NOINLINE insertNewKey #-} @@ -887,7 +866,7 @@ go collPos h k x s (Full ary) = let !st = A.index ary i !st' = go collPos h k x (s+bitsPerSubkey) st- in Full (update16 ary i st')+ in Full (update32 ary i st') where i = index h s go collPos h k x _s (Collision _hy v) | collPos >= 0 = Collision h (setAtPosition collPos k x v)@@ -967,7 +946,7 @@ | otherwise = 0 {-# INLINE two #-} --- | /O(log n)/ Associate the value with the key in this map. If+-- | \(O(\log n)\) Associate the value with the key in this map. If -- this map previously contained a mapping for the key, the old value -- is replaced by the result of applying the given function to the new -- and old value. Example:@@ -996,7 +975,7 @@ | hy == h = if ky == k then case f y of (# v' #) | ptrEq y v' -> t- | otherwise -> Leaf h (L k (v'))+ | otherwise -> Leaf h (L k v') else collision h l (L k x) | otherwise = runST (two s h k x hy t) go h k s t@(BitmapIndexed b ary)@@ -1015,7 +994,7 @@ go h k s t@(Full ary) = let !st = A.index ary i !st' = go h k (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = update32 ary i $! st' in if ptrEq st st' then t else Full ary'@@ -1035,12 +1014,8 @@ insertModifyingArr x f k0 ary0 = go k0 ary0 0 (A.length ary0) where go !k !ary !i !n- | i >= n = A.run $ do- -- Not found, append to the end.- mary <- A.new_ (n + 1)- A.copy ary 0 mary 0 n- A.write mary n (L k x)- return mary+ -- Not found, append to the end.+ | i >= n = A.snoc ary $ L k x | otherwise = case A.index ary i of (L kx y) | k == kx -> case f y of (# y' #) -> if ptrEq y y'@@ -1053,11 +1028,11 @@ unsafeInsertWith :: forall k v. (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v-unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0+unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (\_ a b -> (# f a b #)) k0 v0 m0 {-# INLINABLE unsafeInsertWith #-} unsafeInsertWithKey :: forall k v. (Eq k, Hashable k)- => (k -> v -> v -> v) -> k -> v -> HashMap k v+ => (k -> v -> v -> (# v #)) -> k -> v -> HashMap k v -> HashMap k v unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0) where@@ -1066,7 +1041,8 @@ go !h !k x !_ Empty = return $! Leaf h (L k x) go h k x s t@(Leaf hy l@(L ky y)) | hy == h = if ky == k- then return $! Leaf h (L k (f k x y))+ then case f k x y of+ (# v #) -> return $! Leaf h (L k v) else return $! collision h l (L k x) | otherwise = two s h k x hy t go h k x s t@(BitmapIndexed b ary)@@ -1087,11 +1063,11 @@ return t where i = index h s go h k x s t@(Collision hy v)- | h == hy = return $! Collision h (updateOrSnocWithKey (\key a b -> (# f key a b #) ) k x v)+ | h == hy = return $! Collision h (updateOrSnocWithKey f k x v) | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t) {-# INLINABLE unsafeInsertWithKey #-} --- | /O(log n)/ Remove the mapping for the specified key from this map+-- | \(O(\log n)\) Remove the mapping for the specified key from this map -- if present. delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v delete k m = delete' (hash k) k m@@ -1198,7 +1174,7 @@ go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty" {-# NOINLINE deleteKeyExists #-} --- | /O(log n)/ Adjust the value tied to a given key in this map only+-- | \(O(\log n)\) Adjust the value tied to a given key in this map only -- if it is present. Otherwise, leave the map alone. adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v -- This operation really likes to leak memory, so using this@@ -1236,7 +1212,7 @@ let i = index h s !st = A.index ary i !st' = go h k (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = update32 ary i $! st' in if ptrEq st st' then t else Full ary'@@ -1248,7 +1224,7 @@ | otherwise = t {-# INLINABLE adjust# #-} --- | /O(log n)/ The expression @('update' f k map)@ updates the value @x@ at @k@+-- | \(O(\log n)\) The expression @('update' f k map)@ updates the value @x@ at @k@ -- (if it is in the map). If @(f x)@ is 'Nothing', the element is deleted. -- If it is @('Just' y)@, the key @k@ is bound to the new value @y@. update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a@@ -1256,7 +1232,7 @@ {-# INLINABLE update #-} --- | /O(log n)/ The expression @('alter' f k map)@ alters the value @x@ at @k@, or+-- | \(O(\log n)\) The expression @('alter' f k map)@ alters the value @x@ at @k@, or -- absence thereof. -- -- 'alter' can be used to insert, delete, or update a value in a map. In short:@@ -1272,7 +1248,7 @@ Just v -> insert k v m {-# INLINABLE alter #-} --- | /O(log n)/ The expression @('alterF' f k map)@ alters the value @x@ at+-- | \(O(\log n)\) The expression @('alterF' f k map)@ alters the value @x@ at -- @k@, or absence thereof. -- -- 'alterF' can be used to insert, delete, or update a value in a map.@@ -1292,17 +1268,15 @@ let !h = hash k mv = lookup' h k m- in (<$> f mv) $ \fres ->- case fres of- Nothing -> maybe m (const (delete' h k m)) mv- Just v' -> insert' h k v' m+ in (<$> f mv) $ \case+ Nothing -> maybe m (const (delete' h k m)) mv+ Just v' -> insert' h k v' m -- We unconditionally rewrite alterF in RULES, but we expose an -- unfolding just in case it's used in some way that prevents the -- rule from firing. {-# INLINABLE [0] alterF #-} -#if MIN_VERSION_base(4,8,0) -- This is just a bottom value. See the comment on the "alterFWeird" -- rule. test_bottom :: a@@ -1385,8 +1359,7 @@ -- eagerly, whether or not the given function requires that information. alterFEager :: (Functor f, Eq k, Hashable k) => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)-alterFEager f !k m = (<$> f mv) $ \fres ->- case fres of+alterFEager f !k m = (<$> f mv) $ \case ------------------------------ -- Delete the key from the map.@@ -1419,9 +1392,8 @@ Absent -> Nothing Present v _ -> Just v {-# INLINABLE alterFEager #-}-#endif --- | /O(n*log m)/ Inclusion of maps. A map is included in another map if the keys+-- | \(O(n \log m)\) Inclusion of maps. A map is included in another map if the keys -- are subsets and the corresponding values are equal: -- -- > isSubmapOf m1 m2 = keys m1 `isSubsetOf` keys m2 &&@@ -1437,10 +1409,10 @@ -- -- @since 0.2.12 isSubmapOf :: (Eq k, Hashable k, Eq v) => HashMap k v -> HashMap k v -> Bool-isSubmapOf = (inline isSubmapOfBy) (==)+isSubmapOf = Exts.inline isSubmapOfBy (==) {-# INLINABLE isSubmapOf #-} --- | /O(n*log m)/ Inclusion of maps with value comparison. A map is included in+-- | \(O(n \log m)\) Inclusion of maps with value comparison. A map is included in -- another map if the keys are subsets and if the comparison function is true -- for the corresponding values: --@@ -1512,7 +1484,7 @@ go _ (Full {}) (BitmapIndexed {}) = False {-# INLINABLE isSubmapOfBy #-} --- | /O(min n m))/ Checks if a bitmap indexed node is a submap of another.+-- | \(O(\min n m))\) Checks if a bitmap indexed node is a submap of another. submapBitmapIndexed :: (HashMap k v1 -> HashMap k v2 -> Bool) -> Bitmap -> A.Array (HashMap k v1) -> Bitmap -> A.Array (HashMap k v2) -> Bool submapBitmapIndexed comp !b1 !ary1 !b2 !ary2 = subsetBitmaps && go 0 0 (b1Orb2 .&. negate b1Orb2) where@@ -1539,7 +1511,7 @@ ------------------------------------------------------------------------ -- * Combine --- | /O(n+m)/ The union of two maps. If a key occurs in both maps, the+-- | \(O(n+m)\) The union of two maps. If a key occurs in both maps, the -- mapping from the first will be the mapping in the result. -- -- ==== __Examples__@@ -1550,7 +1522,7 @@ union = unionWith const {-# INLINABLE union #-} --- | /O(n+m)/ The union of two maps. If a key occurs in both maps,+-- | \(O(n+m)\) The union of two maps. If a key occurs in both maps, -- the provided function (first argument) will be used to compute the -- result. unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v@@ -1558,7 +1530,7 @@ unionWith f = unionWithKey (const f) {-# INLINE unionWith #-} --- | /O(n+m)/ The union of two maps. If a key occurs in both maps,+-- | \(O(n+m)\) The union of two maps. If a key occurs in both maps, -- the provided function (first argument) will be used to compute the -- result. unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v@@ -1581,7 +1553,7 @@ | h1 == h2 = Collision h1 (updateOrSnocWithKey (\k a b -> (# f k b a #)) k2 v2 ls1) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Collision h2 ls2)- | h1 == h2 = Collision h1 (updateOrConcatWithKey f ls1 ls2)+ | h1 == h2 = Collision h1 (updateOrConcatWithKey (\k a b -> (# f k a b #)) ls1 ls2) | otherwise = goDifferentHash s h1 h2 t1 t2 -- branch vs. branch go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =@@ -1624,12 +1596,12 @@ go s (Full ary1) t2 = let h2 = leafHashCode t2 i = index h2 s- ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2+ ary' = update32With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2 in Full ary' go s t1 (Full ary2) = let h1 = leafHashCode t1 i = index h1 s- ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2+ ary' = update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2 in Full ary' leafHashCode (Leaf h _) = h@@ -1637,7 +1609,7 @@ leafHashCode _ = error "leafHashCode" goDifferentHash s h1 h2 t1 t2- | m1 == m2 = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)+ | m1 == m2 = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2) | m1 < m2 = BitmapIndexed (m1 .|. m2) (A.pair t1 t2) | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1) where@@ -1648,27 +1620,31 @@ -- | Strict in the result of @f@. unionArrayBy :: (a -> a -> a) -> Bitmap -> Bitmap -> A.Array a -> A.Array a -> A.Array a-unionArrayBy f b1 b2 ary1 ary2 = A.run $ do- let b' = b1 .|. b2- mary <- A.new_ (popCount b')+-- The manual forcing of @b1@, @b2@, @ary1@ and @ary2@ results in handsome+-- Core size reductions with GHC 9.2.2. See the Core diffs in+-- https://github.com/haskell-unordered-containers/unordered-containers/pull/376.+unionArrayBy f !b1 !b2 !ary1 !ary2 = A.run $ do+ let bCombined = b1 .|. b2+ mary <- A.new_ (popCount bCombined) -- iterate over nonzero bits of b1 .|. b2- -- it would be nice if we could shift m by more than 1 each time- let ba = b1 .&. b2- go !i !i1 !i2 !m- | m > b' = return ()- | b' .&. m == 0 = go i i1 i2 (m `unsafeShiftL` 1)- | ba .&. m /= 0 = do+ let go !i !i1 !i2 !b+ | b == 0 = return ()+ | testBit (b1 .&. b2) = do x1 <- A.indexM ary1 i1 x2 <- A.indexM ary2 i2 A.write mary i $! f x1 x2- go (i+1) (i1+1) (i2+1) (m `unsafeShiftL` 1)- | b1 .&. m /= 0 = do+ go (i+1) (i1+1) (i2+1) b'+ | testBit b1 = do A.write mary i =<< A.indexM ary1 i1- go (i+1) (i1+1) (i2 ) (m `unsafeShiftL` 1)- | otherwise = do+ go (i+1) (i1+1) i2 b'+ | otherwise = do A.write mary i =<< A.indexM ary2 i2- go (i+1) (i1 ) (i2+1) (m `unsafeShiftL` 1)- go 0 0 0 (b' .&. negate b') -- XXX: b' must be non-zero+ go (i+1) i1 (i2+1) b'+ where+ m = 1 `unsafeShiftL` countTrailingZeros b+ testBit x = x .&. m /= 0+ b' = b .&. complement m+ go 0 0 0 bCombined return mary -- TODO: For the case where b1 .&. b2 == b1, i.e. when one is a -- subset of the other, we could use a slightly simpler algorithm,@@ -1679,7 +1655,7 @@ -- | Construct a set containing all elements from a list of sets. unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v-unions = L.foldl' union empty+unions = List.foldl' union empty {-# INLINE unions #-} @@ -1699,7 +1675,7 @@ -- ('compose' bc ab '!?') = (bc '!?') <=< (ab '!?') -- @ ----- @since UNRELEASED+-- @since 0.2.13.0 compose :: (Eq b, Hashable b) => HashMap b c -> HashMap a b -> HashMap a c compose bc !ab | null bc = empty@@ -1708,7 +1684,7 @@ ------------------------------------------------------------------------ -- * Transformations --- | /O(n)/ Transform this map by applying a function to every value.+-- | \(O(n)\) Transform this map by applying a function to every value. mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2 mapWithKey f = go where@@ -1722,7 +1698,7 @@ A.map' (\ (L k v) -> L k (f k v)) ary {-# INLINE mapWithKey #-} --- | /O(n)/ Transform this map by applying a function to every value.+-- | \(O(n)\) Transform this map by applying a function to every value. map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2 map f = mapWithKey (const f) {-# INLINE map #-}@@ -1730,7 +1706,7 @@ -- TODO: We should be able to use mutation to create the new -- 'HashMap'. --- | /O(n)/ Perform an 'Applicative' action for each key-value pair+-- | \(O(n)\) Perform an 'Applicative' action for each key-value pair -- in a 'HashMap' and produce a 'HashMap' of all the results. -- -- Note: the order in which the actions occur is unspecified. In particular,@@ -1751,20 +1727,38 @@ Collision h <$> A.traverse' (\ (L k v) -> L k <$> f k v) ary {-# INLINE traverseWithKey #-} +-- | \(O(n)\).+-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.+--+-- The size of the result may be smaller if @f@ maps two or more distinct+-- keys to the same new key. In this case there is no guarantee which of the+-- associated values is chosen for the conflicting key.+--+-- >>> mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])+-- fromList [(4,"b"),(6,"a")]+-- >>> mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")])+-- fromList [(1,"c")]+-- >>> mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")])+-- fromList [(3,"c")]+--+-- @since 0.2.14.0+mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HashMap k1 v -> HashMap k2 v+mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []+ ------------------------------------------------------------------------ -- * Difference and intersection --- | /O(n*log m)/ Difference of two maps. Return elements of the first map+-- | \(O(n \log m)\) Difference of two maps. Return elements of the first map -- not existing in the second. difference :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v difference a b = foldlWithKey' go empty a where go m k v = case lookup k b of- Nothing -> insert k v m+ Nothing -> unsafeInsert k v m _ -> m {-# INLINABLE difference #-} --- | /O(n*log m)/ Difference with a combining function. When two equal keys are+-- | \(O(n \log m)\) Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the values of these keys. -- If it returns 'Nothing', the element is discarded (proper set difference). If -- it returns (@'Just' y@), the element is updated with a new value @y@.@@ -1772,48 +1766,175 @@ differenceWith f a b = foldlWithKey' go empty a where go m k v = case lookup k b of- Nothing -> insert k v m- Just w -> maybe m (\y -> insert k y m) (f v w)+ Nothing -> unsafeInsert k v m+ Just w -> maybe m (\y -> unsafeInsert k y m) (f v w) {-# INLINABLE differenceWith #-} --- | /O(n*log m)/ Intersection of two maps. Return elements of the first+-- | \(O(n \log m)\) Intersection of two maps. Return elements of the first -- map for keys existing in the second. intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v-intersection a b = foldlWithKey' go empty a- where- go m k v = case lookup k b of- Just _ -> insert k v m- _ -> m+intersection = Exts.inline intersectionWith const {-# INLINABLE intersection #-} --- | /O(n*log m)/ Intersection of two maps. If a key occurs in both maps+-- | \(O(n \log m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps.-intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1- -> HashMap k v2 -> HashMap k v3-intersectionWith f a b = foldlWithKey' go empty a- where- go m k v = case lookup k b of- Just w -> insert k (f v w) m- _ -> m+intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3+intersectionWith f = Exts.inline intersectionWithKey $ const f {-# INLINABLE intersectionWith #-} --- | /O(n*log m)/ Intersection of two maps. If a key occurs in both maps+-- | \(O(n \log m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps.-intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3)- -> HashMap k v1 -> HashMap k v2 -> HashMap k v3-intersectionWithKey f a b = foldlWithKey' go empty a- where- go m k v = case lookup k b of- Just w -> insert k (f k v w) m- _ -> m+intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3+intersectionWithKey f = intersectionWithKey# $ \k v1 v2 -> (# f k v1 v2 #) {-# INLINABLE intersectionWithKey #-} +intersectionWithKey# :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3+intersectionWithKey# f = go 0+ where+ -- empty vs. anything+ go !_ _ Empty = Empty+ go _ Empty _ = Empty+ -- leaf vs. anything+ go s (Leaf h1 (L k1 v1)) t2 =+ lookupCont+ (\_ -> Empty)+ (\v _ -> case f k1 v1 v of (# v' #) -> Leaf h1 $ L k1 v')+ h1 k1 s t2+ go s t1 (Leaf h2 (L k2 v2)) =+ lookupCont+ (\_ -> Empty)+ (\v _ -> case f k2 v v2 of (# v' #) -> Leaf h2 $ L k2 v')+ h2 k2 s t1+ -- collision vs. collision+ go _ (Collision h1 ls1) (Collision h2 ls2) = intersectionCollisions f h1 h2 ls1 ls2+ -- branch vs. branch+ go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =+ intersectionArrayBy (go (s + bitsPerSubkey)) b1 b2 ary1 ary2+ go s (BitmapIndexed b1 ary1) (Full ary2) =+ intersectionArrayBy (go (s + bitsPerSubkey)) b1 fullNodeMask ary1 ary2+ go s (Full ary1) (BitmapIndexed b2 ary2) =+ intersectionArrayBy (go (s + bitsPerSubkey)) fullNodeMask b2 ary1 ary2+ go s (Full ary1) (Full ary2) =+ intersectionArrayBy (go (s + bitsPerSubkey)) fullNodeMask fullNodeMask ary1 ary2+ -- collision vs. branch+ go s (BitmapIndexed b1 ary1) t2@(Collision h2 _ls2)+ | b1 .&. m2 == 0 = Empty+ | otherwise = go (s + bitsPerSubkey) (A.index ary1 i) t2+ where+ m2 = mask h2 s+ i = sparseIndex b1 m2+ go s t1@(Collision h1 _ls1) (BitmapIndexed b2 ary2)+ | b2 .&. m1 == 0 = Empty+ | otherwise = go (s + bitsPerSubkey) t1 (A.index ary2 i)+ where+ m1 = mask h1 s+ i = sparseIndex b2 m1+ go s (Full ary1) t2@(Collision h2 _ls2) = go (s + bitsPerSubkey) (A.index ary1 i) t2+ where+ i = index h2 s+ go s t1@(Collision h1 _ls1) (Full ary2) = go (s + bitsPerSubkey) t1 (A.index ary2 i)+ where+ i = index h1 s+{-# INLINE intersectionWithKey# #-}++intersectionArrayBy ::+ ( HashMap k v1 ->+ HashMap k v2 ->+ HashMap k v3+ ) ->+ Bitmap ->+ Bitmap ->+ A.Array (HashMap k v1) ->+ A.Array (HashMap k v2) ->+ HashMap k v3+intersectionArrayBy f !b1 !b2 !ary1 !ary2+ | b1 .&. b2 == 0 = Empty+ | otherwise = runST $ do+ mary <- A.new_ $ popCount bIntersect+ -- iterate over nonzero bits of b1 .|. b2+ let go !i !i1 !i2 !b !bFinal+ | b == 0 = pure (i, bFinal)+ | testBit $ b1 .&. b2 = do+ x1 <- A.indexM ary1 i1+ x2 <- A.indexM ary2 i2+ case f x1 x2 of+ Empty -> go i (i1 + 1) (i2 + 1) b' (bFinal .&. complement m)+ _ -> do+ A.write mary i $! f x1 x2+ go (i + 1) (i1 + 1) (i2 + 1) b' bFinal+ | testBit b1 = go i (i1 + 1) i2 b' bFinal+ | otherwise = go i i1 (i2 + 1) b' bFinal+ where+ m = 1 `unsafeShiftL` countTrailingZeros b+ testBit x = x .&. m /= 0+ b' = b .&. complement m+ (len, bFinal) <- go 0 0 0 bCombined bIntersect+ case len of+ 0 -> pure Empty+ 1 -> do+ l <- A.read mary 0+ if isLeafOrCollision l+ then pure l+ else BitmapIndexed bFinal <$> (A.unsafeFreeze =<< A.shrink mary 1)+ _ -> bitmapIndexedOrFull bFinal <$> (A.unsafeFreeze =<< A.shrink mary len)+ where+ bCombined = b1 .|. b2+ bIntersect = b1 .&. b2+{-# INLINE intersectionArrayBy #-}++intersectionCollisions :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> Hash -> Hash -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> HashMap k v3+intersectionCollisions f h1 h2 ary1 ary2+ | h1 == h2 = runST $ do+ mary2 <- A.thaw ary2 0 $ A.length ary2+ mary <- A.new_ $ min (A.length ary1) (A.length ary2)+ let go i j+ | i >= A.length ary1 || j >= A.lengthM mary2 = pure j+ | otherwise = do+ L k1 v1 <- A.indexM ary1 i+ searchSwap k1 j mary2 >>= \case+ Just (L _k2 v2) -> do+ let !(# v3 #) = f k1 v1 v2+ A.write mary j $ L k1 v3+ go (i + 1) (j + 1)+ Nothing -> do+ go (i + 1) j+ len <- go 0 0+ case len of+ 0 -> pure Empty+ 1 -> Leaf h1 <$> A.read mary 0+ _ -> Collision h1 <$> (A.unsafeFreeze =<< A.shrink mary len)+ | otherwise = Empty+{-# INLINE intersectionCollisions #-}++-- | Say we have+-- @+-- 1 2 3 4+-- @+-- and we search for @3@. Then we can mutate the array to+-- @+-- undefined 2 1 4+-- @+-- We don't actually need to write undefined, we just have to make sure that the next search starts 1 after the current one.+searchSwap :: Eq k => k -> Int -> A.MArray s (Leaf k v) -> ST s (Maybe (Leaf k v))+searchSwap toFind start = go start toFind start+ where+ go i0 k i mary+ | i >= A.lengthM mary = pure Nothing+ | otherwise = do+ l@(L k' _v) <- A.read mary i+ if k == k'+ then do+ A.write mary i =<< A.read mary i0+ pure $ Just l+ else go i0 k (i + 1) mary+{-# INLINE searchSwap #-}+ ------------------------------------------------------------------------ -- * Folds --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- left-identity of the operator). Each application of the operator -- is evaluated before using the result in the next application.@@ -1822,7 +1943,7 @@ foldl' f = foldlWithKey' (\ z _ v -> f z v) {-# INLINE foldl' #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- right-identity of the operator). Each application of the operator -- is evaluated before using the result in the next application.@@ -1831,7 +1952,7 @@ foldr' f = foldrWithKey' (\ _ v z -> f v z) {-# INLINE foldr' #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- left-identity of the operator). Each application of the operator -- is evaluated before using the result in the next application.@@ -1846,7 +1967,7 @@ go z (Collision _ ary) = A.foldl' (\ z' (L k v) -> f z' k v) z ary {-# INLINE foldlWithKey' #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- right-identity of the operator). Each application of the operator -- is evaluated before using the result in the next application.@@ -1861,21 +1982,21 @@ go (Collision _ ary) !z = A.foldr' (\ (L k v) z' -> f k v z') z ary {-# INLINE foldrWithKey' #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- right-identity of the operator). foldr :: (v -> a -> a) -> a -> HashMap k v -> a foldr f = foldrWithKey (const f) {-# INLINE foldr #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- left-identity of the operator). foldl :: (a -> v -> a) -> a -> HashMap k v -> a foldl f = foldlWithKey (\a _k v -> f a v) {-# INLINE foldl #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- right-identity of the operator). foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a@@ -1888,7 +2009,7 @@ go (Collision _ ary) z = A.foldr (\ (L k v) z' -> f k v z') z ary {-# INLINE foldrWithKey #-} --- | /O(n)/ Reduce this map by applying a binary operator to all+-- | \(O(n)\) Reduce this map by applying a binary operator to all -- elements, using the given starting value (typically the -- left-identity of the operator). foldlWithKey :: (a -> k -> v -> a) -> a -> HashMap k v -> a@@ -1901,7 +2022,7 @@ go z (Collision _ ary) = A.foldl (\ z' (L k v) -> f z' k v) z ary {-# INLINE foldlWithKey #-} --- | /O(n)/ Reduce the map by applying a function to each element+-- | \(O(n)\) Reduce the map by applying a function to each element -- and combining the results with a monoid operation. foldMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m foldMapWithKey f = go@@ -1916,7 +2037,7 @@ ------------------------------------------------------------------------ -- * Filter --- | /O(n)/ Transform this map by applying a function to every value+-- | \(O(n)\) Transform this map by applying a function to every value -- and retaining only some of them. mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 mapMaybeWithKey f = filterMapAux onLeaf onColl@@ -1927,13 +2048,13 @@ | otherwise = Nothing {-# INLINE mapMaybeWithKey #-} --- | /O(n)/ Transform this map by applying a function to every value+-- | \(O(n)\) Transform this map by applying a function to every value -- and retaining only some of them. mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 mapMaybe f = mapMaybeWithKey (const f) {-# INLINE mapMaybe #-} --- | /O(n)/ Filter this map by retaining only elements satisfying a+-- | \(O(n)\) Filter this map by retaining only elements satisfying a -- predicate. filterWithKey :: forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v filterWithKey pred = filterMapAux onLeaf onColl@@ -2014,7 +2135,7 @@ | otherwise = step ary mary (i+1) j n {-# INLINE filterMapAux #-} --- | /O(n)/ Filter this map by retaining only elements which values+-- | \(O(n)\) Filter this map by retaining only elements which values -- satisfy a predicate. filter :: (v -> Bool) -> HashMap k v -> HashMap k v filter p = filterWithKey (\_ v -> p v)@@ -2026,34 +2147,34 @@ -- TODO: Improve fusion rules by modelled them after the Prelude ones -- on lists. --- | /O(n)/ Return a list of this map's keys. The list is produced+-- | \(O(n)\) Return a list of this map's keys. The list is produced -- lazily. keys :: HashMap k v -> [k]-keys = L.map fst . toList+keys = List.map fst . toList {-# INLINE keys #-} --- | /O(n)/ Return a list of this map's values. The list is produced+-- | \(O(n)\) Return a list of this map's values. The list is produced -- lazily. elems :: HashMap k v -> [v]-elems = L.map snd . toList+elems = List.map snd . toList {-# INLINE elems #-} ------------------------------------------------------------------------ -- ** Lists --- | /O(n)/ Return a list of this map's elements. The list is+-- | \(O(n)\) Return a list of this map's elements. The list is -- produced lazily. The order of its elements is unspecified. toList :: HashMap k v -> [(k, v)]-toList t = build (\ c z -> foldrWithKey (curry c) z t)+toList t = Exts.build (\ c z -> foldrWithKey (curry c) z t) {-# INLINE toList #-} --- | /O(n)/ Construct a map with the supplied mappings. If the list+-- | \(O(n)\) Construct a map with the supplied mappings. If the list -- contains duplicate mappings, the later mappings take precedence. fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v-fromList = L.foldl' (\ m (k, v) -> unsafeInsert k v m) empty+fromList = List.foldl' (\ m (k, v) -> unsafeInsert k v m) empty {-# INLINABLE fromList #-} --- | /O(n*log n)/ Construct a map from a list of elements. Uses+-- | \(O(n \log n)\) Construct a map from a list of elements. Uses -- the provided function @f@ to merge duplicate entries with -- @(f newVal oldVal)@. --@@ -2084,10 +2205,10 @@ -- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] -- > = fromList [(k, f d (f c (f b a)))] fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty+fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty {-# INLINE fromListWith #-} --- | /O(n*log n)/ Construct a map from a list of elements. Uses+-- | \(O(n \log n)\) Construct a map from a list of elements. Uses -- the provided function to merge duplicate entries. -- -- === Examples@@ -2114,20 +2235,16 @@ -- -- @since 0.2.11 fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty+fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey (\k' a b -> (# f k' a b #)) k v m) empty {-# INLINE fromListWithKey #-} ------------------------------------------------------------------------ -- Array operations --- | /O(n)/ Look up the value associated with the given key in an+-- | \(O(n)\) Look up the value associated with the given key in an -- array. lookupInArrayCont ::-#if __GLASGOW_HASKELL__ >= 802 forall rep (r :: TYPE rep) k v.-#else- forall r k v.-#endif Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0) where@@ -2140,7 +2257,7 @@ | otherwise -> go k ary (i+1) n {-# INLINE lookupInArrayCont #-} --- | /O(n)/ Lookup the value associated with the given key in this+-- | \(O(n)\) Lookup the value associated with the given key in this -- array. Returns 'Nothing' if the key wasn't found. indexOf :: Eq k => k -> A.Array (Leaf k v) -> Maybe Int indexOf k0 ary0 = go k0 ary0 0 (A.length ary0)@@ -2176,12 +2293,8 @@ updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) where go !k v !ary !i !n- | i >= n = A.run $ do- -- Not found, append to the end.- mary <- A.new_ (n + 1)- A.copy ary 0 mary 0 n- A.write mary n (L k v)- return mary+ -- Not found, append to the end.+ | i >= n = A.snoc ary $ L k v | L kx y <- A.index ary i , k == kx , (# v2 #) <- f k v y@@ -2190,11 +2303,7 @@ = go k v ary (i+1) n {-# INLINABLE updateOrSnocWithKey #-} -updateOrConcatWith :: Eq k => (v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)-updateOrConcatWith f = updateOrConcatWithKey (const f)-{-# INLINABLE updateOrConcatWith #-}--updateOrConcatWithKey :: Eq k => (k -> v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)+updateOrConcatWithKey :: Eq k => (k -> v -> v -> (# v #)) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) updateOrConcatWithKey f ary1 ary2 = A.run $ do -- TODO: instead of mapping and then folding, should we traverse? -- We'll have to be careful to avoid allocating pairs or similar.@@ -2216,7 +2325,7 @@ Just i1 -> do -- key occurs in both arrays, store combination in position i1 L k v1 <- A.indexM ary1 i1 L _ v2 <- A.indexM ary2 i2- A.write mary i1 (L k (f k v1 v2))+ case f k v1 v2 of (# v3 #) -> A.write mary i1 (L k v3) go iEnd (i2+1) Nothing -> do -- key is only in ary2, append to end A.write mary iEnd =<< A.indexM ary2 i2@@ -2225,7 +2334,7 @@ return mary {-# INLINABLE updateOrConcatWithKey #-} --- | /O(n*m)/ Check if the first array is a subset of the second array.+-- | \(O(n*m)\) Check if the first array is a subset of the second array. subsetArray :: Eq k => (v1 -> v2 -> Bool) -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> Bool subsetArray cmpV ary1 ary2 = A.length ary1 <= A.length ary2 && A.all inAry2 ary1 where@@ -2235,66 +2344,105 @@ ------------------------------------------------------------------------ -- Manually unrolled loops --- | /O(n)/ Update the element at the given position in this array.-update16 :: A.Array e -> Int -> e -> A.Array e-update16 ary idx b = runST (update16M ary idx b)-{-# INLINE update16 #-}+-- | \(O(n)\) Update the element at the given position in this array.+update32 :: A.Array e -> Int -> e -> A.Array e+update32 ary idx b = runST (update32M ary idx b)+{-# INLINE update32 #-} --- | /O(n)/ Update the element at the given position in this array.-update16M :: A.Array e -> Int -> e -> ST s (A.Array e)-update16M ary idx b = do- mary <- clone16 ary+-- | \(O(n)\) Update the element at the given position in this array.+update32M :: A.Array e -> Int -> e -> ST s (A.Array e)+update32M ary idx b = do+ mary <- clone ary A.write mary idx b A.unsafeFreeze mary-{-# INLINE update16M #-}+{-# INLINE update32M #-} --- | /O(n)/ Update the element at the given position in this array, by applying a function to it.-update16With' :: A.Array e -> Int -> (e -> e) -> A.Array e-update16With' ary idx f+-- | \(O(n)\) Update the element at the given position in this array, by applying a function to it.+update32With' :: A.Array e -> Int -> (e -> e) -> A.Array e+update32With' ary idx f | (# x #) <- A.index# ary idx- = update16 ary idx $! f x-{-# INLINE update16With' #-}+ = update32 ary idx $! f x+{-# INLINE update32With' #-} --- | Unsafely clone an array of 16 elements. The length of the input+-- | Unsafely clone an array of (2^bitsPerSubkey) elements. The length of the input -- array is not checked.-clone16 :: A.Array e -> ST s (A.MArray s e)-clone16 ary =- A.thaw ary 0 16+clone :: A.Array e -> ST s (A.MArray s e)+clone ary =+ A.thaw ary 0 (2^bitsPerSubkey) ------------------------------------------------------------------------ -- Bit twiddling +-- TODO: Name this 'bitsPerLevel'?! What is a "subkey"?+-- https://github.com/haskell-unordered-containers/unordered-containers/issues/425++-- | Number of bits that are inspected at each level of the hash tree.+--+-- This constant is named /t/ in the original /Ideal Hash Trees/ paper. bitsPerSubkey :: Int-bitsPerSubkey = 4+bitsPerSubkey = 5 +-- | The size of a 'Full' node, i.e. @2 ^ 'bitsPerSubkey'@. maxChildren :: Int maxChildren = 1 `unsafeShiftL` bitsPerSubkey -subkeyMask :: Bitmap+-- | Bit mask with the lowest 'bitsPerSubkey' bits set, i.e. @0b11111@.+subkeyMask :: Word subkeyMask = 1 `unsafeShiftL` bitsPerSubkey - 1 -sparseIndex :: Bitmap -> Bitmap -> Int-sparseIndex b m = popCount (b .&. (m - 1))+-- | Given a 'Hash' and a 'Shift' that indicates the level in the tree, compute+-- the index into a 'Full' node or into the bitmap of a `BitmapIndexed` node.+--+-- >>> index 0b0010_0010 0+-- 0b0000_0010+index :: Hash -> Shift -> Int+index w s = fromIntegral $ unsafeShiftR w s .&. subkeyMask+{-# INLINE index #-} -mask :: Word -> Shift -> Bitmap+-- | Given a 'Hash' and a 'Shift' that indicates the level in the tree, compute+-- the bitmap that contains only the 'index' of the hash at this level.+--+-- The result can be used for constructing one-element 'BitmapIndexed' nodes or+-- to check whether a 'BitmapIndexed' node may possibly contain the given 'Hash'.+--+-- >>> mask 0b0010_0010 0+-- 0b0100+mask :: Hash -> Shift -> Bitmap mask w s = 1 `unsafeShiftL` index w s {-# INLINE mask #-} --- | Mask out the 'bitsPerSubkey' bits used for indexing at this level--- of the tree.-index :: Hash -> Shift -> Int-index w s = fromIntegral $ (unsafeShiftR w s) .&. subkeyMask-{-# INLINE index #-}+-- | This array index is computed by counting the number of bits below the+-- 'index' represented by the mask.+--+-- >>> sparseIndex 0b0110_0110 0b0010_0000+-- 2+sparseIndex+ :: Bitmap+ -- ^ Bitmap of a 'BitmapIndexed' node+ -> Bitmap+ -- ^ One-bit 'mask' corresponding to the 'index' of a hash+ -> Int+ -- ^ Index into the array of the 'BitmapIndexed' node+sparseIndex b m = popCount (b .&. (m - 1))+{-# INLINE sparseIndex #-} --- | A bitmask with the 'bitsPerSubkey' least significant bits set.+-- TODO: Should be named _(bit)map_ instead of _mask_++-- | A bitmap with the 'maxChildren' least significant bits set, i.e.+-- @0xFF_FF_FF_FF@. fullNodeMask :: Bitmap-fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren)+-- This needs to use 'shiftL' instead of 'unsafeShiftL', to avoid UB.+-- See issue #412.+fullNodeMask = complement (complement 0 `shiftL` maxChildren) {-# INLINE fullNodeMask #-} +------------------------------------------------------------------------+-- Pointer equality+ -- | Check if two the two arguments are the same value. N.B. This -- function might give false negatives (due to GC moving objects.) ptrEq :: a -> a -> Bool-ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y ==# 1#)+ptrEq x y = Exts.isTrue# (Exts.reallyUnsafePtrEquality# x y ==# 1#) {-# INLINE ptrEq #-} ------------------------------------------------------------------------
src/Data/Strict/HashMap/Autogen/Internal/Array.hs view
@@ -1,4 +1,10 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -20,14 +26,15 @@ -- -- Note that no bounds checking are performed. module Data.Strict.HashMap.Autogen.Internal.Array- ( Array- , MArray+ ( Array(..)+ , MArray(..) -- * Creation , new , new_ , singleton , singletonM+ , snoc , pair -- * Basic interface@@ -69,112 +76,34 @@ , traverse' , toList , fromList+ , fromList'+ , shrink ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative (..), (<$>))-#endif import Control.Applicative (liftA2)-import Control.DeepSeq-import GHC.Exts(Int(..), Int#, reallyUnsafePtrEquality#, tagToEnum#, unsafeCoerce#, State#)-import GHC.ST (ST(..))-import Control.Monad.ST (stToIO)--#if __GLASGOW_HASKELL__ >= 709-import Prelude hiding (filter, foldMap, foldr, foldl, length, map, read, traverse, all)-#else-import Prelude hiding (filter, foldr, foldl, length, map, read, all)-#endif--#if __GLASGOW_HASKELL__ >= 710-import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#,- indexSmallArray#, unsafeFreezeSmallArray#, unsafeThawSmallArray#,- SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#,- sizeofSmallMutableArray#, copySmallMutableArray#, cloneSmallMutableArray#)--#else-import GHC.Exts (Array#, newArray#, readArray#, writeArray#,- indexArray#, unsafeFreezeArray#, unsafeThawArray#,- MutableArray#, sizeofArray#, copyArray#, thawArray#,- sizeofMutableArray#, copyMutableArray#, cloneMutableArray#)-import Data.Monoid (Monoid (..))-#endif+import Control.DeepSeq (NFData (..), NFData1 (..))+import Control.Monad ((>=>))+import Control.Monad.ST (runST, stToIO)+import GHC.Exts (Int (..), SmallArray#, SmallMutableArray#,+ cloneSmallMutableArray#, copySmallArray#,+ copySmallMutableArray#, indexSmallArray#,+ newSmallArray#, readSmallArray#,+ reallyUnsafePtrEquality#, sizeofSmallArray#,+ sizeofSmallMutableArray#, tagToEnum#,+ thawSmallArray#, unsafeCoerce#,+ unsafeFreezeSmallArray#, unsafeThawSmallArray#,+ writeSmallArray#)+import GHC.ST (ST (..))+import Prelude hiding (all, filter, foldMap, foldl, foldr, length,+ map, read, traverse) +import qualified GHC.Exts as Exts+import qualified Language.Haskell.TH.Syntax as TH #if defined(ASSERTS) import qualified Prelude #endif -import Data.Strict.HashMap.Autogen.Internal.Unsafe (runST)-import Control.Monad ((>=>)) --#if __GLASGOW_HASKELL__ >= 710-type Array# a = SmallArray# a-type MutableArray# a = SmallMutableArray# a--newArray# :: Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)-newArray# = newSmallArray#--unsafeFreezeArray# :: SmallMutableArray# d a- -> State# d -> (# State# d, SmallArray# a #)-unsafeFreezeArray# = unsafeFreezeSmallArray#--readArray# :: SmallMutableArray# d a- -> Int# -> State# d -> (# State# d, a #)-readArray# = readSmallArray#--writeArray# :: SmallMutableArray# d a- -> Int# -> a -> State# d -> State# d-writeArray# = writeSmallArray#--indexArray# :: SmallArray# a -> Int# -> (# a #)-indexArray# = indexSmallArray#--unsafeThawArray# :: SmallArray# a- -> State# d -> (# State# d, SmallMutableArray# d a #)-unsafeThawArray# = unsafeThawSmallArray#--sizeofArray# :: SmallArray# a -> Int#-sizeofArray# = sizeofSmallArray#--copyArray# :: SmallArray# a- -> Int#- -> SmallMutableArray# d a- -> Int#- -> Int#- -> State# d- -> State# d-copyArray# = copySmallArray#--cloneMutableArray# :: SmallMutableArray# s a- -> Int#- -> Int#- -> State# s- -> (# State# s, SmallMutableArray# s a #)-cloneMutableArray# = cloneSmallMutableArray#--thawArray# :: SmallArray# a- -> Int#- -> Int#- -> State# d- -> (# State# d, SmallMutableArray# d a #)-thawArray# = thawSmallArray#--sizeofMutableArray# :: SmallMutableArray# s a -> Int#-sizeofMutableArray# = sizeofSmallMutableArray#--copyMutableArray# :: SmallMutableArray# d a- -> Int#- -> SmallMutableArray# d a- -> Int#- -> Int#- -> State# d- -> State# d-copyMutableArray# = copySmallMutableArray#-#endif--------------------------------------------------------------------------- #if defined(ASSERTS) -- This fugly hack is brought by GHC's apparent reluctance to deal -- with MagicHash and UnboxedTuples when inferring types. Eek!@@ -194,7 +123,7 @@ #endif data Array a = Array {- unArray :: !(Array# a)+ unArray :: !(SmallArray# a) } instance Show a => Show (Array a) where@@ -222,15 +151,15 @@ !lenys = length ys0 length :: Array a -> Int-length ary = I# (sizeofArray# (unArray ary))+length ary = I# (sizeofSmallArray# (unArray ary)) {-# INLINE length #-} data MArray s a = MArray {- unMArray :: !(MutableArray# s a)+ unMArray :: !(SmallMutableArray# s a) } lengthM :: MArray s a -> Int-lengthM mary = I# (sizeofMutableArray# (unMArray mary))+lengthM mary = I# (sizeofSmallMutableArray# (unMArray mary)) {-# INLINE lengthM #-} ------------------------------------------------------------------------@@ -250,6 +179,20 @@ -- relevant rnf is strict, or in case it actually isn't. {-# INLINE rnfArray #-} +-- | @since 0.2.14.0+instance NFData1 Array where+ liftRnf = liftRnfArray++liftRnfArray :: (a -> ()) -> Array a -> ()+liftRnfArray rnf0 ary0 = go ary0 n0 0+ where+ n0 = length ary0+ go !ary !n !i+ | i >= n = ()+ | (# x #) <- index# ary i+ = rnf0 x `seq` go ary n (i+1)+{-# INLINE liftRnfArray #-}+ -- | Create a new mutable array of specified size, in the specified -- state thread, with each element containing the specified initial -- value.@@ -258,16 +201,30 @@ {-# INLINE new #-} new' :: Int -> a -> ST s (MArray s a)-new' (I# n#) b =- CHECK_GT("new",n,(0 :: Int))+new' _n@(I# n#) b =+ CHECK_GT("new",_n,(0 :: Int)) ST $ \s ->- case newArray# n# b s of+ case newSmallArray# n# b s of (# s', ary #) -> (# s', MArray ary #) {-# INLINE new' #-} new_ :: Int -> ST s (MArray s a) new_ n = new' n undefinedElem +-- | When 'Exts.shrinkSmallMutableArray#' is available, the returned array is the same as the array given, as it is shrunk in place.+-- Otherwise a copy is made.+shrink :: MArray s a -> Int -> ST s (MArray s a)+#if __GLASGOW_HASKELL__ >= 810+shrink mary _n@(I# n#) =+ CHECK_GT("shrink", _n, (0 :: Int))+ CHECK_LE("shrink", _n, (lengthM mary))+ ST $ \s -> case Exts.shrinkSmallMutableArray# (unMArray mary) n# s of+ s' -> (# s', mary #)+#else+shrink mary n = cloneM mary 0 n+#endif +{-# INLINE shrink #-}+ singleton :: a -> Array a singleton !x = runST (singletonM x) {-# INLINE singleton #-}@@ -276,6 +233,15 @@ singletonM !x = new 1 x >>= unsafeFreeze {-# INLINE singletonM #-} +snoc :: Array a -> a -> Array a+snoc ary x = run $ do+ mary <- new (n + 1) x+ copy ary 0 mary 0 n+ pure mary+ where+ n = length ary+{-# INLINE snoc #-}+ pair :: a -> a -> Array a pair !x !y = run $ do ary <- new 2 x@@ -286,43 +252,43 @@ read :: MArray s a -> Int -> ST s a read ary _i@(I# i#) = ST $ \ s -> CHECK_BOUNDS("read", lengthM ary, _i)- readArray# (unMArray ary) i# s+ readSmallArray# (unMArray ary) i# s {-# INLINE read #-} write :: MArray s a -> Int -> a -> ST s () write ary _i@(I# i#) !b = ST $ \ s -> CHECK_BOUNDS("write", lengthM ary, _i)- case writeArray# (unMArray ary) i# b s of+ case writeSmallArray# (unMArray ary) i# b s of s' -> (# s' , () #) {-# INLINE write #-} index :: Array a -> Int -> a index ary _i@(I# i#) = CHECK_BOUNDS("index", length ary, _i)- case indexArray# (unArray ary) i# of (# b #) -> b+ case indexSmallArray# (unArray ary) i# of (# b #) -> b {-# INLINE index #-} index# :: Array a -> Int -> (# a #) index# ary _i@(I# i#) = CHECK_BOUNDS("index#", length ary, _i)- indexArray# (unArray ary) i#+ indexSmallArray# (unArray ary) i# {-# INLINE index# #-} indexM :: Array a -> Int -> ST s a indexM ary _i@(I# i#) = CHECK_BOUNDS("indexM", length ary, _i)- case indexArray# (unArray ary) i# of (# b #) -> return b+ case indexSmallArray# (unArray ary) i# of (# b #) -> return b {-# INLINE indexM #-} unsafeFreeze :: MArray s a -> ST s (Array a) unsafeFreeze mary- = ST $ \s -> case unsafeFreezeArray# (unMArray mary) s of+ = ST $ \s -> case unsafeFreezeSmallArray# (unMArray mary) s of (# s', ary #) -> (# s', Array ary #) {-# INLINE unsafeFreeze #-} unsafeThaw :: Array a -> ST s (MArray s a) unsafeThaw ary- = ST $ \s -> case unsafeThawArray# (unArray ary) s of+ = ST $ \s -> case unsafeThawSmallArray# (unArray ary) s of (# s', mary #) -> (# s', MArray mary #) {-# INLINE unsafeThaw #-} @@ -336,7 +302,7 @@ CHECK_LE("copy", _sidx + _n, length src) CHECK_LE("copy", _didx + _n, lengthM dst) ST $ \ s# ->- case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of+ case copySmallArray# (unArray src) sidx# (unMArray dst) didx# n# s# of s2 -> (# s2, () #) -- | Unsafely copy the elements of an array. Array bounds are not checked.@@ -345,15 +311,15 @@ CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1) CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1) ST $ \ s# ->- case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of+ case copySmallMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of s2 -> (# s2, () #) cloneM :: MArray s a -> Int -> Int -> ST s (MArray s a) cloneM _mary@(MArray mary#) _off@(I# off#) _len@(I# len#) =- CHECK_BOUNDS("cloneM_off", lengthM _mary, _off - 1)+ CHECK_BOUNDS("cloneM_off", lengthM _mary, _off) CHECK_BOUNDS("cloneM_end", lengthM _mary, _off + _len - 1) ST $ \ s ->- case cloneMutableArray# mary# off# len# s of+ case cloneSmallMutableArray# mary# off# len# s of (# s', mary'# #) -> (# s', MArray mary'# #) -- | Create a new array of the @n@ first elements of @mary@.@@ -361,31 +327,30 @@ trim mary n = cloneM mary 0 n >>= unsafeFreeze {-# INLINE trim #-} --- | /O(n)/ Insert an element at the given position in this array,+-- | \(O(n)\) Insert an element at the given position in this array, -- increasing its size by one. insert :: Array e -> Int -> e -> Array e insert ary idx b = runST (insertM ary idx b) {-# INLINE insert #-} --- | /O(n)/ Insert an element at the given position in this array,+-- | \(O(n)\) Insert an element at the given position in this array, -- increasing its size by one. insertM :: Array e -> Int -> e -> ST s (Array e) insertM ary idx b = CHECK_BOUNDS("insertM", count + 1, idx)- do mary <- new_ (count+1)+ do mary <- new (count+1) b copy ary 0 mary 0 idx- write mary idx b copy ary idx mary (idx+1) (count-idx) unsafeFreeze mary where !count = length ary {-# INLINE insertM #-} --- | /O(n)/ Update the element at the given position in this array.+-- | \(O(n)\) Update the element at the given position in this array. update :: Array e -> Int -> e -> Array e update ary idx b = runST (updateM ary idx b) {-# INLINE update #-} --- | /O(n)/ Update the element at the given position in this array.+-- | \(O(n)\) Update the element at the given position in this array. updateM :: Array e -> Int -> e -> ST s (Array e) updateM ary idx b = CHECK_BOUNDS("updateM", count, idx)@@ -395,7 +360,7 @@ where !count = length ary {-# INLINE updateM #-} --- | /O(n)/ Update the element at the given positio in this array, by+-- | \(O(n)\) Update the element at the given positio in this array, by -- applying a function to it. Evaluates the element to WHNF before -- inserting it into the array. updateWith' :: Array e -> Int -> (e -> e) -> Array e@@ -404,7 +369,7 @@ = update ary idx $! f x {-# INLINE updateWith' #-} --- | /O(1)/ Update the element at the given position in this array,+-- | \(O(1)\) Update the element at the given position in this array, -- without copying. unsafeUpdateM :: Array e -> Int -> e -> ST s () unsafeUpdateM ary idx b =@@ -477,19 +442,19 @@ {-# NOINLINE undefinedElem #-} thaw :: Array e -> Int -> Int -> ST s (MArray s e)-thaw !ary !_o@(I# o#) (I# n#) =- CHECK_LE("thaw", _o + n, length ary)- ST $ \ s -> case thawArray# (unArray ary) o# n# s of+thaw !ary !_o@(I# o#) _n@(I# n#) =+ CHECK_LE("thaw", _o + _n, length ary)+ ST $ \ s -> case thawSmallArray# (unArray ary) o# n# s of (# s2, mary# #) -> (# s2, MArray mary# #) {-# INLINE thaw #-} --- | /O(n)/ Delete an element at the given position in this array,+-- | \(O(n)\) Delete an element at the given position in this array, -- decreasing its size by one. delete :: Array e -> Int -> Array e delete ary idx = runST (deleteM ary idx) {-# INLINE delete #-} --- | /O(n)/ Delete an element at the given position in this array,+-- | \(O(n)\) Delete an element at the given position in this array, -- decreasing its size by one. deleteM :: Array e -> Int -> ST s (Array e) deleteM ary idx = do@@ -507,9 +472,10 @@ in run $ do mary <- new_ n go ary mary 0 n+ return mary where go ary mary i n- | i >= n = return mary+ | i >= n = return () | otherwise = do x <- indexM ary i write mary i $ f x@@ -523,9 +489,10 @@ in run $ do mary <- new_ n go ary mary 0 n+ return mary where go ary mary i n- | i >= n = return mary+ | i >= n = return () | otherwise = do x <- indexM ary i write mary i $! f x@@ -538,15 +505,39 @@ run $ do mary <- new_ n go xs0 mary 0+ return mary where- go [] !mary !_ = return mary- go (x:xs) mary i = do write mary i x- go xs mary (i+1)+ go [] !_ !_ = return ()+ go (x:xs) mary i = do write mary i x+ go xs mary (i+1) +fromList' :: Int -> [a] -> Array a+fromList' n xs0 =+ CHECK_EQ("fromList'", n, Prelude.length xs0)+ run $ do+ mary <- new_ n+ go xs0 mary 0+ return mary+ where+ go [] !_ !_ = return ()+ go (!x:xs) mary i = do write mary i x+ go xs mary (i+1)++-- | @since 0.2.17.0+instance TH.Lift a => TH.Lift (Array a) where+#if MIN_VERSION_template_haskell(2,16,0)+ liftTyped ar = [|| fromList' arlen arlist ||]+#else+ lift ar = [| fromList' arlen arlist |]+#endif+ where+ arlen = length ar+ arlist = toList ar+ toList :: Array a -> [a] toList = foldr (:) [] -newtype STA a = STA {_runSTA :: forall s. MutableArray# s a -> ST s (Array a)}+newtype STA a = STA {_runSTA :: forall s. SmallMutableArray# s a -> ST s (Array a)} runSTA :: Int -> STA a -> Array a runSTA !n (STA m) = runST $ new_ n >>= \ (MArray ar) -> m ar
src/Data/Strict/HashMap/Autogen/Internal/List.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-}@@ -25,10 +26,11 @@ , unorderedCompare ) where +import Data.List (sortBy) import Data.Maybe (fromMaybe)-import Data.List (sortBy)-import Data.Monoid-import Prelude+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup ((<>))+#endif -- Note: previous implemenation isPermutation = null (as // bs) -- was O(n^2) too.@@ -68,7 +70,7 @@ go [] [] = EQ go [] (_ : _) = LT go (_ : _) [] = GT- go (x : xs) (y : ys) = c x y `mappend` go xs ys+ go (x : xs) (y : ys) = c x y <> go xs ys cmpA a a' = compare (inB a) (inB a') cmpB b b' = compare (inA b) (inA b')
src/Data/Strict/HashMap/Autogen/Internal/Strict.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE BangPatterns, CPP, PatternGuards, MagicHash, UnboxedTuples #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-} ------------------------------------------------------------------------@@ -34,8 +38,8 @@ -- especially when key comparison is expensive, as in the case of -- strings. ----- Many operations have a average-case complexity of /O(log n)/. The--- implementation uses a large base (i.e. 16) so in practice these+-- Many operations have a average-case complexity of \(O(\log n)\). The+-- implementation uses a large base (i.e. 32) so in practice these -- operations are constant time. module Data.Strict.HashMap.Autogen.Internal.Strict (@@ -45,102 +49,110 @@ HashMap -- * Construction- , empty+ , HM.empty , singleton -- * Basic interface , HM.null- , size+ , HM.size , HM.member , HM.lookup , (HM.!?) , HM.findWithDefault- , lookupDefault- , (!)+ , HM.lookupDefault+ , (HM.!) , insert , insertWith- , delete+ , HM.delete , adjust , update , alter , alterF- , isSubmapOf- , isSubmapOfBy+ , HM.isSubmapOf+ , HM.isSubmapOfBy -- * Combine -- ** Union- , union+ , HM.union , unionWith , unionWithKey- , unions+ , HM.unions -- ** Compose- , compose+ , HM.compose -- * Transformations , map , mapWithKey , traverseWithKey+ , HM.mapKeys -- * Difference and intersection- , difference+ , HM.difference , differenceWith- , intersection+ , HM.intersection , intersectionWith , intersectionWithKey -- * Folds- , foldMapWithKey- , foldr'- , foldl'- , foldrWithKey'- , foldlWithKey'+ , HM.foldMapWithKey+ , HM.foldr'+ , HM.foldl'+ , HM.foldrWithKey'+ , HM.foldlWithKey' , HM.foldr , HM.foldl- , foldrWithKey- , foldlWithKey+ , HM.foldrWithKey+ , HM.foldlWithKey -- * Filter , HM.filter- , filterWithKey+ , HM.filterWithKey , mapMaybe , mapMaybeWithKey -- * Conversions- , keys- , elems+ , HM.keys+ , HM.elems -- ** Lists- , toList+ , HM.toList , fromList , fromListWith , fromListWithKey ) where -import Data.Bits ((.&.), (.|.))--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative (..), (<$>))-#endif-import qualified Data.List as L-import Data.Hashable (Hashable)-import Prelude hiding (map, lookup)+import Control.Applicative (Const (..))+import Control.Monad.ST (runST)+import Data.Bits ((.&.), (.|.))+import Data.Coerce (coerce)+import Data.Functor.Identity (Identity (..))+-- See Note [Imports from Data.Strict.HashMap.Autogen.Internal]+import Data.Hashable (Hashable)+import Data.Strict.HashMap.Autogen.Internal (Hash, HashMap (..), Leaf (..), LookupRes (..),+ bitsPerSubkey, fullNodeMask, hash, index, mask,+ ptrEq, sparseIndex)+import Prelude hiding (lookup, map) +-- See Note [Imports from Data.Strict.HashMap.Autogen.Internal]+import qualified Data.Strict.HashMap.Autogen.Internal as HM import qualified Data.Strict.HashMap.Autogen.Internal.Array as A-import qualified Data.Strict.HashMap.Autogen.Internal as HM-import Data.Strict.HashMap.Autogen.Internal hiding (- alter, alterF, adjust, fromList, fromListWith, fromListWithKey,- insert, insertWith,- differenceWith, intersectionWith, intersectionWithKey, map, mapWithKey,- mapMaybe, mapMaybeWithKey, singleton, update, unionWith, unionWithKey,- traverseWithKey)-import Data.Strict.HashMap.Autogen.Internal.Unsafe (runST)-#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity-#endif-import Control.Applicative (Const (..))-import Data.Coerce+import qualified Data.List as List+import qualified GHC.Exts as Exts +{-+Note [Imports from Data.Strict.HashMap.Autogen.Internal]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++It is very important for code in this module not to make mistakes about+the strictness properties of any utilities. Mistakes can easily lead to space+leaks, see e.g. #383.++Therefore nearly all functions imported from Data.Strict.HashMap.Autogen.Internal should be+imported qualified. Only functions that do not manipulate HashMaps or their+values are exempted.+-}+ -- $strictness -- -- This module satisfies the following strictness properties:@@ -153,21 +165,21 @@ ------------------------------------------------------------------------ -- * Construction --- | /O(1)/ Construct a map with a single element.+-- | \(O(1)\) Construct a map with a single element. singleton :: (Hashable k) => k -> v -> HashMap k v singleton k !v = HM.singleton k v ------------------------------------------------------------------------ -- * Basic interface --- | /O(log n)/ Associate the specified value with the specified+-- | \(O(\log n)\) Associate the specified value with the specified -- key in this map. If this map previously contained a mapping for -- the key, the old value is replaced. insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v insert k !v = HM.insert k v {-# INLINABLE insert #-} --- | /O(log n)/ Associate the value with the key in this map. If+-- | \(O(\log n)\) Associate the value with the key in this map. If -- this map previously contained a mapping for the key, the old value -- is replaced by the result of applying the given function to the new -- and old value. Example:@@ -183,12 +195,12 @@ go h k x s t@(Leaf hy l@(L ky y)) | hy == h = if ky == k then leaf h k (f x y)- else x `seq` (collision h l (L k x))- | otherwise = x `seq` runST (two s h k x hy t)+ else x `seq` HM.collision h l (L k x)+ | otherwise = x `seq` runST (HM.two s h k x hy t) go h k x s (BitmapIndexed b ary) | b .&. m == 0 = let ary' = A.insert ary i $! leaf h k x- in bitmapIndexedOrFull (b .|. m) ary'+ in HM.bitmapIndexedOrFull (b .|. m) ary' | otherwise = let st = A.index ary i st' = go h k x (s+bitsPerSubkey) st@@ -199,7 +211,7 @@ go h k x s (Full ary) = let st = A.index ary i st' = go h k x (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = HM.update32 ary i $! st' in Full ary' where i = index h s go h k x s t@(Collision hy v)@@ -223,13 +235,13 @@ | hy == h = if ky == k then return $! leaf h k (f k x y) else do- let l' = x `seq` (L k x)- return $! collision h l l'- | otherwise = x `seq` two s h k x hy t+ let l' = x `seq` L k x+ return $! HM.collision h l l'+ | otherwise = x `seq` HM.two s h k x hy t go h k x s t@(BitmapIndexed b ary) | b .&. m == 0 = do ary' <- A.insertM ary i $! leaf h k x- return $! bitmapIndexedOrFull (b .|. m) ary'+ return $! HM.bitmapIndexedOrFull (b .|. m) ary' | otherwise = do st <- A.indexM ary i st' <- go h k x (s+bitsPerSubkey) st@@ -248,7 +260,7 @@ | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t) {-# INLINABLE unsafeInsertWithKey #-} --- | /O(log n)/ Adjust the value tied to a given key in this map only+-- | \(O(\log n)\) Adjust the value tied to a given key in this map only -- if it is present. Otherwise, leave the map alone. adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v adjust f k0 m0 = go h0 k0 0 m0@@ -270,21 +282,21 @@ let i = index h s st = A.index ary i st' = go h k (s+bitsPerSubkey) st- ary' = update16 ary i $! st'+ ary' = HM.update32 ary i $! st' in Full ary' go h k _ t@(Collision hy v) | h == hy = Collision h (updateWith f k v) | otherwise = t {-# INLINABLE adjust #-} --- | /O(log n)/ The expression @('update' f k map)@ updates the value @x@ at @k@+-- | \(O(\log n)\) The expression @('update' f k map)@ updates the value @x@ at @k@ -- (if it is in the map). If @(f x)@ is 'Nothing', the element is deleted. -- If it is @('Just' y)@, the key @k@ is bound to the new value @y@. update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a update f = alter (>>= f) {-# INLINABLE update #-} --- | /O(log n)/ The expression @('alter' f k map)@ alters the value @x@ at @k@, or+-- | \(O(\log n)\) The expression @('alter' f k map)@ alters the value @x@ at @k@, or -- absence thereof. -- -- 'alter' can be used to insert, delete, or update a value in a map. In short:@@ -295,11 +307,11 @@ alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v alter f k m = case f (HM.lookup k m) of- Nothing -> delete k m+ Nothing -> HM.delete k m Just v -> insert k v m {-# INLINABLE alter #-} --- | /O(log n)/ The expression (@'alterF' f k map@) alters the value @x@ at+-- | \(O(\log n)\) The expression (@'alterF' f k map@) alters the value @x@ at -- @k@, or absence thereof. -- -- 'alterF' can be used to insert, delete, or update a value in a map.@@ -317,18 +329,16 @@ -- @f@ and a functor that is similar to Const but not actually Const. alterF f = \ !k !m -> let !h = hash k- mv = lookup' h k m- in (<$> f mv) $ \fres ->- case fres of- Nothing -> maybe m (const (delete' h k m)) mv- Just !v' -> insert' h k v' m+ mv = HM.lookup' h k m+ in (<$> f mv) $ \case+ Nothing -> maybe m (const (HM.delete' h k m)) mv+ Just !v' -> HM.insert' h k v' m -- We rewrite this function unconditionally in RULES, but we expose -- an unfolding just in case it's used in a context where the rules -- don't fire. {-# INLINABLE [0] alterF #-} -#if MIN_VERSION_base(4,8,0) -- See notes in Data.Strict.HashMap.Autogen.Internal test_bottom :: a test_bottom = error "Data.Strict.HashMap.Autogen.alterF internal error: hit test_bottom"@@ -348,13 +358,13 @@ "alterFconstant" forall (f :: Maybe a -> Identity (Maybe a)) x. alterFWeird x x f = \ !k !m ->- Identity (case runIdentity x of {Nothing -> delete k m; Just a -> insert k a m})+ Identity (case runIdentity x of {Nothing -> HM.delete k m; Just a -> insert k a m}) "alterFinsertWith" [1] forall (f :: Maybe a -> Identity (Maybe a)) x y. alterFWeird (coerce (Just x)) (coerce (Just y)) f =- coerce (insertModifying x (\mold -> case runIdentity (f (Just mold)) of- Nothing -> bogus# (# #)- Just !new -> (# new #)))+ coerce (HM.insertModifying x (\mold -> case runIdentity (f (Just mold)) of+ Nothing -> bogus# (# #)+ Just !new -> (# new #))) -- This rule is written a bit differently than the one for lazy -- maps because the adjust here is strict. We could write it the@@ -366,7 +376,7 @@ Nothing -> impossibleAdjust)) "alterFlookup" forall _ign1 _ign2 (f :: Maybe a -> Const r (Maybe a)) .- alterFWeird _ign1 _ign2 f = \ !k !m -> Const (getConst (f (lookup k m)))+ alterFWeird _ign1 _ign2 f = \ !k !m -> Const (getConst (f (HM.lookup k m))) #-} -- This is a very unsafe version of alterF used for RULES. When calling@@ -400,42 +410,41 @@ Absent -> m -- Key did exist, no collision- Present _ collPos -> deleteKeyExists collPos h k m+ Present _ collPos -> HM.deleteKeyExists collPos h k m ------------------------------ -- Update value- Just v' -> case lookupRes of+ Just !v' -> case lookupRes of -- Key did not exist before, insert v' under a new key- Absent -> insertNewKey h k v' m+ Absent -> HM.insertNewKey h k v' m -- Key existed before, no hash collision- Present v collPos -> v' `seq`+ Present v collPos -> if v `ptrEq` v' -- If the value is identical, no-op then m -- If the value changed, update the value.- else insertKeyExists collPos h k v' m+ else HM.insertKeyExists collPos h k v' m where !h = hash k- !lookupRes = lookupRecordCollision h k m+ !lookupRes = HM.lookupRecordCollision h k m !mv = case lookupRes of Absent -> Nothing Present v _ -> Just v {-# INLINABLE alterFEager #-}-#endif ------------------------------------------------------------------------ -- * Combine --- | /O(n+m)/ The union of two maps. If a key occurs in both maps,+-- | \(O(n+m)\) The union of two maps. If a key occurs in both maps, -- the provided function (first argument) will be used to compute the result. unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v unionWith f = unionWithKey (const f) {-# INLINE unionWith #-} --- | /O(n+m)/ The union of two maps. If a key occurs in both maps,+-- | \(O(n+m)\) The union of two maps. If a key occurs in both maps, -- the provided function (first argument) will be used to compute the result. unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v@@ -448,7 +457,7 @@ go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2)) | h1 == h2 = if k1 == k2 then leaf h1 k1 (f k1 v1 v2)- else collision h1 l1 l2+ else HM.collision h1 l1 l2 | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2) | h1 == h2 = Collision h1 (updateOrSnocWithKey f k1 v1 ls2)@@ -457,28 +466,28 @@ | h1 == h2 = Collision h1 (updateOrSnocWithKey (flip . f) k2 v2 ls1) | otherwise = goDifferentHash s h1 h2 t1 t2 go s t1@(Collision h1 ls1) t2@(Collision h2 ls2)- | h1 == h2 = Collision h1 (updateOrConcatWithKey f ls1 ls2)+ | h1 == h2 = Collision h1 (HM.updateOrConcatWithKey (\k a b -> let !v = f k a b in (# v #)) ls1 ls2) | otherwise = goDifferentHash s h1 h2 t1 t2 -- branch vs. branch go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) = let b' = b1 .|. b2- ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2- in bitmapIndexedOrFull b' ary'+ ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2+ in HM.bitmapIndexedOrFull b' ary' go s (BitmapIndexed b1 ary1) (Full ary2) =- let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2+ let ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2 in Full ary' go s (Full ary1) (BitmapIndexed b2 ary2) =- let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2+ let ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2 in Full ary' go s (Full ary1) (Full ary2) =- let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask+ let ary' = HM.unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask ary1 ary2 in Full ary' -- leaf vs. branch go s (BitmapIndexed b1 ary1) t2 | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2 b' = b1 .|. m2- in bitmapIndexedOrFull b' ary'+ in HM.bitmapIndexedOrFull b' ary' | otherwise = let ary' = A.updateWith' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2 in BitmapIndexed b1 ary'@@ -489,7 +498,7 @@ go s t1 (BitmapIndexed b2 ary2) | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1 b' = b2 .|. m1- in bitmapIndexedOrFull b' ary'+ in HM.bitmapIndexedOrFull b' ary' | otherwise = let ary' = A.updateWith' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2 in BitmapIndexed b2 ary'@@ -500,12 +509,12 @@ go s (Full ary1) t2 = let h2 = leafHashCode t2 i = index h2 s- ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2+ ary' = HM.update32With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2 in Full ary' go s t1 (Full ary2) = let h1 = leafHashCode t1 i = index h1 s- ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2+ ary' = HM.update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2 in Full ary' leafHashCode (Leaf h _) = h@@ -513,7 +522,7 @@ leafHashCode _ = error "leafHashCode" goDifferentHash s h1 h2 t1 t2- | m1 == m2 = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)+ | m1 == m2 = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2) | m1 < m2 = BitmapIndexed (m1 .|. m2) (A.pair t1 t2) | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1) where@@ -524,7 +533,7 @@ ------------------------------------------------------------------------ -- * Transformations --- | /O(n)/ Transform this map by applying a function to every value.+-- | \(O(n)\) Transform this map by applying a function to every value. mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2 mapWithKey f = go where@@ -536,7 +545,7 @@ Collision h $ A.map' (\ (L k v) -> let !v' = f k v in L k v') ary {-# INLINE mapWithKey #-} --- | /O(n)/ Transform this map by applying a function to every value.+-- | \(O(n)\) Transform this map by applying a function to every value. map :: (v1 -> v2) -> HashMap k v1 -> HashMap k v2 map f = mapWithKey (const f) {-# INLINE map #-}@@ -545,24 +554,24 @@ ------------------------------------------------------------------------ -- * Filter --- | /O(n)/ Transform this map by applying a function to every value+-- | \(O(n)\) Transform this map by applying a function to every value -- and retaining only some of them. mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2-mapMaybeWithKey f = filterMapAux onLeaf onColl+mapMaybeWithKey f = HM.filterMapAux onLeaf onColl where onLeaf (Leaf h (L k v)) | Just v' <- f k v = Just (leaf h k v') onLeaf _ = Nothing - onColl (L k v) | Just v' <- f k v = Just (L k v')+ onColl (L k v) | Just !v' <- f k v = Just (L k v') | otherwise = Nothing {-# INLINE mapMaybeWithKey #-} --- | /O(n)/ Transform this map by applying a function to every value+-- | \(O(n)\) Transform this map by applying a function to every value -- and retaining only some of them. mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2 mapMaybe f = mapMaybeWithKey (const f) {-# INLINE mapMaybe #-} --- | /O(n)/ Perform an 'Applicative' action for each key-value pair+-- | \(O(n)\) Perform an 'Applicative' action for each key-value pair -- in a 'HashMap' and produce a 'HashMap' of all the results. Each 'HashMap' -- will be strict in all its values. --@@ -591,53 +600,45 @@ ------------------------------------------------------------------------ -- * Difference and intersection --- | /O(n*log m)/ Difference with a combining function. When two equal keys are+-- | \(O(n \log m)\) Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the values of these keys. -- If it returns 'Nothing', the element is discarded (proper set difference). If -- it returns (@'Just' y@), the element is updated with a new value @y@. differenceWith :: (Eq k, Hashable k) => (v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v-differenceWith f a b = foldlWithKey' go empty a+differenceWith f a b = HM.foldlWithKey' go HM.empty a where go m k v = case HM.lookup k b of- Nothing -> insert k v m- Just w -> maybe m (\y -> insert k y m) (f v w)+ Nothing -> v `seq` HM.unsafeInsert k v m+ Just w -> maybe m (\ !y -> HM.unsafeInsert k y m) (f v w) {-# INLINABLE differenceWith #-} --- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps+-- | \(O(n+m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps. intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3-intersectionWith f a b = foldlWithKey' go empty a- where- go m k v = case HM.lookup k b of- Just w -> insert k (f v w) m- _ -> m+intersectionWith f = Exts.inline intersectionWithKey $ const f {-# INLINABLE intersectionWith #-} --- | /O(n+m)/ Intersection of two maps. If a key occurs in both maps+-- | \(O(n+m)\) Intersection of two maps. If a key occurs in both maps -- the provided function is used to combine the values from the two -- maps. intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3-intersectionWithKey f a b = foldlWithKey' go empty a- where- go m k v = case HM.lookup k b of- Just w -> insert k (f k v w) m- _ -> m+intersectionWithKey f = HM.intersectionWithKey# $ \k v1 v2 -> let !v3 = f k v1 v2 in (# v3 #) {-# INLINABLE intersectionWithKey #-} ------------------------------------------------------------------------ -- ** Lists --- | /O(n*log n)/ Construct a map with the supplied mappings. If the+-- | \(O(n \log n)\) Construct a map with the supplied mappings. If the -- list contains duplicate mappings, the later mappings take -- precedence. fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v-fromList = L.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty+fromList = List.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) HM.empty {-# INLINABLE fromList #-} --- | /O(n*log n)/ Construct a map from a list of elements. Uses+-- | \(O(n \log n)\) Construct a map from a list of elements. Uses -- the provided function @f@ to merge duplicate entries with -- @(f newVal oldVal)@. --@@ -668,10 +669,10 @@ -- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] -- > = fromList [(k, f d (f c (f b a)))] fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty+fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) HM.empty {-# INLINE fromListWith #-} --- | /O(n*log n)/ Construct a map from a list of elements. Uses+-- | \(O(n \log n)\) Construct a map from a list of elements. Uses -- the provided function to merge duplicate entries. -- -- === Examples@@ -698,7 +699,7 @@ -- -- @since 0.2.11 fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty+fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) HM.empty {-# INLINE fromListWithKey #-} ------------------------------------------------------------------------@@ -734,13 +735,8 @@ updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0) where go !k v !ary !i !n- | i >= n = A.run $ do- -- Not found, append to the end.- mary <- A.new_ (n + 1)- A.copy ary 0 mary 0 n- let !l = v `seq` (L k v)- A.write mary n l- return mary+ -- Not found, append to the end.+ | i >= n = A.snoc ary $! L k $! v | otherwise = case A.index ary i of (L kx y) | k == kx -> let !v' = f k v y in A.update ary i (L k v') | otherwise -> go k v ary (i+1) n
− src/Data/Strict/HashMap/Autogen/Internal/Unsafe.hs
@@ -1,55 +0,0 @@-{-# LANGUAGE CPP #-}--#if !MIN_VERSION_base(4,9,0)-{-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples #-}-#endif--{-# OPTIONS_HADDOCK not-home #-}---- | = WARNING------ This module is considered __internal__.------ The Package Versioning Policy __does not apply__.------ 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--- closely.------ = Description------ This module exports a workaround for this bug:------ http://hackage.haskell.org/trac/ghc/ticket/5916------ Please read the comments in ghc/libraries/base/GHC/ST.lhs to--- understand what's going on here.------ Code that uses this module should be compiled with -fno-full-laziness-module Data.Strict.HashMap.Autogen.Internal.Unsafe- ( runST- ) where--#if MIN_VERSION_base(4,9,0)--- The GHC issue was fixed in GHC 8.0/base 4.9-import Control.Monad.ST--#else--import GHC.Base (realWorld#)-import qualified GHC.ST as ST---- | Return the value computed by a state transformer computation.--- The @forall@ ensures that the internal state used by the 'ST'--- computation is inaccessible to the rest of the program.-runST :: (forall s. ST.ST s a) -> a-runST st = runSTRep (case st of { ST.ST st_rep -> st_rep })-{-# INLINE runST #-}--runSTRep :: (forall s. ST.STRep s a) -> a-runSTRep st_rep = case st_rep realWorld# of- (# _, r #) -> r-{-# INLINE [0] runSTRep #-}-#endif
src/Data/Strict/HashMap/Autogen/Strict.hs view
@@ -18,7 +18,7 @@ -- especially when key comparison is expensive, as in the case of -- strings. ----- Many operations have a average-case complexity of /O(log n)/. The+-- Many operations have a average-case complexity of \(O(\log n)\). The -- implementation uses a large base (i.e. 16) so in practice these -- operations are constant time. module Data.Strict.HashMap.Autogen.Strict@@ -65,6 +65,7 @@ , map , mapWithKey , traverseWithKey+ , mapKeys -- * Difference and intersection , difference@@ -101,8 +102,10 @@ , fromListWithKey ) where -import Data.Strict.HashMap.Autogen.Internal.Strict as HM-import Prelude ()+import Data.Strict.HashMap.Autogen.Internal.Strict+import Prelude ()++import qualified Data.HashSet.Internal as HS -- $strictness --
src/Data/Strict/IntMap/Autogen/Internal.hs view
@@ -1,18 +1,19 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-}-#if __GLASGOW_HASKELL__-{-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-} #endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif-#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE TypeFamilies #-}-#endif {-# OPTIONS_HADDOCK not-home #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} #include "containers.h" @@ -292,34 +293,19 @@ , mapGentlyWhenMatched ) where -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity (..)) import Control.Applicative (liftA2)-#else-import Control.Applicative (Applicative(pure, (<*>)), (<$>), liftA2)-import Data.Monoid (Monoid(..))-import Data.Traversable (Traversable(traverse))-import Data.Word (Word)-#endif-#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(stimes))-#endif-#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)+#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>))) #endif-#if MIN_VERSION_base(4,9,0) import Data.Semigroup (stimesIdempotentMonoid) import Data.Functor.Classes-#endif import Control.DeepSeq (NFData(rnf)) import Data.Bits import qualified Data.Foldable as Foldable-#if !MIN_VERSION_base(4,8,0)-import Data.Foldable (Foldable())-#endif import Data.Maybe (fromMaybe)-import Data.Typeable import Prelude hiding (lookup, map, filter, foldr, foldl, null) import Data.IntSet.Internal (Key)@@ -327,22 +313,16 @@ import Data.Strict.ContainersUtils.Autogen.BitUtil import Data.Strict.ContainersUtils.Autogen.StrictPair -#if __GLASGOW_HASKELL__+#ifdef __GLASGOW_HASKELL__+import Data.Coerce import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),- DataType, mkDataType)+ DataType, mkDataType, gcast1) import GHC.Exts (build)-#if !MIN_VERSION_base(4,8,0)-import Data.Functor ((<$))-#endif-#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts-#endif import Text.Read+import Language.Haskell.TH.Syntax (Lift) #endif import qualified Control.Category as Category-#if __GLASGOW_HASKELL__ >= 709-import Data.Coerce-#endif -- A "Nat" is a natural machine word (an unsigned Int)@@ -391,6 +371,9 @@ type IntSetPrefix = Int type IntSetBitMap = Word +-- | @since FIXME+deriving instance Lift a => Lift (IntMap a)+ bitmapOf :: Int -> IntSetBitMap bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask) {-# INLINE bitmapOf #-}@@ -399,7 +382,7 @@ Operators --------------------------------------------------------------------} --- | /O(min(n,W))/. Find the value at a key.+-- | \(O(\min(n,W))\). Find the value at a key. -- Calls 'error' when the element can not be found. -- -- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map@@ -408,7 +391,7 @@ (!) :: IntMap a -> Key -> a (!) m k = find k m --- | /O(min(n,W))/. Find the value at a key.+-- | \(O(\min(n,W))\). Find the value at a key. -- Returns 'Nothing' when the element can not be found. -- -- > fromList [(5,'a'), (3,'b')] !? 1 == Nothing@@ -432,16 +415,12 @@ instance Monoid (IntMap a) where mempty = empty mconcat = unions-#if !(MIN_VERSION_base(4,9,0))- mappend = union-#else mappend = (<>) -- | @since 0.5.7 instance Semigroup (IntMap a) where (<>) = union stimes = stimesIdempotentMonoid-#endif -- | Folds in order of increasing key. instance Foldable.Foldable IntMap where@@ -467,7 +446,6 @@ {-# INLINE foldl' #-} foldr' = foldr' {-# INLINE foldr' #-}-#if MIN_VERSION_base(4,8,0) length = size {-# INLINE length #-} null = null@@ -505,7 +483,6 @@ {-# INLINABLE sum #-} product = foldl' (*) 1 {-# INLINABLE product #-}-#endif -- | Traverses in order of increasing key. instance Traversable IntMap where@@ -546,7 +523,7 @@ {-------------------------------------------------------------------- Query --------------------------------------------------------------------}--- | /O(1)/. Is the map empty?+-- | \(O(1)\). Is the map empty? -- -- > Data.Strict.IntMap.Autogen.null (empty) == True -- > Data.Strict.IntMap.Autogen.null (singleton 1 'a') == False@@ -556,7 +533,7 @@ null _ = False {-# INLINE null #-} --- | /O(n)/. Number of elements in the map.+-- | \(O(n)\). Number of elements in the map. -- -- > size empty == 0 -- > size (singleton 1 'a') == 1@@ -568,7 +545,7 @@ go acc (Tip _ _) = 1 + acc go acc Nil = acc --- | /O(min(n,W))/. Is the key a member of the map?+-- | \(O(\min(n,W))\). Is the key a member of the map? -- -- > member 5 (fromList [(5,'a'), (3,'b')]) == True -- > member 1 (fromList [(5,'a'), (3,'b')]) == False@@ -583,7 +560,7 @@ go (Tip kx _) = k == kx go Nil = False --- | /O(min(n,W))/. Is the key not a member of the map?+-- | \(O(\min(n,W))\). Is the key not a member of the map? -- -- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False -- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True@@ -591,34 +568,31 @@ notMember :: Key -> IntMap a -> Bool notMember k m = not $ member k m --- | /O(min(n,W))/. Lookup the value at a key in the map. See also 'Data.Map.lookup'.+-- | \(O(\min(n,W))\). Lookup the value at a key in the map. See also 'Data.Map.lookup'. --- See Note: Local 'go' functions and capturing]+-- See Note: Local 'go' functions and capturing lookup :: Key -> IntMap a -> Maybe a lookup !k = go where- go (Bin p m l r) | nomatch k p m = Nothing- | zero k m = go l- | otherwise = go r+ go (Bin _p m l r) | zero k m = go l+ | otherwise = go r go (Tip kx x) | k == kx = Just x | otherwise = Nothing go Nil = Nothing - -- See Note: Local 'go' functions and capturing] find :: Key -> IntMap a -> a find !k = go where- go (Bin p m l r) | nomatch k p m = not_found- | zero k m = go l- | otherwise = go r+ go (Bin _p m l r) | zero k m = go l+ | otherwise = go r go (Tip kx x) | k == kx = x | otherwise = not_found go Nil = not_found not_found = error ("IntMap.!: key " ++ show k ++ " is not an element of the map") --- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@+-- | \(O(\min(n,W))\). The expression @('findWithDefault' def k map)@ -- returns the value at key @k@ or returns @def@ when the key is not an -- element of the map. --@@ -636,7 +610,7 @@ | otherwise = def go Nil = def --- | /O(log n)/. Find largest key smaller than the given one and return the+-- | \(O(\log n)\). Find largest key smaller than the given one and return the -- corresponding (key, value) pair. -- -- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -657,7 +631,7 @@ | otherwise = Just (ky, y) go def Nil = unsafeFindMax def --- | /O(log n)/. Find smallest key greater than the given one and return the+-- | \(O(\log n)\). Find smallest key greater than the given one and return the -- corresponding (key, value) pair. -- -- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')@@ -678,7 +652,7 @@ | otherwise = Just (ky, y) go def Nil = unsafeFindMin def --- | /O(log n)/. Find largest key smaller or equal to the given one and return+-- | \(O(\log n)\). Find largest key smaller or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -700,7 +674,7 @@ | otherwise = Just (ky, y) go def Nil = unsafeFindMax def --- | /O(log n)/. Find smallest key greater or equal to the given one and return+-- | \(O(\log n)\). Find smallest key greater or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')@@ -740,7 +714,7 @@ {-------------------------------------------------------------------- Disjoint --------------------------------------------------------------------}--- | /O(n+m)/. Check whether the key sets of two maps are disjoint+-- | \(O(n+m)\). Check whether the key sets of two maps are disjoint -- (i.e. their 'intersection' is empty). -- -- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())]) == True@@ -796,7 +770,7 @@ {-------------------------------------------------------------------- Construction --------------------------------------------------------------------}--- | /O(1)/. The empty map.+-- | \(O(1)\). The empty map. -- -- > empty == fromList [] -- > size empty == 0@@ -806,7 +780,7 @@ = Nil {-# INLINE empty #-} --- | /O(1)/. A map of one element.+-- | \(O(1)\). A map of one element. -- -- > singleton 1 'a' == fromList [(1, 'a')] -- > size (singleton 1 'a') == 1@@ -819,7 +793,7 @@ {-------------------------------------------------------------------- Insert --------------------------------------------------------------------}--- | /O(min(n,W))/. Insert a new key\/value pair in the map.+-- | \(O(\min(n,W))\). Insert a new key\/value pair in the map. -- If the key is already present in the map, the associated value is -- replaced with the supplied value, i.e. 'insert' is equivalent to -- @'insertWith' 'const'@.@@ -839,7 +813,7 @@ insert k x Nil = Tip k x -- right-biased insertion, used by 'union'--- | /O(min(n,W))/. Insert with a combining function.+-- | \(O(\min(n,W))\). Insert with a combining function. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -853,7 +827,7 @@ insertWith f k x t = insertWithKey (\_ x' y' -> f x' y') k x t --- | /O(min(n,W))/. Insert with a combining function.+-- | \(O(\min(n,W))\). Insert with a combining function. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -874,7 +848,7 @@ | otherwise = link k (Tip k x) ky t insertWithKey _ k x Nil = Tip k x --- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)+-- | \(O(\min(n,W))\). The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) -- and the second element equal to (@'insertWithKey' f k x map@). --@@ -905,7 +879,7 @@ {-------------------------------------------------------------------- Deletion --------------------------------------------------------------------}--- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not+-- | \(O(\min(n,W))\). Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. -- -- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -922,7 +896,7 @@ | otherwise = t delete _k Nil = Nil --- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not+-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. -- -- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]@@ -933,7 +907,7 @@ adjust f k m = adjustWithKey (\_ x -> f x) k m --- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not+-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. -- -- > let f key x = (show key) ++ ":new " ++ x@@ -942,8 +916,7 @@ -- > adjustWithKey f 7 empty == empty adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a-adjustWithKey f !k t@(Bin p m l r)- | nomatch k p m = t+adjustWithKey f !k (Bin p m l r) | zero k m = Bin p m (adjustWithKey f k l) r | otherwise = Bin p m l (adjustWithKey f k r) adjustWithKey f k t@(Tip ky y)@@ -952,7 +925,7 @@ adjustWithKey _ _ Nil = Nil --- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@+-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --@@ -965,7 +938,7 @@ update f = updateWithKey (\_ x -> f x) --- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@+-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --@@ -975,8 +948,7 @@ -- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a" updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a-updateWithKey f !k t@(Bin p m l r)- | nomatch k p m = t+updateWithKey f !k (Bin p m l r) | zero k m = binCheckLeft p m (updateWithKey f k l) r | otherwise = binCheckRight p m l (updateWithKey f k r) updateWithKey f k t@(Tip ky y)@@ -986,7 +958,7 @@ | otherwise = t updateWithKey _ _ Nil = Nil --- | /O(min(n,W))/. Lookup and update.+-- | \(O(\min(n,W))\). Lookup and update. -- The function returns original value, if it is updated. -- This is different behavior than 'Data.Map.updateLookupWithKey'. -- Returns the original key value if the map entry is deleted.@@ -997,8 +969,7 @@ -- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a") updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)-updateLookupWithKey f !k t@(Bin p m l r)- | nomatch k p m = (Nothing,t)+updateLookupWithKey f !k (Bin p m l r) | zero k m = let !(found,l') = updateLookupWithKey f k l in (found,binCheckLeft p m l' r) | otherwise = let !(found,r') = updateLookupWithKey f k r@@ -1012,7 +983,7 @@ --- | /O(min(n,W))/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.+-- | \(O(\min(n,W))\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in an 'IntMap'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a@@ -1033,7 +1004,7 @@ Just x -> Tip k x Nothing -> Nil --- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ at+-- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at -- @k@, or absence thereof. 'alterF' can be used to inspect, insert, delete, -- or update a value in an 'IntMap'. In short : @'lookup' k <$> 'alterF' f k m = f -- ('lookup' k m)@.@@ -1093,7 +1064,7 @@ unionsWith f ts = Foldable.foldl' (unionWith f) empty ts --- | /O(n+m)/. The (left-biased) union of two maps.+-- | \(O(n+m)\). The (left-biased) union of two maps. -- It prefers the first map when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@). --@@ -1103,7 +1074,7 @@ union m1 m2 = mergeWithKey' Bin const id id m1 m2 --- | /O(n+m)/. The union with a combining function.+-- | \(O(n+m)\). The union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")] @@ -1111,7 +1082,7 @@ unionWith f m1 m2 = unionWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. The union with a combining function.+-- | \(O(n+m)\). The union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]@@ -1123,7 +1094,7 @@ {-------------------------------------------------------------------- Difference --------------------------------------------------------------------}--- | /O(n+m)/. Difference between two maps (based on keys).+-- | \(O(n+m)\). Difference between two maps (based on keys). -- -- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b" @@ -1131,7 +1102,7 @@ difference m1 m2 = mergeWithKey (\_ _ _ -> Nothing) id (const Nil) m1 m2 --- | /O(n+m)/. Difference with a combining function.+-- | \(O(n+m)\). Difference with a combining function. -- -- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing -- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])@@ -1141,7 +1112,7 @@ differenceWith f m1 m2 = differenceWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. Difference with a combining function. When two equal keys are+-- | \(O(n+m)\). Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). -- If it returns (@'Just' y@), the element is updated with a new value @y@.@@ -1156,7 +1127,7 @@ -- TODO(wrengr): re-verify that asymptotic bound--- | /O(n+m)/. Remove all the keys in a given set from a map.+-- | \(O(n+m)\). Remove all the keys in a given set from a map. -- -- @ -- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.notMember`` s) m@@ -1224,7 +1195,7 @@ {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------}--- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).+-- | \(O(n+m)\). The (left-biased) intersection of two maps (based on keys). -- -- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a" @@ -1234,7 +1205,7 @@ -- TODO(wrengr): re-verify that asymptotic bound--- | /O(n+m)/. The restriction of a map to the keys in a set.+-- | \(O(n+m)\). The restriction of a map to the keys in a set. -- -- @ -- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.member`` s) m@@ -1271,7 +1242,7 @@ restrictKeys Nil _ = Nil --- | /O(min(n,W))/. Restrict to the sub-map with all keys matching+-- | \(O(\min(n,W))\). Restrict to the sub-map with all keys matching -- a key prefix. lookupPrefix :: IntSetPrefix -> IntMap a -> IntMap a lookupPrefix !kp t@(Bin p m l r)@@ -1300,7 +1271,7 @@ restrictBM _ Nil = Nil --- | /O(n+m)/. The intersection with a combining function.+-- | \(O(n+m)\). The intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -1308,7 +1279,7 @@ intersectionWith f m1 m2 = intersectionWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. The intersection with a combining function.+-- | \(O(n+m)\). The intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -1321,7 +1292,7 @@ MergeWithKey --------------------------------------------------------------------} --- | /O(n+m)/. A high-performance universal combining function. Using+-- | \(O(n+m)\). A high-performance universal combining function. Using -- 'mergeWithKey', all combining functions can be defined without any loss of -- efficiency (with exception of 'union', 'difference' and 'intersection', -- where sharing of some nodes is lost with 'mergeWithKey').@@ -1482,9 +1453,6 @@ -- -- @since 0.5.9 instance (Applicative f, Monad f) => Monad (WhenMissing f x) where-#if !MIN_VERSION_base(4,8,0)- return = pure-#endif m >>= f = traverseMaybeMissing $ \k x -> do res1 <- missingKey m k x@@ -1567,17 +1535,6 @@ {-# INLINE contramapSecondWhenMatched #-} -#if !MIN_VERSION_base(4,8,0)-newtype Identity a = Identity {runIdentity :: a}--instance Functor Identity where- fmap f (Identity x) = Identity (f x)--instance Applicative Identity where- pure = Identity- Identity f <*> Identity x = Identity (f x)-#endif- -- | A tactic for dealing with keys present in one map but not the -- other in 'merge'. --@@ -1656,9 +1613,6 @@ -- -- @since 0.5.9 instance (Monad f, Applicative f) => Monad (WhenMatched f x y) where-#if !MIN_VERSION_base(4,8,0)- return = pure-#endif m >>= f = zipWithMaybeAMatched $ \k x y -> do res <- runWhenMatched m k x y@@ -1853,7 +1807,7 @@ {-# INLINE filterAMissing #-} --- | /O(n)/. Filter keys and values using an 'Applicative' predicate.+-- | \(O(n)\). Filter keys and values using an 'Applicative' predicate. filterWithKeyA :: Applicative f => (Key -> a -> f Bool) -> IntMap a -> f (IntMap a) filterWithKeyA _ Nil = pure Nil@@ -1894,7 +1848,7 @@ {-# INLINE traverseMaybeMissing #-} --- | /O(n)/. Traverse keys\/values and collect the 'Just' results.+-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results. -- -- @since 0.6.4 traverseMaybeWithKey@@ -2157,7 +2111,7 @@ Min\/Max --------------------------------------------------------------------} --- | /O(min(n,W))/. Update the value at the minimal key.+-- | \(O(\min(n,W))\). Update the value at the minimal key. -- -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")] -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -2173,7 +2127,7 @@ Nothing -> Nil go _ Nil = error "updateMinWithKey Nil" --- | /O(min(n,W))/. Update the value at the maximal key.+-- | \(O(\min(n,W))\). Update the value at the maximal key. -- -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")] -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -2192,7 +2146,7 @@ data View a = View {-# UNPACK #-} !Key a !(IntMap a) --- | /O(min(n,W))/. Retrieves the maximal (key,value) pair of the map, and+-- | \(O(\min(n,W))\). Retrieves the maximal (key,value) pair of the map, and -- the map stripped of that element, or 'Nothing' if passed an empty map. -- -- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")@@ -2220,7 +2174,7 @@ -- See note on NOINLINE at minViewWithKeySure {-# NOINLINE maxViewWithKeySure #-} --- | /O(min(n,W))/. Retrieves the minimal (key,value) pair of the map, and+-- | \(O(\min(n,W))\). Retrieves the minimal (key,value) pair of the map, and -- the map stripped of that element, or 'Nothing' if passed an empty map. -- -- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")@@ -2256,7 +2210,7 @@ -- anyway, which should be good enough. {-# NOINLINE minViewWithKeySure #-} --- | /O(min(n,W))/. Update the value at the maximal key.+-- | \(O(\min(n,W))\). Update the value at the maximal key. -- -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")] -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -2264,7 +2218,7 @@ updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a updateMax f = updateMaxWithKey (const f) --- | /O(min(n,W))/. Update the value at the minimal key.+-- | \(O(\min(n,W))\). Update the value at the minimal key. -- -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")] -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -2272,29 +2226,29 @@ updateMin :: (a -> Maybe a) -> IntMap a -> IntMap a updateMin f = updateMinWithKey (const f) --- | /O(min(n,W))/. Retrieves the maximal key of the map, and the map+-- | \(O(\min(n,W))\). Retrieves the maximal key of the map, and the map -- stripped of that element, or 'Nothing' if passed an empty map. maxView :: IntMap a -> Maybe (a, IntMap a) maxView t = fmap (\((_, x), t') -> (x, t')) (maxViewWithKey t) --- | /O(min(n,W))/. Retrieves the minimal key of the map, and the map+-- | \(O(\min(n,W))\). Retrieves the minimal key of the map, and the map -- stripped of that element, or 'Nothing' if passed an empty map. minView :: IntMap a -> Maybe (a, IntMap a) minView t = fmap (\((_, x), t') -> (x, t')) (minViewWithKey t) --- | /O(min(n,W))/. Delete and find the maximal element.+-- | \(O(\min(n,W))\). Delete and find the maximal element. -- This function throws an error if the map is empty. Use 'maxViewWithKey' -- if the map may be empty. deleteFindMax :: IntMap a -> ((Key, a), IntMap a) deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey --- | /O(min(n,W))/. Delete and find the minimal element.+-- | \(O(\min(n,W))\). Delete and find the minimal element. -- This function throws an error if the map is empty. Use 'minViewWithKey' -- if the map may be empty. deleteFindMin :: IntMap a -> ((Key, a), IntMap a) deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey --- | /O(min(n,W))/. The minimal key of the map. Returns 'Nothing' if the map is empty.+-- | \(O(\min(n,W))\). The minimal key of the map. Returns 'Nothing' if the map is empty. lookupMin :: IntMap a -> Maybe (Key, a) lookupMin Nil = Nothing lookupMin (Tip k v) = Just (k,v)@@ -2305,14 +2259,14 @@ go (Bin _ _ l' _) = go l' go Nil = Nothing --- | /O(min(n,W))/. The minimal key of the map. Calls 'error' if the map is empty.+-- | \(O(\min(n,W))\). The minimal key of the map. Calls 'error' if the map is empty. -- Use 'minViewWithKey' if the map may be empty. findMin :: IntMap a -> (Key, a) findMin t | Just r <- lookupMin t = r | otherwise = error "findMin: empty map has no minimal element" --- | /O(min(n,W))/. The maximal key of the map. Returns 'Nothing' if the map is empty.+-- | \(O(\min(n,W))\). The maximal key of the map. Returns 'Nothing' if the map is empty. lookupMax :: IntMap a -> Maybe (Key, a) lookupMax Nil = Nothing lookupMax (Tip k v) = Just (k,v)@@ -2323,21 +2277,21 @@ go (Bin _ _ _ r') = go r' go Nil = Nothing --- | /O(min(n,W))/. The maximal key of the map. Calls 'error' if the map is empty.+-- | \(O(\min(n,W))\). The maximal key of the map. Calls 'error' if the map is empty. -- Use 'maxViewWithKey' if the map may be empty. findMax :: IntMap a -> (Key, a) findMax t | Just r <- lookupMax t = r | otherwise = error "findMax: empty map has no maximal element" --- | /O(min(n,W))/. Delete the minimal key. Returns an empty map if the map is empty.+-- | \(O(\min(n,W))\). Delete the minimal key. Returns an empty map if the map is empty. -- -- Note that this is a change of behaviour for consistency with 'Data.Map.Map' – -- versions prior to 0.5 threw an error if the 'IntMap' was already empty. deleteMin :: IntMap a -> IntMap a deleteMin = maybe Nil snd . minView --- | /O(min(n,W))/. Delete the maximal key. Returns an empty map if the map is empty.+-- | \(O(\min(n,W))\). Delete the maximal key. Returns an empty map if the map is empty. -- -- Note that this is a change of behaviour for consistency with 'Data.Map.Map' – -- versions prior to 0.5 threw an error if the 'IntMap' was already empty.@@ -2348,13 +2302,13 @@ {-------------------------------------------------------------------- Submap --------------------------------------------------------------------}--- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).+-- | \(O(n+m)\). Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool isProperSubmapOf m1 m2 = isProperSubmapOfBy (==) m1 m2 -{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).+{- | \(O(n+m)\). Is this a proper submap? (ie. a submap but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @keys m1@ and @keys m2@ are not equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when@@ -2403,13 +2357,13 @@ submapCmp _ Nil Nil = EQ submapCmp _ Nil _ = LT --- | /O(n+m)/. Is this a submap?+-- | \(O(n+m)\). Is this a submap? -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool isSubmapOf m1 m2 = isSubmapOfBy (==) m1 m2 -{- | /O(n+m)/.+{- | \(O(n+m)\). The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if all keys in @m1@ are in @m2@, and when @f@ returns 'True' when applied to their respective values. For example, the following@@ -2442,7 +2396,7 @@ {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------}--- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")] @@ -2457,16 +2411,11 @@ {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs- #-}-#endif-#if __GLASGOW_HASKELL__ >= 709--- Safe coercions were introduced in 7.8, but did not play well with RULES yet.-{-# RULES "map/coerce" map coerce = coerce #-} #endif --- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > let f key x = (show key) ++ ":" ++ x -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]@@ -2490,7 +2439,7 @@ #-} #endif --- | /O(n)/.+-- | \(O(n)\). -- @'traverseWithKey' f s == '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.@@ -2507,7 +2456,7 @@ | otherwise = liftA2 (Bin p m) (go l) (go r) {-# INLINE traverseWithKey #-} --- | /O(n)/. The function @'mapAccum'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccum'@ threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a b = (a ++ b, b ++ "X")@@ -2516,7 +2465,7 @@ mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccum f = mapAccumWithKey (\a' _ x -> f a' x) --- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccumWithKey'@ threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")@@ -2526,7 +2475,7 @@ mapAccumWithKey f a t = mapAccumL f a t --- | /O(n)/. The function @'mapAccumL'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccumL'@ threads an accumulating -- argument through the map in ascending order of keys. mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccumL f a t@@ -2543,7 +2492,7 @@ Tip k x -> let (a',x') = f a k x in (a',Tip k x') Nil -> (a,Nil) --- | /O(n)/. The function @'mapAccumRWithKey'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccumRWithKey'@ threads an accumulating -- argument through the map in descending order of keys. mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccumRWithKey f a t@@ -2560,7 +2509,7 @@ Tip k x -> let (a',x') = f a k x in (a',Tip k x') Nil -> (a,Nil) --- | /O(n*min(n,W))/.+-- | \(O(n \min(n,W))\). -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct@@ -2574,7 +2523,7 @@ mapKeys :: (Key->Key) -> IntMap a -> IntMap a mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) [] --- | /O(n*min(n,W))/.+-- | \(O(n \min(n,W))\). -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct@@ -2588,7 +2537,7 @@ mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) [] --- | /O(n*min(n,W))/.+-- | \(O(n \min(n,W))\). -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ -- is strictly monotonic. -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.@@ -2611,7 +2560,7 @@ {-------------------------------------------------------------------- Filter --------------------------------------------------------------------}--- | /O(n)/. Filter all values that satisfy some predicate.+-- | \(O(n)\). Filter all values that satisfy some predicate. -- -- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b" -- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty@@ -2621,7 +2570,7 @@ filter p m = filterWithKey (\_ x -> p x) m --- | /O(n)/. Filter all keys\/values that satisfy some predicate.+-- | \(O(n)\). Filter all keys\/values that satisfy some predicate. -- -- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a" @@ -2632,7 +2581,7 @@ go t@(Tip k x) = if predicate k x then t else Nil go (Bin p m l r) = bin p m (go l) (go r) --- | /O(n)/. Partition the map according to some predicate. The first+-- | \(O(n)\). Partition the map according to some predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. --@@ -2644,7 +2593,7 @@ partition p m = partitionWithKey (\_ x -> p x) m --- | /O(n)/. Partition the map according to some predicate. The first+-- | \(O(n)\). Partition the map according to some predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. --@@ -2666,7 +2615,7 @@ | otherwise -> (Nil :*: t) Nil -> (Nil :*: Nil) --- | /O(n)/. Map values and collect the 'Just' results.+-- | \(O(n)\). Map values and collect the 'Just' results. -- -- > let f x = if x == "a" then Just "new a" else Nothing -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"@@ -2674,7 +2623,7 @@ mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b mapMaybe f = mapMaybeWithKey (\_ x -> f x) --- | /O(n)/. Map keys\/values and collect the 'Just' results.+-- | \(O(n)\). Map keys\/values and collect the 'Just' results. -- -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"@@ -2687,7 +2636,7 @@ Nothing -> Nil mapMaybeWithKey _ Nil = Nil --- | /O(n)/. Map values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results. -- -- > let f a = if a < "c" then Left a else Right a -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -2700,7 +2649,7 @@ mapEither f m = mapEitherWithKey (\_ x -> f x) m --- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results. -- -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -2722,7 +2671,7 @@ Right z -> (Nil :*: Tip k z) go _ Nil = (Nil :*: Nil) --- | /O(min(n,W))/. The expression (@'split' k map@) is a pair @(map1,map2)@+-- | \(O(\min(n,W))\). The expression (@'split' k map@) is a pair @(map1,map2)@ -- where all keys in @map1@ are lower than @k@ and all keys in -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@. --@@ -2772,7 +2721,7 @@ mapGT f (SplitLookup lt fnd gt) = SplitLookup lt fnd (f gt) {-# INLINE mapGT #-} --- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot+-- | \(O(\min(n,W))\). Performs a 'split' but also returns whether the pivot -- key was found in the original map. -- -- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])@@ -2809,7 +2758,7 @@ {-------------------------------------------------------------------- Fold --------------------------------------------------------------------}--- | /O(n)/. Fold the values in the map using the given right-associative+-- | \(O(n)\). Fold the values in the map using the given right-associative -- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. -- -- For example,@@ -2831,7 +2780,7 @@ go z' (Bin _ _ l r) = go (go z' r) l {-# INLINE foldr #-} --- | /O(n)/. A strict version of 'foldr'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldr'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldr' :: (a -> b -> b) -> b -> IntMap a -> b@@ -2847,7 +2796,7 @@ go z' (Bin _ _ l r) = go (go z' r) l {-# INLINE foldr' #-} --- | /O(n)/. Fold the values in the map using the given left-associative+-- | \(O(n)\). Fold the values in the map using the given left-associative -- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@. -- -- For example,@@ -2869,7 +2818,7 @@ go z' (Bin _ _ l r) = go (go z' l) r {-# INLINE foldl #-} --- | /O(n)/. A strict version of 'foldl'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldl'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldl' :: (a -> b -> a) -> a -> IntMap b -> a@@ -2885,7 +2834,7 @@ go z' (Bin _ _ l r) = go (go z' l) r {-# INLINE foldl' #-} --- | /O(n)/. Fold the keys and values in the map using the given right-associative+-- | \(O(n)\). Fold the keys and values in the map using the given right-associative -- binary operator, such that -- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. --@@ -2908,7 +2857,7 @@ go z' (Bin _ _ l r) = go (go z' r) l {-# INLINE foldrWithKey #-} --- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldrWithKey'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldrWithKey' :: (Key -> a -> b -> b) -> b -> IntMap a -> b@@ -2924,7 +2873,7 @@ go z' (Bin _ _ l r) = go (go z' r) l {-# INLINE foldrWithKey' #-} --- | /O(n)/. Fold the keys and values in the map using the given left-associative+-- | \(O(n)\). Fold the keys and values in the map using the given left-associative -- binary operator, such that -- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. --@@ -2947,7 +2896,7 @@ go z' (Bin _ _ l r) = go (go z' l) r {-# INLINE foldlWithKey #-} --- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldlWithKey'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldlWithKey' :: (a -> Key -> b -> a) -> a -> IntMap b -> a@@ -2963,7 +2912,7 @@ go z' (Bin _ _ l r) = go (go z' l) r {-# INLINE foldlWithKey' #-} --- | /O(n)/. Fold the keys and values in the map using the given monoid, such that+-- | \(O(n)\). Fold the keys and values in the map using the given monoid, such that -- -- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@ --@@ -2983,7 +2932,7 @@ {-------------------------------------------------------------------- List variations --------------------------------------------------------------------}--- | /O(n)/.+-- | \(O(n)\). -- Return all elements of the map in the ascending order of their keys. -- Subject to list fusion. --@@ -2993,7 +2942,7 @@ elems :: IntMap a -> [a] elems = foldr (:) [] --- | /O(n)/. Return all keys of the map in ascending order. Subject to list+-- | \(O(n)\). Return all keys of the map in ascending order. Subject to list -- fusion. -- -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]@@ -3002,7 +2951,7 @@ keys :: IntMap a -> [Key] keys = foldrWithKey (\k _ ks -> k : ks) [] --- | /O(n)/. An alias for 'toAscList'. Returns all key\/value pairs in the+-- | \(O(n)\). An alias for 'toAscList'. Returns all key\/value pairs in the -- map in ascending key order. Subject to list fusion. -- -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]@@ -3011,7 +2960,7 @@ assocs :: IntMap a -> [(Key,a)] assocs = toAscList --- | /O(n*min(n,W))/. The set of all keys of the map.+-- | \(O(n \min(n,W))\). The set of all keys of the map. -- -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5] -- > keysSet empty == Data.IntSet.empty@@ -3026,7 +2975,7 @@ computeBm acc (Tip kx _) = acc .|. IntSet.bitmapOf kx computeBm _ Nil = error "Data.IntSet.keysSet: Nil" --- | /O(n)/. Build a map from a set of keys and a function which for each key+-- | \(O(n)\). Build a map from a set of keys and a function which for each key -- computes its value. -- -- > fromSet (\k -> replicate k 'a') (Data.IntSet.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]@@ -3061,7 +3010,8 @@ {-------------------------------------------------------------------- Lists --------------------------------------------------------------------}-#if __GLASGOW_HASKELL__ >= 708++#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHCExts.IsList (IntMap a) where type Item (IntMap a) = (Key,a)@@ -3069,7 +3019,7 @@ toList = toList #endif --- | /O(n)/. Convert the map to a list of key\/value pairs. Subject to list+-- | \(O(n)\). Convert the map to a list of key\/value pairs. Subject to list -- fusion. -- -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]@@ -3078,7 +3028,7 @@ toList :: IntMap a -> [(Key,a)] toList = toAscList --- | /O(n)/. Convert the map to a list of key\/value pairs where the+-- | \(O(n)\). Convert the map to a list of key\/value pairs where the -- keys are in ascending order. Subject to list fusion. -- -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]@@ -3086,7 +3036,7 @@ toAscList :: IntMap a -> [(Key,a)] toAscList = foldrWithKey (\k x xs -> (k,x):xs) [] --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys+-- | \(O(n)\). Convert the map to a list of key\/value pairs where the keys -- are in descending order. Subject to list fusion. -- -- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]@@ -3130,7 +3080,7 @@ #endif --- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.+-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs. -- -- > fromList [] == empty -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]@@ -3142,7 +3092,7 @@ where ins t (k,x) = insert k x t --- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. -- -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "ab"), (5, "cba")] -- > fromListWith (++) [] == empty@@ -3151,7 +3101,7 @@ fromListWith f xs = fromListWithKey (\_ x y -> f x y) xs --- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.+-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. -- -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]@@ -3163,7 +3113,7 @@ where ins t (k,x) = insertWithKey f k x t --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order. -- -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]@@ -3173,7 +3123,7 @@ fromAscList = fromMonoListWithKey Nondistinct (\_ x _ -> x) {-# NOINLINE fromAscList #-} --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys. -- /The precondition (input list is ascending) is not checked./ --@@ -3183,7 +3133,7 @@ fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y) {-# NOINLINE fromAscListWith #-} --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys. -- /The precondition (input list is ascending) is not checked./ --@@ -3194,7 +3144,7 @@ fromAscListWithKey f = fromMonoListWithKey Nondistinct f {-# NOINLINE fromAscListWithKey #-} --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order and all distinct. -- /The precondition (input list is strictly ascending) is not checked./ --@@ -3204,7 +3154,7 @@ fromDistinctAscList = fromMonoListWithKey Distinct (\_ x _ -> x) {-# NOINLINE fromDistinctAscList #-} --- | /O(n)/. Build a map from a list of key\/value pairs with monotonic keys+-- | \(O(n)\). Build a map from a list of key\/value pairs with monotonic keys -- and a combining function. -- -- The precise conditions under which this function works are subtle:@@ -3289,7 +3239,6 @@ nequal Nil Nil = False nequal _ _ = True -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Eq1 IntMap where liftEq eq (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)@@ -3298,7 +3247,6 @@ = (kx == ky) && (eq x y) liftEq _eq Nil Nil = True liftEq _eq _ _ = False-#endif {-------------------------------------------------------------------- Ord@@ -3307,12 +3255,10 @@ instance Ord a => Ord (IntMap a) where compare m1 m2 = compare (toList m1) (toList m2) -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Ord1 IntMap where liftCompare cmp m n = liftCompare (liftCompare cmp) (toList m) (toList n)-#endif {-------------------------------------------------------------------- Functor@@ -3335,7 +3281,6 @@ showsPrec d m = showParen (d > 10) $ showString "fromList " . shows (toList m) -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Show1 IntMap where liftShowsPrec sp sl d m =@@ -3343,7 +3288,6 @@ where sp' = liftShowsPrec sp sl sl' = liftShowList sp sl-#endif {-------------------------------------------------------------------- Read@@ -3363,7 +3307,6 @@ return (fromList xs,t) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Read1 IntMap where liftReadsPrec rp rl = readsData $@@ -3371,15 +3314,8 @@ where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl-#endif {--------------------------------------------------------------------- Typeable---------------------------------------------------------------------}--INSTANCE_TYPEABLE1(IntMap)--{-------------------------------------------------------------------- Helpers --------------------------------------------------------------------} {--------------------------------------------------------------------@@ -3480,7 +3416,7 @@ Utilities --------------------------------------------------------------------} --- | /O(1)/. Decompose a map into pieces based on the structure+-- | \(O(1)\). Decompose a map into pieces based on the structure -- of the underlying tree. This function is useful for consuming a -- map in parallel. --@@ -3513,14 +3449,14 @@ Debugging --------------------------------------------------------------------} --- | /O(n)/. Show the tree that implements the map. The tree is shown+-- | \(O(n)\). Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. showTree :: Show a => IntMap a -> String showTree s = showTreeWith True False s -{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows+{- | \(O(n)\). The expression (@'showTreeWith' hang wide map@) shows the tree that implements the map. If @hang@ is 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If @wide@ is 'True', an extra wide version is shown.
src/Data/Strict/IntMap/Autogen/Merge/Strict.hs view
@@ -1,21 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-#if __GLASGOW_HASKELL__-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}-#endif #if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif-#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE TypeFamilies #-}-#define USE_MAGIC_PROXY 1-#endif -#if USE_MAGIC_PROXY-{-# LANGUAGE MagicHash #-}-#endif- #include "containers.h" -----------------------------------------------------------------------------@@ -112,9 +100,6 @@ , runWhenMissing ) import Data.Strict.IntMap.Autogen.Strict.Internal-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative (..), (<$>))-#endif import Prelude hiding (filter, map, foldl, foldr) -- | Map covariantly over a @'WhenMissing' f k x@.
src/Data/Strict/IntMap/Autogen/Strict.hs view
@@ -48,8 +48,8 @@ -- -- == Detailed performance information ----- The amortized running time is given for each operation, with /n/ referring to--- the number of entries in the map and /W/ referring to the number of bits in+-- The amortized running time is given for each operation, with \(n\) referring to+-- the number of entries in the map and \(W\) referring to the number of bits in -- an 'Int' (32 or 64). -- -- Benchmarks comparing "Data.Strict.IntMap.Autogen.Strict" with other dictionary@@ -77,9 +77,8 @@ -- Workshop on ML, September 1998, pages 77-86, -- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452> ----- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve--- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),--- October 1968, pages 514-534.+-- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+-- Journal of the ACM, 15(4), October 1968, pages 514-534. -- -----------------------------------------------------------------------------
src/Data/Strict/IntMap/Autogen/Strict/Internal.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+ #include "containers.h" -----------------------------------------------------------------------------@@ -46,8 +48,8 @@ -- -- == Detailed performance information ----- The amortized running time is given for each operation, with /n/ referring to--- the number of entries in the map and /W/ referring to the number of bits in+-- The amortized running time is given for each operation, with \(n\) referring to+-- the number of entries in the map and \(W\) referring to the number of bits in -- an 'Int' (32 or 64). -- -- Benchmarks comparing "Data.Strict.IntMap.Autogen.Strict" with other dictionary@@ -75,9 +77,8 @@ -- Workshop on ML, September 1998, pages 77-86, -- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452> ----- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve--- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),--- October 1968, pages 514-534.+-- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+-- Journal of the ACM, 15(4), October 1968, pages 514-534. -- ----------------------------------------------------------------------------- @@ -344,20 +345,14 @@ import qualified Data.IntSet.Internal as IntSet import Data.Strict.ContainersUtils.Autogen.BitUtil import Data.Strict.ContainersUtils.Autogen.StrictPair-#if !MIN_VERSION_base(4,8,0)-import Data.Functor((<$>))-#endif import Control.Applicative (Applicative (..), liftA2) import qualified Data.Foldable as Foldable-#if !MIN_VERSION_base(4,8,0)-import Data.Foldable (Foldable())-#endif {-------------------------------------------------------------------- Query --------------------------------------------------------------------} --- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@+-- | \(O(\min(n,W))\). The expression @('findWithDefault' def k map)@ -- returns the value at key @k@ or returns @def@ when the key is not an -- element of the map. --@@ -378,7 +373,7 @@ {-------------------------------------------------------------------- Construction --------------------------------------------------------------------}--- | /O(1)/. A map of one element.+-- | \(O(1)\). A map of one element. -- -- > singleton 1 'a' == fromList [(1, 'a')] -- > size (singleton 1 'a') == 1@@ -391,7 +386,7 @@ {-------------------------------------------------------------------- Insert --------------------------------------------------------------------}--- | /O(min(n,W))/. Insert a new key\/value pair in the map.+-- | \(O(\min(n,W))\). Insert a new key\/value pair in the map. -- If the key is already present in the map, the associated value is -- replaced with the supplied value, i.e. 'insert' is equivalent to -- @'insertWith' 'const'@.@@ -413,7 +408,7 @@ Nil -> Tip k x -- right-biased insertion, used by 'union'--- | /O(min(n,W))/. Insert with a combining function.+-- | \(O(\min(n,W))\). Insert with a combining function. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -427,7 +422,7 @@ insertWith f k x t = insertWithKey (\_ x' y' -> f x' y') k x t --- | /O(min(n,W))/. Insert with a combining function.+-- | \(O(\min(n,W))\). Insert with a combining function. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -453,7 +448,7 @@ | otherwise -> link k (singleton k x) ky t Nil -> singleton k x --- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)+-- | \(O(\min(n,W))\). The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) -- and the second element equal to (@'insertWithKey' f k x map@). --@@ -486,7 +481,7 @@ {-------------------------------------------------------------------- Deletion --------------------------------------------------------------------}--- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not+-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. -- -- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]@@ -497,7 +492,7 @@ adjust f k m = adjustWithKey (\_ x -> f x) k m --- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not+-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. -- -- > let f key x = (show key) ++ ":new " ++ x@@ -517,7 +512,7 @@ | otherwise -> t Nil -> Nil --- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@+-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --@@ -530,7 +525,7 @@ update f = updateWithKey (\_ x -> f x) --- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@+-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --@@ -553,7 +548,7 @@ | otherwise -> t Nil -> Nil --- | /O(min(n,W))/. Lookup and update.+-- | \(O(\min(n,W))\). Lookup and update. -- The function returns original value, if it is updated. -- This is different behavior than 'Data.Map.updateLookupWithKey'. -- Returns the original key value if the map entry is deleted.@@ -581,7 +576,7 @@ --- | /O(min(n,W))/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.+-- | \(O(\min(n,W))\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in an 'IntMap'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a@@ -604,7 +599,7 @@ Just !x -> Tip k x Nothing -> Nil --- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ at+-- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at -- @k@, or absence thereof. 'alterF' can be used to inspect, insert, delete, -- or update a value in an 'IntMap'. In short : @'lookup' k <$> 'alterF' f k m = f -- ('lookup' k m)@.@@ -654,7 +649,7 @@ unionsWith f ts = Foldable.foldl' (unionWith f) empty ts --- | /O(n+m)/. The union with a combining function.+-- | \(O(n+m)\). The union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")] @@ -662,7 +657,7 @@ unionWith f m1 m2 = unionWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. The union with a combining function.+-- | \(O(n+m)\). The union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]@@ -675,7 +670,7 @@ Difference --------------------------------------------------------------------} --- | /O(n+m)/. Difference with a combining function.+-- | \(O(n+m)\). Difference with a combining function. -- -- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing -- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])@@ -685,7 +680,7 @@ differenceWith f m1 m2 = differenceWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. Difference with a combining function. When two equal keys are+-- | \(O(n+m)\). Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). -- If it returns (@'Just' y@), the element is updated with a new value @y@.@@ -702,7 +697,7 @@ Intersection --------------------------------------------------------------------} --- | /O(n+m)/. The intersection with a combining function.+-- | \(O(n+m)\). The intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -710,7 +705,7 @@ intersectionWith f m1 m2 = intersectionWithKey (\_ x y -> f x y) m1 m2 --- | /O(n+m)/. The intersection with a combining function.+-- | \(O(n+m)\). The intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -723,7 +718,7 @@ MergeWithKey --------------------------------------------------------------------} --- | /O(n+m)/. A high-performance universal combining function. Using+-- | \(O(n+m)\). A high-performance universal combining function. Using -- 'mergeWithKey', all combining functions can be defined without any loss of -- efficiency (with exception of 'union', 'difference' and 'intersection', -- where sharing of some nodes is lost with 'mergeWithKey').@@ -772,7 +767,7 @@ Min\/Max --------------------------------------------------------------------} --- | /O(log n)/. Update the value at the minimal key.+-- | \(O(\log n)\). Update the value at the minimal key. -- -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")] -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -788,7 +783,7 @@ Nothing -> Nil go _ Nil = error "updateMinWithKey Nil" --- | /O(log n)/. Update the value at the maximal key.+-- | \(O(\log n)\). Update the value at the maximal key. -- -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")] -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -804,7 +799,7 @@ Nothing -> Nil go _ Nil = error "updateMaxWithKey Nil" --- | /O(log n)/. Update the value at the maximal key.+-- | \(O(\log n)\). Update the value at the maximal key. -- -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")] -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -812,7 +807,7 @@ updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a updateMax f = updateMaxWithKey (const f) --- | /O(log n)/. Update the value at the minimal key.+-- | \(O(\log n)\). Update the value at the minimal key. -- -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")] -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -824,7 +819,7 @@ {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------}--- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")] @@ -843,7 +838,7 @@ #-} #endif --- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > let f key x = (show key) ++ ":" ++ x -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]@@ -885,7 +880,7 @@ #-} #endif --- | /O(n)/.+-- | \(O(n)\). -- @'traverseWithKey' f s == '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.@@ -902,7 +897,7 @@ | otherwise = liftA2 (Bin p m) (go l) (go r) {-# INLINE traverseWithKey #-} --- | /O(n)/. Traverse keys\/values and collect the 'Just' results.+-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results. -- -- @since 0.6.4 traverseMaybeWithKey@@ -915,7 +910,7 @@ | m < 0 = liftA2 (flip (bin p m)) (go r) (go l) | otherwise = liftA2 (bin p m) (go l) (go r) --- | /O(n)/. The function @'mapAccum'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccum'@ threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a b = (a ++ b, b ++ "X")@@ -924,7 +919,7 @@ mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccum f = mapAccumWithKey (\a' _ x -> f a' x) --- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccumWithKey'@ threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")@@ -934,7 +929,7 @@ mapAccumWithKey f a t = mapAccumL f a t --- | /O(n)/. The function @'mapAccumL'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccumL'@ threads an accumulating -- argument through the map in ascending order of keys. Strict in -- the accumulating argument and the both elements of the -- result of the function.@@ -955,7 +950,7 @@ Tip k x -> let !(a',!x') = f a k x in (a' :*: Tip k x') Nil -> (a :*: Nil) --- | /O(n)/. The function @'mapAccumRWithKey'@ threads an accumulating+-- | \(O(n)\). The function @'mapAccumRWithKey'@ threads an accumulating -- argument through the map in descending order of keys. mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c) mapAccumRWithKey f0 a0 t0 = toPair $ go f0 a0 t0@@ -974,7 +969,7 @@ Tip k x -> let !(a',!x') = f a k x in (a' :*: Tip k x') Nil -> (a :*: Nil) --- | /O(n*log n)/.+-- | \(O(n \log n)\). -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct@@ -990,7 +985,7 @@ {-------------------------------------------------------------------- Filter --------------------------------------------------------------------}--- | /O(n)/. Map values and collect the 'Just' results.+-- | \(O(n)\). Map values and collect the 'Just' results. -- -- > let f x = if x == "a" then Just "new a" else Nothing -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"@@ -998,7 +993,7 @@ mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b mapMaybe f = mapMaybeWithKey (\_ x -> f x) --- | /O(n)/. Map keys\/values and collect the 'Just' results.+-- | \(O(n)\). Map keys\/values and collect the 'Just' results. -- -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"@@ -1011,7 +1006,7 @@ Nothing -> Nil mapMaybeWithKey _ Nil = Nil --- | /O(n)/. Map values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results. -- -- > let f a = if a < "c" then Left a else Right a -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -1024,7 +1019,7 @@ mapEither f m = mapEitherWithKey (\_ x -> f x) m --- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results. -- -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -1050,7 +1045,7 @@ Conversions --------------------------------------------------------------------} --- | /O(n)/. Build a map from a set of keys and a function which for each key+-- | \(O(n)\). Build a map from a set of keys and a function which for each key -- computes its value. -- -- > fromSet (\k -> replicate k 'a') (Data.IntSet.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]@@ -1080,7 +1075,7 @@ {-------------------------------------------------------------------- Lists --------------------------------------------------------------------}--- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.+-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs. -- -- > fromList [] == empty -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]@@ -1092,7 +1087,7 @@ where ins t (k,x) = insert k x t --- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. -- -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")] -- > fromListWith (++) [] == empty@@ -1101,7 +1096,7 @@ fromListWith f xs = fromListWithKey (\_ x y -> f x y) xs --- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.+-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. -- -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")] -- > fromListWith (++) [] == empty@@ -1112,7 +1107,7 @@ where ins t (k,x) = insertWithKey f k x t --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order. -- -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]@@ -1122,7 +1117,7 @@ fromAscList = fromMonoListWithKey Nondistinct (\_ x _ -> x) {-# NOINLINE fromAscList #-} --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys. -- /The precondition (input list is ascending) is not checked./ --@@ -1132,7 +1127,7 @@ fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y) {-# NOINLINE fromAscListWith #-} --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order, with a combining function on equal keys. -- /The precondition (input list is ascending) is not checked./ --@@ -1142,7 +1137,7 @@ fromAscListWithKey f = fromMonoListWithKey Nondistinct f {-# NOINLINE fromAscListWithKey #-} --- | /O(n)/. Build a map from a list of key\/value pairs where+-- | \(O(n)\). Build a map from a list of key\/value pairs where -- the keys are in ascending order and all distinct. -- /The precondition (input list is strictly ascending) is not checked./ --@@ -1152,7 +1147,7 @@ fromDistinctAscList = fromMonoListWithKey Distinct (\_ x _ -> x) {-# NOINLINE fromDistinctAscList #-} --- | /O(n)/. Build a map from a list of key\/value pairs with monotonic keys+-- | \(O(n)\). Build a map from a list of key\/value pairs with monotonic keys -- and a combining function. -- -- The precise conditions under which this function works are subtle:
src/Data/Strict/Map/Autogen/Internal.hs view
@@ -1,17 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-}-#if __GLASGOW_HASKELL__-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}-#endif #if defined(__GLASGOW_HASKELL__)-{-# LANGUAGE Trustworthy #-}-#endif-#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-}-#define USE_MAGIC_PROXY 1 #endif+#define USE_MAGIC_PROXY 1 #ifdef USE_MAGIC_PROXY {-# LANGUAGE MagicHash #-}@@ -267,7 +264,9 @@ , keys , assocs , keysSet+ , argSet , fromSet+ , fromArgSet -- ** Lists , toList@@ -344,7 +343,7 @@ -- Used by the strict version , AreWeStrict (..) , atKeyImpl-#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0)+#ifdef __GLASGOW_HASKELL__ , atKeyPlain #endif , bin@@ -369,35 +368,21 @@ , mapGentlyWhenMatched ) where -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity (..)) import Control.Applicative (liftA3)-#else-import Control.Applicative (Applicative(..), (<$>), liftA3)-import Data.Monoid (Monoid(..))-import Data.Traversable (Traversable(traverse))-#endif-#if MIN_VERSION_base(4,9,0) import Data.Functor.Classes import Data.Semigroup (stimesIdempotentMonoid)-#endif-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup(stimes))-#endif-#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)+import Data.Semigroup (Arg(..), Semigroup(stimes))+#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>))) #endif import Control.Applicative (Const (..)) import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR) import qualified Data.Foldable as Foldable-#if !MIN_VERSION_base(4,8,0)-import Data.Foldable (Foldable())-#endif #if MIN_VERSION_base(4,10,0) import Data.Bifoldable #endif-import Data.Typeable import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop) import qualified Data.Set.Internal as Set@@ -412,20 +397,14 @@ #if __GLASGOW_HASKELL__ import GHC.Exts (build, lazy)-#if !MIN_VERSION_base(4,8,0)-import Data.Functor ((<$))-#endif-#ifdef USE_MAGIC_PROXY+import Language.Haskell.TH.Syntax (Lift)+# ifdef USE_MAGIC_PROXY import GHC.Exts (Proxy#, proxy# )-#endif-#if __GLASGOW_HASKELL__ >= 708+# endif import qualified GHC.Exts as GHCExts-#endif import Text.Read hiding (lift) import Data.Data import qualified Control.Category as Category-#endif-#if __GLASGOW_HASKELL__ >= 708 import Data.Coerce #endif @@ -435,7 +414,7 @@ --------------------------------------------------------------------} infixl 9 !,!?,\\ -- --- | /O(log n)/. Find the value at a key.+-- | \(O(\log n)\). Find the value at a key. -- Calls 'error' when the element can not be found. -- -- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map@@ -447,7 +426,7 @@ {-# INLINE (!) #-} #endif --- | /O(log n)/. Find the value at a key.+-- | \(O(\log n)\). Find the value at a key. -- Returns 'Nothing' when the element can not be found. -- -- prop> fromList [(5, 'a'), (3, 'b')] !? 1 == Nothing@@ -484,22 +463,23 @@ type Size = Int -#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ type role Map nominal representational #endif +#ifdef __GLASGOW_HASKELL__+-- | @since FIXME+deriving instance (Lift k, Lift a) => Lift (Map k a)+#endif+ instance (Ord k) => Monoid (Map k v) where mempty = empty mconcat = unions-#if !(MIN_VERSION_base(4,9,0))- mappend = union-#else mappend = (<>) instance (Ord k) => Semigroup (Map k v) where (<>) = union stimes = stimesIdempotentMonoid-#endif #if __GLASGOW_HASKELL__ @@ -530,7 +510,7 @@ {-------------------------------------------------------------------- Query --------------------------------------------------------------------}--- | /O(1)/. Is the map empty?+-- | \(O(1)\). Is the map empty? -- -- > Data.Strict.Map.Autogen.null (empty) == True -- > Data.Strict.Map.Autogen.null (singleton 1 'a') == False@@ -540,7 +520,7 @@ null (Bin {}) = False {-# INLINE null #-} --- | /O(1)/. The number of elements in the map.+-- | \(O(1)\). The number of elements in the map. -- -- > size empty == 0 -- > size (singleton 1 'a') == 1@@ -552,7 +532,7 @@ {-# INLINE size #-} --- | /O(log n)/. Lookup the value at a key in the map.+-- | \(O(\log n)\). Lookup the value at a key in the map. -- -- The function will return the corresponding value as @('Just' value)@, -- or 'Nothing' if the key isn't in the map.@@ -594,7 +574,7 @@ {-# INLINE lookup #-} #endif --- | /O(log n)/. Is the key a member of the map? See also 'notMember'.+-- | \(O(\log n)\). Is the key a member of the map? See also 'notMember'. -- -- > member 5 (fromList [(5,'a'), (3,'b')]) == True -- > member 1 (fromList [(5,'a'), (3,'b')]) == False@@ -612,7 +592,7 @@ {-# INLINE member #-} #endif --- | /O(log n)/. Is the key not a member of the map? See also 'member'.+-- | \(O(\log n)\). Is the key not a member of the map? See also 'member'. -- -- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False -- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True@@ -625,7 +605,7 @@ {-# INLINE notMember #-} #endif --- | /O(log n)/. Find the value at a key.+-- | \(O(\log n)\). Find the value at a key. -- Calls 'error' when the element can not be found. find :: Ord k => k -> Map k a -> a find = go@@ -641,7 +621,7 @@ {-# INLINE find #-} #endif --- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- | \(O(\log n)\). The expression @('findWithDefault' def k map)@ returns -- the value at key @k@ or returns default value @def@ -- when the key is not in the map. --@@ -661,7 +641,7 @@ {-# INLINE findWithDefault #-} #endif --- | /O(log n)/. Find largest key smaller than the given one and return the+-- | \(O(\log n)\). Find largest key smaller than the given one and return the -- corresponding (key, value) pair. -- -- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -682,7 +662,7 @@ {-# INLINE lookupLT #-} #endif --- | /O(log n)/. Find smallest key greater than the given one and return the+-- | \(O(\log n)\). Find smallest key greater than the given one and return the -- corresponding (key, value) pair. -- -- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')@@ -703,7 +683,7 @@ {-# INLINE lookupGT #-} #endif --- | /O(log n)/. Find largest key smaller or equal to the given one and return+-- | \(O(\log n)\). Find largest key smaller or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -727,7 +707,7 @@ {-# INLINE lookupLE #-} #endif --- | /O(log n)/. Find smallest key greater or equal to the given one and return+-- | \(O(\log n)\). Find smallest key greater or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')@@ -754,7 +734,7 @@ {-------------------------------------------------------------------- Construction --------------------------------------------------------------------}--- | /O(1)/. The empty map.+-- | \(O(1)\). The empty map. -- -- > empty == fromList [] -- > size empty == 0@@ -763,7 +743,7 @@ empty = Tip {-# INLINE empty #-} --- | /O(1)/. A map with a single element.+-- | \(O(1)\). A map with a single element. -- -- > singleton 1 'a' == fromList [(1, 'a')] -- > size (singleton 1 'a') == 1@@ -775,7 +755,7 @@ {-------------------------------------------------------------------- Insertion --------------------------------------------------------------------}--- | /O(log n)/. Insert a new key and value in the map.+-- | \(O(\log n)\). Insert a new key and value in the map. -- If the key is already present in the map, the associated value is -- replaced with the supplied value. 'insert' is equivalent to -- @'insertWith' 'const'@.@@ -855,7 +835,7 @@ {-# INLINE insertR #-} #endif --- | /O(log n)/. Insert with a function, combining new value and old value.+-- | \(O(\log n)\). Insert with a function, combining new value and old value. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -907,7 +887,7 @@ {-# INLINE insertWithR #-} #endif --- | /O(log n)/. Insert with a function, combining key, new value and old value.+-- | \(O(\log n)\). Insert with a function, combining key, new value and old value. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -956,7 +936,7 @@ {-# INLINE insertWithKeyR #-} #endif --- | /O(log n)/. Combines insert operation with old value retrieval.+-- | \(O(\log n)\). Combines insert operation with old value retrieval. -- The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) -- and the second element equal to (@'insertWithKey' f k x map@).@@ -997,7 +977,7 @@ {-------------------------------------------------------------------- Deletion --------------------------------------------------------------------}--- | /O(log n)/. Delete a key and its value from the map. When the key is not+-- | \(O(\log n)\). Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. -- -- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -1025,7 +1005,7 @@ {-# INLINE delete #-} #endif --- | /O(log n)/. Update a value at a specific key with the result of the provided function.+-- | \(O(\log n)\). Update a value at a specific key with the result of the provided function. -- When the key is not -- a member of the map, the original map is returned. --@@ -1041,7 +1021,7 @@ {-# INLINE adjust #-} #endif --- | /O(log n)/. Adjust a value at a specific key. When the key is not+-- | \(O(\log n)\). Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. -- -- > let f key x = (show key) ++ ":new " ++ x@@ -1065,7 +1045,7 @@ {-# INLINE adjustWithKey #-} #endif --- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@+-- | \(O(\log n)\). The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --@@ -1082,7 +1062,7 @@ {-# INLINE update #-} #endif --- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the+-- | \(O(\log n)\). The expression (@'updateWithKey' f k map@) updates the -- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', -- the element is deleted. If it is (@'Just' y@), the key @k@ is bound -- to the new value @y@.@@ -1111,7 +1091,7 @@ {-# INLINE updateWithKey #-} #endif --- | /O(log n)/. Lookup and update. See also 'updateWithKey'.+-- | \(O(\log n)\). Lookup and update. See also 'updateWithKey'. -- The function returns changed value, if it is updated. -- Returns the original key value if the map entry is deleted. --@@ -1144,7 +1124,7 @@ {-# INLINE updateLookupWithKey #-} #endif --- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.+-- | \(O(\log n)\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'Map'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. --@@ -1155,6 +1135,8 @@ -- > let f _ = Just "c" -- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")] -- > alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]+--+-- Note that @'adjust' = alter . fmap@. -- See Note: Type of local 'go' function alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a@@ -1180,7 +1162,7 @@ -- Used to choose the appropriate alterF implementation. data AreWeStrict = Strict | Lazy --- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ at+-- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at -- @k@, or absence thereof. 'alterF' can be used to inspect, insert, delete, -- or update a value in a 'Map'. In short: @'lookup' k \<$\> 'alterF' f k m = f -- ('lookup' k m)@.@@ -1236,14 +1218,12 @@ "alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)) . alterF f k = \m -> Const . getConst . f $ lookup k m #-} -#if MIN_VERSION_base(4,8,0) -- base 4.8 and above include Data.Functor.Identity, so we can -- save a pretty decent amount of time by handling it specially. {-# RULES "alterF/Identity" forall k f . alterF f k = atKeyIdentity k f #-} #endif-#endif atKeyImpl :: (Functor f, Ord k) => AreWeStrict -> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)@@ -1297,10 +1277,7 @@ GT -> (go $! q `snocQB` True) k r EQ -> TraceResult (Just x) (buildQ q) --- GHC 7.8 doesn't manage to unbox the queue properly--- unless we explicitly inline this function. This stuff--- is a bit touchy, unfortunately.-#if __GLASGOW_HASKELL__ >= 710+#ifdef __GLASGOW_HASKELL__ {-# INLINABLE lookupTrace #-} #else {-# INLINE lookupTrace #-}@@ -1370,7 +1347,7 @@ Just (True,tl) -> Bin sz ky y l (replaceAlong tl x r) Nothing -> Bin sz ky x l r -#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0)+#ifdef __GLASGOW_HASKELL__ atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a) atKeyIdentity k f t = Identity $ atKeyPlain Lazy k (coerce f) t {-# INLINABLE atKeyIdentity #-}@@ -1445,7 +1422,7 @@ {-------------------------------------------------------------------- Indexing --------------------------------------------------------------------}--- | /O(log n)/. Return the /index/ of a key, which is its zero-based index in+-- | \(O(\log n)\). Return the /index/ of a key, which is its zero-based index in -- the sequence sorted by keys. The index is a number from /0/ up to, but not -- including, the 'size' of the map. Calls 'error' when the key is not -- a 'member' of the map.@@ -1469,7 +1446,7 @@ {-# INLINABLE findIndex #-} #endif --- | /O(log n)/. Lookup the /index/ of a key, which is its zero-based index in+-- | \(O(\log n)\). Lookup the /index/ of a key, which is its zero-based index in -- the sequence sorted by keys. The index is a number from /0/ up to, but not -- including, the 'size' of the map. --@@ -1492,7 +1469,7 @@ {-# INLINABLE lookupIndex #-} #endif --- | /O(log n)/. Retrieve an element by its /index/, i.e. by its zero-based+-- | \(O(\log n)\). Retrieve an element by its /index/, i.e. by its zero-based -- index in the sequence sorted by keys. If the /index/ is out of range (less -- than zero, greater or equal to 'size' of the map), 'error' is called. --@@ -1553,7 +1530,7 @@ EQ -> insertMin kx x r where sizeL = size l --- | /O(log n)/. Split a map at a particular index.+-- | \(O(\log n)\). Split a map at a particular index. -- -- @ -- splitAt !n !xs = ('take' n xs, 'drop' n xs)@@ -1576,7 +1553,7 @@ EQ -> l :*: insertMin kx x r where sizeL = size l --- | /O(log n)/. Update the element at /index/, i.e. by its zero-based index in+-- | \(O(\log n)\). Update the element at /index/, i.e. by its zero-based index in -- the sequence sorted by keys. If the /index/ is out of range (less than zero, -- greater or equal to 'size' of the map), 'error' is called. --@@ -1602,7 +1579,7 @@ where sizeL = size l --- | /O(log n)/. Delete the element at /index/, i.e. by its zero-based index in+-- | \(O(\log n)\). Delete the element at /index/, i.e. by its zero-based index in -- the sequence sorted by keys. If the /index/ is out of range (less than zero, -- greater or equal to 'size' of the map), 'error' is called. --@@ -1631,7 +1608,7 @@ lookupMinSure k a Tip = (k, a) lookupMinSure _ _ (Bin _ k a l _) = lookupMinSure k a l --- | /O(log n)/. The minimal key of the map. Returns 'Nothing' if the map is empty.+-- | \(O(\log n)\). The minimal key of the map. Returns 'Nothing' if the map is empty. -- -- > lookupMin (fromList [(5,"a"), (3,"b")]) == Just (3,"b") -- > lookupMin empty = Nothing@@ -1642,7 +1619,7 @@ lookupMin Tip = Nothing lookupMin (Bin _ k x l _) = Just $! lookupMinSure k x l --- | /O(log n)/. The minimal key of the map. Calls 'error' if the map is empty.+-- | \(O(\log n)\). The minimal key of the map. Calls 'error' if the map is empty. -- -- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b") -- > findMin empty Error: empty map has no minimal element@@ -1652,7 +1629,7 @@ | Just r <- lookupMin t = r | otherwise = error "Map.findMin: empty map has no minimal element" --- | /O(log n)/. The maximal key of the map. Calls 'error' if the map is empty.+-- | \(O(\log n)\). The maximal key of the map. Calls 'error' if the map is empty. -- -- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a") -- > findMax empty Error: empty map has no maximal element@@ -1661,7 +1638,7 @@ lookupMaxSure k a Tip = (k, a) lookupMaxSure _ _ (Bin _ k a _ r) = lookupMaxSure k a r --- | /O(log n)/. The maximal key of the map. Returns 'Nothing' if the map is empty.+-- | \(O(\log n)\). The maximal key of the map. Returns 'Nothing' if the map is empty. -- -- > lookupMax (fromList [(5,"a"), (3,"b")]) == Just (5,"a") -- > lookupMax empty = Nothing@@ -1677,7 +1654,7 @@ | Just r <- lookupMax t = r | otherwise = error "Map.findMax: empty map has no maximal element" --- | /O(log n)/. Delete the minimal key. Returns an empty map if the map is empty.+-- | \(O(\log n)\). Delete the minimal key. Returns an empty map if the map is empty. -- -- > deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(5,"a"), (7,"c")] -- > deleteMin empty == empty@@ -1687,7 +1664,7 @@ deleteMin (Bin _ kx x l r) = balanceR kx x (deleteMin l) r deleteMin Tip = Tip --- | /O(log n)/. Delete the maximal key. Returns an empty map if the map is empty.+-- | \(O(\log n)\). Delete the maximal key. Returns an empty map if the map is empty. -- -- > deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(3,"b"), (5,"a")] -- > deleteMax empty == empty@@ -1697,7 +1674,7 @@ deleteMax (Bin _ kx x l r) = balanceL kx x l (deleteMax r) deleteMax Tip = Tip --- | /O(log n)/. Update the value at the minimal key.+-- | \(O(\log n)\). Update the value at the minimal key. -- -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")] -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -1706,7 +1683,7 @@ updateMin f m = updateMinWithKey (\_ x -> f x) m --- | /O(log n)/. Update the value at the maximal key.+-- | \(O(\log n)\). Update the value at the maximal key. -- -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")] -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -1716,7 +1693,7 @@ = updateMaxWithKey (\_ x -> f x) m --- | /O(log n)/. Update the value at the minimal key.+-- | \(O(\log n)\). Update the value at the minimal key. -- -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")] -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -1728,7 +1705,7 @@ Just x' -> Bin sx kx x' Tip r updateMinWithKey f (Bin _ kx x l r) = balanceR kx x (updateMinWithKey f l) r --- | /O(log n)/. Update the value at the maximal key.+-- | \(O(\log n)\). Update the value at the maximal key. -- -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")] -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -1740,7 +1717,7 @@ Just x' -> Bin sx kx x' l Tip updateMaxWithKey f (Bin _ kx x l r) = balanceL kx x l (updateMaxWithKey f r) --- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and+-- | \(O(\log n)\). Retrieves the minimal (key,value) pair of the map, and -- the map stripped of that element, or 'Nothing' if passed an empty map. -- -- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")@@ -1756,7 +1733,7 @@ -- the Just. {-# INLINE minViewWithKey #-} --- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and+-- | \(O(\log n)\). Retrieves the maximal (key,value) pair of the map, and -- the map stripped of that element, or 'Nothing' if passed an empty map. -- -- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")@@ -1770,7 +1747,7 @@ -- See note on inlining at minViewWithKey {-# INLINE maxViewWithKey #-} --- | /O(log n)/. Retrieves the value associated with minimal key of the+-- | \(O(\log n)\). Retrieves the value associated with minimal key of the -- map, and the map stripped of that element, or 'Nothing' if passed an -- empty map. --@@ -1782,7 +1759,7 @@ Nothing -> Nothing Just ~((_, x), t') -> Just (x, t') --- | /O(log n)/. Retrieves the value associated with maximal key of the+-- | \(O(\log n)\). Retrieves the value associated with maximal key of the -- map, and the map stripped of that element, or 'Nothing' if passed an -- empty map. --@@ -1825,7 +1802,7 @@ {-# INLINABLE unionsWith #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). -- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@).@@ -1849,7 +1826,7 @@ {-------------------------------------------------------------------- Union with a combining function --------------------------------------------------------------------}--- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")] @@ -1869,7 +1846,7 @@ {-# INLINABLE unionWith #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). -- Union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value@@ -1900,7 +1877,7 @@ -- relies on doing it the way we do, and it's not clear whether that -- bound holds the other way. --- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Difference of two maps. -- Return elements of the first map not existing in the second map. -- -- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"@@ -1919,7 +1896,7 @@ {-# INLINABLE difference #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Set' from a 'Map'.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Remove all keys in a 'Set' from a 'Map'. -- -- @ -- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m@@ -1942,7 +1919,7 @@ {-# INLINABLE withoutKeys #-} #endif --- | /O(n+m)/. Difference with a combining function.+-- | \(O(n+m)\). Difference with a combining function. -- When two equal keys are -- encountered, the combining function is applied to the values of these keys. -- If it returns 'Nothing', the element is discarded (proper set difference). If@@ -1958,7 +1935,7 @@ {-# INLINABLE differenceWith #-} #endif --- | /O(n+m)/. Difference with a combining function. When two equal keys are+-- | \(O(n+m)\). Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). If -- it returns (@'Just' y@), the element is updated with a new value @y@.@@ -1978,7 +1955,7 @@ {-------------------------------------------------------------------- Intersection --------------------------------------------------------------------}--- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection of two maps. -- Return data in the first map for the keys existing in both maps. -- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). --@@ -2000,7 +1977,7 @@ {-# INLINABLE intersection #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/. Restrict a 'Map' to only those keys+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Restrict a 'Map' to only those keys -- found in a 'Set'. -- -- @@@ -2025,7 +2002,7 @@ {-# INLINABLE restrictKeys #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -2045,7 +2022,7 @@ {-# INLINABLE intersectionWith #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -2067,7 +2044,7 @@ {-------------------------------------------------------------------- Disjoint --------------------------------------------------------------------}--- | /O(m*log(n\/m + 1)), m <= n/. Check whether the key sets of two+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Check whether the key sets of two -- maps are disjoint (i.e., their 'intersection' is empty). -- -- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())]) == True@@ -2116,24 +2093,6 @@ | null bc = empty | otherwise = mapMaybe (bc !?) ab -#if !MIN_VERSION_base (4,8,0)--- | The identity type.-newtype Identity a = Identity { runIdentity :: a }-#if __GLASGOW_HASKELL__ == 708-instance Functor Identity where- fmap = coerce-instance Applicative Identity where- (<*>) = coerce- pure = Identity-#else-instance Functor Identity where- fmap f (Identity a) = Identity (f a)-instance Applicative Identity where- Identity f <*> Identity x = Identity (f x)- pure = Identity-#endif-#endif- -- | A tactic for dealing with keys present in one map but not the other in -- 'merge' or 'mergeA'. --@@ -2180,9 +2139,6 @@ -- -- @since 0.5.9 instance (Applicative f, Monad f) => Monad (WhenMissing f k x) where-#if !MIN_VERSION_base(4,8,0)- return = pure-#endif m >>= f = traverseMaybeMissing $ \k x -> do res1 <- missingKey m k x case res1 of@@ -2318,9 +2274,6 @@ -- -- @since 0.5.9 instance (Monad f, Applicative f) => Monad (WhenMatched f k x y) where-#if !MIN_VERSION_base(4,8,0)- return = pure-#endif m >>= f = zipWithMaybeAMatched $ \k x y -> do res <- runWhenMatched m k x y case res of@@ -2732,7 +2685,7 @@ MergeWithKey --------------------------------------------------------------------} --- | /O(n+m)/. An unsafe general combining function.+-- | \(O(n+m)\). An unsafe general combining function. -- -- WARNING: This function can produce corrupt maps and its results -- may depend on the internal structures of its inputs. Users should@@ -2792,7 +2745,7 @@ {-------------------------------------------------------------------- Submap --------------------------------------------------------------------}--- | /O(m*log(n\/m + 1)), m <= n/.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). -- isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool@@ -2801,7 +2754,7 @@ {-# INLINABLE isSubmapOf #-} #endif -{- | /O(m*log(n\/m + 1)), m <= n/.+{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when applied to their respective values. For example, the following@@ -2850,7 +2803,7 @@ {-# INLINABLE submap' #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isProperSubmapOf m1 m2@@ -2859,7 +2812,7 @@ {-# INLINABLE isProperSubmapOf #-} #endif -{- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).+{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when @keys m1@ and @keys m2@ are not equal, all keys in @m1@ are in @m2@, and when @f@ returns 'True' when@@ -2887,7 +2840,7 @@ {-------------------------------------------------------------------- Filter and partition --------------------------------------------------------------------}--- | /O(n)/. Filter all values that satisfy the predicate.+-- | \(O(n)\). Filter all values that satisfy the predicate. -- -- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b" -- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty@@ -2897,7 +2850,7 @@ filter p m = filterWithKey (\_ x -> p x) m --- | /O(n)/. Filter all keys\/values that satisfy the predicate.+-- | \(O(n)\). Filter all keys\/values that satisfy the predicate. -- -- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a" @@ -2911,7 +2864,7 @@ where !pl = filterWithKey p l !pr = filterWithKey p r --- | /O(n)/. Filter keys and values using an 'Applicative'+-- | \(O(n)\). Filter keys and values using an 'Applicative' -- predicate. filterWithKeyA :: Applicative f => (k -> a -> f Bool) -> Map k a -> f (Map k a) filterWithKeyA _ Tip = pure Tip@@ -2923,7 +2876,7 @@ | otherwise = link kx x pl pr combine False pl pr = link2 pl pr --- | /O(log n)/. Take while a predicate on the keys holds.+-- | \(O(\log n)\). Take while a predicate on the keys holds. -- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, -- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. --@@ -2940,7 +2893,7 @@ | p kx = link kx x l (takeWhileAntitone p r) | otherwise = takeWhileAntitone p l --- | /O(log n)/. Drop while a predicate on the keys holds.+-- | \(O(\log n)\). Drop while a predicate on the keys holds. -- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, -- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. --@@ -2957,7 +2910,7 @@ | p kx = dropWhileAntitone p r | otherwise = link kx x (dropWhileAntitone p l) r --- | /O(log n)/. Divide a map at the point where a predicate on the keys stops holding.+-- | \(O(\log n)\). Divide a map at the point where a predicate on the keys stops holding. -- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, -- @j \< k ==\> p j \>= p k@. --@@ -2981,7 +2934,7 @@ | p kx = let u :*: v = go p r in link kx x l u :*: v | otherwise = let u :*: v = go p l in u :*: link kx x v r --- | /O(n)/. Partition the map according to a predicate. The first+-- | \(O(n)\). Partition the map according to a predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. --@@ -2993,7 +2946,7 @@ partition p m = partitionWithKey (\_ x -> p x) m --- | /O(n)/. Partition the map according to a predicate. The first+-- | \(O(n)\). Partition the map according to a predicate. The first -- map contains all elements that satisfy the predicate, the second all -- elements that fail the predicate. See also 'split'. --@@ -3017,7 +2970,7 @@ (l1 :*: l2) = go p l (r1 :*: r2) = go p r --- | /O(n)/. Map values and collect the 'Just' results.+-- | \(O(n)\). Map values and collect the 'Just' results. -- -- > let f x = if x == "a" then Just "new a" else Nothing -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"@@ -3025,7 +2978,7 @@ mapMaybe :: (a -> Maybe b) -> Map k a -> Map k b mapMaybe f = mapMaybeWithKey (\_ x -> f x) --- | /O(n)/. Map keys\/values and collect the 'Just' results.+-- | \(O(n)\). Map keys\/values and collect the 'Just' results. -- -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"@@ -3036,7 +2989,7 @@ Just y -> link kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r) Nothing -> link2 (mapMaybeWithKey f l) (mapMaybeWithKey f r) --- | /O(n)/. Traverse keys\/values and collect the 'Just' results.+-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results. -- -- @since 0.5.8 traverseMaybeWithKey :: Applicative f@@ -3051,7 +3004,7 @@ Nothing -> link2 l' r' Just x' -> link kx x' l' r' --- | /O(n)/. Map values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results. -- -- > let f a = if a < "c" then Left a else Right a -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -3064,7 +3017,7 @@ mapEither f m = mapEitherWithKey (\_ x -> f x) m --- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results. -- -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -3087,7 +3040,7 @@ {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------}--- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")] @@ -3103,16 +3056,11 @@ {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs- #-}-#endif-#if __GLASGOW_HASKELL__ >= 709--- Safe coercions were introduced in 7.8, but did not work well with RULES yet.-{-# RULES "map/coerce" map coerce = coerce #-} #endif --- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > let f key x = (show key) ++ ":" ++ x -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]@@ -3133,7 +3081,7 @@ #-} #endif --- | /O(n)/.+-- | \(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.@@ -3148,7 +3096,7 @@ go (Bin s k v l r) = liftA3 (flip (Bin s k)) (go l) (f k v) (go r) {-# INLINE traverseWithKey #-} --- | /O(n)/. The function 'mapAccum' threads an accumulating+-- | \(O(n)\). The function 'mapAccum' threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a b = (a ++ b, b ++ "X")@@ -3158,7 +3106,7 @@ mapAccum f a m = mapAccumWithKey (\a' _ x' -> f a' x') a m --- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating+-- | \(O(n)\). The function 'mapAccumWithKey' threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")@@ -3168,7 +3116,7 @@ mapAccumWithKey f a t = mapAccumL f a t --- | /O(n)/. The function 'mapAccumL' threads an accumulating+-- | \(O(n)\). The function 'mapAccumL' threads an accumulating -- argument through the map in ascending order of keys. mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumL _ a Tip = (a,Tip)@@ -3178,7 +3126,7 @@ (a3,r') = mapAccumL f a2 r in (a3,Bin sx kx x' l' r') --- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating+-- | \(O(n)\). The function 'mapAccumRWithKey' threads an accumulating -- argument through the map in descending order of keys. mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumRWithKey _ a Tip = (a,Tip)@@ -3188,7 +3136,7 @@ (a3,l') = mapAccumRWithKey f a2 l in (a3,Bin sx kx x' l' r') --- | /O(n*log n)/.+-- | \(O(n \log n)\). -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct@@ -3205,7 +3153,7 @@ {-# INLINABLE mapKeys #-} #endif --- | /O(n*log n)/.+-- | \(O(n \log n)\). -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct@@ -3223,7 +3171,7 @@ #endif --- | /O(n)/.+-- | \(O(n)\). -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ -- is strictly monotonic. -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.@@ -3250,7 +3198,7 @@ Folds --------------------------------------------------------------------} --- | /O(n)/. Fold the values in the map using the given right-associative+-- | \(O(n)\). Fold the values in the map using the given right-associative -- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. -- -- For example,@@ -3266,17 +3214,17 @@ go z' (Bin _ _ x l r) = go (f x (go z' r)) l {-# INLINE foldr #-} --- | /O(n)/. A strict version of 'foldr'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldr'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldr' :: (a -> b -> b) -> b -> Map k a -> b foldr' f z = go z where- go !z' Tip = z'- go z' (Bin _ _ x l r) = go (f x (go z' r)) l+ go !z' Tip = z'+ go z' (Bin _ _ x l r) = go (f x $! go z' r) l {-# INLINE foldr' #-} --- | /O(n)/. Fold the values in the map using the given left-associative+-- | \(O(n)\). Fold the values in the map using the given left-associative -- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@. -- -- For example,@@ -3292,17 +3240,19 @@ go z' (Bin _ _ x l r) = go (f (go z' l) x) r {-# INLINE foldl #-} --- | /O(n)/. A strict version of 'foldl'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldl'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldl' :: (a -> b -> a) -> a -> Map k b -> a foldl' f z = go z where- go !z' Tip = z'- go z' (Bin _ _ x l r) = go (f (go z' l) x) r+ go !z' Tip = z'+ go z' (Bin _ _ x l r) =+ let !z'' = go z' l+ in go (f z'' x) r {-# INLINE foldl' #-} --- | /O(n)/. Fold the keys and values in the map using the given right-associative+-- | \(O(n)\). Fold the keys and values in the map using the given right-associative -- binary operator, such that -- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. --@@ -3319,17 +3269,17 @@ go z' (Bin _ kx x l r) = go (f kx x (go z' r)) l {-# INLINE foldrWithKey #-} --- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldrWithKey'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldrWithKey' :: (k -> a -> b -> b) -> b -> Map k a -> b foldrWithKey' f z = go z where go !z' Tip = z'- go z' (Bin _ kx x l r) = go (f kx x (go z' r)) l+ go z' (Bin _ kx x l r) = go (f kx x $! go z' r) l {-# INLINE foldrWithKey' #-} --- | /O(n)/. Fold the keys and values in the map using the given left-associative+-- | \(O(n)\). Fold the keys and values in the map using the given left-associative -- binary operator, such that -- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. --@@ -3346,17 +3296,19 @@ go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r {-# INLINE foldlWithKey #-} --- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is+-- | \(O(n)\). A strict version of 'foldlWithKey'. Each application of the operator is -- evaluated before using the result in the next application. This -- function is strict in the starting value. foldlWithKey' :: (a -> k -> b -> a) -> a -> Map k b -> a foldlWithKey' f z = go z where- go !z' Tip = z'- go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r+ go !z' Tip = z'+ go z' (Bin _ kx x l r) =+ let !z'' = go z' l+ in go (f z'' kx x) r {-# INLINE foldlWithKey' #-} --- | /O(n)/. Fold the keys and values in the map using the given monoid, such that+-- | \(O(n)\). Fold the keys and values in the map using the given monoid, such that -- -- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@ --@@ -3374,7 +3326,7 @@ {-------------------------------------------------------------------- List variations --------------------------------------------------------------------}--- | /O(n)/.+-- | \(O(n)\). -- Return all elements of the map in the ascending order of their keys. -- Subject to list fusion. --@@ -3384,7 +3336,7 @@ elems :: Map k a -> [a] elems = foldr (:) [] --- | /O(n)/. Return all keys of the map in ascending order. Subject to list+-- | \(O(n)\). Return all keys of the map in ascending order. Subject to list -- fusion. -- -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]@@ -3393,7 +3345,7 @@ keys :: Map k a -> [k] keys = foldrWithKey (\k _ ks -> k : ks) [] --- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map+-- | \(O(n)\). An alias for 'toAscList'. Return all key\/value pairs in the map -- in ascending key order. Subject to list fusion. -- -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]@@ -3403,7 +3355,7 @@ assocs m = toAscList m --- | /O(n)/. The set of all keys of the map.+-- | \(O(n)\). The set of all keys of the map. -- -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [3,5] -- > keysSet empty == Data.Set.empty@@ -3412,7 +3364,16 @@ keysSet Tip = Set.Tip keysSet (Bin sz kx _ l r) = Set.Bin sz kx (keysSet l) (keysSet r) --- | /O(n)/. Build a map from a set of keys and a function which for each key+-- | \(O(n)\). The set of all elements of the map contained in 'Arg's.+--+-- > argSet (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [Arg 3 "b",Arg 5 "a"]+-- > argSet empty == Data.Set.empty++argSet :: Map k a -> Set.Set (Arg k a)+argSet Tip = Set.Tip+argSet (Bin sz kx x l r) = Set.Bin sz (Arg kx x) (argSet l) (argSet r)++-- | \(O(n)\). Build a map from a set of keys and a function which for each key -- computes its value. -- -- > fromSet (\k -> replicate k 'a') (Data.Set.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]@@ -3422,10 +3383,20 @@ fromSet _ Set.Tip = Tip fromSet f (Set.Bin sz x l r) = Bin sz x (f x) (fromSet f l) (fromSet f r) +-- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.+--+-- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")]+-- > fromArgSet Data.Set.empty == empty++fromArgSet :: Set.Set (Arg k a) -> Map k a+fromArgSet Set.Tip = Tip+fromArgSet (Set.Bin sz (Arg x v) l r) = Bin sz x v (fromArgSet l) (fromArgSet r)+ {-------------------------------------------------------------------- Lists --------------------------------------------------------------------}-#if __GLASGOW_HASKELL__ >= 708++#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance (Ord k) => GHCExts.IsList (Map k v) where type Item (Map k v) = (k,v)@@ -3433,7 +3404,7 @@ toList = toList #endif --- | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.+-- | \(O(n \log n)\). Build a map from a list of key\/value pairs. See also 'fromAscList'. -- If the list contains more than one value for the same key, the last value -- for the key is retained. --@@ -3485,7 +3456,7 @@ {-# INLINABLE fromList #-} #endif --- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. -- -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")] -- > fromListWith (++) [] == empty@@ -3497,7 +3468,7 @@ {-# INLINABLE fromListWith #-} #endif --- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.+-- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. -- -- > let f k a1 a2 = (show k) ++ a1 ++ a2 -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]@@ -3512,7 +3483,7 @@ {-# INLINABLE fromListWithKey #-} #endif --- | /O(n)/. Convert the map to a list of key\/value pairs. Subject to list fusion.+-- | \(O(n)\). Convert the map to a list of key\/value pairs. Subject to list fusion. -- -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")] -- > toList empty == []@@ -3520,7 +3491,7 @@ toList :: Map k a -> [(k,a)] toList = toAscList --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are+-- | \(O(n)\). Convert the map to a list of key\/value pairs where the keys are -- in ascending order. Subject to list fusion. -- -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]@@ -3528,7 +3499,7 @@ toAscList :: Map k a -> [(k,a)] toAscList = foldrWithKey (\k x xs -> (k,x):xs) [] --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys+-- | \(O(n)\). Convert the map to a list of key\/value pairs where the keys -- are in descending order. Subject to list fusion. -- -- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]@@ -3578,7 +3549,7 @@ fromAscList xs == fromList xs fromAscListWith f xs == fromListWith f xs --------------------------------------------------------------------}--- | /O(n)/. Build a map from an ascending list in linear time.+-- | \(O(n)\). Build a map from an ascending list in linear time. -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]@@ -3605,7 +3576,7 @@ {-# INLINABLE fromAscList #-} #endif --- | /O(n)/. Build a map from a descending list in linear time.+-- | \(O(n)\). Build a map from a descending list in linear time. -- /The precondition (input list is descending) is not checked./ -- -- > fromDescList [(5,"a"), (3,"b")] == fromList [(3, "b"), (5, "a")]@@ -3633,7 +3604,7 @@ {-# INLINABLE fromDescList #-} #endif --- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- | \(O(n)\). Build a map from an ascending list in linear time with a combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]@@ -3647,7 +3618,7 @@ {-# INLINABLE fromAscListWith #-} #endif --- | /O(n)/. Build a map from a descending list in linear time with a combining function for equal keys.+-- | \(O(n)\). Build a map from a descending list in linear time with a combining function for equal keys. -- /The precondition (input list is descending) is not checked./ -- -- > fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "ba")]@@ -3663,7 +3634,7 @@ {-# INLINABLE fromDescListWith #-} #endif --- | /O(n)/. Build a map from an ascending list in linear time with a+-- | \(O(n)\). Build a map from an ascending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ --@@ -3691,7 +3662,7 @@ {-# INLINABLE fromAscListWithKey #-} #endif --- | /O(n)/. Build a map from a descending list in linear time with a+-- | \(O(n)\). Build a map from a descending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is descending) is not checked./ --@@ -3719,7 +3690,7 @@ #endif --- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.+-- | \(O(n)\). Build a map from an ascending list of distinct elements in linear time. -- /The precondition is not checked./ -- -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]@@ -3745,7 +3716,7 @@ (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of (r :*: zs) -> (link ky y l r :*: zs) --- | /O(n)/. Build a map from a descending list of distinct elements in linear time.+-- | \(O(n)\). Build a map from a descending list of distinct elements in linear time. -- /The precondition is not checked./ -- -- > fromDistinctDescList [(5,"a"), (3,"b")] == fromList [(3, "b"), (5, "a")]@@ -3808,7 +3779,7 @@ {-------------------------------------------------------------------- Split --------------------------------------------------------------------}--- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where+-- | \(O(\log n)\). The expression (@'split' k map@) is a pair @(map1,map2)@ where -- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@. -- Any key equal to @k@ is found in neither @map1@ nor @map2@. --@@ -3832,7 +3803,7 @@ {-# INLINABLE split #-} #endif --- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just+-- | \(O(\log n)\). The expression (@'splitLookup' k map@) splits a map just -- like 'split' but also returns @'lookup' k map@. -- -- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])@@ -3977,7 +3948,7 @@ MaxView km xm r' -> MaxView km xm (balanceL k x l r') {-# NOINLINE maxViewSure #-} --- | /O(log n)/. Delete and find the minimal element.+-- | \(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 empty Error: can not return the minimal element of an empty map@@ -3987,7 +3958,7 @@ Nothing -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip) Just res -> res --- | /O(log n)/. Delete and find the maximal element.+-- | \(O(\log n)\). Delete and find the maximal element. -- -- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")]) -- > deleteFindMax empty Error: can not return the maximal element of an empty map@@ -4177,7 +4148,6 @@ instance (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toAscList m1) (toAscList m2) -#if MIN_VERSION_base(4,9,0) {-------------------------------------------------------------------- Lifted instances --------------------------------------------------------------------}@@ -4219,7 +4189,6 @@ where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl-#endif {-------------------------------------------------------------------- Functor@@ -4256,7 +4225,6 @@ {-# INLINE foldl' #-} foldr' = foldr' {-# INLINE foldr' #-}-#if MIN_VERSION_base(4,8,0) length = size {-# INLINE length #-} null = null@@ -4285,7 +4253,6 @@ {-# INLINABLE sum #-} product = foldl' (*) 1 {-# INLINABLE product #-}-#endif #if MIN_VERSION_base(4,10,0) -- | @since 0.6.3.1@@ -4340,16 +4307,10 @@ showString "fromList " . shows (toList m) {--------------------------------------------------------------------- Typeable---------------------------------------------------------------------}--INSTANCE_TYPEABLE2(Map)--{-------------------------------------------------------------------- Utilities --------------------------------------------------------------------} --- | /O(1)/. Decompose a map into pieces based on the structure of the underlying+-- | \(O(1)\). Decompose a map into pieces based on the structure of the underlying -- tree. This function is useful for consuming a map in parallel. -- -- No guarantee is made as to the sizes of the pieces; an internal, but
src/Data/Strict/Map/Autogen/Internal/Debug.hs view
@@ -6,7 +6,7 @@ import Data.Strict.Map.Autogen.Internal (Map (..), size, delta) import Control.Monad (guard) --- | /O(n)/. Show the tree that implements the map. The tree is shown+-- | \(O(n)\). Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. See 'showTreeWith'. showTree :: (Show k,Show a) => Map k a -> String showTree m@@ -15,7 +15,7 @@ showElem k x = show k ++ ":=" ++ show x -{- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows+{- | \(O(n)\). The expression (@'showTreeWith' showelem hang wide map@) shows the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If @wide@ is 'True', an extra wide version is shown.@@ -103,7 +103,7 @@ {-------------------------------------------------------------------- Assertions --------------------------------------------------------------------}--- | /O(n)/. Test if the internal map structure is valid.+-- | \(O(n)\). Test if the internal map structure is valid. -- -- > valid (fromAscList [(3,"b"), (5,"a")]) == True -- > valid (fromAscList [(5,"a"), (3,"b")]) == False
src/Data/Strict/Map/Autogen/Merge/Strict.hs view
@@ -1,19 +1,6 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-#if __GLASGOW_HASKELL__-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}-#endif-#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-}-#endif-#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE TypeFamilies #-}-#define USE_MAGIC_PROXY 1-#endif--#if USE_MAGIC_PROXY-{-# LANGUAGE MagicHash #-} #endif #include "containers.h"
src/Data/Strict/Map/Autogen/Strict.hs view
@@ -55,7 +55,7 @@ -- -- == Detailed performance information ----- The amortized running time is given for each operation, with /n/ referring to+-- The amortized running time is given for each operation, with \(n\) referring to -- the number of entries in the map. -- -- Benchmarks comparing "Data.Strict.Map.Autogen.Strict" with other dictionary implementations@@ -108,6 +108,7 @@ , empty , singleton , fromSet+ , fromArgSet -- ** From Unordered Lists , fromList@@ -223,6 +224,7 @@ , keys , assocs , keysSet+ , argSet -- ** Lists , toList
src/Data/Strict/Map/Autogen/Strict/Internal.hs view
@@ -226,7 +226,9 @@ , keys , assocs , keysSet+ , argSet , fromSet+ , fromArgSet -- ** Lists , toList@@ -299,7 +301,7 @@ , maxViewWithKey -- * Debugging-#if defined(__GLASGOW_HASKELL__)+#ifdef __GLASGOW_HASKELL__ , showTree , showTreeWith #endif@@ -327,11 +329,10 @@ , (!) , (!?) , (\\)+ , argSet , assocs , atKeyImpl-#if MIN_VERSION_base(4,8,0) , atKeyPlain-#endif , balance , balanceL , balanceR@@ -415,26 +416,21 @@ import Data.Strict.Map.Autogen.Internal.Debug (valid) import Control.Applicative (Const (..), liftA3)-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative (..), (<$>))-#endif+import Data.Semigroup (Arg (..)) import qualified Data.Set.Internal as Set import qualified Data.Strict.Map.Autogen.Internal as L import Data.Strict.ContainersUtils.Autogen.StrictPair import Data.Bits (shiftL, shiftR)-#if __GLASGOW_HASKELL__ >= 709+#ifdef __GLASGOW_HASKELL__ import Data.Coerce #endif -#if __GLASGOW_HASKELL__ && MIN_VERSION_base(4,8,0)+#ifdef __GLASGOW_HASKELL__ import Data.Functor.Identity (Identity (..)) #endif import qualified Data.Foldable as Foldable-#if !MIN_VERSION_base(4,8,0)-import Data.Foldable (Foldable())-#endif -- $strictness --@@ -469,7 +465,7 @@ Query --------------------------------------------------------------------} --- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- | \(O(\log n)\). The expression @('findWithDefault' def k map)@ returns -- the value at key @k@ or returns default value @def@ -- when the key is not in the map. --@@ -495,7 +491,7 @@ Construction --------------------------------------------------------------------} --- | /O(1)/. A map with a single element.+-- | \(O(1)\). A map with a single element. -- -- > singleton 1 'a' == fromList [(1, 'a')] -- > size (singleton 1 'a') == 1@@ -507,7 +503,7 @@ {-------------------------------------------------------------------- Insertion --------------------------------------------------------------------}--- | /O(log n)/. Insert a new key and value in the map.+-- | \(O(\log n)\). Insert a new key and value in the map. -- If the key is already present in the map, the associated value is -- replaced with the supplied value. 'insert' is equivalent to -- @'insertWith' 'const'@.@@ -533,7 +529,7 @@ {-# INLINE insert #-} #endif --- | /O(log n)/. Insert with a function, combining new value and old value.+-- | \(O(\log n)\). Insert with a function, combining new value and old value. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -575,7 +571,7 @@ {-# INLINE insertWithR #-} #endif --- | /O(log n)/. Insert with a function, combining key, new value and old value.+-- | \(O(\log n)\). Insert with a function, combining key, new value and old value. -- @'insertWithKey' f key value mp@ -- will insert the pair (key, value) into @mp@ if key does -- not exist in the map. If the key does exist, the function will@@ -626,7 +622,7 @@ {-# INLINE insertWithKeyR #-} #endif --- | /O(log n)/. Combines insert operation with old value retrieval.+-- | \(O(\log n)\). Combines insert operation with old value retrieval. -- The expression (@'insertLookupWithKey' f k x map@) -- is a pair where the first element is equal to (@'lookup' k map@) -- and the second element equal to (@'insertWithKey' f k x map@).@@ -667,7 +663,7 @@ Deletion --------------------------------------------------------------------} --- | /O(log n)/. Update a value at a specific key with the result of the provided function.+-- | \(O(\log n)\). Update a value at a specific key with the result of the provided function. -- When the key is not -- a member of the map, the original map is returned. --@@ -683,7 +679,7 @@ {-# INLINE adjust #-} #endif --- | /O(log n)/. Adjust a value at a specific key. When the key is not+-- | \(O(\log n)\). Adjust a value at a specific key. When the key is not -- a member of the map, the original map is returned. -- -- > let f key x = (show key) ++ ":new " ++ x@@ -708,7 +704,7 @@ {-# INLINE adjustWithKey #-} #endif --- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@+-- | \(O(\log n)\). The expression (@'update' f k map@) updates the value @x@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --@@ -725,7 +721,7 @@ {-# INLINE update #-} #endif --- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the+-- | \(O(\log n)\). The expression (@'updateWithKey' f k map@) updates the -- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', -- the element is deleted. If it is (@'Just' y@), the key @k@ is bound -- to the new value @y@.@@ -754,7 +750,7 @@ {-# INLINE updateWithKey #-} #endif --- | /O(log n)/. Lookup and update. See also 'updateWithKey'.+-- | \(O(\log n)\). Lookup and update. See also 'updateWithKey'. -- The function returns changed value, if it is updated. -- Returns the original key value if the map entry is deleted. --@@ -784,7 +780,7 @@ {-# INLINE updateLookupWithKey #-} #endif --- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.+-- | \(O(\log n)\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'Map'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. --@@ -795,6 +791,8 @@ -- > let f _ = Just "c" -- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")] -- > alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]+--+-- Note that @'adjust' = alter . fmap@. -- See Map.Internal.Note: Type of local 'go' function alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a@@ -817,7 +815,7 @@ {-# INLINE alter #-} #endif --- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ at @k@, or absence thereof.+-- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at @k@, or absence thereof. -- 'alterF' can be used to inspect, insert, delete, or update a value in a 'Map'. -- In short: @'lookup' k \<$\> 'alterF' f k m = f ('lookup' k m)@. --@@ -870,11 +868,6 @@ -- `Control.Applicative.Const` and just doing a lookup. {-# RULES "alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)) . alterF f k = \m -> Const . getConst . f $ lookup k m- #-}-#if MIN_VERSION_base(4,8,0)--- base 4.8 and above include Data.Functor.Identity, so we can--- save a pretty decent amount of time by handling it specially.-{-# RULES "alterF/Identity" forall k f . alterF f k = atKeyIdentity k f #-} @@ -882,13 +875,12 @@ atKeyIdentity k f t = Identity $ atKeyPlain Strict k (coerce f) t {-# INLINABLE atKeyIdentity #-} #endif-#endif {-------------------------------------------------------------------- Indexing --------------------------------------------------------------------} --- | /O(log n)/. Update the element at /index/. Calls 'error' when an+-- | \(O(\log n)\). Update the element at /index/. Calls 'error' when an -- invalid index is used. -- -- > updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "x"), (5, "a")]@@ -917,7 +909,7 @@ Minimal, Maximal --------------------------------------------------------------------} --- | /O(log n)/. Update the value at the minimal key.+-- | \(O(\log n)\). Update the value at the minimal key. -- -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")] -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -926,7 +918,7 @@ updateMin f m = updateMinWithKey (\_ x -> f x) m --- | /O(log n)/. Update the value at the maximal key.+-- | \(O(\log n)\). Update the value at the maximal key. -- -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")] -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -936,7 +928,7 @@ = updateMaxWithKey (\_ x -> f x) m --- | /O(log n)/. Update the value at the minimal key.+-- | \(O(\log n)\). Update the value at the minimal key. -- -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")] -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"@@ -948,7 +940,7 @@ Just x' -> x' `seq` Bin sx kx x' Tip r updateMinWithKey f (Bin _ kx x l r) = balanceR kx x (updateMinWithKey f l) r --- | /O(log n)/. Update the value at the maximal key.+-- | \(O(\log n)\). Update the value at the maximal key. -- -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")] -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"@@ -980,7 +972,7 @@ {-------------------------------------------------------------------- Union with a combining function --------------------------------------------------------------------}--- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")] @@ -996,7 +988,7 @@ {-# INLINABLE unionWith #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). -- Union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value@@ -1018,7 +1010,7 @@ Difference --------------------------------------------------------------------} --- | /O(n+m)/. Difference with a combining function.+-- | \(O(n+m)\). Difference with a combining function. -- When two equal keys are -- encountered, the combining function is applied to the values of these keys. -- If it returns 'Nothing', the element is discarded (proper set difference). If@@ -1034,7 +1026,7 @@ {-# INLINABLE differenceWith #-} #endif --- | /O(n+m)/. Difference with a combining function. When two equal keys are+-- | \(O(n+m)\). Difference with a combining function. When two equal keys are -- encountered, the combining function is applied to the key and both values. -- If it returns 'Nothing', the element is discarded (proper set difference). If -- it returns (@'Just' y@), the element is updated with a new value @y@.@@ -1054,7 +1046,7 @@ Intersection --------------------------------------------------------------------} --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -1072,7 +1064,7 @@ {-# INLINABLE intersectionWith #-} #endif --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -1210,7 +1202,7 @@ MergeWithKey --------------------------------------------------------------------} --- | /O(n+m)/. An unsafe universal combining function.+-- | \(O(n+m)\). An unsafe universal combining function. -- -- WARNING: This function can produce corrupt maps and its results -- may depend on the internal structures of its inputs. Users should@@ -1272,7 +1264,7 @@ Filter and partition --------------------------------------------------------------------} --- | /O(n)/. Map values and collect the 'Just' results.+-- | \(O(n)\). Map values and collect the 'Just' results. -- -- > let f x = if x == "a" then Just "new a" else Nothing -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"@@ -1280,7 +1272,7 @@ mapMaybe :: (a -> Maybe b) -> Map k a -> Map k b mapMaybe f = mapMaybeWithKey (\_ x -> f x) --- | /O(n)/. Map keys\/values and collect the 'Just' results.+-- | \(O(n)\). Map keys\/values and collect the 'Just' results. -- -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"@@ -1291,7 +1283,7 @@ Just y -> y `seq` link kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r) Nothing -> link2 (mapMaybeWithKey f l) (mapMaybeWithKey f r) --- | /O(n)/. Traverse keys\/values and collect the 'Just' results.+-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results. -- -- @since 0.5.8 @@ -1307,7 +1299,7 @@ Nothing -> link2 l' r' Just !x' -> link kx x' l' r' --- | /O(n)/. Map values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results. -- -- > let f a = if a < "c" then Left a else Right a -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -1320,7 +1312,7 @@ mapEither f m = mapEitherWithKey (\_ x -> f x) m --- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.+-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results. -- -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])@@ -1343,7 +1335,7 @@ {-------------------------------------------------------------------- Mapping --------------------------------------------------------------------}--- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")] @@ -1363,7 +1355,7 @@ #-} #endif --- | /O(n)/. Map a function over all values in the map.+-- | \(O(n)\). Map a function over all values in the map. -- -- > let f key x = (show key) ++ ":" ++ x -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]@@ -1392,7 +1384,7 @@ #-} #endif --- | /O(n)/.+-- | \(O(n)\). -- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (\v' -> v' \`seq\` (k,v')) <$> f k v) ('toList' m)@ -- That is, it behaves much like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value and the values are@@ -1408,7 +1400,7 @@ go (Bin s k v l r) = liftA3 (\ l' !v' r' -> Bin s k v' l' r') (go l) (f k v) (go r) {-# INLINE traverseWithKey #-} --- | /O(n)/. The function 'mapAccum' threads an accumulating+-- | \(O(n)\). The function 'mapAccum' threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a b = (a ++ b, b ++ "X")@@ -1418,7 +1410,7 @@ mapAccum f a m = mapAccumWithKey (\a' _ x' -> f a' x') a m --- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating+-- | \(O(n)\). The function 'mapAccumWithKey' threads an accumulating -- argument through the map in ascending order of keys. -- -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")@@ -1428,7 +1420,7 @@ mapAccumWithKey f a t = mapAccumL f a t --- | /O(n)/. The function 'mapAccumL' threads an accumulating+-- | \(O(n)\). The function 'mapAccumL' threads an accumulating -- argument through the map in ascending order of keys. mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumL _ a Tip = (a,Tip)@@ -1438,7 +1430,7 @@ (a3,r') = mapAccumL f a2 r in x' `seq` (a3,Bin sx kx x' l' r') --- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating+-- | \(O(n)\). The function 'mapAccumRWithKey' threads an accumulating -- argument through the map in descending order of keys. mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c) mapAccumRWithKey _ a Tip = (a,Tip)@@ -1448,7 +1440,7 @@ (a3,l') = mapAccumRWithKey f a2 l in x' `seq` (a3,Bin sx kx x' l' r') --- | /O(n*log n)/.+-- | \(O(n \log n)\). -- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. -- -- The size of the result may be smaller if @f@ maps two or more distinct@@ -1469,7 +1461,7 @@ Conversions --------------------------------------------------------------------} --- | /O(n)/. Build a map from a set of keys and a function which for each key+-- | \(O(n)\). Build a map from a set of keys and a function which for each key -- computes its value. -- -- > fromSet (\k -> replicate k 'a') (Data.Set.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]@@ -1479,10 +1471,19 @@ fromSet _ Set.Tip = Tip fromSet f (Set.Bin sz x l r) = case f x of v -> v `seq` Bin sz x v (fromSet f l) (fromSet f r) +-- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.+--+-- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")]+-- > fromArgSet Data.Set.empty == empty++fromArgSet :: Set.Set (Arg k a) -> Map k a+fromArgSet Set.Tip = Tip+fromArgSet (Set.Bin sz (Arg x v) l r) = v `seq` Bin sz x v (fromArgSet l) (fromArgSet r)+ {-------------------------------------------------------------------- Lists --------------------------------------------------------------------}--- | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.+-- | \(O(n \log n)\). Build a map from a list of key\/value pairs. See also 'fromAscList'. -- If the list contains more than one value for the same key, the last value -- for the key is retained. --@@ -1534,7 +1535,7 @@ {-# INLINABLE fromList #-} #endif --- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. -- -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")] -- > fromListWith (++) [] == empty@@ -1546,7 +1547,7 @@ {-# INLINABLE fromListWith #-} #endif --- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.+-- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. -- -- > let f k a1 a2 = (show k) ++ a1 ++ a2 -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]@@ -1573,7 +1574,7 @@ fromDescListWith f xs == fromListWith f xs --------------------------------------------------------------------} --- | /O(n)/. Build a map from an ascending list in linear time.+-- | \(O(n)\). Build a map from an ascending list in linear time. -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]@@ -1587,7 +1588,7 @@ {-# INLINABLE fromAscList #-} #endif --- | /O(n)/. Build a map from a descending list in linear time.+-- | \(O(n)\). Build a map from a descending list in linear time. -- /The precondition (input list is descending) is not checked./ -- -- > fromDescList [(5,"a"), (3,"b")] == fromList [(3, "b"), (5, "a")]@@ -1601,7 +1602,7 @@ {-# INLINABLE fromDescList #-} #endif --- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.+-- | \(O(n)\). Build a map from an ascending list in linear time with a combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]@@ -1615,7 +1616,7 @@ {-# INLINABLE fromAscListWith #-} #endif --- | /O(n)/. Build a map from a descending list in linear time with a combining function for equal keys.+-- | \(O(n)\). Build a map from a descending list in linear time with a combining function for equal keys. -- /The precondition (input list is descending) is not checked./ -- -- > fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "ba")]@@ -1629,7 +1630,7 @@ {-# INLINABLE fromDescListWith #-} #endif --- | /O(n)/. Build a map from an ascending list in linear time with a+-- | \(O(n)\). Build a map from an ascending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is ascending) is not checked./ --@@ -1657,7 +1658,7 @@ {-# INLINABLE fromAscListWithKey #-} #endif --- | /O(n)/. Build a map from a descending list in linear time with a+-- | \(O(n)\). Build a map from a descending list in linear time with a -- combining function for equal keys. -- /The precondition (input list is descending) is not checked./ --@@ -1685,7 +1686,7 @@ {-# INLINABLE fromDescListWithKey #-} #endif --- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.+-- | \(O(n)\). Build a map from an ascending list of distinct elements in linear time. -- /The precondition is not checked./ -- -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]@@ -1712,7 +1713,7 @@ (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of (r :*: zs) -> y `seq` (link ky y l r :*: zs) --- | /O(n)/. Build a map from a descending list of distinct elements in linear time.+-- | \(O(n)\). Build a map from a descending list of distinct elements in linear time. -- /The precondition is not checked./ -- -- > fromDistinctDescList [(5,"a"), (3,"b")] == fromList [(3, "b"), (5, "a")]
src/Data/Strict/Sequence.hs view
@@ -10,6 +10,33 @@ The documentation in the auto-generated modules have not been updated in a particularly sophisticated way, so may sound weird or contradictory. In those cases, please re-interpret such weird wording in the context of the above.++== Detailed note on laziness++'Seq' uses internal laziness for performance; and our data structure preserves+this laziness and performance in a way that retains the strictness of values.+For technical details, see the source code of our patch. As a user of the data+structure, what you need to know is that:++* Strictness is guaranteed when constructing containers - values added to a+ container are evaluated /before/ the new, larger, container itself is+ evaluated.++* Laziness and performance applies when splitting or combining existing+ containers, whose values have already been evaluated as per the previous+ point.++== Bugs++One known bug, is that whole-container transforms (such as @fmap@) are not+entirely strict, since they make use of the lazy behaviour above to avoid doing+work that is unnecessary (in the lazy case) to a large part of the data+structure. This is possible to fix, by re-implementing all such transforms so+that they force the lazy parts as well; we just haven't gotten around to it+yet. (This would revert the performance back to @O(n)@, but this is unavoidable+since all such transforms on strict data structures must inherently evaluate+every single element.)+ -} module Data.Strict.Sequence ( module Data.Strict.Sequence.Autogen
src/Data/Strict/Sequence/Autogen.hs view
@@ -78,7 +78,7 @@ -- -- == Detailed performance information ----- An amortized running time is given for each operation, with /n/ referring+-- An amortized running time is given for each operation, with \(n\) referring -- to the length of the sequence and /i/ being the integral index used by -- some operations. These bounds hold even in a persistent (shared) setting. --@@ -296,7 +296,7 @@ shift2Right :: Seq a -> Seq a -> (Seq a, Seq a) shift2Right Empty ys = (Empty, ys) shift2Right (Empty :|> x) ys = (Empty, x :<| ys)-shift2Right (xs :|> x1 :|> x2) = (xs, x1 :<| x2 :<| ys)+shift2Right (xs :|> x1 :|> x2) ys = (xs, x1 :<| x2 :<| ys) @ @
src/Data/Strict/Sequence/Autogen/Internal.hs view
@@ -4,11 +4,14 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} #endif #ifdef DEFINE_PATTERN_SYNONYMS {-# LANGUAGE PatternSynonyms #-}@@ -17,6 +20,7 @@ {-# LANGUAGE PatternGuards #-} {-# OPTIONS_HADDOCK not-home #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- -- |@@ -192,13 +196,10 @@ #if MIN_VERSION_base(4,11,0) (<>), #endif-#if MIN_VERSION_base(4,8,0) Applicative, (<$>), foldMap, Monoid,-#endif null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1, scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3, unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)-import qualified Data.List import Control.Applicative (Applicative(..), (<$>), (<**>), Alternative, liftA2, liftA3) import qualified Control.Applicative as Applicative@@ -208,13 +209,11 @@ import Data.Functor (Functor(..)) import Data.Strict.ContainersUtils.Autogen.State (State(..), execState) import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)+import qualified Data.Foldable as F -#if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as Semigroup import Data.Functor.Classes-#endif import Data.Traversable-import Data.Typeable -- GHC specific stuff #ifdef __GLASGOW_HASKELL__@@ -223,8 +222,7 @@ readPrec, readListPrec, readListPrecDefault) import Data.Data import Data.String (IsString(..))-#endif-#if __GLASGOW_HASKELL__+import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics (Generic, Generic1) #endif @@ -236,22 +234,11 @@ #endif import Data.Strict.ContainersUtils.Autogen.Coercions ((.#), (.^#))--- Coercion on GHC 7.8+-#if __GLASGOW_HASKELL__ >= 708 import Data.Coerce import qualified GHC.Exts-#else-#endif --- Identity functor on base 4.8 (GHC 7.10+)-#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity (Identity(..))-#endif -#if !MIN_VERSION_base(4,8,0)-import Data.Word (Word)-#endif- import Data.Strict.ContainersUtils.Autogen.StrictPair (StrictPair (..), toPair) import Control.Monad.Zip (MonadZip (..)) import Control.Monad.Fix (MonadFix (..), fix)@@ -350,6 +337,41 @@ -- | General-purpose finite sequences. newtype Seq a = Seq (FingerTree (Elem a)) +#ifdef __GLASGOW_HASKELL__+-- | @since FIXME+instance TH.Lift a => TH.Lift (Seq a) where+# if MIN_VERSION_template_haskell(2,16,0)+ liftTyped t = [|| coerceFT z ||]+# else+ lift t = [| coerceFT z |]+# endif+ where+ -- We rebalance the sequence to use only 3-nodes before lifting its+ -- underlying finger tree. This should minimize the size and depth of the+ -- tree generated at run-time. It also reduces the size of the splice,+ -- but I don't know how that affects the size of the resulting Core once+ -- all the types are added.+ Seq ft = zipWith (flip const) (replicate (length t) ()) t++ -- We remove the 'Elem' constructors to reduce the size of the splice+ -- and the number of types and coercions in the generated Core. Instead+ -- of, say,+ --+ -- Seq (Deep 3 (Two (Elem 1) (Elem 2)) EmptyT (One (Elem 3)))+ --+ -- we generate+ --+ -- coerceFT (Deep 3 (Two 1 2)) EmptyT (One 3)+ z :: FingerTree a+ z = coerce ft++-- | We use this to help the types work out for splices in the+-- Lift instance. Things get a bit yucky otherwise.+coerceFT :: FingerTree a -> Seq a+coerceFT = coerce++#endif+ instance Functor Seq where fmap = fmapSeq #ifdef __GLASGOW_HASKELL__@@ -362,11 +384,6 @@ {-# NOINLINE [1] fmapSeq #-} {-# RULES "fmapSeq/fmapSeq" forall f g xs . fmapSeq f (fmapSeq g xs) = fmapSeq (f . g) xs- #-}-#endif-#if __GLASGOW_HASKELL__ >= 709--- Safe coercions were introduced in 7.8, but did not work well with RULES yet.-{-# RULES "fmapSeq/coerce" fmapSeq coerce = coerce #-} #endif@@ -399,12 +416,10 @@ foldl1 f (Seq xs) = getElem (foldl1 f' xs) where f' (Elem x) (Elem y) = Elem (f x y) -#if MIN_VERSION_base(4,8,0) length = length {-# INLINE length #-} null = null {-# INLINE null #-}-#endif instance Traversable Seq where #if __GLASGOW_HASKELL__@@ -456,7 +471,7 @@ (\a' b' c' d' -> Four (Elem a') (Elem b') (Elem c') (Elem d')) (f a) (f b)- (f c) <*> + (f c) <*> (f d) traverseDigitN :: Applicative f@@ -520,7 +535,7 @@ EmptyR -> fmap firstf xs Seq fs''FT :> lastf -> case rigidify xsFT of RigidEmpty -> empty- RigidOne (Elem x) -> fmap ($x) fs+ RigidOne (Elem x) -> fmap ($ x) fs RigidTwo (Elem x1) (Elem x2) -> Seq $ ap2FT firstf fs''FT lastf (x1, x2) RigidThree (Elem x1) (Elem x2) (Elem x3) ->@@ -592,7 +607,7 @@ (fmap (fmap (f lastx)) (nodeToDigit sf)) where lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ lift_elem = coerce #else lift_elem f x (Elem y) = Elem (f x y)@@ -774,8 +789,8 @@ squashR (Two12 n1 n2) m = node3 n1 n2 m --- | /O(m*n)/ (incremental) Takes an /O(m)/ function and a finger tree of size--- /n/ and maps the function over the tree leaves. Unlike the usual 'fmap', the+-- | \(O(mn)\) (incremental) Takes an \(O(m)\) function and a finger tree of size+-- \(n\) and maps the function over the tree leaves. Unlike the usual 'fmap', the -- function is applied to the "leaves" of the 'FingerTree' (i.e., given a -- @FingerTree (Elem a)@, it applies the function to elements of type @Elem -- a@), replacing the leaves with subtrees of at least the same height, e.g.,@@ -790,7 +805,7 @@ mapMulNode mul f (Node2 s a b) = Node2 (mul * s) (f a) (f b) mapMulNode mul f (Node3 s a b c) = Node3 (mul * s) (f a) (f b) (f c) --- | /O(log n)/ (incremental) Takes the extra flexibility out of a 'FingerTree'+-- | \(O(\log n)\) (incremental) Takes the extra flexibility out of a 'FingerTree' -- to make it a genuine 2-3 finger tree. The result of 'rigidify' will have -- only two and three digits at the top level and only one and two -- digits elsewhere. If the tree has fewer than four elements, 'rigidify'@@ -820,7 +835,7 @@ Three b c d -> RigidFull $ Rigid s (node2 a b) EmptyTh (node2 c d) Four b c d e -> RigidFull $ Rigid s (node3 a b c) EmptyTh (node2 d e) --- | /O(log n)/ (incremental) Takes a tree whose left side has been rigidified+-- | \(O(\log n)\) (incremental) Takes a tree whose left side has been rigidified -- and finishes the job. rigidifyRight :: Int -> Digit23 (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> Rigidified (Elem a) @@ -837,7 +852,7 @@ Node2 _ a b -> RigidThree a b e Node3 _ a b c -> RigidFull $ Rigid s (node2 a b) EmptyTh (node2 c e) --- | /O(log n)/ (incremental) Rejigger a finger tree so the digits are all ones+-- | \(O(\log n)\) (incremental) Rejigger a finger tree so the digits are all ones -- and twos. thin :: Sized a => FingerTree a -> Thin a -- Note that 'thin12' will produce a 'DeepTh' constructor immediately before@@ -905,7 +920,6 @@ showString "fromList " . shows (toList xs) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Show1 Seq where liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $@@ -918,7 +932,6 @@ -- | @since 0.5.9 instance Ord1 Seq where liftCompare cmp xs ys = liftCompare cmp (toList xs) (toList ys)-#endif instance Read a => Read (Seq a) where #ifdef __GLASGOW_HASKELL__@@ -935,32 +948,22 @@ return (fromList xs,t) #endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.9 instance Read1 Seq where liftReadsPrec _rp readLst p = readParen (p > 10) $ \r -> do ("fromList",s) <- lex r (xs,t) <- readLst s pure (fromList xs, t)-#endif instance Monoid (Seq a) where mempty = empty-#if MIN_VERSION_base(4,9,0) mappend = (Semigroup.<>)-#else- mappend = (><)-#endif -#if MIN_VERSION_base(4,9,0) -- | @since 0.5.7 instance Semigroup.Semigroup (Seq a) where (<>) = (><) stimes = cycleNTimes . fromIntegral-#endif -INSTANCE_TYPEABLE1(Seq)- #if __GLASGOW_HASKELL__ instance Data a => Data (Seq a) where gfoldl f z s = case viewl s of@@ -1004,6 +1007,8 @@ -- | @since 0.6.1 deriving instance Generic (FingerTree a)++deriving instance TH.Lift a => TH.Lift (FingerTree a) #endif instance Sized a => Sized (FingerTree a) where@@ -1016,7 +1021,7 @@ instance Foldable FingerTree where foldMap _ EmptyT = mempty foldMap f' (Single x') = f' x'- foldMap f' (Deep _ pr' m' sf') = + foldMap f' (Deep _ pr' m' sf') = foldMapDigit f' pr' <> foldMapTree (foldMapNode f') m' <> foldMapDigit f' sf'@@ -1024,7 +1029,7 @@ foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m foldMapTree _ EmptyT = mempty foldMapTree f (Single x) = f x- foldMapTree f (Deep _ pr m sf) = + foldMapTree f (Deep _ pr m sf) = foldMapDigitN f pr <> foldMapTree (foldMapNodeN f) m <> foldMapDigitN f sf@@ -1195,6 +1200,8 @@ -- | @since 0.6.1 deriving instance Generic (Digit a)++deriving instance TH.Lift a => TH.Lift (Digit a) #endif foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b@@ -1296,6 +1303,8 @@ -- | @since 0.6.1 deriving instance Generic (Node a)++deriving instance TH.Lift a => TH.Lift (Node a) #endif foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b@@ -1371,7 +1380,7 @@ size _ = 1 instance Functor Elem where-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ -- This cuts the time for <*> by around a fifth. fmap = coerce #else@@ -1380,7 +1389,7 @@ instance Foldable Elem where foldr f z (Elem x) = f x z-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ foldMap = coerce foldl = coerce foldl' = coerce@@ -1399,17 +1408,7 @@ ------------------------------------------------------- -- Applicative construction --------------------------------------------------------#if !MIN_VERSION_base(4,8,0)-newtype Identity a = Identity {runIdentity :: a} -instance Functor Identity where- fmap f (Identity x) = Identity (f x)--instance Applicative Identity where- pure = Identity- Identity f <*> Identity x = Identity (f x)-#endif- -- | 'applicativeTree' takes an Applicative-wrapped construction of a -- piece of a FingerTree, assumed to always have the same size (which -- is put in the second argument), and replicates it as many times as@@ -1418,7 +1417,7 @@ {-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-} {-# SPECIALIZE applicativeTree :: Int -> Int -> Identity a -> Identity (FingerTree a) #-} -- Special note: the Identity specialization automatically does node sharing,--- reducing memory usage of the resulting tree to /O(log n)/.+-- reducing memory usage of the resulting tree to \(O(\log n)\). applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a) applicativeTree n !mSize m = case n of 0 -> pure EmptyT@@ -1709,17 +1708,10 @@ -- -- For @base >= 4.8.0@ and @containers >= 0.5.11@, 'replicateM' -- is a synonym for 'replicateA'.-#if MIN_VERSION_base(4,8,0) replicateM :: Applicative m => Int -> m a -> m (Seq a) replicateM = replicateA-#else-replicateM :: Monad m => Int -> m a -> m (Seq a)-replicateM n x- | n >= 0 = Applicative.unwrapMonad (replicateA n (Applicative.WrapMonad x))- | otherwise = error "replicateM takes a nonnegative integer argument"-#endif --- | /O(/log/ k)/. @'cycleTaking' k xs@ forms a sequence of length @k@ by+-- | \(O(\log k)\). @'cycleTaking' k xs@ forms a sequence of length @k@ by -- repeatedly concatenating @xs@ with itself. @xs@ may only be empty if -- @k@ is 0. --@@ -2178,9 +2170,10 @@ -- | @since 0.5.8 deriving instance Generic (ViewL a)-#endif -INSTANCE_TYPEABLE1(ViewL)+-- | @since FIXME+deriving instance TH.Lift a => TH.Lift (ViewL a)+#endif instance Functor ViewL where {-# INLINE fmap #-}@@ -2188,6 +2181,9 @@ fmap f (x :< xs) = f x :< fmap f xs instance Foldable ViewL where+ foldMap _ EmptyL = mempty+ foldMap f (x :< xs) = f x <> foldMap f xs+ foldr _ z EmptyL = z foldr f z (x :< xs) = f x (foldr f z xs) @@ -2197,13 +2193,11 @@ foldl1 _ EmptyL = error "foldl1: empty view" foldl1 f (x :< xs) = foldl f x xs -#if MIN_VERSION_base(4,8,0) null EmptyL = True null (_ :< _) = False length EmptyL = 0 length (_ :< xs) = 1 + length xs-#endif instance Traversable ViewL where traverse _ EmptyL = pure EmptyL@@ -2243,9 +2237,10 @@ -- | @since 0.5.8 deriving instance Generic (ViewR a)-#endif -INSTANCE_TYPEABLE1(ViewR)+-- | @since FIXME+deriving instance TH.Lift a => TH.Lift (ViewR a)+#endif instance Functor ViewR where {-# INLINE fmap #-}@@ -2264,13 +2259,12 @@ foldr1 _ EmptyR = error "foldr1: empty view" foldr1 f (xs :> x) = foldr f x xs-#if MIN_VERSION_base(4,8,0)+ null EmptyR = True null (_ :> _) = False length EmptyR = 0 length (xs :> _) = length xs + 1-#endif instance Traversable ViewR where traverse _ EmptyR = pure EmptyR@@ -2351,7 +2345,7 @@ -- See note on unsigned arithmetic in splitAt | fromIntegral i < (fromIntegral (size xs) :: Word) = case lookupTree i xs of Place _ (Elem x) -> x- | otherwise = + | otherwise = error $ "index out of bounds in call to: Data.Strict.Sequence.Autogen.index " ++ show i -- | \( O(\log(\min(i,n-i))) \). The element at the specified position,@@ -2528,7 +2522,7 @@ -- -- @since 0.5.8 adjust :: forall a . (a -> a) -> Int -> Seq a -> Seq a-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ adjust f i xs -- See note on unsigned arithmetic in splitAt | fromIntegral i < (fromIntegral (length xs) :: Word) =@@ -3136,7 +3130,7 @@ foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs' where lift_elem :: (Int -> a -> m) -> (Int -> Elem a -> m)-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ lift_elem g = coerce g #else lift_elem g = \s (Elem a) -> g s a@@ -3333,7 +3327,7 @@ {-# INLINE mb #-} lift_elem :: (Int -> a) -> (Int -> Elem a)-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ lift_elem g = coerce g #else lift_elem g = Elem . g@@ -3350,8 +3344,8 @@ #ifdef __GLASGOW_HASKELL__ fromArray a = fromFunction (GHC.Arr.numElements a) (GHC.Arr.unsafeAt a) where- -- The following definition uses (Ix i) constraing, which is needed for the- -- other fromArray definition.+ -- The following definition uses an (Ix i) constraint, which is needed for+ -- the other fromArray definition. _ = Data.Array.rangeSize (Data.Array.bounds a) #else fromArray a = fromList2 (Data.Array.rangeSize (Data.Array.bounds a)) (Data.Array.elems a)@@ -4368,7 +4362,7 @@ !n10 = Node3 (3*s) n1 n2 n3 map_elem :: [a] -> [Elem a]-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ map_elem xs = coerce xs #else map_elem xs = Data.List.map Elem xs@@ -4378,7 +4372,7 @@ -- essentially: Free ((,) a) b. data ListFinal a cont = LFinal !cont | LCons !a (ListFinal a cont) -#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ instance GHC.Exts.IsList (Seq a) where type Item (Seq a) = a fromList = fromList@@ -4409,7 +4403,7 @@ fmapReverse f (Seq xs) = Seq (fmapReverseTree (lift_elem f) xs) where lift_elem :: (a -> b) -> (Elem a -> Elem b)-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ lift_elem = coerce #else lift_elem g (Elem a) = Elem (g a)@@ -4737,7 +4731,7 @@ -- This instance is only used at the very top of the tree; -- the rest of the elements are handled by unzipWithNodeElem instance UnzipWith Elem where-#if __GLASGOW_HASKELL__ >= 708+#ifdef __GLASGOW_HASKELL__ unzipWith' = coerce #else unzipWith' f (Elem a) = case f a of (x, y) -> (Elem x, Elem y)
src/Data/Strict/Vector/Autogen.hs view
@@ -1,18 +1,20 @@-{-# LANGUAGE CPP- , DeriveDataTypeable- , FlexibleInstances- , MultiParamTypeClasses- , TypeFamilies- , Rank2Types- , BangPatterns- #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.Strict.Vector.Autogen -- Copyright : (c) Roman Leshchinskiy 2008-2010+-- Alexey Kuleshevich 2020-2022+-- Aleksey Khudyakov 2020-2022+-- Andrew Lelechenko 2020-2022 -- License : BSD-style ----- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Maintainer : Haskell Libraries Team <libraries@haskell.org> -- Stability : experimental -- Portability : non-portable --@@ -23,11 +25,10 @@ -- -- * immutable ----- and support a rich interface of both list-like operations, and bulk+-- They support a rich interface of both list-like operations and bulk -- array operations. ----- For unboxed arrays, use "Data.Strict.Vector.Autogen.Unboxed"---+-- For unboxed arrays, use "Data.Strict.Vector.Autogen.Unboxed". module Data.Strict.Vector.Autogen ( -- * Boxed vectors@@ -121,7 +122,7 @@ takeWhile, dropWhile, -- ** Partitioning- partition, unstablePartition, partitionWith, span, break,+ partition, unstablePartition, partitionWith, span, break, groupBy, group, -- ** Searching elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices,@@ -134,7 +135,8 @@ -- ** Specialised folds all, any, and, or, sum, product,- maximum, maximumBy, minimum, minimumBy,+ maximum, maximumBy, maximumOn,+ minimum, minimumBy, minimumOn, minIndex, minIndexBy, maxIndex, maxIndexBy, -- ** Monadic folds@@ -145,7 +147,7 @@ -- ** Monadic sequencing sequence, sequence_, - -- * Prefix sums (scans)+ -- * Scans prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1',@@ -164,7 +166,7 @@ toList, Data.Strict.Vector.Autogen.fromList, Data.Strict.Vector.Autogen.fromListN, -- ** Arrays- fromArray, toArray,+ toArray, fromArray, toArraySlice, unsafeFromArraySlice, -- ** Other vector types G.convert,@@ -200,19 +202,13 @@ zipWith, zipWith3, zip, zip3, unzip, unzip3, filter, takeWhile, dropWhile, span, break, elem, notElem,- foldl, foldl1, foldr, foldr1,-#if __GLASGOW_HASKELL__ >= 706- foldMap,-#endif+ foldl, foldl1, foldr, foldr1, foldMap, all, any, and, or, sum, product, minimum, maximum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, mapM, mapM_, sequence, sequence_ ) -#if MIN_VERSION_base(4,9,0) import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..))-#endif- import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault )@@ -222,17 +218,13 @@ import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid ( Monoid(..) )-#endif--#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..))-#endif -- | Boxed vectors, supporting efficient slicing.-data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(Array a)+data Vector a = Vector {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !(Array a) deriving ( Typeable ) liftRnfV :: (a -> ()) -> Vector a -> ()@@ -256,22 +248,17 @@ readPrec = G.readPrec readListPrec = readListPrecDefault -#if MIN_VERSION_base(4,9,0) instance Show1 Vector where liftShowsPrec = G.liftShowsPrec instance Read1 Vector where liftReadsPrec = G.liftReadsPrec-#endif -#if __GLASGOW_HASKELL__ >= 708- instance Exts.IsList (Vector a) where type Item (Vector a) = a fromList = Data.Strict.Vector.Autogen.fromList fromListN = Data.Strict.Vector.Autogen.fromListN toList = toList-#endif instance Data a => Data (Vector a) where gfoldl = G.gfoldl@@ -312,9 +299,6 @@ {-# INLINE (==) #-} xs == ys = Bundle.eq (G.stream xs) (G.stream ys) - {-# INLINE (/=) #-}- xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))- -- See http://trac.haskell.org/vector/ticket/12 instance Ord a => Ord (Vector a) where {-# INLINE compare #-}@@ -332,13 +316,11 @@ {-# INLINE (>=) #-} xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT -#if MIN_VERSION_base(4,9,0) instance Eq1 Vector where liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys) instance Ord1 Vector where liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys)-#endif instance Semigroup (Vector a) where {-# INLINE (<>) #-}@@ -352,7 +334,7 @@ mempty = empty {-# INLINE mappend #-}- mappend = (++)+ mappend = (<>) {-# INLINE mconcat #-} mconcat = concat@@ -361,10 +343,8 @@ {-# INLINE fmap #-} fmap = map -#if MIN_VERSION_base(4,8,0) {-# INLINE (<$) #-} (<$) = map . const-#endif instance Monad Vector where {-# INLINE return #-}@@ -400,7 +380,7 @@ {-# INLINE munzip #-} munzip = unzip --- | Instance has same semantics as one for lists+-- | This instance has the same semantics as the one for lists. -- -- @since 0.12.2.0 instance MonadFix Vector where@@ -451,15 +431,12 @@ {-# INLINE foldl1 #-} foldl1 = foldl1 -#if MIN_VERSION_base(4,6,0) {-# INLINE foldr' #-} foldr' = foldr' {-# INLINE foldl' #-} foldl' = foldl'-#endif -#if MIN_VERSION_base(4,8,0) {-# INLINE toList #-} toList = toList @@ -483,7 +460,6 @@ {-# INLINE product #-} product = product-#endif instance Traversable.Traversable Vector where {-# INLINE traverse #-}@@ -503,12 +479,12 @@ -- Length information -- ------------------ --- | /O(1)/ Yield the length of the vector+-- | /O(1)/ Yield the length of the vector. length :: Vector a -> Int {-# INLINE length #-} length = G.length --- | /O(1)/ Test whether a vector is empty+-- | /O(1)/ Test whether a vector is empty. null :: Vector a -> Bool {-# INLINE null #-} null = G.null@@ -516,37 +492,37 @@ -- Indexing -- -------- --- | O(1) Indexing+-- | O(1) Indexing. (!) :: Vector a -> Int -> a {-# INLINE (!) #-} (!) = (G.!) --- | O(1) Safe indexing+-- | O(1) Safe indexing. (!?) :: Vector a -> Int -> Maybe a {-# INLINE (!?) #-} (!?) = (G.!?) --- | /O(1)/ First element+-- | /O(1)/ First element. head :: Vector a -> a {-# INLINE head #-} head = G.head --- | /O(1)/ Last element+-- | /O(1)/ Last element. last :: Vector a -> a {-# INLINE last #-} last = G.last --- | /O(1)/ Unsafe indexing without bounds checking+-- | /O(1)/ Unsafe indexing without bounds checking. unsafeIndex :: Vector a -> Int -> a {-# INLINE unsafeIndex #-} unsafeIndex = G.unsafeIndex --- | /O(1)/ First element without checking if the vector is empty+-- | /O(1)/ First element, without checking if the vector is empty. unsafeHead :: Vector a -> a {-# INLINE unsafeHead #-} unsafeHead = G.unsafeHead --- | /O(1)/ Last element without checking if the vector is empty+-- | /O(1)/ Last element, without checking if the vector is empty. unsafeLast :: Vector a -> a {-# INLINE unsafeLast #-} unsafeLast = G.unsafeLast@@ -571,8 +547,7 @@ -- > write mv i x -- -- Here, no references to @v@ are retained because indexing (but /not/ the--- elements) is evaluated eagerly.---+-- element) is evaluated eagerly. indexM :: Monad m => Vector a -> Int -> m a {-# INLINE indexM #-} indexM = G.indexM@@ -589,19 +564,19 @@ {-# INLINE lastM #-} lastM = G.lastM --- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an+-- | /O(1)/ Indexing in a monad, without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: Monad m => Vector a -> Int -> m a {-# INLINE unsafeIndexM #-} unsafeIndexM = G.unsafeIndexM --- | /O(1)/ First element in a monad without checking for empty vectors.+-- | /O(1)/ First element in a monad, without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: Monad m => Vector a -> m a {-# INLINE unsafeHeadM #-} unsafeHeadM = G.unsafeHeadM --- | /O(1)/ Last element in a monad without checking for empty vectors.+-- | /O(1)/ Last element in a monad, without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: Monad m => Vector a -> m a {-# INLINE unsafeLastM #-}@@ -632,20 +607,20 @@ tail = G.tail -- | /O(1)/ Yield at the first @n@ elements without copying. The vector may--- contain less than @n@ elements in which case it is returned unchanged.+-- contain less than @n@ elements, in which case it is returned unchanged. take :: Int -> Vector a -> Vector a {-# INLINE take #-} take = G.take -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may--- contain less than @n@ elements in which case an empty vector is returned.+-- contain less than @n@ elements, in which case an empty vector is returned. drop :: Int -> Vector a -> Vector a {-# INLINE drop #-} drop = G.drop --- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying.+-- | /O(1)/ Yield the first @n@ elements paired with the remainder, without copying. ----- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@+-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@, -- but slightly more efficient. -- -- @since 0.7.1@@ -653,14 +628,16 @@ {-# INLINE splitAt #-} splitAt = G.splitAt --- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if empty.+-- | /O(1)/ Yield the 'head' and 'tail' of the vector, or 'Nothing' if+-- the vector is empty. -- -- @since 0.12.2.0 uncons :: Vector a -> Maybe (a, Vector a) {-# INLINE uncons #-} uncons = G.uncons --- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if empty.+-- | /O(1)/ Yield the 'last' and 'init' of the vector, or 'Nothing' if+-- the vector is empty. -- -- @since 0.12.2.0 unsnoc :: Vector a -> Maybe (Vector a, a)@@ -668,7 +645,7 @@ unsnoc = G.unsnoc -- | /O(1)/ Yield a slice of the vector without copying. The vector must--- contain at least @i+n@ elements but this is not checked.+-- contain at least @i+n@ elements, but this is not checked. unsafeSlice :: Int -- ^ @i@ starting index -> Int -- ^ @n@ length -> Vector a@@ -677,25 +654,25 @@ unsafeSlice = G.unsafeSlice -- | /O(1)/ Yield all but the last element without copying. The vector may not--- be empty but this is not checked.+-- be empty, but this is not checked. unsafeInit :: Vector a -> Vector a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit -- | /O(1)/ Yield all but the first element without copying. The vector may not--- be empty but this is not checked.+-- be empty, but this is not checked. unsafeTail :: Vector a -> Vector a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail -- | /O(1)/ Yield the first @n@ elements without copying. The vector must--- contain at least @n@ elements but this is not checked.+-- contain at least @n@ elements, but this is not checked. unsafeTake :: Int -> Vector a -> Vector a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector--- must contain at least @n@ elements but this is not checked.+-- must contain at least @n@ elements, but this is not checked. unsafeDrop :: Int -> Vector a -> Vector a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop@@ -703,29 +680,29 @@ -- Initialisation -- -------------- --- | /O(1)/ Empty vector+-- | /O(1)/ The empty vector. empty :: Vector a {-# INLINE empty #-} empty = G.empty --- | /O(1)/ Vector with exactly one element+-- | /O(1)/ A vector with exactly one element. singleton :: a -> Vector a {-# INLINE singleton #-} singleton = G.singleton --- | /O(n)/ Vector of the given length with the same value in each position+-- | /O(n)/ A vector of the given length with the same value in each position. replicate :: Int -> a -> Vector a {-# INLINE replicate #-} replicate = G.replicate -- | /O(n)/ Construct a vector of the given length by applying the function to--- each index+-- each index. generate :: Int -> (Int -> a) -> Vector a {-# INLINE generate #-} generate = G.generate --- | /O(n)/ Apply function \(\max(n - 1, 0)\) times to an initial value, producing a vector--- of length \(\max(n, 0)\). Zeroth element will contain the initial value, that's why there+-- | /O(n)/ Apply the function \(\max(n - 1, 0)\) times to an initial value, producing a vector+-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there -- is one less function application than the number of elements in the produced vector. -- -- \( \underbrace{x, f (x), f (f (x)), \ldots}_{\max(0,n)\rm{~elements}} \)@@ -805,7 +782,6 @@ -- generator function to the already constructed part of the vector. -- -- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in <a,b,c>--- constructN :: Int -> (Vector a -> a) -> Vector a {-# INLINE constructN #-} constructN = G.constructN@@ -815,7 +791,6 @@ -- of the vector. -- -- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in <c,b,a>--- constructrN :: Int -> (Vector a -> a) -> Vector a {-# INLINE constructrN #-} constructrN = G.constructrN@@ -823,7 +798,7 @@ -- Enumeration -- ----------- --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@+-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+1@ -- etc. This operation is usually more efficient than 'enumFromTo'. -- -- > enumFromN 5 3 = <5,6,7>@@ -831,17 +806,17 @@ {-# INLINE enumFromN #-} enumFromN = G.enumFromN --- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@,+-- | /O(n)/ Yield a vector of the given length, containing the values @x@, @x+y@, -- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. ----- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4>+-- > enumFromStepN 1 2 5 = <1,3,5,7,9> enumFromStepN :: Num a => a -> a -> Int -> Vector a {-# INLINE enumFromStepN #-} enumFromStepN = G.enumFromStepN -- | /O(n)/ Enumerate values from @x@ to @y@. ----- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- /WARNING:/ This operation can be very inefficient. If possible, use -- 'enumFromN' instead. enumFromTo :: Enum a => a -> a -> Vector a {-# INLINE enumFromTo #-}@@ -849,7 +824,7 @@ -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. ----- /WARNING:/ This operation can be very inefficient. If at all possible, use+-- /WARNING:/ This operation can be very inefficient. If possible, use -- 'enumFromStepN' instead. enumFromThenTo :: Enum a => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-}@@ -858,23 +833,23 @@ -- Concatenation -- ------------- --- | /O(n)/ Prepend an element+-- | /O(n)/ Prepend an element. cons :: a -> Vector a -> Vector a {-# INLINE cons #-} cons = G.cons --- | /O(n)/ Append an element+-- | /O(n)/ Append an element. snoc :: Vector a -> a -> Vector a {-# INLINE snoc #-} snoc = G.snoc infixr 5 ++--- | /O(m+n)/ Concatenate two vectors+-- | /O(m+n)/ Concatenate two vectors. (++) :: Vector a -> Vector a -> Vector a {-# INLINE (++) #-} (++) = (G.++) --- | /O(n)/ Concatenate all vectors in the list+-- | /O(n)/ Concatenate all vectors in the list. concat :: [Vector a] -> Vector a {-# INLINE concat #-} concat = G.concat@@ -889,16 +864,16 @@ replicateM = G.replicateM -- | /O(n)/ Construct a vector of the given length by applying the monadic--- action to each index+-- action to each index. generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) {-# INLINE generateM #-} generateM = G.generateM --- | /O(n)/ Apply monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector--- of length \(\max(n, 0)\). Zeroth element will contain the initial value, that's why there+-- | /O(n)/ Apply the monadic function \(\max(n - 1, 0)\) times to an initial value, producing a vector+-- of length \(\max(n, 0)\). The 0th element will contain the initial value, which is why there -- is one less function application than the number of elements in the produced vector. ----- For non-monadic version see `iterateN`+-- For a non-monadic version, see `iterateN`. -- -- @since 0.12.0.0 iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Vector a)@@ -925,7 +900,7 @@ -- Restricting memory usage -- ------------------------ --- | /O(n)/ Yield the argument but force it not to retain any extra memory,+-- | /O(n)/ Yield the argument, but force it not to retain any extra memory, -- possibly by copying it. -- -- This is especially useful when dealing with slices. For example:@@ -942,8 +917,8 @@ -- Bulk updates -- ------------ --- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector--- element at position @i@ by @a@.+-- | /O(m+n)/ For each pair @(i,a)@ from the list of index/value pairs,+-- replace the vector element at position @i@ by @a@. -- -- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> --@@ -983,17 +958,17 @@ {-# INLINE update_ #-} update_ = G.update_ --- | Same as ('//') but without bounds checking.+-- | Same as ('//'), but without bounds checking. unsafeUpd :: Vector a -> [(Int, a)] -> Vector a {-# INLINE unsafeUpd #-} unsafeUpd = G.unsafeUpd --- | Same as 'update' but without bounds checking.+-- | Same as 'update', but without bounds checking. unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a {-# INLINE unsafeUpdate #-} unsafeUpdate = G.unsafeUpdate --- | Same as 'update_' but without bounds checking.+-- | Same as 'update_', but without bounds checking. unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ = G.unsafeUpdate_@@ -1007,8 +982,8 @@ -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.accum (+) (V.fromList [1000.0,2000.0,3000.0]) [(2,4),(1,6),(0,3),(1,10)]--- [1003.0,2016.0,3004.0]+-- >>> V.accum (+) (V.fromList [1000,2000,3000]) [(2,4),(1,6),(0,3),(1,10)]+-- [1003,2016,3004] accum :: (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> [(Int,b)] -- ^ list of index/value pairs (of length @n@)@@ -1022,8 +997,8 @@ -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.accumulate (+) (V.fromList [1000.0,2000.0,3000.0]) (V.fromList [(2,4),(1,6),(0,3),(1,10)])--- [1003.0,2016.0,3004.0]+-- >>> V.accumulate (+) (V.fromList [1000,2000,3000]) (V.fromList [(2,4),(1,6),(0,3),(1,10)])+-- [1003,2016,3004] accumulate :: (a -> b -> a) -- ^ accumulating function @f@ -> Vector a -- ^ initial vector (of length @m@) -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@)@@ -1052,17 +1027,17 @@ {-# INLINE accumulate_ #-} accumulate_ = G.accumulate_ --- | Same as 'accum' but without bounds checking.+-- | Same as 'accum', but without bounds checking. unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE unsafeAccum #-} unsafeAccum = G.unsafeAccum --- | Same as 'accumulate' but without bounds checking.+-- | Same as 'accumulate', but without bounds checking. unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a {-# INLINE unsafeAccumulate #-} unsafeAccumulate = G.unsafeAccumulate --- | Same as 'accumulate_' but without bounds checking.+-- | Same as 'accumulate_', but without bounds checking. unsafeAccumulate_ :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE unsafeAccumulate_ #-}@@ -1071,13 +1046,13 @@ -- Permutations -- ------------ --- | /O(n)/ Reverse a vector+-- | /O(n)/ Reverse a vector. reverse :: Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse -- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the--- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is+-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@, but is -- often much more efficient. -- -- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>@@ -1085,7 +1060,7 @@ {-# INLINE backpermute #-} backpermute = G.backpermute --- | Same as 'backpermute' but without bounds checking.+-- | Same as 'backpermute', but without bounds checking. unsafeBackpermute :: Vector a -> Vector Int -> Vector a {-# INLINE unsafeBackpermute #-} unsafeBackpermute = G.unsafeBackpermute@@ -1107,7 +1082,7 @@ -- Indexing -- -------- --- | /O(n)/ Pair each element in a vector with its index+-- | /O(n)/ Pair each element in a vector with its index. indexed :: Vector a -> Vector (Int,a) {-# INLINE indexed #-} indexed = G.indexed@@ -1115,12 +1090,12 @@ -- Mapping -- ------- --- | /O(n)/ Map a function over a vector+-- | /O(n)/ Map a function over a vector. map :: (a -> b) -> Vector a -> Vector b {-# INLINE map #-} map = G.map --- | /O(n)/ Apply a function to every element of a vector and its index+-- | /O(n)/ Apply a function to every element of a vector and its index. imap :: (Int -> a -> b) -> Vector a -> Vector b {-# INLINE imap #-} imap = G.imap@@ -1134,25 +1109,25 @@ -- --------------- -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a--- vector of results+-- vector of results. mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b) {-# INLINE mapM #-} mapM = G.mapM -- | /O(n)/ Apply the monadic action to every element of a vector and its--- index, yielding a vector of results+-- index, yielding a vector of results. imapM :: Monad m => (Int -> a -> m b) -> Vector a -> m (Vector b) {-# INLINE imapM #-} imapM = G.imapM -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the--- results+-- results. mapM_ :: Monad m => (a -> m b) -> Vector a -> m () {-# INLINE mapM_ #-} mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to every element of a vector and its--- index, ignoring the results+-- index, ignoring the results. imapM_ :: Monad m => (Int -> a -> m b) -> Vector a -> m () {-# INLINE imapM_ #-} imapM_ = G.imapM_@@ -1170,15 +1145,15 @@ forM_ = G.forM_ -- | /O(n)/ Apply the monadic action to all elements of the vector and their indices, yielding a--- vector of results. Equivalent to 'flip' 'imapM'.+-- vector of results. Equivalent to @'flip' 'imapM'@. -- -- @since 0.12.2.0 iforM :: Monad m => Vector a -> (Int -> a -> m b) -> m (Vector b) {-# INLINE iforM #-} iforM = G.iforM --- | /O(n)/ Apply the monadic action to all elements of the vector and their indices and ignore the--- results. Equivalent to 'flip' 'imapM_'.+-- | /O(n)/ Apply the monadic action to all elements of the vector and their indices+-- and ignore the results. Equivalent to @'flip' 'imapM_'@. -- -- @since 0.12.2.0 iforM_ :: Monad m => Vector a -> (Int -> a -> m b) -> m ()@@ -1244,12 +1219,12 @@ {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 --- | Elementwise pairing of array elements.+-- | /O(min(m,n))/ Zip two vectors. zip :: Vector a -> Vector b -> Vector (a, b) {-# INLINE zip #-} zip = G.zip --- | zip together three vectors into a vector of triples+-- | Zip together three vectors into a vector of triples. zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) {-# INLINE zip3 #-} zip3 = G.zip3@@ -1299,25 +1274,25 @@ -- --------------- -- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a--- vector of results+-- vector of results. zipWithM :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE zipWithM #-} zipWithM = G.zipWithM -- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes--- the element index and yield a vector of results+-- the element index and yield a vector of results. izipWithM :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) {-# INLINE izipWithM #-} izipWithM = G.izipWithM -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the--- results+-- results. zipWithM_ :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE zipWithM_ #-} zipWithM_ = G.zipWithM_ -- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes--- the element index and ignore the results+-- the element index and ignore the results. izipWithM_ :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () {-# INLINE izipWithM_ #-} izipWithM_ = G.izipWithM_@@ -1325,54 +1300,63 @@ -- Filtering -- --------- --- | /O(n)/ Drop elements that do not satisfy the predicate+-- | /O(n)/ Drop all elements that do not satisfy the predicate. filter :: (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-} filter = G.filter --- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to--- values and their indices+-- | /O(n)/ Drop all elements that do not satisfy the predicate which is applied to+-- the values and their indices. ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter --- | /O(n)/ Drop repeated adjacent elements.+-- | /O(n)/ Drop repeated adjacent elements. The first element in each group is returned.+--+-- ==== __Examples__+--+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.uniq $ V.fromList [1,3,3,200,3]+-- [1,3,200,3]+-- >>> import Data.Semigroup+-- >>> V.uniq $ V.fromList [ Arg 1 'a', Arg 1 'b', Arg 1 'c']+-- [Arg 1 'a'] uniq :: (Eq a) => Vector a -> Vector a {-# INLINE uniq #-} uniq = G.uniq --- | /O(n)/ Drop elements when predicate returns Nothing+-- | /O(n)/ Map the values and collect the 'Just' results. mapMaybe :: (a -> Maybe b) -> Vector a -> Vector b {-# INLINE mapMaybe #-} mapMaybe = G.mapMaybe --- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing+-- | /O(n)/ Map the indices/values and collect the 'Just' results. imapMaybe :: (Int -> a -> Maybe b) -> Vector a -> Vector b {-# INLINE imapMaybe #-} imapMaybe = G.imapMaybe --- | /O(n)/ Return a Vector of all the `Just` values.+-- | /O(n)/ Return a Vector of all the 'Just' values. -- -- @since 0.12.2.0 catMaybes :: Vector (Maybe a) -> Vector a {-# INLINE catMaybes #-} catMaybes = mapMaybe id --- | /O(n)/ Drop elements that do not satisfy the monadic predicate+-- | /O(n)/ Drop all elements that do not satisfy the monadic predicate. filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} filterM = G.filterM --- | /O(n)/ Apply monadic function to each element of vector and--- discard elements returning Nothing.+-- | /O(n)/ Apply the monadic function to each element of the vector and+-- discard elements returning 'Nothing'. -- -- @since 0.12.2.0 mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Vector a -> m (Vector b) {-# INLINE mapMaybeM #-} mapMaybeM = G.mapMaybeM --- | /O(n)/ Apply monadic function to each element of vector and its index.--- Discards elements returning Nothing.+-- | /O(n)/ Apply the monadic function to each element of the vector and its index.+-- Discard elements returning 'Nothing'. -- -- @since 0.12.2.0 imapMaybeM :: Monad m => (Int -> a -> m (Maybe b)) -> Vector a -> m (Vector b)@@ -1380,7 +1364,7 @@ imapMaybeM = G.imapMaybeM -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate.--- Current implementation is not copy-free, unless the result vector is+-- The current implementation is not copy-free, unless the result vector is -- fused away. takeWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-}@@ -1403,14 +1387,6 @@ {-# INLINE partition #-} partition = G.partition --- | /O(n)/ Split the vector in two parts, the first one containing those--- elements that satisfy the predicate and the second one those that don't.--- The order of the elements is not preserved but the operation is often--- faster than 'partition'.-unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)-{-# INLINE unstablePartition #-}-unstablePartition = G.unstablePartition- -- | /O(n)/ Split the vector into two parts, the first one containing the -- @`Left`@ elements and the second containing the @`Right`@ elements. -- The relative order of the elements is preserved.@@ -1420,6 +1396,14 @@ {-# INLINE partitionWith #-} partitionWith = G.partitionWith +-- | /O(n)/ Split the vector in two parts, the first one containing those+-- elements that satisfy the predicate and the second one those that don't.+-- The order of the elements is not preserved, but the operation is often+-- faster than 'partition'.+unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)+{-# INLINE unstablePartition #-}+unstablePartition = G.unstablePartition+ -- | /O(n)/ Split the vector into the longest prefix of elements that satisfy -- the predicate and the rest without copying. span :: (a -> Bool) -> Vector a -> (Vector a, Vector a)@@ -1432,17 +1416,57 @@ {-# INLINE break #-} break = G.break +-- | /O(n)/ Split a vector into a list of slices, using a predicate function.+--+-- The concatenation of this list of slices is equal to the argument vector,+-- and each slice contains only equal elements, as determined by the equality+-- predicate function.+--+-- Does not fuse.+--+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> import Data.Char (isUpper)+-- >>> V.groupBy (\a b -> isUpper a == isUpper b) (V.fromList "Mississippi River")+-- ["M","ississippi ","R","iver"]+--+-- See also 'Data.List.groupBy', 'group'.+--+-- @since 0.13.0.1+groupBy :: (a -> a -> Bool) -> Vector a -> [Vector a]+{-# INLINE groupBy #-}+groupBy = G.groupBy++-- | /O(n)/ Split a vector into a list of slices of the input vector.+--+-- The concatenation of this list of slices is equal to the argument vector,+-- and each slice contains only equal elements.+--+-- Does not fuse.+--+-- This is the equivalent of 'groupBy (==)'.+--+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.group (V.fromList "Mississippi")+-- ["M","i","ss","i","ss","i","pp","i"]+--+-- See also 'Data.List.group'.+--+-- @since 0.13.0.1+group :: Eq a => Vector a -> [Vector a]+{-# INLINE group #-}+group = G.groupBy (==)+ -- Searching -- --------- infix 4 `elem`--- | /O(n)/ Check if the vector contains an element+-- | /O(n)/ Check if the vector contains an element. elem :: Eq a => a -> Vector a -> Bool {-# INLINE elem #-} elem = G.elem infix 4 `notElem`--- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem')+-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem'). notElem :: Eq a => a -> Vector a -> Bool {-# INLINE notElem #-} notElem = G.notElem@@ -1465,14 +1489,14 @@ {-# INLINE findIndices #-} findIndices = G.findIndices --- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or+-- | /O(n)/ Yield 'Just' the index of the first occurrence of the given element or -- 'Nothing' if the vector does not contain the element. This is a specialised -- version of 'findIndex'. elemIndex :: Eq a => a -> Vector a -> Maybe Int {-# INLINE elemIndex #-} elemIndex = G.elemIndex --- | /O(n)/ Yield the indices of all occurences of the given element in+-- | /O(n)/ Yield the indices of all occurrences of the given element in -- ascending order. This is a specialised version of 'findIndices'. elemIndices :: Eq a => a -> Vector a -> Vector Int {-# INLINE elemIndices #-}@@ -1481,72 +1505,72 @@ -- Folding -- ------- --- | /O(n)/ Left fold+-- | /O(n)/ Left fold. foldl :: (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl #-} foldl = G.foldl --- | /O(n)/ Left fold on non-empty vectors+-- | /O(n)/ Left fold on non-empty vectors. foldl1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-} foldl1 = G.foldl1 --- | /O(n)/ Left fold with strict accumulator+-- | /O(n)/ Left fold with strict accumulator. foldl' :: (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl' #-} foldl' = G.foldl' --- | /O(n)/ Left fold on non-empty vectors with strict accumulator+-- | /O(n)/ Left fold on non-empty vectors with strict accumulator. foldl1' :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1' #-} foldl1' = G.foldl1' --- | /O(n)/ Right fold+-- | /O(n)/ Right fold. foldr :: (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr #-} foldr = G.foldr --- | /O(n)/ Right fold on non-empty vectors+-- | /O(n)/ Right fold on non-empty vectors. foldr1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldr1 #-} foldr1 = G.foldr1 --- | /O(n)/ Right fold with a strict accumulator+-- | /O(n)/ Right fold with a strict accumulator. foldr' :: (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr' #-} foldr' = G.foldr' --- | /O(n)/ Right fold on non-empty vectors with strict accumulator+-- | /O(n)/ Right fold on non-empty vectors with strict accumulator. foldr1' :: (a -> a -> a) -> Vector a -> a {-# INLINE foldr1' #-} foldr1' = G.foldr1' --- | /O(n)/ Left fold (function applied to each element and its index)+-- | /O(n)/ Left fold using a function applied to each element and its index. ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl #-} ifoldl = G.ifoldl --- | /O(n)/ Left fold with strict accumulator (function applied to each element--- and its index)+-- | /O(n)/ Left fold with strict accumulator using a function applied to each element+-- and its index. ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a {-# INLINE ifoldl' #-} ifoldl' = G.ifoldl' --- | /O(n)/ Right fold (function applied to each element and its index)+-- | /O(n)/ Right fold using a function applied to each element and its index. ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr #-} ifoldr = G.ifoldr --- | /O(n)/ Right fold with strict accumulator (function applied to each--- element and its index)+-- | /O(n)/ Right fold with strict accumulator using a function applied to each+-- element and its index. ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b {-# INLINE ifoldr' #-} ifoldr' = G.ifoldr' --- | /O(n)/ Map each element of the structure to a monoid, and combine--- the results. It uses same implementation as corresponding method of--- 'Foldable' type cless. Note it's implemented in terms of 'foldr'--- and won't fuse with functions that traverse vector from left to+-- | /O(n)/ Map each element of the structure to a monoid and combine+-- the results. It uses the same implementation as the corresponding method+-- of the 'Foldable' type class. Note that it's implemented in terms of 'foldr'+-- and won't fuse with functions that traverse the vector from left to -- right ('map', 'generate', etc.). -- -- @since 0.12.2.0@@ -1554,9 +1578,9 @@ {-# INLINE foldMap #-} foldMap = G.foldMap --- | /O(n)/ 'foldMap' which is strict in accumulator. It uses same--- implementation as corresponding method of 'Foldable' type class.--- Note it's implemented in terms of 'foldl'' so it fuses in most+-- | /O(n)/ Like 'foldMap', but strict in the accumulator. It uses the same+-- implementation as the corresponding method of the 'Foldable' type class.+-- Note that it's implemented in terms of 'foldl'', so it fuses in most -- contexts. -- -- @since 0.12.2.0@@ -1573,9 +1597,9 @@ -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.all even $ V.fromList [2, 4, 12 :: Int]+-- >>> V.all even $ V.fromList [2, 4, 12] -- True--- >>> V.all even $ V.fromList [2, 4, 13 :: Int]+-- >>> V.all even $ V.fromList [2, 4, 13] -- False -- >>> V.all even (V.empty :: V.Vector Int) -- True@@ -1588,9 +1612,9 @@ -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.any even $ V.fromList [1, 3, 7 :: Int]+-- >>> V.any even $ V.fromList [1, 3, 7] -- False--- >>> V.any even $ V.fromList [3, 2, 13 :: Int]+-- >>> V.any even $ V.fromList [3, 2, 13] -- True -- >>> V.any even (V.empty :: V.Vector Int) -- False@@ -1598,7 +1622,7 @@ {-# INLINE any #-} any = G.any --- | /O(n)/ Check if all elements are 'True'+-- | /O(n)/ Check if all elements are 'True'. -- -- ==== __Examples__ --@@ -1611,7 +1635,7 @@ {-# INLINE and #-} and = G.and --- | /O(n)/ Check if any element is 'True'+-- | /O(n)/ Check if any element is 'True'. -- -- ==== __Examples__ --@@ -1624,12 +1648,12 @@ {-# INLINE or #-} or = G.or --- | /O(n)/ Compute the sum of the elements+-- | /O(n)/ Compute the sum of the elements. -- -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.sum $ V.fromList [300,20,1 :: Int]+-- >>> V.sum $ V.fromList [300,20,1] -- 321 -- >>> V.sum (V.empty :: V.Vector Int) -- 0@@ -1637,12 +1661,12 @@ {-# INLINE sum #-} sum = G.sum --- | /O(n)/ Compute the produce of the elements+-- | /O(n)/ Compute the product of the elements. -- -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.product $ V.fromList [1,2,3,4 :: Int]+-- >>> V.product $ V.fromList [1,2,3,4] -- 24 -- >>> V.product (V.empty :: V.Vector Int) -- 1@@ -1651,49 +1675,124 @@ product = G.product -- | /O(n)/ Yield the maximum element of the vector. The vector may not be--- empty.+-- empty. In case of a tie, the first occurrence wins. -- -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.maximum $ V.fromList [2.0, 1.0]--- 2.0+-- >>> V.maximum $ V.fromList [2, 1]+-- 2+-- >>> import Data.Semigroup+-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 2 'b']+-- Arg 2 'b'+-- >>> V.maximum $ V.fromList [Arg 1 'a', Arg 1 'b']+-- Arg 1 'a' maximum :: Ord a => Vector a -> a {-# INLINE maximum #-} maximum = G.maximum --- | /O(n)/ Yield the maximum element of the vector according to the given--- comparison function. The vector may not be empty.+-- | /O(n)/ Yield the maximum element of the vector according to the+-- given comparison function. The vector may not be empty. In case of+-- a tie, the first occurrence wins. This behavior is different from+-- 'Data.List.maximumBy' which returns the last tie.+--+-- ==== __Examples__+--+-- >>> import Data.Ord+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.maximumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')]+-- (2,'a')+-- >>> V.maximumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')]+-- (1,'a') maximumBy :: (a -> a -> Ordering) -> Vector a -> a {-# INLINE maximumBy #-} maximumBy = G.maximumBy +-- | /O(n)/ Yield the maximum element of the vector by comparing the results+-- of a key function on each element. In case of a tie, the first occurrence+-- wins. The vector may not be empty.+--+-- ==== __Examples__+--+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.maximumOn fst $ V.fromList [(2,'a'), (1,'b')]+-- (2,'a')+-- >>> V.maximumOn fst $ V.fromList [(1,'a'), (1,'b')]+-- (1,'a')+--+-- @since 0.13.0.0+maximumOn :: Ord b => (a -> b) -> Vector a -> a+{-# INLINE maximumOn #-}+maximumOn = G.maximumOn+ -- | /O(n)/ Yield the minimum element of the vector. The vector may not be--- empty.+-- empty. In case of a tie, the first occurrence wins. -- -- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V--- >>> V.minimum $ V.fromList [2.0, 1.0]--- 1.0+-- >>> V.minimum $ V.fromList [2, 1]+-- 1+-- >>> import Data.Semigroup+-- >>> V.minimum $ V.fromList [Arg 2 'a', Arg 1 'b']+-- Arg 1 'b'+-- >>> V.minimum $ V.fromList [Arg 1 'a', Arg 1 'b']+-- Arg 1 'a' minimum :: Ord a => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum --- | /O(n)/ Yield the minimum element of the vector according to the given--- comparison function. The vector may not be empty.+-- | /O(n)/ Yield the minimum element of the vector according to the+-- given comparison function. The vector may not be empty. In case of+-- a tie, the first occurrence wins.+--+-- ==== __Examples__+--+-- >>> import Data.Ord+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.minimumBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')]+-- (1,'b')+-- >>> V.minimumBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')]+-- (1,'a') minimumBy :: (a -> a -> Ordering) -> Vector a -> a {-# INLINE minimumBy #-} minimumBy = G.minimumBy +-- | /O(n)/ Yield the minimum element of the vector by comparing the results+-- of a key function on each element. In case of a tie, the first occurrence+-- wins. The vector may not be empty.+--+-- ==== __Examples__+--+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.minimumOn fst $ V.fromList [(2,'a'), (1,'b')]+-- (1,'b')+-- >>> V.minimumOn fst $ V.fromList [(1,'a'), (1,'b')]+-- (1,'a')+--+-- @since 0.13.0.0+minimumOn :: Ord b => (a -> b) -> Vector a -> a+{-# INLINE minimumOn #-}+minimumOn = G.minimumOn+ -- | /O(n)/ Yield the index of the maximum element of the vector. The vector -- may not be empty. maxIndex :: Ord a => Vector a -> Int {-# INLINE maxIndex #-} maxIndex = G.maxIndex --- | /O(n)/ Yield the index of the maximum element of the vector according to--- the given comparison function. The vector may not be empty.+-- | /O(n)/ Yield the index of the maximum element of the vector+-- according to the given comparison function. The vector may not be+-- empty. In case of a tie, the first occurrence wins.+--+-- ==== __Examples__+--+-- >>> import Data.Ord+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')]+-- 0+-- >>> V.maxIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')]+-- 0 maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int {-# INLINE maxIndexBy #-} maxIndexBy = G.maxIndexBy@@ -1706,6 +1805,15 @@ -- | /O(n)/ Yield the index of the minimum element of the vector according to -- the given comparison function. The vector may not be empty.+--+-- ==== __Examples__+--+-- >>> import Data.Ord+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.minIndexBy (comparing fst) $ V.fromList [(2,'a'), (1,'b')]+-- 1+-- >>> V.minIndexBy (comparing fst) $ V.fromList [(1,'a'), (1,'b')]+-- 0 minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int {-# INLINE minIndexBy #-} minIndexBy = G.minIndexBy@@ -1713,66 +1821,66 @@ -- Monadic folds -- ------------- --- | /O(n)/ Monadic fold+-- | /O(n)/ Monadic fold. foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM #-} foldM = G.foldM --- | /O(n)/ Monadic fold (action applied to each element and its index)+-- | /O(n)/ Monadic fold using a function applied to each element and its index. ifoldM :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a {-# INLINE ifoldM #-} ifoldM = G.ifoldM --- | /O(n)/ Monadic fold over non-empty vectors+-- | /O(n)/ Monadic fold over non-empty vectors. fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M #-} fold1M = G.fold1M --- | /O(n)/ Monadic fold with strict accumulator+-- | /O(n)/ Monadic fold with strict accumulator. foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a {-# INLINE foldM' #-} foldM' = G.foldM' --- | /O(n)/ Monadic fold with strict accumulator (action applied to each--- element and its index)+-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each+-- element and its index. ifoldM' :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a {-# INLINE ifoldM' #-} ifoldM' = G.ifoldM' --- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator+-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator. fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a {-# INLINE fold1M' #-} fold1M' = G.fold1M' --- | /O(n)/ Monadic fold that discards the result+-- | /O(n)/ Monadic fold that discards the result. foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM_ #-} foldM_ = G.foldM_ --- | /O(n)/ Monadic fold that discards the result (action applied to each--- element and its index)+-- | /O(n)/ Monadic fold that discards the result using a function applied to+-- each element and its index. ifoldM_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m () {-# INLINE ifoldM_ #-} ifoldM_ = G.ifoldM_ --- | /O(n)/ Monadic fold over non-empty vectors that discards the result+-- | /O(n)/ Monadic fold over non-empty vectors that discards the result. fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M_ #-} fold1M_ = G.fold1M_ --- | /O(n)/ Monadic fold with strict accumulator that discards the result+-- | /O(n)/ Monadic fold with strict accumulator that discards the result. foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () {-# INLINE foldM'_ #-} foldM'_ = G.foldM'_ -- | /O(n)/ Monadic fold with strict accumulator that discards the result--- (action applied to each element and its index)+-- using a function applied to each element and its index. ifoldM'_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m () {-# INLINE ifoldM'_ #-} ifoldM'_ = G.ifoldM'_ -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator--- that discards the result+-- that discards the result. fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m () {-# INLINE fold1M'_ #-} fold1M'_ = G.fold1M'_@@ -1780,155 +1888,210 @@ -- Monadic sequencing -- ------------------ --- | Evaluate each action and collect the results+-- | Evaluate each action and collect the results. sequence :: Monad m => Vector (m a) -> m (Vector a) {-# INLINE sequence #-} sequence = G.sequence --- | Evaluate each action and discard the results+-- | Evaluate each action and discard the results. sequence_ :: Monad m => Vector (m a) -> m () {-# INLINE sequence_ #-} sequence_ = G.sequence_ --- Prefix sums (scans)--- -------------------+-- Scans+-- ----- --- | /O(n)/ Prescan+-- | /O(n)/ Left-to-right prescan. -- -- @ -- prescanl f z = 'init' . 'scanl' f z -- @ ----- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@+-- ==== __Examples__ --+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.prescanl (+) 0 (V.fromList [1,2,3,4])+-- [0,1,3,6] prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl #-} prescanl = G.prescanl --- | /O(n)/ Prescan with strict accumulator+-- | /O(n)/ Left-to-right prescan with strict accumulator. prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl' #-} prescanl' = G.prescanl' --- | /O(n)/ Scan+-- | /O(n)/ Left-to-right postscan. -- -- @ -- postscanl f z = 'tail' . 'scanl' f z -- @ ----- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@+-- ==== __Examples__ --+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.postscanl (+) 0 (V.fromList [1,2,3,4])+-- [1,3,6,10] postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl #-} postscanl = G.postscanl --- | /O(n)/ Scan with strict accumulator+-- | /O(n)/ Left-to-right postscan with strict accumulator. postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE postscanl' #-} postscanl' = G.postscanl' --- | /O(n)/ Haskell-style scan+-- | /O(n)/ Left-to-right scan. -- -- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> -- > where y1 = z -- > yi = f y(i-1) x(i-1) ----- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@+-- ==== __Examples__ --+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.scanl (+) 0 (V.fromList [1,2,3,4])+-- [0,1,3,6,10] scanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl --- | /O(n)/ Haskell-style scan with strict accumulator+-- | /O(n)/ Left-to-right scan with strict accumulator. scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl' #-} scanl' = G.scanl' --- | /O(n)/ Scan over a vector with its index+-- | /O(n)/ Left-to-right scan over a vector with its index. -- -- @since 0.12.0.0 iscanl :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE iscanl #-} iscanl = G.iscanl --- | /O(n)/ Scan over a vector (strictly) with its index+-- | /O(n)/ Left-to-right scan over a vector (strictly) with its index. -- -- @since 0.12.0.0 iscanl' :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE iscanl' #-} iscanl' = G.iscanl' --- | /O(n)/ Scan over a non-empty vector+-- | /O(n)/ Initial-value free left-to-right scan over a vector. -- -- > scanl f <x1,...,xn> = <y1,...,yn> -- > where y1 = x1 -- > yi = f y(i-1) xi --+-- Note: Since 0.13, application of this to an empty vector no longer+-- results in an error; instead it produces an empty vector.+--+-- ==== __Examples__+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.scanl1 min $ V.fromListN 5 [4,2,4,1,3]+-- [4,2,2,1,1]+-- >>> V.scanl1 max $ V.fromListN 5 [1,3,2,5,4]+-- [1,3,3,5,5]+-- >>> V.scanl1 min (V.empty :: V.Vector Int)+-- [] scanl1 :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1 #-} scanl1 = G.scanl1 --- | /O(n)/ Scan over a non-empty vector with a strict accumulator+-- | /O(n)/ Initial-value free left-to-right scan over a vector with a strict accumulator.+--+-- Note: Since 0.13, application of this to an empty vector no longer+-- results in an error; instead it produces an empty vector.+--+-- ==== __Examples__+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.scanl1' min $ V.fromListN 5 [4,2,4,1,3]+-- [4,2,2,1,1]+-- >>> V.scanl1' max $ V.fromListN 5 [1,3,2,5,4]+-- [1,3,3,5,5]+-- >>> V.scanl1' min (V.empty :: V.Vector Int)+-- [] scanl1' :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanl1' #-} scanl1' = G.scanl1' --- | /O(n)/ Right-to-left prescan+-- | /O(n)/ Right-to-left prescan. -- -- @ -- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' -- @--- prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr #-} prescanr = G.prescanr --- | /O(n)/ Right-to-left prescan with strict accumulator+-- | /O(n)/ Right-to-left prescan with strict accumulator. prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr' #-} prescanr' = G.prescanr' --- | /O(n)/ Right-to-left scan+-- | /O(n)/ Right-to-left postscan. postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr #-} postscanr = G.postscanr --- | /O(n)/ Right-to-left scan with strict accumulator+-- | /O(n)/ Right-to-left postscan with strict accumulator. postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE postscanr' #-} postscanr' = G.postscanr' --- | /O(n)/ Right-to-left Haskell-style scan+-- | /O(n)/ Right-to-left scan. scanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr #-} scanr = G.scanr --- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator+-- | /O(n)/ Right-to-left scan with strict accumulator. scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE scanr' #-} scanr' = G.scanr' --- | /O(n)/ Right-to-left scan over a vector with its index+-- | /O(n)/ Right-to-left scan over a vector with its index. -- -- @since 0.12.0.0 iscanr :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE iscanr #-} iscanr = G.iscanr --- | /O(n)/ Right-to-left scan over a vector (strictly) with its index+-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index. -- -- @since 0.12.0.0 iscanr' :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE iscanr' #-} iscanr' = G.iscanr' --- | /O(n)/ Right-to-left scan over a non-empty vector+-- | /O(n)/ Right-to-left, initial-value free scan over a vector.+--+-- Note: Since 0.13, application of this to an empty vector no longer+-- results in an error; instead it produces an empty vector.+--+-- ==== __Examples__+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.scanr1 min $ V.fromListN 5 [3,1,4,2,4]+-- [1,1,2,2,4]+-- >>> V.scanr1 max $ V.fromListN 5 [4,5,2,3,1]+-- [5,5,3,3,1]+-- >>> V.scanr1 min (V.empty :: V.Vector Int)+-- [] scanr1 :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1 #-} scanr1 = G.scanr1 --- | /O(n)/ Right-to-left scan over a non-empty vector with a strict--- accumulator+-- | /O(n)/ Right-to-left, initial-value free scan over a vector with a strict+-- accumulator.+--+-- Note: Since 0.13, application of this to an empty vector no longer+-- results in an error; instead it produces an empty vector.+--+-- ==== __Examples__+-- >>> import qualified Data.Strict.Vector.Autogen as V+-- >>> V.scanr1' min $ V.fromListN 5 [3,1,4,2,4]+-- [1,1,2,2,4]+-- >>> V.scanr1' max $ V.fromListN 5 [4,5,2,3,1]+-- [5,5,3,3,1]+-- >>> V.scanr1' min (V.empty :: V.Vector Int)+-- [] scanr1' :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1' #-} scanr1' = G.scanr1'@@ -1936,7 +2099,7 @@ -- Comparisons -- ------------------------ --- | /O(n)/ Check if two vectors are equal using supplied equality+-- | /O(n)/ Check if two vectors are equal using the supplied equality -- predicate. -- -- @since 0.12.2.0@@ -1944,8 +2107,8 @@ {-# INLINE eqBy #-} eqBy = G.eqBy --- | /O(n)/ Compare two vectors using supplied comparison function for--- vector elements. Comparison works same as for lists.+-- | /O(n)/ Compare two vectors using the supplied comparison function for+-- vector elements. Comparison works the same as for lists. -- -- > cmpBy compare == compare --@@ -1956,17 +2119,21 @@ -- Conversions - Lists -- ------------------------ --- | /O(n)/ Convert a vector to a list+-- | /O(n)/ Convert a vector to a list. toList :: Vector a -> [a] {-# INLINE toList #-} toList = G.toList --- | /O(n)/ Convert a list to a vector+-- | /O(n)/ Convert a list to a vector. fromList :: [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList --- | /O(n)/ Convert the first @n@ elements of a list to a vector+-- | /O(n)/ Convert the first @n@ elements of a list to a vector. It's+-- expected that the supplied list will be exactly @n@ elements long. As+-- an optimization, this function allocates a buffer for @n@ elements, which+-- could be used for DoS-attacks by exhausting the memory if an attacker controls+-- that parameter. -- -- @ -- fromListN n xs = 'fromList' ('take' n xs)@@ -1983,42 +2150,92 @@ -- @since 0.12.2.0 fromArray :: Array a -> Vector a {-# INLINE fromArray #-}-fromArray x = Vector 0 (sizeofArray x) x+fromArray arr = Vector 0 (sizeofArray arr) arr -- | /O(n)/ Convert a vector to an array. -- -- @since 0.12.2.0 toArray :: Vector a -> Array a {-# INLINE toArray #-}-toArray (Vector offset size arr)- | offset == 0 && size == sizeofArray arr = arr- | otherwise = cloneArray arr offset size+toArray (Vector offset len arr)+ | offset == 0 && len == sizeofArray arr = arr+ | otherwise = cloneArray arr offset len +-- | /O(1)/ Extract the underlying `Array`, offset where vector starts and the+-- total number of elements in the vector. Below property always holds:+--+-- > let (array, offset, len) = toArraySlice v+-- > v === unsafeFromArraySlice len offset array+--+-- @since 0.13.0.0+toArraySlice :: Vector a -> (Array a, Int, Int)+{-# INLINE toArraySlice #-}+toArraySlice (Vector offset len arr) = (arr, offset, len)+++-- | /O(1)/ Convert an array slice to a vector. This function is very unsafe,+-- because constructing an invalid vector can yield almost all other safe+-- functions in this module unsafe. These are equivalent:+--+-- > unsafeFromArraySlice len offset === unsafeTake len . unsafeDrop offset . fromArray+--+-- @since 0.13.0.0+unsafeFromArraySlice ::+ Array a -- ^ Immutable boxed array.+ -> Int -- ^ Offset+ -> Int -- ^ Length+ -> Vector a+{-# INLINE unsafeFromArraySlice #-}+unsafeFromArraySlice arr offset len = Vector offset len arr+ -- Conversions - Mutable vectors -- ----------------------------- --- | /O(1)/ Unsafe convert a mutable vector to an immutable one without+-- | /O(1)/ Unsafely convert a mutable vector to an immutable one without -- copying. The mutable vector may not be used after this operation. unsafeFreeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) {-# INLINE unsafeFreeze #-} unsafeFreeze = G.unsafeFreeze --- | /O(1)/ Unsafely convert an immutable vector to a mutable one without--- copying. The immutable vector may not be used after this operation.+-- | /O(n)/ Yield an immutable copy of the mutable vector.+freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a)+{-# INLINE freeze #-}+freeze = G.freeze++-- | /O(1)/ Unsafely convert an immutable vector to a mutable one+-- without copying. Note that this is a very dangerous function and+-- generally it's only safe to read from the resulting vector. In this+-- case, the immutable vector could be used safely as well.+--+-- Problems with mutation happen because GHC has a lot of freedom to+-- introduce sharing. As a result mutable vectors produced by+-- @unsafeThaw@ may or may not share the same underlying buffer. For+-- example:+--+-- > foo = do+-- > let vec = V.generate 10 id+-- > mvec <- V.unsafeThaw vec+-- > do_something mvec+--+-- Here GHC could lift @vec@ outside of foo which means that all calls to+-- @do_something@ will use same buffer with possibly disastrous+-- results. Whether such aliasing happens or not depends on the program in+-- question, optimization levels, and GHC flags.+--+-- All in all, attempts to modify a vector produced by @unsafeThaw@ fall out of+-- domain of software engineering and into realm of black magic, dark+-- rituals, and unspeakable horrors. The only advice that could be given+-- is: "Don't attempt to mutate a vector produced by @unsafeThaw@ unless you+-- know how to prevent GHC from aliasing buffers accidentally. We don't." unsafeThaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) {-# INLINE unsafeThaw #-} unsafeThaw = G.unsafeThaw --- | /O(n)/ Yield a mutable copy of the immutable vector.+-- | /O(n)/ Yield a mutable copy of an immutable vector. thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) {-# INLINE thaw #-} thaw = G.thaw --- | /O(n)/ Yield an immutable copy of the mutable vector.-freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a)-{-# INLINE freeze #-}-freeze = G.freeze- -- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must -- have the same length. This is not checked. unsafeCopy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m ()@@ -2030,3 +2247,6 @@ copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy++-- $setup+-- >>> :set -Wno-type-defaults
+ src/Data/Strict/Vector/Autogen/Internal/Check.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_HADDOCK hide #-}++-- |+-- Module : Data.Strict.Vector.Autogen.Internal.Check+-- Copyright : (c) Roman Leshchinskiy 2009+-- Alexey Kuleshevich 2020-2022+-- Aleksey Khudyakov 2020-2022+-- Andrew Lelechenko 2020-2022+-- License : BSD-style+--+-- Maintainer : Haskell Libraries Team <libraries@haskell.org>+-- Stability : experimental+-- Portability : non-portable+--+-- Bounds checking infrastructure+--+module Data.Strict.Vector.Autogen.Internal.Check (+ HasCallStack,+ Checks(..), doChecks,++ internalError,+ check, checkIndex, checkLength, checkSlice,+ inRange+) where++import GHC.Exts (Int(..), Int#)+import Prelude hiding( error, (&&), (||), not )+import qualified Prelude as P+import GHC.Stack (HasCallStack)++-- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline+-- these functions into unfoldings which makes the intermediate code size+-- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539.+infixr 2 ||+infixr 3 &&++not :: Bool -> Bool+{-# INLINE not #-}+not True = False+not False = True++(&&) :: Bool -> Bool -> Bool+{-# INLINE (&&) #-}+False && _ = False+True && x = x++(||) :: Bool -> Bool -> Bool+{-# INLINE (||) #-}+True || _ = True+False || x = x+++data Checks = Bounds | Unsafe | Internal deriving( Eq )++doBoundsChecks :: Bool+#ifdef VECTOR_BOUNDS_CHECKS+doBoundsChecks = True+#else+doBoundsChecks = False+#endif++doUnsafeChecks :: Bool+#ifdef VECTOR_UNSAFE_CHECKS+doUnsafeChecks = True+#else+doUnsafeChecks = False+#endif++doInternalChecks :: Bool+#ifdef VECTOR_INTERNAL_CHECKS+doInternalChecks = True+#else+doInternalChecks = False+#endif+++doChecks :: Checks -> Bool+{-# INLINE doChecks #-}+doChecks Bounds = doBoundsChecks+doChecks Unsafe = doUnsafeChecks+doChecks Internal = doInternalChecks++internalError :: HasCallStack => String -> a+{-# NOINLINE internalError #-}+internalError msg+ = P.error $ unlines+ ["*** Internal error in package vector ***"+ ,"*** Please submit a bug report at http://github.com/haskell/vector"+ ,msg]+++checkError :: HasCallStack => Checks -> String -> a+{-# NOINLINE checkError #-}+checkError kind msg+ = case kind of+ Internal -> internalError msg+ _ -> P.error msg++check :: HasCallStack => Checks -> String -> Bool -> a -> a+{-# INLINE check #-}+check kind msg cond x+ | not (doChecks kind) || cond = x+ | otherwise = checkError kind msg++checkIndex_msg :: Int -> Int -> String+{-# INLINE checkIndex_msg #-}+checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n#++checkIndex_msg# :: Int# -> Int# -> String+{-# NOINLINE checkIndex_msg# #-}+checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#)++checkIndex :: HasCallStack => Checks -> Int -> Int -> a -> a+{-# INLINE checkIndex #-}+checkIndex kind i n x+ = check kind (checkIndex_msg i n) (inRange i n) x+++checkLength_msg :: Int -> String+{-# INLINE checkLength_msg #-}+checkLength_msg (I# n#) = checkLength_msg# n#++checkLength_msg# :: Int# -> String+{-# NOINLINE checkLength_msg# #-}+checkLength_msg# n# = "negative length " ++ show (I# n#)++checkLength :: HasCallStack => Checks -> Int -> a -> a+{-# INLINE checkLength #-}+checkLength kind n = check kind (checkLength_msg n) (n >= 0)+++checkSlice_msg :: Int -> Int -> Int -> String+{-# INLINE checkSlice_msg #-}+checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n#++checkSlice_msg# :: Int# -> Int# -> Int# -> String+{-# NOINLINE checkSlice_msg# #-}+checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#)++checkSlice :: HasCallStack => Checks -> Int -> Int -> Int -> a -> a+{-# INLINE checkSlice #-}+checkSlice kind i m n x+ = check kind (checkSlice_msg i m n) (i >= 0 && m >= 0 && m <= n - i) x++-- Lengths are never negative, so we can check @0 <= i < length v@+-- using one unsigned comparison.+inRange :: Int -> Int -> Bool+{-# INLINE inRange #-}+inRange i n = (fromIntegral i :: Word) < (fromIntegral n :: Word)
src/Data/Strict/Vector/Autogen/Mutable.hs view
@@ -1,20 +1,27 @@-{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-}-+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.Strict.Vector.Autogen.Mutable -- Copyright : (c) Roman Leshchinskiy 2008-2010+-- Alexey Kuleshevich 2020-2022+-- Aleksey Khudyakov 2020-2022+-- Andrew Lelechenko 2020-2022 -- License : BSD-style ----- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Maintainer : Haskell Libraries Team <libraries@haskell.org> -- Stability : experimental -- Portability : non-portable -- -- Mutable boxed vectors.--- module Data.Strict.Vector.Autogen.Mutable ( -- * Mutable boxed vectors- MVector(..), IOVector, STVector,+ MVector(MVector), IOVector, STVector, -- * Accessors @@ -40,7 +47,7 @@ clear, -- * Accessing individual elements- read, write, modify, modifyM, swap, exchange,+ read, readMaybe, write, modify, modifyM, swap, exchange, unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange, -- * Folds@@ -54,15 +61,18 @@ nextPermutation, -- ** Filling and copying- set, copy, move, unsafeCopy, unsafeMove, -- ** Arrays- fromMutableArray, toMutableArray+ fromMutableArray, toMutableArray,++ -- * Re-exports+ PrimMonad, PrimState, RealWorld ) where import Control.Monad (when, liftM) import qualified Data.Vector.Generic.Mutable as G+import Data.Strict.Vector.Autogen.Internal.Check import Data.Primitive.Array import Control.Monad.Primitive @@ -73,10 +83,16 @@ #include "vector.h" -+type role MVector nominal representational -- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@).-data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableArray s a)+data MVector s a = MVector { _offset :: {-# UNPACK #-} !Int+ -- ^ Offset in underlying array+ , _size :: {-# UNPACK #-} !Int+ -- ^ Size of slice+ , _array :: {-# UNPACK #-} !(MutableArray s a)+ -- ^ Underlying array+ } deriving ( Typeable ) type IOVector = MVector RealWorld@@ -158,14 +174,14 @@ {-# INLINE moveBackwards #-} moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () moveBackwards !arr !dstOff !srcOff !len =- INTERNAL_CHECK(check) "moveBackwards" "not a backwards move" (dstOff < srcOff)+ check Internal "not a backwards move" (dstOff < srcOff) $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) {-# INLINE moveForwardsSmallOverlap #-} -- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small. moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () moveForwardsSmallOverlap !arr !dstOff !srcOff !len =- INTERNAL_CHECK(check) "moveForwardsSmallOverlap" "not a forward move" (dstOff > srcOff)+ check Internal "not a forward move" (dstOff > srcOff) $ do tmp <- newArray overlap uninitialised loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i@@ -176,7 +192,7 @@ -- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large. moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () moveForwardsLargeOverlap !arr !dstOff !srcOff !len =- INTERNAL_CHECK(check) "moveForwardsLargeOverlap" "not a forward move" (dstOff > srcOff)+ check Internal "not a forward move" (dstOff > srcOff) $ do queue <- newArray nonOverlap uninitialised loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i@@ -206,7 +222,7 @@ {-# INLINE length #-} length = G.length --- | Check whether the vector is empty+-- | Check whether the vector is empty. null :: MVector s a -> Bool {-# INLINE null #-} null = G.null@@ -223,22 +239,37 @@ {-# INLINE slice #-} slice = G.slice +-- | Take the @n@ first elements of the mutable vector without making a+-- copy. For negative @n@, the empty vector is returned. If @n@ is larger+-- than the vector's length, the vector is returned unchanged. take :: Int -> MVector s a -> MVector s a {-# INLINE take #-} take = G.take +-- | Drop the @n@ first element of the mutable vector without making a+-- copy. For negative @n@, the vector is returned unchanged. If @n@ is+-- larger than the vector's length, the empty vector is returned. drop :: Int -> MVector s a -> MVector s a {-# INLINE drop #-} drop = G.drop -{-# INLINE splitAt #-}+-- | /O(1)/ Split the mutable vector into the first @n@ elements+-- and the remainder, without copying.+--+-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@,+-- but slightly more efficient. splitAt :: Int -> MVector s a -> (MVector s a, MVector s a)+{-# INLINE splitAt #-} splitAt = G.splitAt +-- | Drop the last element of the mutable vector without making a copy.+-- If the vector is empty, an exception is thrown. init :: MVector s a -> MVector s a {-# INLINE init #-} init = G.init +-- | Drop the first element of the mutable vector without making a copy.+-- If the vector is empty, an exception is thrown. tail :: MVector s a -> MVector s a {-# INLINE tail #-} tail = G.tail@@ -252,18 +283,24 @@ {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice +-- | Unsafe variant of 'take'. If @n@ is out of range, it will+-- simply create an invalid slice that likely violate memory safety. unsafeTake :: Int -> MVector s a -> MVector s a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake +-- | Unsafe variant of 'drop'. If @n@ is out of range, it will+-- simply create an invalid slice that likely violate memory safety. unsafeDrop :: Int -> MVector s a -> MVector s a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop +-- | Same as 'init', but doesn't do range checks. unsafeInit :: MVector s a -> MVector s a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit +-- | Same as 'tail', but doesn't do range checks. unsafeTail :: MVector s a -> MVector s a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail@@ -285,7 +322,7 @@ new = G.new -- | Create a mutable vector of the given length. The vector elements--- are set to bottom so accessing them will cause an exception.+-- are set to bottom, so accessing them will cause an exception. -- -- @since 0.5 unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a)@@ -306,6 +343,7 @@ -- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative) -- and fill it with the results of applying the function to each index.+-- Iteration starts at index 0. -- -- @since 0.12.3.0 generate :: (PrimMonad m) => Int -> (Int -> a) -> m (MVector (PrimState m) a)@@ -330,14 +368,14 @@ -- ------- -- | Grow a boxed vector by the given number of elements. The number must be--- non-negative. Same semantics as in `G.grow` for generic vector. It differs+-- non-negative. This has the same semantics as 'G.grow' for generic vectors. It differs -- from @grow@ functions for unpacked vectors, however, in that only pointers to--- values are copied over, therefore values themselves will be shared between+-- values are copied over, therefore the values themselves will be shared between the -- two vectors. This is an important distinction to know about during memory--- usage analysis and in case when values themselves are of a mutable type, eg.--- `Data.IORef.IORef` or another mutable vector.+-- usage analysis and in case the values themselves are of a mutable type, e.g.+-- 'Data.IORef.IORef' or another mutable vector. ----- ====__Examples__+-- ==== __Examples__ -- -- >>> import qualified Data.Strict.Vector.Autogen as V -- >>> import qualified Data.Strict.Vector.Autogen.Mutable as MV@@ -350,30 +388,30 @@ -- -- >>> MV.write mv' 3 999 -- >>> MV.write mv' 4 777--- >>> V.unsafeFreeze mv'+-- >>> V.freeze mv' -- [10,20,30,999,777] -- -- It is important to note that the source mutable vector is not affected when -- the newly allocated one is mutated. -- -- >>> MV.write mv' 2 888--- >>> V.unsafeFreeze mv'+-- >>> V.freeze mv' -- [10,20,888,999,777]--- >>> V.unsafeFreeze mv+-- >>> V.freeze mv -- [10,20,30] -- -- @since 0.5 grow :: PrimMonad m- => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow --- | Grow a vector by the given number of elements. The number must be non-negative but--- this is not checked. Same semantics as in `G.unsafeGrow` for generic vector.+-- | Grow a vector by the given number of elements. The number must be non-negative, but+-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors. -- -- @since 0.5 unsafeGrow :: PrimMonad m- => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)+ => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow = G.unsafeGrow @@ -381,7 +419,7 @@ -- ------------------------ -- | Reset all elements of the vector to some undefined value, clearing all--- references to external objects. This is usually a noop for unboxed vectors.+-- references to external objects. clear :: PrimMonad m => MVector (PrimState m) a -> m () {-# INLINE clear #-} clear = G.clear@@ -389,11 +427,36 @@ -- Accessing individual elements -- ----------------------------- --- | Yield the element at the given position.+-- | Yield the element at the given position. Will throw an exception if+-- the index is out of range.+--+-- ==== __Examples__+--+-- >>> import qualified Data.Strict.Vector.Autogen.Mutable as MV+-- >>> v <- MV.generate 10 (\x -> x*x)+-- >>> MV.read v 3+-- 9 read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a {-# INLINE read #-} read = G.read +-- | Yield the element at the given position. Returns 'Nothing' if+-- the index is out of range.+--+-- @since 0.13+--+-- ==== __Examples__+--+-- >>> import qualified Data.Strict.Vector.Autogen.Mutable as MV+-- >>> v <- MV.generate 10 (\x -> x*x)+-- >>> MV.readMaybe v 3+-- Just 9+-- >>> MV.readMaybe v 13+-- Nothing+readMaybe :: (PrimMonad m) => MVector (PrimState m) a -> Int -> m (Maybe a)+{-# INLINE readMaybe #-}+readMaybe = G.readMaybe+ -- | Replace the element at the given position. write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () {-# INLINE write #-}@@ -472,7 +535,7 @@ copy = G.copy -- | Copy a vector. The two vectors must have the same length and may not--- overlap. This is not checked.+-- overlap, but this is not checked. unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target -> MVector (PrimState m) a -- ^ source -> m ()@@ -505,13 +568,15 @@ {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove --- | Compute the next (lexicographically) permutation of given vector in-place.--- Returns False when input is the last permutation-nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool+-- Modifying vectors+-- -----------------++-- | Compute the (lexicographically) next permutation of the given vector in-place.+-- Returns False when the input is the last permutation.+nextPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool {-# INLINE nextPermutation #-} nextPermutation = G.nextPermutation - -- Folds -- ----- @@ -530,7 +595,7 @@ imapM_ = G.imapM_ -- | /O(n)/ Apply the monadic action to every element of the vector,--- discarding the results. It's same as the @flip mapM_@.+-- discarding the results. It's the same as @flip mapM_@. -- -- @since 0.12.3.0 forM_ :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m b) -> m ()@@ -538,7 +603,7 @@ forM_ = G.forM_ -- | /O(n)/ Apply the monadic action to every element of the vector--- and its index, discarding the results. It's same as the @flip imapM_@.+-- and its index, discarding the results. It's the same as @flip imapM_@. -- -- @since 0.12.3.0 iforM_ :: (PrimMonad m) => MVector (PrimState m) a -> (Int -> a -> m b) -> m ()@@ -559,14 +624,14 @@ {-# INLINE foldl' #-} foldl' = G.foldl' --- | /O(n)/ Pure left fold (function applied to each element and its index).+-- | /O(n)/ Pure left fold using a function applied to each element and its index. -- -- @since 0.12.3.0 ifoldl :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b {-# INLINE ifoldl #-} ifoldl = G.ifoldl --- | /O(n)/ Pure left fold with strict accumulator (function applied to each element and its index).+-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index. -- -- @since 0.12.3.0 ifoldl' :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b@@ -587,15 +652,15 @@ {-# INLINE foldr' #-} foldr' = G.foldr' --- | /O(n)/ Pure right fold (function applied to each element and its index).+-- | /O(n)/ Pure right fold using a function applied to each element and its index. -- -- @since 0.12.3.0 ifoldr :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b {-# INLINE ifoldr #-} ifoldr = G.ifoldr --- | /O(n)/ Pure right fold with strict accumulator (function applied--- to each element and its index).+-- | /O(n)/ Pure right fold with strict accumulator using a function applied+-- to each element and its index. -- -- @since 0.12.3.0 ifoldr' :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b@@ -616,14 +681,14 @@ {-# INLINE foldM' #-} foldM' = G.foldM' --- | /O(n)/ Monadic fold (action applied to each element and its index).+-- | /O(n)/ Monadic fold using a function applied to each element and its index. -- -- @since 0.12.3.0 ifoldM :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b {-# INLINE ifoldM #-} ifoldM = G.ifoldM --- | /O(n)/ Monadic fold with strict accumulator (action applied to each element and its index).+-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index. -- -- @since 0.12.3.0 ifoldM' :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b@@ -644,15 +709,15 @@ {-# INLINE foldrM' #-} foldrM' = G.foldrM' --- | /O(n)/ Monadic right fold (action applied to each element and its index).+-- | /O(n)/ Monadic right fold using a function applied to each element and its index. -- -- @since 0.12.3.0 ifoldrM :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b {-# INLINE ifoldrM #-} ifoldrM = G.ifoldrM --- | /O(n)/ Monadic right fold with strict accumulator (action applied--- to each element and its index).+-- | /O(n)/ Monadic right fold with strict accumulator using a function applied+-- to each element and its index. -- -- @since 0.12.3.0 ifoldrM' :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b@@ -669,7 +734,7 @@ {-# INLINE fromMutableArray #-} fromMutableArray marr = let size = sizeofMutableArray marr- in MVector 0 size `liftM` cloneMutableArray marr 0 size+ in MVector 0 size `liftM` cloneMutableArray marr 0 size -- | /O(n)/ Make a copy of a mutable vector into a new mutable array. --
strict-containers.cabal view
@@ -1,5 +1,6 @@+Cabal-Version: 2.2 Name: strict-containers-Version: 0.1+Version: 0.2 Synopsis: Strict containers. Category: Data, Data Structures Description:@@ -38,30 +39,32 @@ . -- generated list for versions -- DO NOT EDIT below, AUTOGEN versions- * containers v0.6.4.1- * unordered-containers v0.2.13.0- * vector v0.12.3.0+ * containers v0.6.6+ * unordered-containers v0.2.19.1+ * vector vector-0.13.0.0 -- DO NOT EDIT above, AUTOGEN versions-License: BSD3+License: BSD-3-Clause License-File: LICENSE Maintainer: Ximin Luo <infinity0@pwned.gg> Copyright: (c) 2021 by Ximin Luo Homepage: https://github.com/haskellari/strict-containers-Cabal-Version: >= 1.10 Build-type: Simple extra-source-files: CHANGELOG.md -- generated list for includes -- DO NOT EDIT below, AUTOGEN includes+ include/vector.h include/containers.h -- DO NOT EDIT above, AUTOGEN includes tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5- || ==8.8.3- || ==8.10.4- || ==9.0.1+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.4+ || ==9.4.2 library default-language: Haskell2010@@ -69,18 +72,19 @@ ghc-options: -Wall build-depends:- base >= 4.5.0.0 && < 5- , array >= 0.4.0.0- , binary >= 0.8.4.1 && < 0.9- , containers >= 0.5.9.2 && < 0.7- , deepseq >= 1.2 && < 1.5- , indexed-traversable >= 0.1.1 && < 0.2- , hashable >= 1.2.7.0 && < 1.4- , primitive >= 0.6.4.0 && < 0.8- , unordered-containers >= 0.2 && < 0.3- , strict >= 0.4 && < 0.5- , vector >= 0.12 && < 0.13- , vector-binary-instances >= 0.2 && < 0.3+ base >= 4.5.0.0 && < 5+ , array >= 0.4.0.0+ , binary >= 0.8.4.1 && < 0.9+ , containers >= 0.6.6 && < 0.7+ , deepseq >= 1.2 && < 1.5+ , indexed-traversable >= 0.1.1 && < 0.2+ , hashable >= 1.2.7.0 && < 1.5+ , primitive >= 0.6.4.0 && < 0.8+ , unordered-containers >= 0.2.19.1 && < 0.3+ , strict >= 0.4 && < 0.5+ , template-haskell+ , vector >= 0.13.0.0 && < 0.14+ , vector-binary-instances >= 0.2.2.0 && < 0.3 exposed-modules: Data.Strict.HashMap@@ -92,7 +96,6 @@ Data.Strict.HashMap.Autogen.Internal.Array Data.Strict.HashMap.Autogen.Internal.Strict Data.Strict.HashMap.Autogen.Internal.List- Data.Strict.HashMap.Autogen.Internal.Unsafe -- DO NOT EDIT above, AUTOGEN HashMap Data.Strict.HashSet Data.Strict.IntMap@@ -144,53 +147,51 @@ -- DO NOT EDIT below, AUTOGEN Vector Data.Strict.Vector.Autogen Data.Strict.Vector.Autogen.Mutable+ Data.Strict.Vector.Autogen.Internal.Check -- DO NOT EDIT above, AUTOGEN Vector include-dirs: include -- generated list for tests -- DO NOT EDIT below, AUTOGEN tests+common containers-deps+ build-depends:+ array >=0.4.0.0+ , base >=4.9.1 && <5+ , deepseq >=1.2 && <1.5+ , template-haskell++common containers-test-deps+ import: containers-deps+ build-depends:+ strict-containers,containers+ , QuickCheck >=2.7.1+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , transformers+ test-suite map-strict-properties+ import: containers-test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: map-properties.hs type: exitcode-stdio-1.0- build-depends: containers, strict-containers- build-depends:- array >=0.4.0.0- , base >=4.6 && <5- , deepseq >=1.2 && <1.5- cpp-options: -DSTRICT+ ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends:- HUnit- , QuickCheck >=2.7.1- , test-framework- , test-framework-hunit- , test-framework-quickcheck2- , transformers- test-suite map-strictness-properties+ import: containers-test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: map-strictness.hs type: exitcode-stdio-1.0- build-depends: containers, strict-containers build-depends:- array >=0.4.0.0- , base >=4.6 && <5- , ChasingBottoms- , deepseq >=1.2 && <1.5- , HUnit- , QuickCheck >=2.7.1- , test-framework >=0.3.3- , test-framework-quickcheck2 >=0.2.9- , test-framework-hunit+ ChasingBottoms ghc-options: -Wall other-extensions:@@ -200,33 +201,28 @@ other-modules: Utils.IsUnit + if impl(ghc >= 8.6)+ build-depends:+ nothunks+ other-modules:+ Utils.NoThunks+ test-suite intmap-strict-properties+ import: containers-test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intmap-properties.hs type: exitcode-stdio-1.0 cpp-options: -DSTRICT other-modules: IntMapValidity- build-depends: strict-containers- build-depends:- array >=0.4.0.0- , base >=4.6 && <5- , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends: containers, strict-containers- build-depends:- HUnit- , QuickCheck >=2.7.1- , test-framework- , test-framework-hunit- , test-framework-quickcheck2- test-suite intmap-strictness-properties+ import: containers-test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: intmap-strictness.hs@@ -235,64 +231,32 @@ BangPatterns CPP - build-depends: containers, strict-containers build-depends:- array >=0.4.0.0- , base >=4.6 && <5- , ChasingBottoms- , deepseq >=1.2 && <1.5- , HUnit- , QuickCheck >=2.7.1- , test-framework >=0.3.3- , test-framework-quickcheck2 >=0.2.9- , test-framework-hunit+ ChasingBottoms ghc-options: -Wall other-modules: Utils.IsUnit + if impl(ghc >= 8.6)+ build-depends:+ nothunks+ other-modules:+ Utils.NoThunks+ test-suite seq-properties+ import: containers-test-deps default-language: Haskell2010 hs-source-dirs: tests main-is: seq-properties.hs type: exitcode-stdio-1.0- build-depends: strict-containers- build-depends:- array >=0.4.0.0- , base >=4.6 && <5- , deepseq >=1.2 && <1.5 ghc-options: -O2 other-extensions: BangPatterns CPP - build-depends:- QuickCheck >=2.7.1- , test-framework- , test-framework-quickcheck2- , transformers--test-suite hashmap-strict-properties- hs-source-dirs: tests- main-is: HashMapProperties.hs- type: exitcode-stdio-1.0-- build-depends:- base,- containers >= 0.5.8,- hashable >= 1.0.1.1,- QuickCheck >= 2.4.0.1,- test-framework >= 0.3.3,- test-framework-quickcheck2 >= 0.2.9,- strict-containers,- unordered-containers-- default-language: Haskell2010- ghc-options: -Wall- cpp-options: -DASSERTS -DSTRICT- test-suite vector-tests-O0 Default-Language: Haskell2010 type: exitcode-stdio-1.0@@ -313,21 +277,20 @@ QuickCheck >= 2.9 && < 2.15, HUnit, tasty, tasty-hunit, tasty-quickcheck, transformers >= 0.2.0.0- if !impl(ghc > 8.0)- Build-Depends: semigroups default-extensions: CPP, ScopedTypeVariables, PatternGuards, MultiParamTypeClasses, FlexibleContexts,- Rank2Types,+ RankNTypes, TypeSynonymInstances, TypeFamilies, TemplateHaskell Ghc-Options: -O0 -threaded Ghc-Options: -Wall+ -- DO NOT EDIT above, AUTOGEN tests
− tests/HashMapProperties.hs
@@ -1,591 +0,0 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} -- because of Arbitrary (HashMap k v)---- | Tests for the 'Data.Strict.HashMap.Autogen.Lazy' module. We test functions by--- comparing them to a simpler model, an association list.--module Main (main) where--import Control.Monad ( guard )-import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0)-import Data.Bifoldable-#endif-import Data.Function (on)-import Data.Hashable (Hashable(hashWithSalt))-import qualified Data.List as L-import Data.Ord (comparing)-#if defined(STRICT)-import Data.Strict.HashMap.Autogen.Strict (HashMap)-import qualified Data.Strict.HashMap.Autogen.Strict as HM-import qualified Data.Map.Strict as M-#else-import Data.Strict.HashMap.Autogen.Lazy (HashMap)-import qualified Data.Strict.HashMap.Autogen.Lazy as HM-import qualified Data.Map.Lazy as M-#endif-import Test.QuickCheck (Arbitrary(..), Property, (==>), (===), forAll, elements)-import Test.Framework (Test, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity (Identity (..))-#endif-import Control.Applicative (Const (..))-import Test.QuickCheck.Function (Fun, apply)-import Test.QuickCheck.Poly (A, B)---- Key type that generates more hash collisions.-newtype Key = K { unK :: Int }- deriving (Arbitrary, Eq, Ord, Read, Show)--instance Hashable Key where- hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20--instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where- arbitrary = fmap (HM.fromList) arbitrary----------------------------------------------------------------------------- * Properties----------------------------------------------------------------------------- ** Instances--pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==)--pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)---- We cannot compare to `Data.Map` as ordering is different.-pOrd1 :: [(Key, Int)] -> Bool-pOrd1 xs = compare x x == EQ- where- x = HM.fromList xs--pOrd2 :: [(Key, Int)] -> [(Key, Int)] -> [(Key, Int)] -> Bool-pOrd2 xs ys zs = case (compare x y, compare y z) of- (EQ, o) -> compare x z == o- (o, EQ) -> compare x z == o- (LT, LT) -> compare x z == LT- (GT, GT) -> compare x z == GT- (LT, GT) -> True -- ys greater than xs and zs.- (GT, LT) -> True- where- x = HM.fromList xs- y = HM.fromList ys- z = HM.fromList zs--pOrd3 :: [(Key, Int)] -> [(Key, Int)] -> Bool-pOrd3 xs ys = case (compare x y, compare y x) of- (EQ, EQ) -> True- (LT, GT) -> True- (GT, LT) -> True- _ -> False- where- x = HM.fromList xs- y = HM.fromList ys--pOrdEq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pOrdEq xs ys = case (compare x y, x == y) of- (EQ, True) -> True- (LT, False) -> True- (GT, False) -> True- _ -> False- where- x = HM.fromList xs- y = HM.fromList ys--pReadShow :: [(Key, Int)] -> Bool-pReadShow xs = M.fromList xs == read (show (M.fromList xs))--pFunctor :: [(Key, Int)] -> Bool-pFunctor = fmap (+ 1) `eq_` fmap (+ 1)--pFoldable :: [(Int, Int)] -> Bool-pFoldable = (L.sort . Foldable.foldr (:) []) `eq`- (L.sort . Foldable.foldr (:) [])--pHashable :: [(Key, Int)] -> [Int] -> Int -> Property-pHashable xs is salt =- x == y ==> hashWithSalt salt x === hashWithSalt salt y- where- xs' = L.nubBy (\(k,_) (k',_) -> k == k') xs- ys = shuffle is xs'- x = HM.fromList xs'- y = HM.fromList ys- -- Shuffle the list using indexes in the second- shuffle :: [Int] -> [a] -> [a]- shuffle idxs = L.map snd- . L.sortBy (comparing fst)- . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])----------------------------------------------------------------------------- ** Basic interface--pSize :: [(Key, Int)] -> Bool-pSize = M.size `eq` HM.size--pMember :: Key -> [(Key, Int)] -> Bool-pMember k = M.member k `eq` HM.member k--pLookup :: Key -> [(Key, Int)] -> Bool-pLookup k = M.lookup k `eq` HM.lookup k--pLookupOperator :: Key -> [(Key, Int)] -> Bool-pLookupOperator k = M.lookup k `eq` (HM.!? k)--pInsert :: Key -> Int -> [(Key, Int)] -> Bool-pInsert k v = M.insert k v `eq_` HM.insert k v--pDelete :: Key -> [(Key, Int)] -> Bool-pDelete k = M.delete k `eq_` HM.delete k--newtype AlwaysCollide = AC Int- deriving (Arbitrary, Eq, Ord, Show)--instance Hashable AlwaysCollide where- hashWithSalt _ _ = 1---- White-box test that tests the case of deleting one of two keys from--- a map, where the keys' hash values collide.-pDeleteCollision :: AlwaysCollide -> AlwaysCollide -> AlwaysCollide -> Int- -> Property-pDeleteCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==>- HM.member toKeep $ HM.delete toDelete $- HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)]- where- which = idx `mod` 3- toDelete- | which == 0 = k1- | which == 1 = k2- | which == 2 = k3- | otherwise = error "Impossible"- toKeep- | which == 0 = k2- | which == 1 = k3- | which == 2 = k1- | otherwise = error "Impossible"--pInsertWith :: Key -> [(Key, Int)] -> Bool-pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1--pAdjust :: Key -> [(Key, Int)] -> Bool-pAdjust k = M.adjust succ k `eq_` HM.adjust succ k--pUpdateAdjust :: Key -> [(Key, Int)] -> Bool-pUpdateAdjust k = M.update (Just . succ) k `eq_` HM.update (Just . succ) k--pUpdateDelete :: Key -> [(Key, Int)] -> Bool-pUpdateDelete k = M.update (const Nothing) k `eq_` HM.update (const Nothing) k--pAlterAdjust :: Key -> [(Key, Int)] -> Bool-pAlterAdjust k = M.alter (fmap succ) k `eq_` HM.alter (fmap succ) k--pAlterInsert :: Key -> [(Key, Int)] -> Bool-pAlterInsert k = M.alter (const $ Just 3) k `eq_` HM.alter (const $ Just 3) k--pAlterDelete :: Key -> [(Key, Int)] -> Bool-pAlterDelete k = M.alter (const Nothing) k `eq_` HM.alter (const Nothing) k----- We choose the list functor here because we don't fuss with--- it in alterF rules and because it has a sufficiently interesting--- structure to have a good chance of breaking if something is wrong.-pAlterF :: Key -> Fun (Maybe A) [Maybe A] -> [(Key, A)] -> Property-pAlterF k f xs =- fmap M.toAscList (M.alterF (apply f) k (M.fromList xs))- ===- fmap toAscList (HM.alterF (apply f) k (HM.fromList xs))--#if !MIN_VERSION_base(4,8,0)-newtype Identity a = Identity {runIdentity :: a}-instance Functor Identity where- fmap f (Identity x) = Identity (f x)-#endif--pAlterFAdjust :: Key -> [(Key, Int)] -> Bool-pAlterFAdjust k =- runIdentity . M.alterF (Identity . fmap succ) k `eq_`- runIdentity . HM.alterF (Identity . fmap succ) k--pAlterFInsert :: Key -> [(Key, Int)] -> Bool-pAlterFInsert k =- runIdentity . M.alterF (const . Identity . Just $ 3) k `eq_`- runIdentity . HM.alterF (const . Identity . Just $ 3) k--pAlterFInsertWith :: Key -> Fun Int Int -> [(Key, Int)] -> Bool-pAlterFInsertWith k f =- runIdentity . M.alterF (Identity . Just . maybe 3 (apply f)) k `eq_`- runIdentity . HM.alterF (Identity . Just . maybe 3 (apply f)) k--pAlterFDelete :: Key -> [(Key, Int)] -> Bool-pAlterFDelete k =- runIdentity . M.alterF (const (Identity Nothing)) k `eq_`- runIdentity . HM.alterF (const (Identity Nothing)) k--pAlterFLookup :: Key- -> Fun (Maybe A) B- -> [(Key, A)] -> Bool-pAlterFLookup k f =- getConst . M.alterF (Const . apply f :: Maybe A -> Const B (Maybe A)) k- `eq`- getConst . HM.alterF (Const . apply f) k--pSubmap :: [(Key, Int)] -> [(Key, Int)] -> Bool-pSubmap xs ys = M.isSubmapOf (M.fromList xs) (M.fromList ys) ==- HM.isSubmapOf (HM.fromList xs) (HM.fromList ys)--pSubmapReflexive :: HashMap Key Int -> Bool-pSubmapReflexive m = HM.isSubmapOf m m--pSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Bool-pSubmapUnion m1 m2 = HM.isSubmapOf m1 (HM.union m1 m2)--pNotSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Property-pNotSubmapUnion m1 m2 = not (HM.isSubmapOf m1 m2) ==> HM.isSubmapOf m1 (HM.union m1 m2)--pSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Bool-pSubmapDifference m1 m2 = HM.isSubmapOf (HM.difference m1 m2) m1--pNotSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Property-pNotSubmapDifference m1 m2 =- not (HM.null (HM.intersection m1 m2)) ==>- not (HM.isSubmapOf m1 (HM.difference m1 m2))--pSubmapDelete :: HashMap Key Int -> Property-pSubmapDelete m = not (HM.null m) ==>- forAll (elements (HM.keys m)) $ \k ->- HM.isSubmapOf (HM.delete k m) m--pNotSubmapDelete :: HashMap Key Int -> Property-pNotSubmapDelete m =- not (HM.null m) ==>- forAll (elements (HM.keys m)) $ \k ->- not (HM.isSubmapOf m (HM.delete k m))--pSubmapInsert :: Key -> Int -> HashMap Key Int -> Property-pSubmapInsert k v m = not (HM.member k m) ==> HM.isSubmapOf m (HM.insert k v m)--pNotSubmapInsert :: Key -> Int -> HashMap Key Int -> Property-pNotSubmapInsert k v m = not (HM.member k m) ==> not (HM.isSubmapOf (HM.insert k v m) m)----------------------------------------------------------------------------- ** Combine--pUnion :: [(Key, Int)] -> [(Key, Int)] -> Bool-pUnion xs ys = M.union (M.fromList xs) `eq_` HM.union (HM.fromList xs) $ ys--pUnionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool-pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_`- HM.unionWith (-) (HM.fromList xs) $ ys--pUnionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool-pUnionWithKey xs ys = M.unionWithKey go (M.fromList xs) `eq_`- HM.unionWithKey go (HM.fromList xs) $ ys- where- go :: Key -> Int -> Int -> Int- go (K k) i1 i2 = k - i1 + i2--pUnions :: [[(Key, Int)]] -> Bool-pUnions xss = M.toAscList (M.unions (map M.fromList xss)) ==- toAscList (HM.unions (map HM.fromList xss))----------------------------------------------------------------------------- ** Transformations--pMap :: [(Key, Int)] -> Bool-pMap = M.map (+ 1) `eq_` HM.map (+ 1)--pTraverse :: [(Key, Int)] -> Bool-pTraverse xs =- L.sort (fmap (L.sort . M.toList) (M.traverseWithKey (\_ v -> [v + 1, v + 2]) (M.fromList (take 10 xs))))- == L.sort (fmap (L.sort . HM.toList) (HM.traverseWithKey (\_ v -> [v + 1, v + 2]) (HM.fromList (take 10 xs))))----------------------------------------------------------------------------- ** Difference and intersection--pDifference :: [(Key, Int)] -> [(Key, Int)] -> Bool-pDifference xs ys = M.difference (M.fromList xs) `eq_`- HM.difference (HM.fromList xs) $ ys--pDifferenceWith :: [(Key, Int)] -> [(Key, Int)] -> Bool-pDifferenceWith xs ys = M.differenceWith f (M.fromList xs) `eq_`- HM.differenceWith f (HM.fromList xs) $ ys- where- f x y = if x == 0 then Nothing else Just (x - y)--pIntersection :: [(Key, Int)] -> [(Key, Int)] -> Bool-pIntersection xs ys = M.intersection (M.fromList xs) `eq_`- HM.intersection (HM.fromList xs) $ ys--pIntersectionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool-pIntersectionWith xs ys = M.intersectionWith (-) (M.fromList xs) `eq_`- HM.intersectionWith (-) (HM.fromList xs) $ ys--pIntersectionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool-pIntersectionWithKey xs ys = M.intersectionWithKey go (M.fromList xs) `eq_`- HM.intersectionWithKey go (HM.fromList xs) $ ys- where- go :: Key -> Int -> Int -> Int- go (K k) i1 i2 = k - i1 - i2----------------------------------------------------------------------------- ** Folds--pFoldr :: [(Int, Int)] -> Bool-pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) [])--pFoldl :: [(Int, Int)] -> Bool-pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) [])--#if MIN_VERSION_base(4,10,0)-pBifoldMap :: [(Int, Int)] -> Bool-pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m- where f (k, v) = [k, v]- m = HM.fromList xs--pBifoldr :: [(Int, Int)] -> Bool-pBifoldr xs = concatMap f (HM.toList m) == bifoldr (:) (:) [] m- where f (k, v) = [k, v]- m = HM.fromList xs--pBifoldl :: [(Int, Int)] -> Bool-pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m- where f (k, v) = [k, v]- m = HM.fromList xs-#endif--pFoldrWithKey :: [(Int, Int)] -> Bool-pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq`- (sortByKey . HM.foldrWithKey f [])- where f k v z = (k, v) : z--pFoldMapWithKey :: [(Int, Int)] -> Bool-pFoldMapWithKey = (sortByKey . M.foldMapWithKey f) `eq`- (sortByKey . HM.foldMapWithKey f)- where f k v = [(k, v)]--pFoldrWithKey' :: [(Int, Int)] -> Bool-pFoldrWithKey' = (sortByKey . M.foldrWithKey' f []) `eq`- (sortByKey . HM.foldrWithKey' f [])- where f k v z = (k, v) : z--pFoldlWithKey :: [(Int, Int)] -> Bool-pFoldlWithKey = (sortByKey . M.foldlWithKey f []) `eq`- (sortByKey . HM.foldlWithKey f [])- where f z k v = (k, v) : z--pFoldlWithKey' :: [(Int, Int)] -> Bool-pFoldlWithKey' = (sortByKey . M.foldlWithKey' f []) `eq`- (sortByKey . HM.foldlWithKey' f [])- where f z k v = (k, v) : z--pFoldl' :: [(Int, Int)] -> Bool-pFoldl' = (L.sort . M.foldl' (flip (:)) []) `eq` (L.sort . HM.foldl' (flip (:)) [])--pFoldr' :: [(Int, Int)] -> Bool-pFoldr' = (L.sort . M.foldr' (:) []) `eq` (L.sort . HM.foldr' (:) [])----------------------------------------------------------------------------- ** Filter--pMapMaybeWithKey :: [(Key, Int)] -> Bool-pMapMaybeWithKey = M.mapMaybeWithKey f `eq_` HM.mapMaybeWithKey f- where f k v = guard (odd (unK k + v)) >> Just (v + 1)--pMapMaybe :: [(Key, Int)] -> Bool-pMapMaybe = M.mapMaybe f `eq_` HM.mapMaybe f- where f v = guard (odd v) >> Just (v + 1)--pFilter :: [(Key, Int)] -> Bool-pFilter = M.filter odd `eq_` HM.filter odd--pFilterWithKey :: [(Key, Int)] -> Bool-pFilterWithKey = M.filterWithKey p `eq_` HM.filterWithKey p- where p k v = odd (unK k + v)----------------------------------------------------------------------------- ** Conversions---- The free magma is used to test that operations are applied in the--- same order.-data Magma a- = Leaf a- | Op (Magma a) (Magma a)- deriving (Show, Eq, Ord)--instance Hashable a => Hashable (Magma a) where- hashWithSalt s (Leaf a) = hashWithSalt s (hashWithSalt (1::Int) a)- hashWithSalt s (Op m n) = hashWithSalt s (hashWithSalt (hashWithSalt (2::Int) m) n)---- 'eq_' already calls fromList.-pFromList :: [(Key, Int)] -> Bool-pFromList = id `eq_` id--pFromListWith :: [(Key, Int)] -> Bool-pFromListWith kvs = (M.toAscList $ M.fromListWith Op kvsM) ==- (toAscList $ HM.fromListWith Op kvsM)- where kvsM = fmap (fmap Leaf) kvs--pFromListWithKey :: [(Key, Int)] -> Bool-pFromListWithKey kvs = (M.toAscList $ M.fromListWithKey combine kvsM) ==- (toAscList $ HM.fromListWithKey combine kvsM)- where kvsM = fmap (\(K k,v) -> (Leaf k, Leaf v)) kvs- combine k v1 v2 = Op k (Op v1 v2)--pToList :: [(Key, Int)] -> Bool-pToList = M.toAscList `eq` toAscList--pElems :: [(Key, Int)] -> Bool-pElems = (L.sort . M.elems) `eq` (L.sort . HM.elems)--pKeys :: [(Key, Int)] -> Bool-pKeys = (L.sort . M.keys) `eq` (L.sort . HM.keys)----------------------------------------------------------------------------- * Test list--tests :: [Test]-tests =- [- -- Instances- testGroup "instances"- [ testProperty "==" pEq- , testProperty "/=" pNeq- , testProperty "compare reflexive" pOrd1- , testProperty "compare transitive" pOrd2- , testProperty "compare antisymmetric" pOrd3- , testProperty "Ord => Eq" pOrdEq- , testProperty "Read/Show" pReadShow- , testProperty "Functor" pFunctor- , testProperty "Foldable" pFoldable- , testProperty "Hashable" pHashable- ]- -- Basic interface- , testGroup "basic interface"- [ testProperty "size" pSize- , testProperty "member" pMember- , testProperty "lookup" pLookup- , testProperty "!?" pLookupOperator- , testProperty "insert" pInsert- , testProperty "delete" pDelete- , testProperty "deleteCollision" pDeleteCollision- , testProperty "insertWith" pInsertWith- , testProperty "adjust" pAdjust- , testProperty "updateAdjust" pUpdateAdjust- , testProperty "updateDelete" pUpdateDelete- , testProperty "alterAdjust" pAlterAdjust- , testProperty "alterInsert" pAlterInsert- , testProperty "alterDelete" pAlterDelete- , testProperty "alterF" pAlterF- , testProperty "alterFAdjust" pAlterFAdjust- , testProperty "alterFInsert" pAlterFInsert- , testProperty "alterFInsertWith" pAlterFInsertWith- , testProperty "alterFDelete" pAlterFDelete- , testProperty "alterFLookup" pAlterFLookup- , testGroup "isSubmapOf"- [ testProperty "container compatibility" pSubmap- , testProperty "m ⊆ m" pSubmapReflexive- , testProperty "m1 ⊆ m1 ∪ m2" pSubmapUnion- , testProperty "m1 ⊈ m2 ⇒ m1 ∪ m2 ⊈ m1" pNotSubmapUnion- , testProperty "m1\\m2 ⊆ m1" pSubmapDifference- , testProperty "m1 ∩ m2 ≠ ∅ ⇒ m1 ⊈ m1\\m2 " pNotSubmapDifference- , testProperty "delete k m ⊆ m" pSubmapDelete- , testProperty "m ⊈ delete k m " pNotSubmapDelete- , testProperty "k ∉ m ⇒ m ⊆ insert k v m" pSubmapInsert- , testProperty "k ∉ m ⇒ insert k v m ⊈ m" pNotSubmapInsert- ]- ]- -- Combine- , testProperty "union" pUnion- , testProperty "unionWith" pUnionWith- , testProperty "unionWithKey" pUnionWithKey- , testProperty "unions" pUnions- -- Transformations- , testProperty "map" pMap- , testProperty "traverse" pTraverse- -- Folds- , testGroup "folds"- [ testProperty "foldr" pFoldr- , testProperty "foldl" pFoldl-#if MIN_VERSION_base(4,10,0)- , testProperty "bifoldMap" pBifoldMap- , testProperty "bifoldr" pBifoldr- , testProperty "bifoldl" pBifoldl-#endif- , testProperty "foldrWithKey" pFoldrWithKey- , testProperty "foldlWithKey" pFoldlWithKey- , testProperty "foldrWithKey'" pFoldrWithKey'- , testProperty "foldlWithKey'" pFoldlWithKey'- , testProperty "foldl'" pFoldl'- , testProperty "foldr'" pFoldr'- , testProperty "foldMapWithKey" pFoldMapWithKey- ]- , testGroup "difference and intersection"- [ testProperty "difference" pDifference- , testProperty "differenceWith" pDifferenceWith- , testProperty "intersection" pIntersection- , testProperty "intersectionWith" pIntersectionWith- , testProperty "intersectionWithKey" pIntersectionWithKey- ]- -- Filter- , testGroup "filter"- [ testProperty "filter" pFilter- , testProperty "filterWithKey" pFilterWithKey- , testProperty "mapMaybe" pMapMaybe- , testProperty "mapMaybeWithKey" pMapMaybeWithKey- ]- -- Conversions- , testGroup "conversions"- [ testProperty "elems" pElems- , testProperty "keys" pKeys- , testProperty "fromList" pFromList- , testProperty "fromListWith" pFromListWith- , testProperty "fromListWithKey" pFromListWithKey- , testProperty "toList" pToList- ]- ]----------------------------------------------------------------------------- * Model--type Model k v = M.Map k v---- | Check that a function operating on a 'HashMap' is equivalent to--- one operating on a 'Model'.-eq :: (Eq a, Eq k, Hashable k, Ord k)- => (Model k v -> a) -- ^ Function that modifies a 'Model'- -> (HM.HashMap k v -> a) -- ^ Function that modified a 'HashMap' in the same- -- way- -> [(k, v)] -- ^ Initial content of the 'HashMap' and 'Model'- -> Bool -- ^ True if the functions are equivalent-eq f g xs = g (HM.fromList xs) == f (M.fromList xs)--infix 4 `eq`--eq_ :: (Eq k, Eq v, Hashable k, Ord k)- => (Model k v -> Model k v) -- ^ Function that modifies a 'Model'- -> (HM.HashMap k v -> HM.HashMap k v) -- ^ Function that modified a- -- 'HashMap' in the same way- -> [(k, v)] -- ^ Initial content of the 'HashMap'- -- and 'Model'- -> Bool -- ^ True if the functions are- -- equivalent-eq_ f g = (M.toAscList . f) `eq` (toAscList . g)--infix 4 `eq_`----------------------------------------------------------------------------- * Test harness--main :: IO ()-main = defaultMain tests----------------------------------------------------------------------------- * Helpers--sortByKey :: Ord k => [(k, v)] -> [(k, v)]-sortByKey = L.sortBy (compare `on` fst)--toAscList :: Ord k => HM.HashMap k v -> [(k, v)]-toAscList = L.sortBy (compare `on` fst) . HM.toList
tests/IntMapValidity.hs view
@@ -2,7 +2,7 @@ import Data.Bits (xor, (.&.)) import Data.Strict.IntMap.Autogen.Internal-import Test.QuickCheck (Property, counterexample, property, (.&&.))+import Test.Tasty.QuickCheck (Property, counterexample, property, (.&&.)) import Data.Strict.ContainersUtils.Autogen.BitUtil (bitcount) {--------------------------------------------------------------------
tests/Tests/Bundle.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ConstraintKinds #-} module Tests.Bundle ( tests ) where import Boilerplater@@ -13,16 +14,11 @@ import Text.Show.Functions () import Data.List (foldl', foldl1', unfoldr, find, findIndex) --- migration from testframework to tasty-type Test = TestTree -#define COMMON_CONTEXT(a) \- VANILLA_CONTEXT(a)--#define VANILLA_CONTEXT(a) \- Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property+type CommonContext a = ( Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a+ , Model a ~ a, EqTest a ~ Property) -testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]+testSanity :: forall v a. (CommonContext a) => S.Bundle v a -> [TestTree] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList@@ -33,7 +29,7 @@ prop_toList_fromList :: P ([a] -> [a]) = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id -testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]+testPolymorphicFunctions :: forall v a. (CommonContext a) => S.Bundle v a -> [TestTree] testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, @@ -151,7 +147,7 @@ = (\n f a -> S.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) -testBoolFunctions :: forall v. S.Bundle v Bool -> [Test]+testBoolFunctions :: forall v. S.Bundle v Bool -> [TestTree] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ]) where prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and
tests/Tests/Vector/Boxed.hs view
@@ -8,7 +8,9 @@ import GHC.Exts (inline) -testGeneralBoxedVector :: forall a. (CommonContext a Data.Strict.Vector.Vector, Ord a, Data a) => Data.Strict.Vector.Vector a -> [Test]+testGeneralBoxedVector+ :: forall a. (CommonContext a Data.Strict.Vector.Vector, Ord a, Data a)+ => Data.Strict.Vector.Vector a -> [TestTree] testGeneralBoxedVector dummy = concatMap ($ dummy) [ testSanity@@ -31,7 +33,9 @@ , testBoolFunctions ] -testNumericBoxedVector :: forall a. (CommonContext a Data.Strict.Vector.Vector, Ord a, Num a, Enum a, Random a, Data a) => Data.Strict.Vector.Vector a -> [Test]+testNumericBoxedVector+ :: forall a. (CommonContext a Data.Strict.Vector.Vector, Ord a, Num a, Enum a, Random a, Data a)+ => Data.Strict.Vector.Vector a -> [TestTree] testNumericBoxedVector dummy = concatMap ($ dummy) [ testGeneralBoxedVector@@ -44,4 +48,5 @@ testBoolBoxedVector (undefined :: Data.Strict.Vector.Vector Bool) , testGroup "Int" $ testNumericBoxedVector (undefined :: Data.Strict.Vector.Vector Int)+ , testGroup "unstream" $ testUnstream (undefined :: Data.Strict.Vector.Vector Int) ]
tests/Tests/Vector/Property.hs view
@@ -18,10 +18,10 @@ , testNumFunctions , testNestedVectorFunctions , testDataFunctions+ , testUnstream -- re-exports , Data , Random- , Test ) where import Boilerplater@@ -30,8 +30,6 @@ import Control.Monad import Control.Monad.ST import qualified Data.Traversable as T (Traversable(..))-import Data.Foldable (Foldable(foldMap))-import Data.Functor.Identity import Data.Orphans () import Data.Foldable (foldrM) import qualified Data.Vector.Generic as V@@ -46,7 +44,6 @@ import Text.Show.Functions () import Data.List -import Data.Monoid import qualified Control.Applicative as Applicative import System.Random (Random)@@ -67,8 +64,6 @@ type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a) , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a) --- | migration hack for moving from TestFramework to Tasty-type Test = TestTree -- TODO: implement Vector equivalents of list functions for some of the commented out properties -- TODO: add tests for the other extra functions@@ -77,7 +72,7 @@ -- new, -- unsafeSlice, unsafeIndex, -testSanity :: forall a v. (CommonContext a v) => v a -> [Test]+testSanity :: forall a v. (CommonContext a v) => v a -> [TestTree] {-# INLINE testSanity #-} testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList,@@ -91,7 +86,7 @@ prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s -testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test]+testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [TestTree] -- FIXME: inlining of unboxed properties blows up the memory during compilation. See #272 --{-# INLINE testPolymorphicFunctions #-} testPolymorphicFunctions _ = $(testProperties [@@ -174,6 +169,7 @@ 'prop_partition, {- 'prop_unstablePartition, -} 'prop_partitionWith, 'prop_span, 'prop_break,+ 'prop_groupBy, -- Searching 'prop_elem, 'prop_notElem,@@ -339,6 +335,7 @@ = V.partitionWith `eq` partitionWith prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break+ prop_groupBy :: P ((a -> a -> Bool) -> v a -> [v a]) = V.groupBy `eq` groupBy prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem@@ -398,10 +395,10 @@ = V.scanl `eq` scanl prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanl' `eq` scanl- prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanl1 `eq` scanl1- prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanl1' `eq` scanl1+ prop_scanl1 :: P ((a -> a -> a) -> v a -> v a)+ = V.scanl1 `eq` scanl1+ prop_scanl1' :: P ((a -> a -> a) -> v a -> v a)+ = V.scanl1' `eq` scanl1 prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a) = V.iscanl `eq` iscanl prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a)@@ -423,10 +420,10 @@ = V.iscanr `eq` iscanr prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) = V.iscanr' `eq` iscanr- prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanr1 `eq` scanr1- prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>- V.scanr1' `eq` scanr1+ prop_scanr1 :: P ((a -> a -> a) -> v a -> v a)+ = V.scanr1 `eq` scanr1+ prop_scanr1' :: P ((a -> a -> a) -> v a -> v a)+ = V.scanr1' `eq` scanr1 prop_concatMap = forAll arbitrary $ \xs -> forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs@@ -604,7 +601,7 @@ , VectorContext (a, a, a) v , VectorContext (Int, a) v )- => v a -> [Test]+ => v a -> [TestTree] {-# INLINE testTuplyFunctions #-} testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 , 'prop_unzip, 'prop_unzip3@@ -623,30 +620,34 @@ where prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) -testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test]+testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [TestTree] {-# INLINE testOrdFunctions #-} testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum, 'prop_minIndex, 'prop_maxIndex, 'prop_maximumBy, 'prop_minimumBy,+ 'prop_maximumOn, 'prop_minimumOn, 'prop_maxIndexBy, 'prop_minIndexBy,- 'prop_ListLastMaxIndexWins, 'prop_FalseListFirstMaxIndexWins ])+ 'prop_ListFirstMaxIndexWins, 'prop_FalseListFirstMaxIndexWins ]) where prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex- prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` listMaxIndexFMW+ prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex prop_maximumBy :: P (v a -> a) = not . V.null ===> V.maximumBy compare `eq` maximum prop_minimumBy :: P (v a -> a) = not . V.null ===> V.minimumBy compare `eq` minimum+ prop_maximumOn :: P (v a -> a) =+ not . V.null ===> V.maximumOn id `eq` maximum+ prop_minimumOn :: P (v a -> a) =+ not . V.null ===> V.minimumOn id `eq` minimum prop_maxIndexBy :: P (v a -> Int) =- not . V.null ===> V.maxIndexBy compare `eq` listMaxIndexFMW- --- (maxIndex)- prop_ListLastMaxIndexWins :: P (v a -> Int) =- not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexLMW+ not . V.null ===> V.maxIndexBy compare `eq` maxIndex+ prop_ListFirstMaxIndexWins :: P (v a -> Int) =+ not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexFMW prop_FalseListFirstMaxIndexWinsDesc :: P (v a -> Int) = (\x -> not $ V.null x && (V.uniq x /= x ) )===> ( maxIndex . V.toList) `eq` listMaxIndexFMW prop_FalseListFirstMaxIndexWins :: Property@@ -657,9 +658,6 @@ listMaxIndexFMW :: Ord a => [a] -> Int listMaxIndexFMW = ( fst . extractFMW . sconcat . DLE.fromList . fmap FMW . zip [0 :: Int ..]) -listMaxIndexLMW :: Ord a => [a] -> Int-listMaxIndexLMW = ( fst . extractLMW . sconcat . DLE.fromList . fmap LMW . zip [0 :: Int ..])- newtype LastMaxWith a i = LMW {extractLMW:: (i,a)} deriving(Eq,Show,Read) instance (Ord a) => Semigroup (LastMaxWith a i) where@@ -674,7 +672,7 @@ | otherwise = x -testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test]+testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [TestTree] {-# INLINE testEnumFunctions #-} testEnumFunctions _ = $(testProperties [ 'prop_enumFromN, 'prop_enumFromThenN,@@ -706,7 +704,7 @@ where d = abs (j-i) -testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test]+testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [TestTree] {-# INLINE testMonoidFunctions #-} testMonoidFunctions _ = $(testProperties [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ])@@ -715,14 +713,14 @@ prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat -testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test]+testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [TestTree] {-# INLINE testFunctorFunctions #-} testFunctorFunctions _ = $(testProperties [ 'prop_fmap ]) where prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap -testMonadFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, MonadZip v) => v a -> [Test]+testMonadFunctions :: forall a v. (CommonContext a v, VectorContext (a, a) v, MonadZip v) => v a -> [TestTree] {-# INLINE testMonadFunctions #-} testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind , 'prop_mzip, 'prop_munzip@@ -741,7 +739,7 @@ , Show (v (Writer [a] a)) , TestData (v (Writer [a] a)) )- => v a -> [Test]+ => v a -> [TestTree] testSequenceFunctions _ = $(testProperties [ 'prop_sequence, 'prop_sequence_ ]) where@@ -750,7 +748,7 @@ prop_sequence_ :: P (v (Writer [a] a) -> Writer [a] ()) = V.sequence_ `eq` sequence_ -testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test]+testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [TestTree] {-# INLINE testApplicativeFunctions #-} testApplicativeFunctions _ = $(testProperties [ 'prop_applicative_pure, 'prop_applicative_appl ])@@ -760,7 +758,7 @@ prop_applicative_appl :: [a -> a] -> P (v a -> v a) = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs -testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test]+testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [TestTree] {-# INLINE testAlternativeFunctions #-} testAlternativeFunctions _ = $(testProperties [ 'prop_alternative_empty, 'prop_alternative_or ])@@ -769,21 +767,21 @@ prop_alternative_or :: P (v a -> v a -> v a) = (Applicative.<|>) `eq` (Applicative.<|>) -testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test]+testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [TestTree] {-# INLINE testBoolFunctions #-} testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) where prop_and :: P (v Bool -> Bool) = V.and `eq` and prop_or :: P (v Bool -> Bool) = V.or `eq` or -testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test]+testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [TestTree] {-# INLINE testNumFunctions #-} testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) where prop_sum :: P (v a -> a) = V.sum `eq` sum prop_product :: P (v a -> a) = V.product `eq` product -testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test]+testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [TestTree] {-# INLINE testNestedVectorFunctions #-} testNestedVectorFunctions _ = $(testProperties [ 'prop_concat@@ -791,7 +789,7 @@ where prop_concat :: P ([v a] -> v a) = V.concat `eq` concat -testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [Test]+testDataFunctions :: forall a v. (CommonContext a v, Data a, Data (v a)) => v a -> [TestTree] {-# INLINE testDataFunctions #-} testDataFunctions _ = $(testProperties ['prop_glength]) where@@ -802,3 +800,32 @@ toA :: Data b => b -> Int toA x = maybe (glength x) (const 1) (cast x :: Maybe a)++testUnstream :: forall v. (CommonContext Int v) => v Int -> [TestTree]+{-# INLINE testUnstream #-}+testUnstream _ =+ [ testProperty "unstream == vunstream (exact)" $ \(n :: Int) ->+ let v1,v2 :: v Int+ v1 = runST $ V.freeze =<< MV.unstream (streamExact n)+ v2 = runST $ V.freeze =<< MV.vunstream (streamExact n)+ in v1 == v2+ , testProperty "unstream == vunstream (unknown)" $ \(n :: Int) ->+ let v1,v2 :: v Int+ v1 = runST $ V.freeze =<< MV.unstream (streamUnknown n)+ v2 = runST $ V.freeze =<< MV.vunstream (streamUnknown n)+ in v1 == v2+ --+ , testProperty "unstreamR ~= vunstream (exact)" $ \(n :: Int) ->+ let v1,v2 :: v Int+ v1 = runST $ V.freeze =<< MV.unstreamR (streamExact n)+ v2 = runST $ V.freeze =<< MV.vunstream (streamExact n)+ in V.reverse v1 == v2+ , testProperty "unstreamR ~= vunstream (unknown)" $ \(n :: Int) ->+ let v1,v2 :: v Int+ v1 = runST $ V.freeze =<< MV.unstreamR (streamUnknown n)+ v2 = runST $ V.freeze =<< MV.vunstream (streamUnknown n)+ in V.reverse v1 == v2+ ]+ where+ streamExact n = S.generate (abs n) id+ streamUnknown = S.unfoldr (\i -> if i > 0 then (Just (i-1,i-1)) else Nothing) . abs
tests/Tests/Vector/UnitTests.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+ {-# LANGUAGE ScopedTypeVariables #-} module Tests.Vector.UnitTests (tests) where@@ -13,6 +13,7 @@ import qualified Data.List as List import qualified Data.Vector.Generic as Generic import qualified Data.Strict.Vector as Boxed+import qualified Data.Strict.Vector.Autogen.Internal.Check as Check import qualified Data.Strict.Vector.Autogen.Mutable as MBoxed import qualified Data.Vector.Primitive as Primitive import qualified Data.Vector.Storable as Storable@@ -44,6 +45,12 @@ dummy :: a dummy = undefined +withBoundsChecksOnly :: [TestTree] -> [TestTree]+withBoundsChecksOnly ts =+ if Check.doChecks Check.Bounds+ then ts+ else []+ tests :: [TestTree] tests = [ testGroup "Data.Vector.Storable.Vector Alignment"@@ -67,14 +74,15 @@ , regression188 ([] :: [Char]) ] ]- , testGroup "Negative tests"- [ testGroup "slice out of bounds #257"+ , testGroup "Negative tests" $+ withBoundsChecksOnly [ testGroup "slice out of bounds #257" [ testGroup "Boxed" $ testsSliceOutOfBounds Boxed.slice , testGroup "Primitive" $ testsSliceOutOfBounds Primitive.slice , testGroup "Storable" $ testsSliceOutOfBounds Storable.slice , testGroup "Unboxed" $ testsSliceOutOfBounds Unboxed.slice- ]- , testGroup "take #282"+ ]]+ +++ [ testGroup "take #282" [ testCase "Boxed" $ testTakeOutOfMemory Boxed.take , testCase "Primitive" $ testTakeOutOfMemory Primitive.take , testCase "Storable" $ testTakeOutOfMemory Storable.take@@ -84,6 +92,8 @@ , testGroup "Data.Vector" [ testCase "MonadFix" checkMonadFix , testCase "toFromArray" toFromArray+ , testCase "toFromArraySlice" toFromArraySlice+ , testCase "toFromArraySliceUnsafe" toFromArraySliceUnsafe , testCase "toFromMutableArray" toFromMutableArray ] ]@@ -130,7 +140,7 @@ in assertBool assertMsg (errSuffix `List.isSuffixOf` err) where errSuffix =- "(slice): invalid slice (" +++ "invalid slice (" ++ show i ++ "," ++ show m ++ "," ++ show (List.length xs) ++ ")" {-# INLINE sliceTest #-} @@ -156,13 +166,11 @@ alignedIntVec :: Storable.Vector (Aligned Int) alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] -#if __GLASGOW_HASKELL__ >= 800 -- Ensure that Mutable is really an injective type family by typechecking a -- function which relies on injectivity. _f :: (Generic.Vector v a, Generic.Vector w a, PrimMonad f) => Generic.Mutable v (PrimState f) a -> f (w a) _f v = Generic.convert `fmap` Generic.unsafeFreeze v-#endif checkMonadFix :: Assertion checkMonadFix = assertBool "checkMonadFix" $@@ -196,6 +204,22 @@ toFromArray = mkArrayRoundtrip $ \name v -> assertEqual name v $ Boxed.fromArray (Boxed.toArray v)++toFromArraySlice :: Assertion+toFromArraySlice =+ mkArrayRoundtrip $ \name v ->+ case Boxed.toArraySlice v of+ (arr, off, n) ->+ assertEqual name v $+ Boxed.take n (Boxed.drop off (Boxed.fromArray arr))++toFromArraySliceUnsafe :: Assertion+toFromArraySliceUnsafe =+ mkArrayRoundtrip $ \name v ->+ case Boxed.toArraySlice v of+ (arr, off, n) ->+ assertEqual name v $+ Boxed.unsafeFromArraySlice arr off n toFromMutableArray :: Assertion toFromMutableArray = mkArrayRoundtrip assetRoundtrip
tests/Utilities.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleInstances, GADTs #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} module Utilities where import Test.QuickCheck@@ -16,7 +17,6 @@ import Data.Function (on) import Data.Functor.Identity import Data.List ( sortBy )-import Data.Monoid import Data.Maybe (catMaybes) instance Show a => Show (S.Bundle v a) where@@ -350,7 +350,7 @@ maxIndex :: Ord a => [a] -> Int maxIndex = fst . foldr1 imax . zip [0..] where- imax (i,x) (j,y) | x > y = (i,x)+ imax (i,x) (j,y) | x >= y = (i,x) | otherwise = (j,y) iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a]
+ tests/Utils/NoThunks.hs view
@@ -0,0 +1,15 @@+module Utils.NoThunks (whnfHasNoThunks) where++import Data.Maybe (isNothing)++import NoThunks.Class (NoThunks, noThunks)+import Test.QuickCheck (Property, ioProperty)++-- | Check that after evaluating the argument to weak head normal form there+-- are no thunks.+--+whnfHasNoThunks :: NoThunks a => a -> Property+whnfHasNoThunks a = ioProperty+ . fmap isNothing+ . noThunks []+ $! a
tests/intmap-properties.hs view
@@ -27,18 +27,16 @@ import Data.List (nub,sort) import qualified Data.List as List import qualified Data.IntSet as IntSet-import Test.Framework-import Test.Framework.Providers.HUnit-import Test.Framework.Providers.QuickCheck2-import Test.HUnit hiding (Test, Testable)-import Test.QuickCheck-import Test.QuickCheck.Function (Fun(..), apply)+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Test.QuickCheck.Function (apply) import Test.QuickCheck.Poly (A, B, C) default (Int) main :: IO ()-main = defaultMain+main = defaultMain $ testGroup "intmap-properties" [ testCase "index" test_index , testCase "index_lookup" test_index_lookup@@ -133,10 +131,8 @@ , testCase "maxView" test_maxView , testCase "minViewWithKey" test_minViewWithKey , testCase "maxViewWithKey" test_maxViewWithKey-#if MIN_VERSION_base(4,8,0) , testCase "minimum" test_minimum , testCase "maximum" test_maximum-#endif , testProperty "valid" prop_valid , testProperty "empty valid" prop_emptyValid , testProperty "insert to singleton" prop_singleton@@ -238,16 +234,6 @@ type SMap = IntMap String ------------------------------------------------------------------tests :: [Test]-tests = [ testGroup "Test Case" [- ]- , testGroup "Property Test" [- ]- ]------------------------------------------------------------------- -- Unit tests ---------------------------------------------------------------- @@ -307,12 +293,17 @@ test_lookup :: Assertion test_lookup = do- employeeCurrency 1 @?= Just 1- employeeCurrency 2 @?= Nothing+ employeeCurrency 1 @?= Just 1+ employeeCurrency 2 @?= Just 2+ employeeCurrency 3 @?= Just 3+ employeeCurrency 4 @?= Just 4+ employeeCurrency 5 @?= Nothing+ employeeCurrency (2^10) @?= Just 42+ employeeCurrency 6 @?= Nothing where- employeeDept = fromList([(1,2), (3,1)])- deptCountry = fromList([(1,1), (2,2)])- countryCurrency = fromList([(1, 2), (2, 1)])+ employeeDept = fromList [(1,2), (2, 14), (3, 10), (4, 18), (2^10, 100)]+ deptCountry = fromList [(1,1), (14, 14), (10, 10), (18, 18), (100, 100), (2,2)]+ countryCurrency = fromList [(1, 2), (2, 1), (14, 2), (10, 3), (18, 4), (100, 42)] employeeCurrency :: Int -> Maybe Int employeeCurrency name = do dept <- lookup name employeeDept@@ -1117,8 +1108,6 @@ maxViewWithKey (fromList [(5,"a"), (-3,"b")]) @?= Just ((5,"a"), singleton (-3) "b") maxViewWithKey (empty :: SMap) @?= Nothing --#if MIN_VERSION_base(4,8,0) test_minimum :: Assertion test_minimum = do getOW (minimum testOrdMap) @?= "min"@@ -1139,8 +1128,6 @@ instance Ord a => Ord (OrdWith a) where OrdWith _ a1 <= OrdWith _ a2 = a1 <= a2-#endif- ---------------------------------------------------------------- -- Valid IntMaps
tests/intmap-strictness.hs view
@@ -5,12 +5,13 @@ module Main (main) where import Test.ChasingBottoms.IsBottom-import Test.Framework (Test, TestName, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(arbitrary))-import Test.QuickCheck.Function (Fun(..), apply)-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)+import Test.Tasty (TestTree, TestName, defaultMain, testGroup)+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty, Arbitrary(arbitrary), Fun)+#if __GLASGOW_HASKELL__ >= 806+import Test.Tasty.QuickCheck (Property)+#endif+import Test.QuickCheck.Function (apply) import Data.Strict.IntMap.Autogen.Strict (IntMap) import qualified Data.Strict.IntMap.Autogen.Strict as M@@ -18,6 +19,9 @@ import qualified Data.IntSet as IntSet import Utils.IsUnit+#if __GLASGOW_HASKELL__ >= 806+import Utils.NoThunks+#endif instance Arbitrary v => Arbitrary (IntMap v) where arbitrary = M.fromList `fmap` arbitrary@@ -103,6 +107,16 @@ where elems = [(k, v) | k <- nubInt ks, v <- [undefined, undefined, ()]] +#if __GLASGOW_HASKELL__ >= 806+pStrictFoldr' :: IntMap Int -> Property+pStrictFoldr' m = whnfHasNoThunks (M.foldr' (:) [] m)+#endif++#if __GLASGOW_HASKELL__ >= 806+pStrictFoldl' :: IntMap Int -> Property+pStrictFoldl' m = whnfHasNoThunks (M.foldl' (flip (:)) [] m)+#endif+ -- copy over definitions from Data.Containers.Utils so we can support older GHC -- that have older versions of containers without this module nubInt :: [Int] -> [Int]@@ -130,7 +144,7 @@ -- in most cases. An exception is `L.fromListWith const`, which cannot -- evaluate the `const` calls. -tExtraThunksM :: Test+tExtraThunksM :: TestTree tExtraThunksM = testGroup "IntMap.Strict - extra thunks" $ if not isUnitSupported then [] else -- for strict maps, all the values should be evaluated to ()@@ -145,15 +159,15 @@ ] where m0 = M.singleton 42 ()- check :: TestName -> IntMap () -> Test+ check :: TestName -> IntMap () -> TestTree check n m = testCase n $ case M.lookup 42 m of Just v -> assertBool msg (isUnit v)- _ -> assertString "key not found"+ _ -> assertBool "key not found" False where msg = "too lazy -- expected fully evaluated ()" -tExtraThunksL :: Test-tExtraThunksL = testGroup "IntMap.Strict - extra thunks" $+tExtraThunksL :: TestTree+tExtraThunksL = testGroup "IntMap.Lazy - extra thunks" $ if not isUnitSupported then [] else -- for lazy maps, the *With functions should leave `const () ()` thunks, -- but the other functions should produce fully evaluated ().@@ -171,10 +185,10 @@ ] where m0 = L.singleton 42 ()- check :: TestName -> Bool -> L.IntMap () -> Test+ check :: TestName -> Bool -> L.IntMap () -> TestTree check n e m = testCase n $ case L.lookup 42 m of Just v -> assertBool msg (e == isUnit v)- _ -> assertString "key not found"+ _ -> assertBool "key not found" False where msg | e = "too lazy -- expected fully evaluated ()" | otherwise = "too strict -- expected a thunk"@@ -182,7 +196,7 @@ ------------------------------------------------------------------------ -- * Test list -tests :: [Test]+tests :: [TestTree] tests = [ -- Basic interface@@ -208,6 +222,10 @@ pInsertLookupWithKeyValueStrict , testProperty "fromAscList is somewhat value-lazy" pFromAscListLazy , testProperty "fromAscList is somewhat value-strict" pFromAscListStrict+#if __GLASGOW_HASKELL__ >= 806+ , testProperty "strict foldr'" pStrictFoldr'+ , testProperty "strict foldl'" pStrictFoldl'+#endif ] , tExtraThunksM , tExtraThunksL@@ -217,7 +235,7 @@ -- * Test harness main :: IO ()-main = defaultMain tests+main = defaultMain $ testGroup "intmap-strictness" tests ------------------------------------------------------------------------ -- * Utilities
tests/map-properties.hs view
@@ -19,6 +19,7 @@ import Data.Maybe hiding (mapMaybe) import qualified Data.Maybe as Maybe (mapMaybe) import Data.Ord+import Data.Semigroup (Arg(..)) import Data.Function import qualified Data.Foldable as Foldable #if MIN_VERSION_base(4,10,0)@@ -30,12 +31,10 @@ import Data.List (nub,sort) import qualified Data.List as List import qualified Data.Set as Set-import Test.Framework-import Test.Framework.Providers.HUnit-import Test.Framework.Providers.QuickCheck2-import Test.HUnit hiding (Test, Testable)-import Test.QuickCheck-import Test.QuickCheck.Function (Fun (..), apply)+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Test.QuickCheck.Function (apply) import Test.QuickCheck.Poly (A, B) import Control.Arrow (first) @@ -48,7 +47,7 @@ apply2 f a b = apply f (a, b) main :: IO ()-main = defaultMain+main = defaultMain $ testGroup "map-properties" [ testCase "ticket4242" test_ticket4242 , testCase "index" test_index , testCase "size" test_size@@ -101,7 +100,9 @@ , testCase "keys" test_keys , testCase "assocs" test_assocs , testCase "keysSet" test_keysSet+ , testCase "argSet" test_argSet , testCase "fromSet" test_fromSet+ , testCase "fromArgSet" test_fromArgSet , testCase "toList" test_toList , testCase "fromList" test_fromList , testCase "fromListWith" test_fromListWith@@ -240,7 +241,9 @@ , testProperty "bifoldl'" prop_bifoldl' #endif , testProperty "keysSet" prop_keysSet+ , testProperty "argSet" prop_argSet , testProperty "fromSet" prop_fromSet+ , testProperty "fromArgSet" prop_fromArgSet , testProperty "takeWhileAntitone" prop_takeWhileAntitone , testProperty "dropWhileAntitone" prop_dropWhileAntitone , testProperty "spanAntitone" prop_spanAntitone@@ -713,11 +716,21 @@ keysSet (fromList [(5,"a"), (3,"b")]) @?= Set.fromList [3,5] keysSet (empty :: UMap) @?= Set.empty +test_argSet :: Assertion+test_argSet = do+ argSet (fromList [(5,"a"), (3,"b")]) @?= Set.fromList [Arg 3 "b",Arg 5 "a"]+ argSet (empty :: UMap) @?= Set.empty+ test_fromSet :: Assertion test_fromSet = do fromSet (\k -> replicate k 'a') (Set.fromList [3, 5]) @?= fromList [(5,"aaaaa"), (3,"aaa")] fromSet undefined Set.empty @?= (empty :: IMap) +test_fromArgSet :: Assertion+test_fromArgSet = do+ fromArgSet (Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) @?= fromList [(5,"aaaaa"), (3,"aaa")]+ fromArgSet Set.empty @?= (empty :: IMap)+ ---------------------------------------------------------------- -- Lists @@ -1558,7 +1571,16 @@ prop_keysSet xs = keysSet (fromList xs) == Set.fromList (List.map fst xs) +prop_argSet :: [(Int, Int)] -> Bool+prop_argSet xs =+ argSet (fromList xs) == Set.fromList (List.map (uncurry Arg) xs)+ prop_fromSet :: [(Int, Int)] -> Bool prop_fromSet ys = let xs = List.nubBy ((==) `on` fst) ys in fromSet (\k -> fromJust $ List.lookup k xs) (Set.fromList $ List.map fst xs) == fromList xs++prop_fromArgSet :: [(Int, Int)] -> Bool+prop_fromArgSet ys =+ let xs = List.nubBy ((==) `on` fst) ys+ in fromArgSet (Set.fromList $ List.map (uncurry Arg) xs) == fromList xs
tests/map-strictness.hs view
@@ -1,20 +1,26 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Test.ChasingBottoms.IsBottom-import Test.Framework (Test, TestName, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(arbitrary))-import Test.QuickCheck.Function (Fun(..), apply)-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)+import Test.Tasty (TestTree, TestName, defaultMain, testGroup)+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty, Arbitrary(arbitrary), Fun)+#if __GLASGOW_HASKELL__ >= 806+import Test.Tasty.QuickCheck (Property)+#endif+import Test.QuickCheck.Function (apply) import Data.Strict.Map.Autogen.Strict (Map) import qualified Data.Strict.Map.Autogen.Strict as M import qualified Data.Map.Lazy as L import Utils.IsUnit+#if __GLASGOW_HASKELL__ >= 806+import Utils.NoThunks+#endif instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (Map k v) where@@ -82,6 +88,26 @@ not (isBottom $ M.insertLookupWithKey (const3 1) k bottom m) | otherwise = isBottom $ M.insertLookupWithKey (apply3 f) k bottom m +#if __GLASGOW_HASKELL__ >= 806+pStrictFoldr' :: Map Int Int -> Property+pStrictFoldr' m = whnfHasNoThunks (M.foldr' (:) [] m)+#endif++#if __GLASGOW_HASKELL__ >= 806+pStrictFoldl' :: Map Int Int -> Property+pStrictFoldl' m = whnfHasNoThunks (M.foldl' (flip (:)) [] m)+#endif++#if __GLASGOW_HASKELL__ >= 806+pStrictFoldrWithKey' :: Map Int Int -> Property+pStrictFoldrWithKey' m = whnfHasNoThunks (M.foldrWithKey' (\_ a as -> a : as) [] m)+#endif++#if __GLASGOW_HASKELL__ >= 806+pStrictFoldlWithKey' :: Map Int Int -> Property+pStrictFoldlWithKey' m = whnfHasNoThunks (M.foldlWithKey' (\as _ a -> a : as) [] m)+#endif+ ------------------------------------------------------------------------ -- check for extra thunks --@@ -90,7 +116,7 @@ -- in most cases. An exception is `L.fromListWith const`, which cannot -- evaluate the `const` calls. -tExtraThunksM :: Test+tExtraThunksM :: TestTree tExtraThunksM = testGroup "Map.Strict - extra thunks" $ if not isUnitSupported then [] else -- for strict maps, all the values should be evaluated to ()@@ -105,14 +131,14 @@ ] where m0 = M.singleton 42 ()- check :: TestName -> M.Map Int () -> Test+ check :: TestName -> M.Map Int () -> TestTree check n m = testCase n $ case M.lookup 42 m of Just v -> assertBool msg (isUnit v)- _ -> assertString "key not found"+ _ -> assertBool "key not found" False where msg = "too lazy -- expected fully evaluated ()" -tExtraThunksL :: Test+tExtraThunksL :: TestTree tExtraThunksL = testGroup "Map.Lazy - extra thunks" $ if not isUnitSupported then [] else -- for lazy maps, the *With functions should leave `const () ()` thunks,@@ -128,10 +154,10 @@ ] where m0 = L.singleton 42 ()- check :: TestName -> Bool -> L.Map Int () -> Test+ check :: TestName -> Bool -> L.Map Int () -> TestTree check n e m = testCase n $ case L.lookup 42 m of Just v -> assertBool msg (e == isUnit v)- _ -> assertString "key not found"+ _ -> assertBool "key not found" False where msg | e = "too lazy -- expected fully evaluated ()" | otherwise = "too strict -- expected a thunk"@@ -139,7 +165,7 @@ ------------------------------------------------------------------------ -- * Test list -tests :: [Test]+tests :: [TestTree] tests = [ -- Basic interface@@ -162,6 +188,12 @@ pInsertLookupWithKeyKeyStrict , testProperty "insertLookupWithKey is value-strict" pInsertLookupWithKeyValueStrict+#if __GLASGOW_HASKELL__ >= 806+ , testProperty "strict foldr'" pStrictFoldr'+ , testProperty "strict foldl'" pStrictFoldl'+ , testProperty "strict foldrWithKey'" pStrictFoldrWithKey'+ , testProperty "strict foldlWithKey'" pStrictFoldlWithKey'+#endif ] , tExtraThunksM , tExtraThunksL@@ -171,7 +203,7 @@ -- * Test harness main :: IO ()-main = defaultMain tests+main = defaultMain $ testGroup "map-strictness" tests ------------------------------------------------------------------------ -- * Utilities@@ -184,3 +216,4 @@ const3 :: a -> b -> c -> d -> a const3 x _ _ _ = x+
tests/seq-properties.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TemplateHaskell #-} #include "containers.h" @@ -25,9 +26,7 @@ import Data.Maybe import Data.Function (on) import Data.Monoid (Monoid(..), All(..), Endo(..), Dual(..))-#if MIN_VERSION_base(4,9,0) import Data.Semigroup (stimes, stimesMonoid)-#endif import Data.Traversable (Traversable(traverse), sequenceA) import Prelude hiding ( lookup, null, length, take, drop, splitAt,@@ -36,22 +35,24 @@ all, sum) import qualified Prelude import qualified Data.List-import Test.QuickCheck hiding ((><))-import Test.QuickCheck.Poly-#if __GLASGOW_HASKELL__ >= 800-import Test.QuickCheck.Property-#endif-import Test.QuickCheck.Function-import Test.Framework-import Test.Framework.Providers.QuickCheck2+import Test.Tasty+import Test.Tasty.QuickCheck hiding ((><))+import Test.QuickCheck.Function (apply)+import Test.QuickCheck.Poly (A, OrdA, B(..), OrdB, C) import Control.Monad.Zip (MonadZip (..)) import Control.DeepSeq (deepseq) import Control.Monad.Fix (MonadFix (..))+import Test.Tasty.HUnit+import qualified Language.Haskell.TH.Syntax as TH main :: IO ()-main = defaultMain- [ testProperty "fmap" prop_fmap+main = defaultMain $ testGroup "seq-properties"+ [ test_lift+#if MIN_VERSION_template_haskell(2,16,0)+ , test_liftTyped+#endif+ , testProperty "fmap" prop_fmap , testProperty "(<$)" prop_constmap , testProperty "foldr" prop_foldr , testProperty "foldr'" prop_foldr'@@ -148,17 +149,13 @@ , testProperty "intersperse" prop_intersperse , testProperty ">>=" prop_bind , testProperty "mfix" test_mfix-#if __GLASGOW_HASKELL__ >= 800 , testProperty "Empty pattern" prop_empty_pat , testProperty "Empty constructor" prop_empty_con , testProperty "Left view pattern" prop_viewl_pat , testProperty "Left view constructor" prop_viewl_con , testProperty "Right view pattern" prop_viewr_pat , testProperty "Right view constructor" prop_viewr_con-#endif-#if MIN_VERSION_base(4,9,0) , testProperty "stimes" prop_stimes-#endif ] ------------------------------------------------------------------------@@ -598,21 +595,13 @@ prop_sortOn (Fun _ f) xs = toList' (sortOn f xs) ~= listSortOn f (toList xs) where-#if MIN_VERSION_base(4,8,0) listSortOn = Data.List.sortOn-#else- listSortOn k = Data.List.sortBy (compare `on` k)-#endif prop_sortOnStable :: Fun A UnstableOrd -> Seq A -> Bool prop_sortOnStable (Fun _ f) xs = toList' (sortOn f xs) ~= listSortOn f (toList xs) where-#if MIN_VERSION_base(4,8,0) listSortOn = Data.List.sortOn-#else- listSortOn k = Data.List.sortBy (compare `on` k)-#endif prop_unstableSort :: Seq OrdA -> Bool prop_unstableSort xs =@@ -858,7 +847,6 @@ prop_cycleTaking n xs = (n <= 0 || not (null xs)) ==> toList' (cycleTaking n xs) ~= Data.List.take n (Data.List.cycle (toList xs)) -#if __GLASGOW_HASKELL__ >= 800 prop_empty_pat :: Seq A -> Bool prop_empty_pat xs@Empty = null xs prop_empty_pat xs = not (null xs)@@ -869,8 +857,8 @@ prop_viewl_pat :: Seq A -> Property prop_viewl_pat xs@(y :<| ys) | z :< zs <- viewl xs = y === z .&&. ys === zs- | otherwise = property failed-prop_viewl_pat xs = property . liftBool $ null xs+ | otherwise = property False+prop_viewl_pat xs = property $ null xs prop_viewl_con :: A -> Seq A -> Property prop_viewl_con x xs = x :<| xs === x <| xs@@ -878,12 +866,11 @@ prop_viewr_pat :: Seq A -> Property prop_viewr_pat xs@(ys :|> y) | zs :> z <- viewr xs = y === z .&&. ys === zs- | otherwise = property failed-prop_viewr_pat xs = property . liftBool $ null xs+ | otherwise = property False+prop_viewr_pat xs = property $ null xs prop_viewr_con :: Seq A -> A -> Property prop_viewr_con xs x = xs :|> x === xs |> x-#endif -- Monad operations @@ -893,11 +880,9 @@ -- Semigroup operations -#if MIN_VERSION_base(4,9,0) prop_stimes :: NonNegative Int -> Seq A -> Property prop_stimes (NonNegative n) s = stimes n s === stimesMonoid n s-#endif -- MonadFix operation @@ -930,7 +915,6 @@ Action m f <*> Action n x = Action (m+n) (f x) instance Monad M where- return x = Action 0 x Action m x >>= f = let Action n y = f x in Action (m+n) y instance Foldable M where@@ -938,3 +922,21 @@ instance Traversable M where traverse f (Action n x) = Action n <$> f x++-- ----------+--+-- Unit tests+--+-- ----------++test_lift :: TestTree+test_lift = testCase "lift" $ do+ (mempty :: Seq Int) @=? $([| $(TH.lift (fromList [] :: Seq Integer)) |])+ fromList [1..3 :: Int] @=? $([| $(TH.lift (fromList [1..3 :: Integer])) |])++#if MIN_VERSION_template_haskell(2,16,0)+test_liftTyped :: TestTree+test_liftTyped = testCase "liftTyped" $ do+ (mempty :: Seq Int) @=? $$([|| $$(TH.liftTyped (fromList [])) ||])+ fromList [1..3 :: Int] @=? $$([|| $$(TH.liftTyped (fromList [1..3])) ||])+#endif