primitive-containers 0.4.0 → 0.4.1

raw patch · 12 files changed

+333/−40 lines, 12 filesdep ~contiguousdep ~contiguous-checkeddep ~primitivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: contiguous, contiguous-checked, primitive, primitive-checked

API changes (from Hackage documentation)

Files

• primitive-containers.cabal +8/−8
• src/Data/Continuous/Set/Internal.hs +4/−7
• src/Data/Map/Internal.hs +14/−1
• src/Data/Map/Lifted/Lifted.hs +26/−1
• src/Data/Map/Lifted/Unlifted.hs +26/−1
• src/Data/Map/Unboxed/Lifted.hs +26/−1
• src/Data/Map/Unboxed/Unboxed.hs +17/−2
• src/Data/Map/Unboxed/Unlifted.hs +21/−4
• src/Data/Map/Unlifted/Lifted.hs +26/−1
• src/Data/Map/Unlifted/Unboxed.hs +26/−1
• src/Data/Set/Unboxed/Internal.hs +17/−2
• test/Main.hs +122/−11

@@ -1,6 +1,6 @@ cabal-version: 2.0 name: primitive-containers-version: 0.4.0+version: 0.4.1 synopsis: containers backed by arrays description:   Containers backed by flat arrays. Updates require rebuilding the@@ -41,13 +41,13 @@     , deepseq >= 1.4     , primitive-unlifted >= 0.1 && <0.2   if flag(checked)-    build-depends: -        contiguous-checked >= 0.4 && < 0.5-      , primitive-checked >= 0.6.4.1+    build-depends:+        contiguous-checked >= 0.4 && < 0.6+      , primitive-checked >= 0.6.4.1 && < 0.8   else-    build-depends: -        contiguous >= 0.4 && < 0.5-      , primitive >= 0.6.4+    build-depends:+        contiguous >= 0.4 && < 0.6+      , primitive >= 0.6.4 && < 0.8   exposed-modules:     Data.Continuous.Set.Lifted     Data.Diet.Map.Strict.Lifted.Lifted@@ -103,7 +103,7 @@     , containers >= 0.5.10     , primitive     , primitive-containers-    , primitive-unlifted+    , primitive-unlifted >= 0.1.1     , quickcheck-classes >= 0.6.2     , tasty     , tasty-hunit

@@ -24,15 +24,12 @@ import Prelude hiding (lookup,showsPrec,concat,map,foldr,negate,null)  import Control.Monad.ST (ST,runST)-import Data.Bool (bool) import Data.Word (Word8) import Data.Primitive.Contiguous (Contiguous,Element,Mutable) import Data.Primitive (PrimArray,MutablePrimArray) import Data.Bits (unsafeShiftL,unsafeShiftR,(.|.),(.&.))-import qualified Data.Foldable as F import qualified Prelude as P import qualified Data.Primitive.Contiguous as I-import qualified Data.Concatenation as C  -- Although the data constructor for this type is exported, -- it isn't needed by anything in the continuous Set modules. It is needed@@ -245,13 +242,13 @@   GT -> Just (xinc,x)   LT -> Just (yinc,y)   EQ -> Just (max xinc yinc,y)-      + eatFromPositiveInfinity ::      Inclusivity -- inclusivity for positive infinity   -> a -- lower bound for positive infinity   -> arr a -- set 1   -> PrimArray Word8-  -> Int -- pairs in set 1 +  -> Int -- pairs in set 1   -> arr a -- set 2   -> PrimArray Word8   -> Int -- pairs in set 2@@ -263,7 +260,7 @@   -> a -- upper bound for negative infinity   -> arr a -- set 1   -> PrimArray Word8-  -> Int -- pairs in set 1 +  -> Int -- pairs in set 1   -> arr a -- set 2   -> PrimArray Word8   -> Int -- pairs in set 2@@ -391,7 +388,7 @@   where   go !start !end = if end <= start     then if end == start-      then +      then         let !(# valLo #) = I.index# keys (2 * start)             !(# valHi #) = I.index# keys (2 * start + 1)          in case indexInclusivityPair incs start of

