diff --git a/containers/src/Data/IntSet/Internal.hs b/containers/src/Data/IntSet/Internal.hs index 566280cac..a301f87cf 100644 --- a/containers/src/Data/IntSet/Internal.hs +++ b/containers/src/Data/IntSet/Internal.hs @@ -203,7 +203,8 @@ import Utils.Containers.Internal.Prelude hiding import Prelude () import Utils.Containers.Internal.BitUtil (iShiftRL, shiftLL, shiftRL) -import Utils.Containers.Internal.Strict (StrictPair(..), toPair) +import Utils.Containers.Internal.Strict + (StrictPair(..), StrictTriple(..), toPair) import Data.IntSet.Internal.IntTreeCommons ( Key , Prefix(..) @@ -1049,40 +1050,39 @@ splitMember x t = if x >= 0 -- handle negative numbers. then case go x l of - (lt, fnd, gt) -> + TripleS lt fnd gt -> let !lt' = binCheckL p lt r in (lt', fnd, gt) else case go x r of - (lt, fnd, gt) -> + TripleS lt fnd gt -> let !gt' = binCheckR p l gt in (lt, fnd, gt') - _ -> go x t + _ -> case go x t of + TripleS lt fnd gt -> (lt, fnd, gt) where go !x' t'@(Bin p l r) - | nomatch x' p = if x' < unPrefix p then (Nil, False, t') else (t', False, Nil) + | nomatch x' p = if x' < unPrefix p + then TripleS Nil False t' + else TripleS t' False Nil | left x' p = case go x' l of - (lt, fnd, gt) -> - let !gt' = binCheckL p gt r - in (lt, fnd, gt') + TripleS lt fnd gt -> TripleS lt fnd (binCheckL p gt r) | otherwise = case go x' r of - (lt, fnd, gt) -> - let !lt' = binCheckR p l lt - in (lt', fnd, gt) + TripleS lt fnd gt -> TripleS (binCheckR p l lt) fnd gt go x' t'@(Tip kx' bm) - | kx' > x' = (Nil, False, t') + | kx' > x' = TripleS Nil False t' -- equivalent to kx' > prefixOf x' - | kx' < prefixOf x' = (t', False, Nil) + | kx' < prefixOf x' = TripleS t' False Nil | otherwise = let !lt = tip kx' (bm .&. lowerBitmap) !found = (bm .&. bitmapOfx') /= 0 !gt = tip kx' (bm .&. higherBitmap) - in (lt, found, gt) + in TripleS lt found gt where bitmapOfx' = bitmapOf x' lowerBitmap = bitmapOfx' - 1 higherBitmap = complement (lowerBitmap + bitmapOfx') - go _ Nil = (Nil, False, Nil) + go _ Nil = TripleS Nil False Nil {---------------------------------------------------------------------- Min/Max diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs index 4720d198b..227ba0da7 100644 --- a/containers/src/Data/Set/Internal.hs +++ b/containers/src/Data/Set/Internal.hs @@ -241,7 +241,8 @@ import qualified Data.Foldable as Foldable import Control.DeepSeq (NFData(rnf),NFData1(liftRnf)) import Data.List.NonEmpty (NonEmpty(..)) -import Utils.Containers.Internal.Strict (StrictPair(..), toPair) +import Utils.Containers.Internal.Strict + (StrictPair(..), StrictTriple(..), toPair) import Utils.Containers.Internal.PtrEquality import Utils.Containers.Internal.EqOrdUtil (EqM(..), OrdM(..)) @@ -1430,16 +1431,17 @@ splitS x (Bin _ y l r) -- | \(O(\log n)\). Performs a 'split' but also returns whether the pivot -- element was found in the original set. splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a) -splitMember _ Tip = (Tip, False, Tip) -splitMember x (Bin _ y l r) - = case compare x y of - LT -> let (lt, found, gt) = splitMember x l - !gt' = linkR y gt r - in (lt, found, gt') - GT -> let (lt, found, gt) = splitMember x r - !lt' = linkL y l lt - in (lt', found, gt) - EQ -> (l, True, r) +splitMember x0 t = case go x0 t of + TripleS lt found gt -> (lt, found, gt) + where + go _ Tip = TripleS Tip False Tip + go x (Bin _ y l r) = + case compare x y of + LT -> case go x l of + TripleS lt found gt -> TripleS lt found (linkR y gt r) + GT -> case go x r of + TripleS lt found gt -> TripleS (linkL y l lt) found gt + EQ -> TripleS l True r #if __GLASGOW_HASKELL__ {-# INLINABLE splitMember #-} #endif