@@ -31,6 +31,7 @@   , foldrMapWithKeyM'     -- * Traversals   , traverse+  , traverseWithKey   , traverseWithKey_     -- * Functions   , append@@ -78,7 +79,6 @@ import Data.Set.Internal (Set(..))  import qualified Data.Concatenation as C-import qualified Data.List as L import qualified Data.Primitive.Contiguous as I import qualified Data.Semigroup as SG import qualified Prelude as P@@ -319,6 +319,11 @@   vsFinal <- I.resize varr dstLen >>= I.unsafeFreeze   return (Map ksFinal vsFinal) +newtype STA arr a = STA { _runSTA :: forall s. Mutable arr s a -> ST s (arr a) }++runSTA :: (Contiguous arr, Element arr a) => Int -> STA arr a -> arr a+runSTA !sz (STA m) = runST $ I.new sz >>= \arr -> m arr+ showsPrec :: (Contiguous karr, Element karr k, Show k, Contiguous varr, Element varr v, Show v) => Int -> Map karr varr k v -> ShowS showsPrec p xs = showParen (p > 10) $   showString "fromList " . shows (toList xs)@@ -642,6 +647,14 @@ {-# INLINEABLE traverse #-} traverse f (Map theKeys theVals) =   fmap (Map theKeys) (I.traverse f theVals)++traverseWithKey :: (Contiguous karr, Element karr k, Contiguous varr, Element varr v, Element varr v', Applicative f)+  => (k -> v -> f v')+  -> Map karr varr k v+  -> f (Map karr varr k v')+{-# INLINEABLE traverseWithKey #-}+traverseWithKey f (Map theKeys theVals) = fmap (Map theKeys)+  $ I.itraverse (\i v -> f (I.index theKeys i) v) theVals  traverseWithKey_ :: forall karr varr k v m b. (Applicative m, Contiguous karr, Element karr k, Contiguous varr, Element varr v)   => (k -> v -> m b)

@@ -19,6 +19,10 @@   , foldlWithKey'   , foldrWithKey'   , foldMapWithKey'+    -- * Traversals+  , traverse+  , traverseWithKey+  , traverseWithKey_     -- * Monadic Folds   , foldlWithKeyM'   , foldrWithKeyM'@@ -35,7 +39,7 @@   , elems   ) where -import Prelude hiding (lookup,map)+import Prelude hiding (lookup,map,traverse)  import Data.Semigroup (Semigroup) import Data.Primitive.Array (Array)@@ -164,6 +168,27 @@   -> Map k v   -> Map k v appendWithKey f (Map m) (Map n) = Map (I.appendWithKey f m n)++-- | /O(n)/ traversal over the values in the map.+traverse :: Applicative f+  => (v -> f b)+  -> Map k v+  -> f (Map k b)+traverse f (Map m) = Map <$> I.traverse f m++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: Applicative f+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m++-- | /O(n)/ like 'traverseWithKey', but discards the results.+traverseWithKey_ :: Applicative f+  => (k -> v -> f b)+  -> Map k v+  -> f ()+traverseWithKey_ f (Map m) = I.traverseWithKey_ f m  -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold -- is strict in the accumulator.

@@ -24,6 +24,10 @@   , foldrWithKeyM'   , foldlMapWithKeyM'   , foldrMapWithKeyM'+    -- * Traversals+  , traverse+  , traverseWithKey+  , traverseWithKey_     -- * List Conversion   , toList   , fromList@@ -34,7 +38,7 @@   , elems   ) where -import Prelude hiding (lookup,map)+import Prelude hiding (lookup,map,traverse)  import Data.Semigroup (Semigroup) import Data.Primitive (Array)@@ -162,6 +166,27 @@   -> Map k v   -> Map k v appendWithKey f (Map m) (Map n) = Map (I.appendWithKey f m n)++-- | /O(n)/ traversal over the values in the map.+traverse :: (Applicative f, PrimUnlifted v, PrimUnlifted b)+  => (v -> f b)+  -> Map k v+  -> f (Map k b)+traverse f (Map m) = Map <$> I.traverse f m++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: (Applicative f, PrimUnlifted v, PrimUnlifted b)+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m++-- | /O(n)/ like 'traverseWithKey', but discards the results.+traverseWithKey_ :: (Applicative f, PrimUnlifted v, PrimUnlifted b)+  => (k -> v -> f b)+  -> Map k v+  -> f ()+traverseWithKey_ f (Map m) = I.traverseWithKey_ f m  -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold -- is strict in the accumulator.

@@ -30,6 +30,10 @@   , foldrWithKeyM'   , foldlMapWithKeyM'   , foldrMapWithKeyM'+    -- * Traversals+  , traverse+  , traverseWithKey+  , traverseWithKey_     -- * List Conversion   , toList   , fromList@@ -42,7 +46,7 @@   , unsafeFreezeZip   ) where -import Prelude hiding (lookup,map)+import Prelude hiding (lookup,map,traverse)  import Control.DeepSeq (NFData) import Control.Monad.ST (ST)@@ -189,6 +193,27 @@   -> Map k v   -> Map k v appendWithKey f (Map m) (Map n) = Map (I.appendWithKey f m n)++-- | /O(n)/ traversal over the values in the map.+traverse :: (Applicative f, Prim k)+  => (v -> f b)+  -> Map k v+  -> f (Map k b)+traverse f (Map m) = Map <$> I.traverse f m++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: (Applicative f, Prim k)+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m++-- | /O(n)/ like 'traverseWithKey', but discards the results.+traverseWithKey_ :: (Applicative f, Prim k)+  => (k -> v -> f b)+  -> Map k v+  -> f ()+traverseWithKey_ f (Map m) = I.traverseWithKey_ f m  -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold -- is strict in the accumulator.

@@ -26,6 +26,8 @@   , foldlMapWithKeyM'   , foldrMapWithKeyM'     -- * Traversals+  , traverse+  , traverseWithKey   , traverseWithKey_     -- * List Conversion   , toList@@ -39,7 +41,7 @@   , unsafeFreezeZip   ) where -import Prelude hiding (lookup,map)+import Prelude hiding (lookup,map,traverse)  import Control.Monad.Primitive (PrimMonad) import Control.Monad.ST (ST)@@ -47,7 +49,6 @@ import Data.Primitive.Types (Prim) import Data.Semigroup (Semigroup) import Data.Set.Unboxed.Internal (Set(..))-import GHC.Exts (inline)  import qualified Data.Map.Internal as I import qualified Data.Semigroup as SG@@ -243,6 +244,20 @@   -> Map k v -- ^ map   -> m b foldrMapWithKeyM' f (Map m) = I.foldrMapWithKeyM' f m++-- | /O(n)/ traversal over the values in the map.+traverse :: (Applicative f, Prim k, Prim v, Prim b)+  => (v -> f b)+  -> Map k v+  -> f (Map k b)+traverse f (Map m) = Map <$> I.traverse f m++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: (Applicative f, Prim k, Prim v, Prim b)+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m  -- | /O(n)/ Traverse the keys and values of the map from left to right. traverseWithKey_ :: (Monad m, Prim k, Prim v)

@@ -29,6 +29,8 @@   , foldrMapWithKeyM'     -- * Traversals   , traverse+  , traverseWithKey+  , traverseWithKey_     -- * List Conversion   , fromList   , fromListAppend@@ -249,11 +251,26 @@ foldrMapWithKeyM' f (Map m) = I.foldrMapWithKeyM' f m  -- | /O(n)/ Traverse the values of the map.-traverse :: (Applicative m, Prim k, PrimUnlifted v, PrimUnlifted w)-  => (v -> m w)+traverse :: (Applicative m, Prim k, PrimUnlifted v, PrimUnlifted b)+  => (v -> m b)   -> Map k v-  -> m (Map k w)-traverse f (Map m) = fmap Map (I.traverse f m)+  -> m (Map k b)+traverse f (Map m) = Map <$> (I.traverse f m)++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: (Applicative f, Prim k, PrimUnlifted v, PrimUnlifted b)+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m++-- | /O(n)/ Traverse the keys and values of the map from left to right.+traverseWithKey_ :: (Monad m, Prim k, PrimUnlifted v)+  => (k -> v -> m b) -- ^ reduction+  -> Map k v -- ^ map+  -> m ()+traverseWithKey_ f (Map m) = I.traverseWithKey_ f m+  -- | /O(n)/ Fold over the keys and values of the map with a monoidal -- accumulator. This function does not have left and right variants since

@@ -21,6 +21,10 @@   , foldrWithKeyM'   , foldlMapWithKeyM'   , foldrMapWithKeyM'+    -- * Traversals+  , traverse+  , traverseWithKey+  , traverseWithKey_     -- * List Conversion   , fromList   , fromListAppend@@ -31,7 +35,7 @@   , unsafeFreezeZip   ) where -import Prelude hiding (lookup,map)+import Prelude hiding (lookup,map,traverse)  import Control.Monad.ST (ST) import Data.Semigroup (Semigroup)@@ -154,6 +158,27 @@   -> Map k v   -> Map k w mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)++-- | /O(n)/ traversal over the values in the map.+traverse :: (Applicative f, PrimUnlifted k)+  => (v -> f b)+  -> Map k v+  -> f (Map k b)+traverse f (Map m) = Map <$> I.traverse f m++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: (Applicative f, PrimUnlifted k)+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m++-- | /O(n)/ like 'traverseWithKey', but discards the results.+traverseWithKey_ :: (Applicative f, PrimUnlifted k)+  => (k -> v -> f b)+  -> Map k v+  -> f ()+traverseWithKey_ f (Map m) = I.traverseWithKey_ f m  -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold -- is strict in the accumulator.

@@ -20,6 +20,10 @@   , foldrWithKeyM'   , foldlMapWithKeyM'   , foldrMapWithKeyM'+    -- * Traversals+  , traverse+  , traverseWithKey+  , traverseWithKey_     -- * List Conversion   , fromList   , fromListAppend@@ -30,7 +34,7 @@   , unsafeFreezeZip   ) where -import Prelude hiding (lookup,map)+import Prelude hiding (lookup,map,traverse)  import Control.Monad.ST (ST) import Data.Semigroup (Semigroup)@@ -151,6 +155,27 @@   -> Map k v   -> Map k w mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)++-- | /O(n)/ traversal over the values in the map.+traverse :: (Applicative f, PrimUnlifted k, Prim v, Prim b)+  => (v -> f b)+  -> Map k v+  -> f (Map k b)+traverse f (Map m) = Map <$> I.traverse f m++-- | /O(n)/ traversal over the values in the map, using the keys.+traverseWithKey :: (Applicative f, PrimUnlifted k, Prim v, Prim b)+  => (k -> v -> f b)+  -> Map k v+  -> f (Map k b)+traverseWithKey f (Map m) = Map <$> I.traverseWithKey f m++-- | /O(n)/ like 'traverseWithKey', but discards the results.+traverseWithKey_ :: (Applicative f, PrimUnlifted k, Prim v)+  => (k -> v -> f b)+  -> Map k v+  -> f ()+traverseWithKey_ f (Map m) = I.traverseWithKey_ f m  -- | /O(n)/ Left monadic fold over the keys and values of the map. This fold -- is strict in the accumulator.

@@ -3,6 +3,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}  module Data.Set.Unboxed.Internal   ( Set(..)@@ -13,9 +14,9 @@ import Prelude hiding (foldr)  import Data.Hashable (Hashable)-import Data.Primitive (Prim,PrimArray,Array)+import Data.Primitive (Prim,PrimArray(..)) import Data.Semigroup (Semigroup)-import Text.Show (showListWith)+import Data.Primitive.Unlifted.Class (PrimUnlifted(..))  import qualified Data.Foldable as F import qualified Data.Hashable as H@@ -44,6 +45,20 @@  instance (Hashable a, Prim a) => Hashable (Set a) where   hashWithSalt s (Set arr) = I.liftHashWithSalt H.hashWithSalt s arr++instance PrimUnlifted (Set a) where+  type Unlifted (Set a) = E.ByteArray#+  {-# inline toUnlifted# #-}+  {-# inline fromUnlifted# #-}+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  toUnlifted# (Set (I.Set p)) = toUnlifted# p+  fromUnlifted# b# = Set (I.Set (PrimArray b#))+  writeUnliftedArray# a i s = E.writeByteArrayArray# a i (toUnlifted# s)+  readUnliftedArray# a i s0 = case E.readByteArrayArray# a i s0 of+    (# s1, x #) -> (# s1, fromUnlifted# x #)+  indexUnliftedArray# a i = fromUnlifted# (E.indexByteArrayArray# a i)  -- | The functions that convert a list to a 'Set' are asymptotically -- better that using @'foldMap' 'singleton'@, with a cost of /O(n*log n)/

@@ -172,7 +172,7 @@   , testGroup "Continuous"     [ testGroup "Set"       [ testGroup "Lifted"-        [ testGroup "Unit" +        [ testGroup "Unit"           [ testCase "A" $ do               let s = CSL.singleton Nothing (Just (Inclusive,55 :: Integer))                       <>@@ -216,6 +216,7 @@         , lawsToTest (QCC.commutativeMonoidLaws (Proxy :: Proxy (DSL.Set Word16)))         , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DSL.Set Word16)))         , TQC.testProperty "member" (dietMemberProp @Word8 E.fromList DSL.member)+        -- DIET SETS         , TQC.testProperty "difference" dietSetDifferenceProp         , TQC.testProperty "intersection" dietSetIntersectionProp         , TQC.testProperty "negate" dietSetNegateProp@@ -230,6 +231,21 @@           , TQC.testProperty "border" dietSetBetweenBorderProp           , TQC.testProperty "inside" dietSetBetweenBorderNearProp           ]+        -- S (newtype)+        , TQC.testProperty "difference" dietSetDifferenceProp'+        , TQC.testProperty "intersection" dietSetIntersectionProp'+        , TQC.testProperty "negate" dietSetNegateProp'+        , TQC.testProperty "aboveInclusive" dietSetAboveProp'+        , testGroup "belowInclusive"+          [ TQC.testProperty "basic" dietSetBelowProp'+          , TQC.testProperty "lowest" dietSetBelowLowestProp'+          , TQC.testProperty "highest" dietSetBelowHighestProp'+          ]+        , testGroup "betweenInclusive"+          [ TQC.testProperty "basic" dietSetBetweenProp'+          , TQC.testProperty "border" dietSetBetweenBorderProp'+          , TQC.testProperty "inside" dietSetBetweenBorderNearProp'+          ]         ]       ]     , testGroup "Map"@@ -283,18 +299,36 @@       ys' = dietSetToSet ys    in DSL.difference xs ys === DSL.fromList (map (\x -> (x,x)) (S.toList (S.difference xs' ys'))) +dietSetDifferenceProp' :: QC.Property+dietSetDifferenceProp' = QC.property $ \(S xs :: S Word8) (S ys :: S Word8) ->+  let xs' = dietSetToSet xs+      ys' = dietSetToSet ys+   in DSL.difference xs ys === DSL.fromList (map (\x -> (x,x)) (S.toList (S.difference xs' ys')))+ dietSetIntersectionProp :: QC.Property dietSetIntersectionProp = QC.property $ \(xs :: DSL.Set Word8) (ys :: DSL.Set Word8) ->   let xs' = dietSetToSet xs       ys' = dietSetToSet ys    in DSL.intersection xs ys === DSL.fromList (map (\x -> (x,x)) (S.toList (S.intersection xs' ys'))) +dietSetIntersectionProp' :: QC.Property+dietSetIntersectionProp' = QC.property $ \(S xs :: S Word8) (S ys :: S Word8) ->+  let xs' = dietSetToSet xs+      ys' = dietSetToSet ys+   in DSL.intersection xs ys === DSL.fromList (map (\x -> (x,x)) (S.toList (S.intersection xs' ys')))+ dietSetNegateProp :: QC.Property dietSetNegateProp = QC.property $ \(xs :: DSL.Set Word8) ->   let xs' = dietSetToSet xs       expected = foldMap (\n -> bool (S.singleton n) mempty (S.member n xs')) [minBound..maxBound]    in DSL.negate xs === mconcat (map (\x -> DSL.singleton x x) (F.toList expected)) +dietSetNegateProp' :: QC.Property+dietSetNegateProp' = QC.property $ \(S xs :: S Word8) ->+  let xs' = dietSetToSet xs+      expected = foldMap (\n -> bool (S.singleton n) mempty (S.member n xs')) [minBound..maxBound]+   in DSL.negate xs === mconcat (map (\x -> DSL.singleton x x) (F.toList expected))+ dietSetAboveProp :: QC.Property dietSetAboveProp = QC.property $ \(y :: Word8) (ys :: DSL.Set Word8) ->   let ys' = dietSetToSet ys@@ -302,6 +336,13 @@       r = if isMember then S.insert y c else c    in DSL.aboveInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r)) +dietSetAboveProp' :: QC.Property+dietSetAboveProp' = QC.property $ \(y :: Word8) (S ys :: S Word8) ->+  let ys' = dietSetToSet ys+      (_,isMember,c) = S.splitMember y ys'+      r = if isMember then S.insert y c else c+   in DSL.aboveInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r))+ dietSetBelowProp :: QC.Property dietSetBelowProp = QC.property $ \(y :: Word8) (ys :: DSL.Set Word8) ->   let ys' = dietSetToSet ys@@ -309,35 +350,71 @@       r = if isMember then S.insert y c else c    in DSL.belowInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r)) +dietSetBelowProp' :: QC.Property+dietSetBelowProp' = QC.property $ \(y :: Word8) (S ys :: S Word8) ->+  let ys' = dietSetToSet ys+      (c,isMember,_) = S.splitMember y ys'+      r = if isMember then S.insert y c else c+   in DSL.belowInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r))+ dietSetBelowLowestProp :: QC.Property dietSetBelowLowestProp = QC.property $ \(ys :: DSL.Set Word8) ->   let ys' = dietSetToSet ys    in case S.lookupMin ys' of         Nothing -> QC.property QC.Discard-        Just y -> +        Just y ->           let (c,isMember,_) = S.splitMember y ys'               r = if isMember then S.insert y c else c            in QC.property (DSL.belowInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r))) +dietSetBelowLowestProp' :: QC.Property+dietSetBelowLowestProp' = QC.property $ \(S ys :: S Word8) ->+  let ys' = dietSetToSet ys+   in case S.lookupMin ys' of+        Nothing -> QC.property QC.Discard+        Just y ->+          let (c,isMember,_) = S.splitMember y ys'+              r = if isMember then S.insert y c else c+           in QC.property (DSL.belowInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r)))+ dietSetBelowHighestProp :: QC.Property dietSetBelowHighestProp = QC.property $ \(ys :: DSL.Set Word8) ->   let ys' = dietSetToSet ys    in case S.lookupMax ys' of         Nothing -> QC.property QC.Discard-        Just y -> +        Just y ->           let (c,isMember,_) = S.splitMember y ys'               r = if isMember then S.insert y c else c            in QC.property (DSL.belowInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r))) +dietSetBelowHighestProp' :: QC.Property+dietSetBelowHighestProp' = QC.property $ \(S ys :: S Word8) ->+  let ys' = dietSetToSet ys+   in case S.lookupMax ys' of+        Nothing -> QC.property QC.Discard+        Just y ->+          let (c,isMember,_) = S.splitMember y ys'+              r = if isMember then S.insert y c else c+           in QC.property (DSL.belowInclusive y ys === DSL.fromList (map (\x -> (x,x)) (S.toList r)))+ dietSetBetweenProp :: QC.Property dietSetBetweenProp = QC.property $ \(x :: Word8) (y :: Word8) (ys :: DSL.Set Word8) ->   (x <= y)-  ==> +  ==>   ( let ys' = dietSetToSet ys         r = S.filter (\e -> e >= x && e <= y) ys'      in DSL.betweenInclusive x y ys === DSL.fromList (map (\z -> (z,z)) (S.toList r))   ) +dietSetBetweenProp' :: QC.Property+dietSetBetweenProp' = QC.property $ \(x :: Word8) (y :: Word8) (S ys :: S Word8) ->+  (x <= y)+  ==>+  ( let ys' = dietSetToSet ys+        r = S.filter (\e -> e >= x && e <= y) ys'+     in DSL.betweenInclusive x y ys === DSL.fromList (map (\z -> (z,z)) (S.toList r))+  )+ dietSetBetweenBorderProp :: QC.Property dietSetBetweenBorderProp = QC.property $ \(ys :: DSL.Set Word8) ->   let ys' = dietSetToSet ys@@ -345,10 +422,21 @@         Nothing -> QC.property QC.Discard         Just hi -> case S.lookupMin ys' of           Nothing -> QC.property QC.Discard-          Just lo -> +          Just lo ->             let r = S.filter (\e -> e >= lo && e <= hi) ys'              in DSL.betweenInclusive lo hi ys === DSL.fromList (map (\z -> (z,z)) (S.toList r)) +dietSetBetweenBorderProp' :: QC.Property+dietSetBetweenBorderProp' = QC.property $ \(S ys :: S Word8) ->+  let ys' = dietSetToSet ys+   in case S.lookupMax ys' of+        Nothing -> QC.property QC.Discard+        Just hi -> case S.lookupMin ys' of+          Nothing -> QC.property QC.Discard+          Just lo ->+            let r = S.filter (\e -> e >= lo && e <= hi) ys'+             in DSL.betweenInclusive lo hi ys === DSL.fromList (map (\z -> (z,z)) (S.toList r))+ dietSetBetweenBorderNearProp :: QC.Property dietSetBetweenBorderNearProp = QC.property $ \(ys :: DSL.Set Word8) ->   let ys' = dietSetToSet ys@@ -361,6 +449,18 @@         )       ) +dietSetBetweenBorderNearProp' :: QC.Property+dietSetBetweenBorderNearProp' = QC.property $ \(S ys :: S Word8) ->+  let ys' = dietSetToSet ys+   in ( S.size ys' > 1+        ==>+        ( let hi = pred (S.findMax ys')+              lo = succ (S.findMin ys')+              r = S.filter (\e -> e >= lo && e <= hi) ys'+           in DSL.betweenInclusive lo hi ys === DSL.fromList (map (\z -> (z,z)) (S.toList r))+        )+      )+ -- This enumerates all of the element contained by all ranges -- in the diet set. dietSetToSet :: (Enum a, Ord a) => DSL.Set a -> S.Set a@@ -410,14 +510,14 @@ appendWithKeyUnboxedLiftedProp :: QC.Property appendWithKeyUnboxedLiftedProp = QC.property $ \(xs :: M.Map Word8 Word8) ys ->   let xs' = MUL.fromList (M.toList xs)-      ys' = MUL.fromList (M.toList ys) +      ys' = MUL.fromList (M.toList ys)       func k x y = k + 2 * x + 3 * y    in MUL.toList (MUL.appendWithKey func xs' ys') === M.toList (M.unionWithKey func xs ys)  appendWithKeyLiftedLiftedProp :: QC.Property appendWithKeyLiftedLiftedProp = QC.property $ \(xs :: M.Map Word8 Word8) ys ->   let xs' = MLL.fromList (M.toList xs)-      ys' = MLL.fromList (M.toList ys) +      ys' = MLL.fromList (M.toList ys)       func k x y = k + 2 * x + 3 * y    in MLL.toList (MLL.appendWithKey func xs' ys') === M.toList (M.unionWithKey func xs ys) @@ -593,7 +693,7 @@  instance (Ord k, Enum k, Eq v, Bounded k, Arbitrary k, Arbitrary v) => Arbitrary (MIDBTS.Map k v) where   arbitrary = liftA2 MIDBTS.fromList QC.arbitrary (QC.vectorOf 10 arbitraryOrderedPairValue)-    + instance (Arbitrary k, Ord k, Arbitrary v, Eq v, Semigroup v) => Arbitrary (MSL.Map k v) where   arbitrary = do     len <- QC.choose (0,4)@@ -618,7 +718,18 @@       return (lo,hi,v)     return (DMUL.fromListAppend ys)   shrink x = map E.fromList (QC.shrink (E.toList x))-    ++newtype S a = S (DSL.Set a)+  deriving (Eq, Show)++instance (Arbitrary a, Ord a, Enum a, Bounded a) => Arbitrary (S a) where+  arbitrary = do+    sz <- QC.choose (200, 400)+    k <- QC.arbitrary+    xs <- increasingOrderedPairsHelper sz k+    pure $ S $ DSL.fromList xs+  shrink (S x) = map (S . E.fromList) (QC.shrink (E.toList x))+ instance (Arbitrary a, Ord a, Enum a, Bounded a) => Arbitrary (DSL.Set a) where   arbitrary = DSL.fromList <$> QC.vectorOf 7 arbitraryOrderedPair   shrink x = map E.fromList (QC.shrink (E.toList x))@@ -628,7 +739,7 @@     sz <- QC.choose (0,7)     k <- QC.arbitrary     foldMap (\(lo,hi) -> DUSL.singleton (Just lo) (Just hi)) <$> increasingOrderedPairsHelper sz k-    + increasingOrderedPairsHelper :: (Ord k, Enum k, Bounded k) => Int -> k -> Gen [(k,k)] increasingOrderedPairsHelper n k = if n > 0   then case atLeastTwoGreaterThan k of@@ -685,7 +796,7 @@ instance Monoid Int where   mempty = 0   mappend = (SG.<>)-  + instance SG.Semigroup Integer where   (<>) = (+)