packages feed

rangeset (empty) → 0.0.1.0

raw patch · 21 files changed

+1720/−0 lines, 21 filesdep +QuickCheckdep +arraydep +base

Dependencies added: QuickCheck, array, base, containers, deepseq, gauge, rangeset, selective, tasty, tasty-hunit, tasty-quickcheck

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for `rangeset`++## 0.0.1.0 -- 2022-06-22++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2022, Jamie Willis+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,2 @@+# range-set+Efficient sets for semi-contiguous data
+ benchmarks/BenchmarkUtils.hs view
@@ -0,0 +1,7 @@+module BenchmarkUtils where++import Gauge.Main         (Benchmark, defaultMainWith)+import Gauge.Main.Options (Config(displayMode), defaultConfig, DisplayMode(Condensed))++condensedMain :: [Benchmark] -> IO ()+condensedMain = defaultMainWith (defaultConfig {displayMode = Condensed})
+ benchmarks/RangeSetBench.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE StandaloneDeriving, DeriveAnyClass, DeriveGeneric, BangPatterns, TypeApplications, ScopedTypeVariables, BlockArguments, AllowAmbiguousTypes, CPP #-}+module Main where++-- #define USE_ENUM++import Gauge+import BenchmarkUtils++import Data.RangeSet (RangeSet)+#ifdef USE_ENUM+import Data.EnumSet (Set)+#else+import Data.Set (Set)+#endif+import Test.QuickCheck++import Control.Monad+import Control.DeepSeq++import Data.Array.IO++import Data.List+import Data.Maybe++import Data.Bifunctor (bimap)++import Control.Selective (whileS)++import GHC.Generics (Generic)++import qualified Data.RangeSet as RangeSet+import qualified Data.RangeSet.Internal as RangeSet+#ifdef USE_ENUM+import qualified Data.EnumSet as Set+#else+import qualified Data.Set as Set+#endif+import qualified Data.List as List+import GHC.Real (Fractional, (%))++deriving instance (Generic a, NFData a) => NFData (RangeSet a)+deriving instance Generic a => Generic (RangeSet a)+deriving instance Generic Int+deriving instance Generic Word+deriving instance Generic Char++main :: IO ()+main = do+  xss <- forM [1..10] $ \n -> generate (vectorOf (n * 10) (chooseInt (0, n * 20)))+  (ratios, bins) <- unzip <$> fillBins @Word+  --print bins++  condensedMain [+      --contiguityBench ratios bins,+      rangeFromList,+      rangeMemberDeleteBench,+      rangeUnionBench,+      rangeDiffBench,+      rangeIntersectBench,+      setMemberDeleteBench,+      fromListBench xss+    ]++rangeFromList :: Benchmark+rangeFromList =+  env (return (xs1, xs2, xs3, xs4)) $ \xs -> bgroup "RangeSet.fromList" [+      bench "Pathological" $ nf RangeSet.fromList (pi4_1 xs),+      bench "4 way split" $ nf RangeSet.fromList (pi4_2 xs),+      bench "Small" $ nf RangeSet.fromList (pi4_3 xs),+      bench "alphaNum" $ nf RangeSet.fromList (pi4_4 xs)+  ]++fromListBench :: [[Int]] -> Benchmark+fromListBench xss =+  bgroup "fromList" (map (makeBench (show . length)+                                    [ ("Set", nf Set.fromList)+                                    , ("RangeSet", nf RangeSet.fromList)+                                    ]) xss)++pi4_1 :: (a, b, c, d) -> a+pi4_1 (x, _, _, _) = x++pi4_2 :: (a, b, c, d) -> b+pi4_2 (_, x, _, _) = x++pi4_3 :: (a, b, c, d) -> c+pi4_3 (_, _, x, _) = x++pi4_4 :: (a, b, c, d) -> d+pi4_4 (_, _, _, x) = x++xs1, xs2, xs3 :: [Word]+xs1 = [0,2..2048]+xs2 = List.delete 1536 (List.delete 512 (List.delete 1024 [0..2048]))+xs3 = [1, 2, 3, 5, 6, 7, 8, 11, 12, 13, 14, 16, 17, 18, 19, 20, 21, 22, 23, 25]+xs4 = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['_']++ys1 = [0..2048]+ys2 = [0..27]+ys3 = ['\x00'..'\xff']++rangeMemberDeleteBench :: Benchmark+rangeMemberDeleteBench =+  env (return (RangeSet.fromList xs1,+               RangeSet.fromList xs2,+               RangeSet.fromList xs3,+               RangeSet.fromList xs4)) $ \t ->+    bgroup "RangeSet" [+      bgroup "member" [+        bench "Pathological" $ nf (f ys1) (pi4_1 t),+        bench "4 way split" $ nf (f ys1) (pi4_2 t),+        bench "Small" $ nf (f ys2) (pi4_3 t),+        bench "alphaNum" $ nf (f ys3) (pi4_4 t)+      ],+      bgroup "delete" [+        bench "Pathological" $ nf (g ys1) (pi4_1 t),+        bench "4 way split" $ nf (g ys1) (pi4_2 t),+        bench "Small" $ nf (g ys2) (pi4_3 t),+        bench "alphaNum" $ nf (g ys3) (pi4_4 t)+      ]+    ]+  where+    f ys t = List.foldl' (\ !_ y -> RangeSet.member y t) False ys+    g ys t = List.foldl' (\ !t y -> RangeSet.delete y t) t ys++setMemberDeleteBench :: Benchmark+setMemberDeleteBench =+  env (return (Set.fromList xs1,+               Set.fromList xs2,+               Set.fromList xs3,+               Set.fromList xs4)) $ \t ->+    bgroup "Set" [+            bgroup "member" [+        bench "Pathological" $ nf (f ys1) (pi4_1 t),+        bench "4 way split" $ nf (f ys1) (pi4_2 t),+        bench "Small" $ nf (f ys2) (pi4_3 t),+        bench "alphaNum" $ nf (f ys3) (pi4_4 t)+      ],+      bgroup "delete" [+        bench "Pathological" $ nf (g ys1) (pi4_1 t),+        bench "4 way split" $ nf (g ys1) (pi4_2 t),+        bench "Small" $ nf (g ys2) (pi4_3 t),+        bench "alphaNum" $ nf (g ys3) (pi4_4 t)+      ]+    ]+  where+    f ys t = List.foldl' (\ !_ y -> Set.member y t) False ys+    g ys t = List.foldl' (\ !t y -> Set.delete y t) t ys++zs1, zs2, zs3, zs4 :: RangeSet Word+zs1 = RangeSet.fromRanges [(0, 50), (100, 150), (200, 250), (300, 350), (400, 450), (475, 500)]+zs2 = RangeSet.fromRanges [(25, 75), (125, 175), (225, 275), (325, 375), (425, 475), (485, 500)]+zs3 = RangeSet.fromRanges [(51, 99), (151, 199), (251, 299), (351, 399), (451, 474)]+zs4 = RangeSet.fromRanges [(0, 125), (140, 222), (230, 240), (310, 351), (373, 381), (462, 491)]++rangeUnionBench :: Benchmark+rangeUnionBench =+  env (return (zs1, zs2, zs3, zs4)) $ \t -> bgroup "union" [+      bench "same" $ nf (RangeSet.union (pi4_1 t)) (pi4_1 t),+      bench "overlaps" $ nf (RangeSet.union (pi4_1 t)) (pi4_2 t),+      bench "disjoint" $ nf (RangeSet.union (pi4_1 t)) (pi4_3 t),+      bench "messy" $ nf (RangeSet.union (pi4_1 t)) (pi4_4 t)+  ]++rangeDiffBench :: Benchmark+rangeDiffBench =+  env (return (zs1, zs2, zs3, zs4)) $ \t -> bgroup "difference" [+      bench "same" $ nf (RangeSet.difference (pi4_1 t)) (pi4_1 t),+      bench "overlaps" $ nf (RangeSet.difference (pi4_1 t)) (pi4_2 t),+      bench "disjoint" $ nf (RangeSet.difference (pi4_1 t)) (pi4_3 t),+      bench "messy" $ nf (RangeSet.difference (pi4_1 t)) (pi4_4 t)+  ]++rangeIntersectBench :: Benchmark+rangeIntersectBench =+  env (return (zs1, zs2, zs3, zs4)) $ \t -> bgroup "intersection" [+      bench "same" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_1 t),+      bench "overlaps" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_2 t),+      bench "disjoint" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_3 t),+      bench "messy" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_4 t)+  ]++-- Density benchmark+-- This benchmark generates bunches of random data with a contiguity measure of 0.0 to 1.0+-- this is defined as $1 - m/n$ where $n$ is the number of elements in the set and $m$ the number+-- of ranges. For each of these random sets, each element is queried in turn, and the average+-- time is taken. This comparison is done between the rangeset and the data.set++contiguity :: Enum a => RangeSet a -> Rational+contiguity s = 1 - fromIntegral (RangeSet.sizeRanges s) % fromIntegral (RangeSet.size s)++numContBins :: Int+numContBins = 20++binSize :: Int+binSize = 50++approxSetSize :: Int+approxSetSize = 100++maxElem :: Enum a => a+maxElem = toEnum (approxSetSize - 1)++minElem :: Enum a => a+minElem = toEnum 0++elems :: forall a. Enum a => [a]+elems = [minElem @a .. maxElem @a]++fillBins :: forall a. (Ord a, Enum a) => IO [(Rational, [(RangeSet a, Set a, [a])])]+fillBins = do+  bins <- newArray (0, numContBins-1) [] :: IO (IOArray Int [(RangeSet a, [a])])+  let granulation = 1 % fromIntegral numContBins+  let toRatio = (* granulation) . fromIntegral+  let idxs = map toRatio [0..numContBins-1]+  print idxs++  whileS do+    shuffled <- generate (shuffle (elems @a))+    let sets = scanr (\x -> bimap (RangeSet.insert x) (x:)) (RangeSet.empty, []) shuffled+    forM_ (init sets) $ \set -> do+      let c = contiguity (fst set)+      let idx = fromMaybe 0 (findIndex (>= c) idxs)+      binC <- readArray bins idx+      writeArray bins idx (set : binC)+    szs <- map length <$> getElems bins+    print szs+    return (any (< binSize) szs)++  map (bimap toRatio (map (\(r, xs) -> (r, Set.fromList xs, sort xs)))) <$> getAssocs bins++contiguityBench :: forall a. (NFData a, Ord a, Enum a, Generic a) => [Rational] -> [[(RangeSet a, Set a, [a])]] -> Benchmark+contiguityBench ratios bins = es `deepseq` env (return (map unzip3 bins)) $ \dat ->+    bgroup "contiguity" (concatMap (mkBench dat) (zip ratios [0..]))++  where+    es = elems @a+    mkBench dat (ratio, i) = let ~(rs, ss, xss) = dat !! i in [+        bench ("overhead rangeset-all (" ++ show ratio ++ ")") $ nf (overheadRangeSetAllMember es) rs,+        bench ("overhead set-all (" ++ show ratio ++ ")") $ nf (overheadSetAllMember es) ss,+        bench ("rangeset-all (" ++ show ratio ++ ")") $ nf (rangeSetAllMember es) rs,+        bench ("set-all (" ++ show ratio ++ ")") $ nf (setAllMember es) ss,+        bench ("overhead rangeset-mem (" ++ show ratio ++ ")") $ nf (uncurry overheadRangeSetMember) (xss, rs),+        bench ("overhead set-mem (" ++ show ratio ++ ")") $ nf (uncurry overheadSetMember) (xss, ss),+        bench ("rangeset-mem (" ++ show ratio ++ ")") $ nf (uncurry rangeSetMember) (xss, rs),+        bench ("set-mem (" ++ show ratio ++ ")") $ nf (uncurry setMember) (xss, ss),+        bench ("overhead rangeset-ins (" ++ show ratio ++ ")") $ nf overheadRangeSetInsert xss,+        bench ("overhead set-ins (" ++ show ratio ++ ")") $ nf overheadSetInsert xss,+        bench ("rangeset-ins (" ++ show ratio ++ ")") $ nf rangeSetInsert xss,+        bench ("set-ins (" ++ show ratio ++ ")") $ nf setInsert xss+      ]++    overheadRangeSetAllMember :: [a] -> [RangeSet a] -> [Bool]+    overheadRangeSetAllMember !elems rs = [False | r <- rs, x <- elems]++    overheadSetAllMember :: [a] -> [Set a] -> [Bool]+    overheadSetAllMember !elems ss = [False | s <- ss, x <- elems]++    rangeSetAllMember :: [a] -> [RangeSet a] -> [Bool]+    rangeSetAllMember !elems rs = [RangeSet.member x r | r <- rs, x <- elems]++    setAllMember :: [a] -> [Set a] -> [Bool]+    setAllMember !elems ss = [Set.member x s | s <- ss, x <- elems]++    overheadRangeSetMember :: [[a]] -> [RangeSet a] -> [Bool]+    overheadRangeSetMember xss rs = [False | (r, xs) <- zip rs xss, x <- xs]++    overheadSetMember :: [[a]] -> [Set a] -> [Bool]+    overheadSetMember xss ss = [False | (s, xs) <- zip ss xss, x <- xs]++    rangeSetMember :: [[a]] -> [RangeSet a] -> [Bool]+    rangeSetMember xss rs = [RangeSet.member x r | (r, xs) <- zip rs xss, x <- xs]++    setMember :: [[a]] -> [Set a] -> [Bool]+    setMember xss ss = [Set.member x s | (s, xs) <- zip ss xss, x <- xs]++    overheadRangeSetInsert :: [[a]] -> [RangeSet a]+    overheadRangeSetInsert = map (foldr (flip const) RangeSet.empty)++    overheadSetInsert :: [[a]] -> [Set a]+    overheadSetInsert = map (foldr (flip const) Set.empty)++    rangeSetInsert :: [[a]] -> [RangeSet a]+    rangeSetInsert = map (foldr RangeSet.insert RangeSet.empty)++    setInsert :: [[a]] -> [Set a]+    setInsert = map (foldr Set.insert Set.empty)++makeBench :: NFData a => (a -> String) -> [(String, a -> Benchmarkable)] -> a -> Benchmark+makeBench caseName cases x = env (return x) (\x ->+  bgroup (caseName x) (map (\(name, gen) -> bench name $ gen x) cases))
+ rangeset.cabal view
@@ -0,0 +1,108 @@+cabal-version:       2.2+name:                rangeset+-- https://wiki.haskell.org/Package_versioning_policy+-- PVP summary:      +--------- breaking changes+--                   | +------- breaking changes+--                   | | +----- non-breaking additions+--                   | | | +--- code changes with no API change+version:             0.0.1.0+synopsis:            Efficient sets for semi-contiguous data+description:         Exposes the range-set datastructure, which can encode+                     enumerable data efficiently by compressing contiguous+                     ranges of members within the set.+++homepage:            https://github.com/j-mie6/rangeset/tree/master+bug-reports:         https://github.com/j-mie6/rangeset/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Jamie Willis, range-set Contributors+maintainer:          Jamie Willis <j.willis19@imperial.ac.uk>+category:            Data+build-type:          Simple+extra-doc-files:     ChangeLog.md+                     README.md+tested-with:         GHC == 8.6.5,+                     GHC == 8.8.4,+                     GHC == 8.10.7,+                     GHC == 9.0.2,+                     GHC == 9.2.3++flag safe-haskell-rangeset+  description: Make the RangeSet implementation use only safe-haskell things+  default:     False+  manual:      True++library+  exposed-modules:     Data.RangeSet+                       Data.RangeSet.Builders+                       Data.RangeSet.Primitives+                       Data.RangeSet.SetCrossSet++                       Data.RangeSet.Internal+                       Data.RangeSet.Internal.Types+                       Data.RangeSet.Internal.TestingUtils+                       Data.RangeSet.Internal.Enum+                       Data.RangeSet.Internal.SmartConstructors+                       Data.RangeSet.Internal.Extractors+                       Data.RangeSet.Internal.Inserters+                       Data.RangeSet.Internal.Lumpers+                       Data.RangeSet.Internal.Splitters+                       Data.RangeSet.Internal.Heuristics++  build-depends:       base                 >= 4.10    && < 5+  build-tool-depends:  cpphs:cpphs          >= 1.18.8  && < 1.21+  hs-source-dirs:      src/ghc+  default-language:    Haskell2010+  ghc-options:         -Wall -Weverything -Wcompat+                       -Wno-name-shadowing+                       -Wno-missing-import-lists+                       -Wno-unsafe+                       -Wno-all-missed-specialisations+                       -Wno-incomplete-uni-patterns+                       -pgmP cpphs -optP --cpp+                       -freverse-errors++  if impl(ghc >= 8.10)+    ghc-options:       -Wno-missing-safe-haskell-mode+  if impl(ghc >= 9.2)+    ghc-options:       -Wno-missing-kind-signatures+  if flag(safe-haskell-rangeset)+    cpp-options:       -DSAFE++common test-common+  build-depends:       base >=4.10 && <5,+                       rangeset,+                       tasty+  hs-source-dirs:      test+  default-language:    Haskell2010++-- TODO: break this into two groups, one for hunit and the other for quickcheck+test-suite rangeset+  import:              test-common+  type:                exitcode-stdio-1.0+  build-depends:       tasty-hunit, tasty-quickcheck+  main-is:             RangeSet.hs++common benchmark-common+  build-depends:       base >=4.10 && <5,+                       rangeset,+                       gauge,+                       deepseq+  hs-source-dirs:      benchmarks+  other-modules:       BenchmarkUtils+  default-language:    Haskell2010++benchmark rangeset-bench+  import:              benchmark-common+  type:                exitcode-stdio-1.0+  build-depends:       containers,+                       QuickCheck,+                       array,+                       selective+  main-is:             RangeSetBench.hs+  --other-modules:       Data.EnumSet++source-repository head+  type:                git+  location:            https://github.com/j-mie6/rangeset
+ src/ghc/Data/RangeSet.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE MagicHash, UnboxedTuples, TypeApplications, BangPatterns, ScopedTypeVariables, Safe #-}+{-|+Module      : Data.RangeSet+Description : Efficient set for (semi-)contiguous data.+License     : BSD-3-Clause+Maintainer  : Jamie Willis+Stability   : stable++This module contains the implementation of an efficient set for contiguous data. It has a much+smaller memory footprint than a @Set@, and can result in asymptotically faster operations.++@since 0.0.1.0+-}+module Data.RangeSet (+    RangeSet,+    module Data.RangeSet.Primitives,+    singleton, null, full, isSingle, extractSingle, size, sizeRanges,+    notMember, findMin, findMax,+    module Data.RangeSet.SetCrossSet, complement,+    isSubsetOf, isProperSubsetOf,+    allLess, allMore,+    elems, unelems,+    module Data.RangeSet.Builders,+  ) where++import Prelude hiding (null)+import Data.RangeSet.Internal+import Data.RangeSet.Builders+import Data.RangeSet.Primitives+import Data.RangeSet.SetCrossSet++{-|+A `RangeSet` containing a single value.++@since 0.0.1.0+-}+singleton :: Enum a => a -> RangeSet a+singleton x = single 1 (fromEnum x) (fromEnum x)++{-|+Is this set empty?++@since 0.0.1.0+-}+null :: RangeSet a -> Bool+null Tip = True+null _ = False++{-|+Is this set full?++@since 0.0.1.0+-}+full :: forall a. (Enum a, Bounded a) => RangeSet a -> Bool+full Tip = False+full (Fork _ _ l u _ _) = l == fromEnum @a minBound && fromEnum @a maxBound == u++{-|+Does this set contain a single element?++@since 0.0.1.0+-}+isSingle :: RangeSet a -> Bool+isSingle (Fork _ 1 _ _ _ _) = True+isSingle _ = False++{-|+Possibly extract the element contained in the set if it is a singleton set.++@since 0.0.1.0+-}+extractSingle :: Enum a => RangeSet a -> Maybe a+extractSingle (Fork _ 1 x _ _ _) = Just (toEnum x)+extractSingle _                  = Nothing++{-|+Return the number of /contiguous ranges/ that populate the set.++@since 0.0.1.0+-}+sizeRanges :: Enum a => RangeSet a -> Int+sizeRanges = fold (\_ _ szl szr -> szl + szr + 1) 0++{-|+Test whether or not a given value is not found within the set.++@since 0.0.1.0+-}+{-# INLINEABLE notMember #-}+notMember :: Enum a => a -> RangeSet a -> Bool+notMember x = not . member x++{-|+Find the minimum value within the set, if one exists.++@since 0.0.1.0+-}+{-# INLINE findMin #-}+findMin :: Enum a => RangeSet a -> Maybe a+findMin Tip = Nothing+findMin (Fork _ _ l u lt _) = let (# !m, !_ #) = minRange l u lt in Just (toEnum m)++{-|+Find the maximum value within the set, if one exists.++@since 0.0.1.0+-}+{-# INLINE findMax #-}+findMax :: Enum a => RangeSet a -> Maybe a+findMax Tip = Nothing+findMax (Fork _ _ l u _ rt) = let (# !_, !m #) = maxRange l u rt in Just (toEnum m)++{-|+Filters a set by removing all values greater than or equal to the given value.++@since 0.0.1.0+-}+{-# INLINEABLE allLess #-}+allLess :: Enum a => a -> RangeSet a -> RangeSet a+allLess = allLessE . fromEnum++{-|+Filters a set by removing all values less than or equal to the given value.++@since 0.0.1.0+-}+{-# INLINEABLE allMore #-}+allMore :: Enum a => a -> RangeSet a -> RangeSet a+allMore = allMoreE . fromEnum++{-|+Inverts a set: every value which was an element is no longer an element, and every value that+was not an element now is. This is only possible on `Bounded` types.++@since 0.0.1.0+-}+{-# INLINEABLE complement #-}+complement :: forall a. (Bounded a, Enum a) => RangeSet a -> RangeSet a+complement Tip = single (diffE minBoundE maxBoundE) minBoundE maxBoundE+  where+    !minBoundE = fromEnum @a minBound+    !maxBoundE = fromEnum @a maxBound+complement t | full t = Tip+complement t@(Fork _ sz l u lt rt) = case maxl of+  SJust x -> unsafeInsertR (diffE x maxBoundE) x maxBoundE t'+  SNothing -> t'+  where+    !minBoundE = fromEnum @a minBound+    !maxBoundE = fromEnum @a maxBound+    (# !minl, !minu, !rest #) = minDelete sz l u lt rt++    -- The complement of a tree is at most 1 larger or smaller than the original+    -- if both min and max are minBound and maxBound, it will shrink+    -- if neither min or max are minBound or maxBound, it will grow+    -- otherwise, the tree will not change size+    -- The insert or shrink will happen at an extremity, and rebalance need only occur along the spine+                       -- this is safe, because we've checked for the maxSet case already+    !(# !t', !maxl #) | minl == minBoundE = push (succ minu) rest+                      | otherwise         = push minBoundE t++    safeSucc !x+      | x == maxBoundE = SNothing+      | otherwise      = SJust (succ x)++    -- the argument l should not be altered, it /must/ be the correct lower bound+    -- the return /must/ be the next correct lower bound+    push :: E -> RangeSet a -> (# RangeSet a, StrictMaybeE #)+    push !maxl Tip = (# Tip, SJust maxl #)+    push min (Fork _ _ u max lt Tip) =+      let (# !lt', SJust l #) = push min lt+      in  (# fork l (pred u) lt' Tip, safeSucc max #)+    push min (Fork _ _ u l' lt rt@Fork{}) =+      let (# !lt', SJust l #) = push min lt+          -- this is safe, because we know the right-tree contains elements larger than l'+          !(# !rt', !max #) = push (succ l') rt+      in  (# fork l (pred u) lt' rt', max #)++{-|+Tests if all the element of the first set appear in the second, but also that the first and second+sets are not equal.++@since 0.0.1.0+-}+{-# INLINE isProperSubsetOf #-}+isProperSubsetOf :: RangeSet a -> RangeSet a -> Bool+isProperSubsetOf t1 t2 = size t1 < size t2 && uncheckedSubsetOf t1 t2++{-|+Tests if all the elements of the first set appear in the second.++@since 0.0.1.0+-}+{-# INLINEABLE isSubsetOf #-}+isSubsetOf :: RangeSet a -> RangeSet a -> Bool+isSubsetOf t1 t2 = size t1 <= size t2 && uncheckedSubsetOf t1 t2++{-|+Returns all the elements found within the set.++@since 0.0.1.0+-}+{-# INLINE elems #-}+elems :: Enum a => RangeSet a -> [a]+elems t = fold (\l u lt rt -> lt . (range l u ++) . rt) id t []++{-|+Returns all the values that are not found within the set.++@since 0.0.1.0+-}+{-# INLINEABLE unelems #-}+unelems :: forall a. (Bounded a, Enum a) => RangeSet a -> [a]+unelems t = foldE fork tip t (fromEnum @a minBound) (fromEnum @a maxBound) []+  where+    fork :: E -> E -> (E -> E -> [a] -> [a]) -> (E -> E -> [a] -> [a]) -> E -> E -> ([a] -> [a])+    fork l' u' lt rt l u = dxs . dys+      where+        dxs | l' == l   = id+            | otherwise = lt l (pred l')+        dys | u == u'   = id+            | otherwise = rt (succ u') u+    tip :: E -> E -> [a] -> [a]+    tip l u = (range (toEnum l) (toEnum u) ++)
+ src/ghc/Data/RangeSet/Builders.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables, Safe #-}+module Data.RangeSet.Builders (fromRanges, fromDistinctAscRanges, insertRange, fromList, fromDistinctAscList) where++import Prelude hiding (id, (.))+import Data.RangeSet.Internal+import Data.RangeSet.Primitives++id :: SRangeList -> SRangeList+id ss = ss++(.) :: (SRangeList -> SRangeList) -> (SRangeList -> SRangeList) -> SRangeList -> SRangeList+(f . g) ss = f (g ss)++{-|+Constructs a `RangeSet` given a list of ranges.++@since 0.0.1.0+-}+fromRanges :: forall a. Enum a => [(a, a)] -> RangeSet a+fromRanges [] = Tip+fromRanges ((x, y):rs) = go rs ey (SRangeCons ex ey) 1+  where+    !ex = fromEnum x+    !ey = fromEnum y+    go :: [(a, a)] -> E -> (SRangeList -> SRangeList) -> Int -> RangeSet a+    go [] !_ k !n = fromDistinctAscRangesSz (k SNil) n+    go ((x, y):rs) z k n+      -- ordering and disjointness of the ranges broken+      | ex <= z || ey <= z = insertRangeE ex ey (foldr (uncurry insertRange) (fromDistinctAscRangesSz (k SNil) n) rs)+      | otherwise          = go rs ey (k . SRangeCons ex ey) (n + 1)+      where+        !ex = fromEnum x+        !ey = fromEnum y++{-|+Constructs a `RangeSet` given a list of ranges that are in ascending order and do not overlap (this is unchecked).++@since 0.0.1.0+-}+fromDistinctAscRanges :: forall a. Enum a => [(a, a)] -> RangeSet a+fromDistinctAscRanges rs = go rs id 0+  where+    go :: [(a, a)] -> (SRangeList -> SRangeList) -> Int -> RangeSet a+    go [] k !n = fromDistinctAscRangesSz (k SNil) n+    go ((x, y):rs) k n = go rs (k . SRangeCons (fromEnum x) (fromEnum y)) (n + 1)++{-|+Inserts a range into a `RangeSet`.++@since 0.0.1.0+-}+{-# INLINE insertRange #-}+insertRange :: Enum a => a -> a -> RangeSet a -> RangeSet a+insertRange l u t =+  let !le = fromEnum l+      !ue = fromEnum u+  in insertRangeE le ue t++{-|+Builds a `RangeSet` from a given list of elements.++@since 0.0.1.0+-}+fromList :: forall a. Enum a => [a] -> RangeSet a+fromList [] = Tip+fromList (x:xs) = go xs (fromEnum x) (fromEnum x) id 1+  where+    go :: [a] -> E -> E -> (SRangeList -> SRangeList) -> Int -> RangeSet a+    go [] !l !u k !n = fromDistinctAscRangesSz (k (SRangeCons l u SNil)) n+    go (!x:xs) l u k n+      -- ordering or uniqueness is broken+      | ex <= u      = insertE ex (foldr insert (fromDistinctAscRangesSz (k (SRangeCons l u SNil)) n) xs)+      -- the current range is expanded+      | ex == succ u = go xs l ex k n+      -- a new range begins+      | otherwise    = go xs ex ex (k . SRangeCons l u) (n + 1)+      where !ex = fromEnum x+++-- not sure if this one is any use, it avoids one comparison per element...+{-|+Builds a `RangeSet` from a given list of elements that are in ascending order with no duplicates (this is unchecked).++@since 0.0.1.0+-}+fromDistinctAscList :: forall a. Enum a => [a] -> RangeSet a+fromDistinctAscList [] = Tip+fromDistinctAscList (x:xs) = go xs (fromEnum x) (fromEnum x) id 1+  where+    go :: [a] -> E -> E -> (SRangeList -> SRangeList) -> Int -> RangeSet a+    go [] !l !u k !n = fromDistinctAscRangesSz (k (SRangeCons l u SNil)) n+    go (!x:xs) l u k n+      -- the current range is expanded+      | ex == succ u = go xs l ex k n+      -- a new range begins+      | otherwise    = go xs ex ex (k . SRangeCons l u) (n + 1)+      where !ex = fromEnum x
+ src/ghc/Data/RangeSet/Internal.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE MagicHash, UnboxedTuples, MultiWayIf, BangPatterns, CPP #-}+#ifdef SAFE+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+module Data.RangeSet.Internal (+    module Data.RangeSet.Internal,+    RangeSet(..), E, SRangeList(..), StrictMaybeE(..),+    size, height, foldE,+    module Data.RangeSet.Internal.Enum,+    module Data.RangeSet.Internal.SmartConstructors,+    module Data.RangeSet.Internal.Inserters,+    module Data.RangeSet.Internal.Extractors,+    module Data.RangeSet.Internal.Lumpers,+    module Data.RangeSet.Internal.Splitters,+    module Data.RangeSet.Internal.Heuristics+  ) where++import Prelude++import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.Enum+import Data.RangeSet.Internal.SmartConstructors+import Data.RangeSet.Internal.Inserters+import Data.RangeSet.Internal.Extractors+import Data.RangeSet.Internal.Lumpers+import Data.RangeSet.Internal.Splitters+import Data.RangeSet.Internal.Heuristics++{-# INLINEABLE insertE #-}+insertE :: E -> RangeSet a -> RangeSet a+insertE !x Tip = single 1 x x+insertE x t@(Fork h sz l u lt rt)+  -- Nothing happens when it's already in range+  | l <= x = if+    | x <= u -> t+  -- If it is adjacent to the upper range, it may fuse+    | x == succ u -> fuseRight h (sz + 1) l x lt rt                                         -- we know x > u since x <= l && not x <= u+  -- Otherwise, insert and balance for right+    | otherwise -> ifStayedSame rt (insertE x rt) t (balance (sz + 1) l u lt)               -- cannot be biased, because fusion can shrink a tree+  | {- x < l -} otherwise = if+  -- If it is adjacent to the lower, it may fuse+    x == pred l then fuseLeft h (sz + 1) x u lt rt                                          -- the equality must be guarded by an existence check+  -- Otherwise, insert and balance for left+                else ifStayedSame lt (insertE x lt) t $ \lt' -> balance (sz + 1) l u lt' rt -- cannot be biased, because fusion can shrink a tree+  where+    {-# INLINE fuseLeft #-}+    fuseLeft !h !sz !x !u Tip !rt = Fork h sz x u Tip rt+    fuseLeft h sz x u (Fork _ lsz ll lu llt lrt) rt+      | (# !l, !x', lt' #) <- maxDelete lsz ll lu llt lrt+      -- we know there exists an element larger than x'+      -- if x == x' + 1, we fuse (x != x' since that breaks disjointness, x == pred l)+      , x == succ x' = balanceR sz l u lt' rt+      | otherwise    = Fork h sz x u lt rt+    {-# INLINE fuseRight #-}+    fuseRight !h !sz !l !x !lt Tip = Fork h sz l x lt Tip+    fuseRight h sz l x lt (Fork _ rsz rl ru rlt rrt)+      | (# !x', !u, rt' #) <- minDelete rsz rl ru rlt rrt+      -- we know there exists an element smaller than x'+      -- if x == x' - 1, we fuse (x != x' since that breaks disjointness, as x == succ u)+      , x == pred x' = balanceL sz l u lt rt'+      | otherwise    = Fork h sz l x lt rt++{-# INLINEABLE deleteE #-}+deleteE :: E -> RangeSet a -> RangeSet a+deleteE !_ Tip = Tip+deleteE x t@(Fork h sz l u lt rt) =+  case compare l x of+    -- If its the only part of the range, the node is removed+    EQ | x == u    -> glue (sz - 1) lt rt+    -- If it's at an extreme, it shrinks the range+       | otherwise -> Fork h (sz - 1) (succ l) u lt rt+    LT -> case compare x u of+    -- If it's at an extreme, it shrinks the range+       EQ          -> Fork h (sz - 1) l (pred u) lt rt+    -- Otherwise, if it's still in range, the range undergoes fission+       LT          -> fission (sz - 1) l x u lt rt+    -- Otherwise delete and balance for one of the left or right+       GT          -> ifStayedSame rt (deleteE x rt) t $ balance (sz - 1) l u lt             -- cannot be biased, because fisson can grow a tree+    GT             -> ifStayedSame lt (deleteE x lt) t $ \lt' -> balance (sz - 1) l u lt' rt -- cannot be biased, because fisson can grow a tree+  where+    {- Fission breaks a node into two new ranges+       we'll push the range down into the smallest child, ensuring it's balanced -}+    {-# INLINE fission #-}+    fission :: Size -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+    fission !sz !l1 !x !u2 !lt !rt+      | height lt > height rt = forkSz sz l1 u1 lt (unsafeInsertL sz' l2 u2 rt)+      | otherwise = forkSz sz l1 u1 (unsafeInsertR sz' l2 u2 lt) rt+      where+        !u1 = pred x+        !l2 = succ x+        !sz' = diffE l2 u2++uncheckedSubsetOf :: RangeSet a -> RangeSet a -> Bool+uncheckedSubsetOf Tip _ = True+uncheckedSubsetOf _ Tip = False+uncheckedSubsetOf (Fork _ _ l u lt rt) t = case splitOverlap l u t of+  (# lt', Fork 1 _ x y _ _, rt' #) ->+       x == l && y == u+    && size lt <= size lt' && size rt <= size rt'+    && uncheckedSubsetOf lt lt' && uncheckedSubsetOf rt rt'+  _                                -> False++fromDistinctAscRangesSz :: SRangeList -> Int -> RangeSet a+fromDistinctAscRangesSz rs !n = case go rs 0 (n - 1) of (# t, _ #) -> t+  where+    go :: SRangeList -> Int -> Int -> (# RangeSet a, SRangeList #)+    go rs !i !j+      | i > j     = (# Tip, rs #)+      | otherwise =+        let !mid = (i + j) `div` 2+        in case go rs i (mid - 1) of+             (# lt, rs' #) ->+                let !(SRangeCons l u rs'') = rs'+                in case go rs'' (mid + 1) j of+                      (# rt, rs''' #) -> (# fork l u lt rt, rs''' #)++{-# INLINE insertRangeE #-}+-- This could be improved, but is OK+insertRangeE :: E -> E -> RangeSet a -> RangeSet a+insertRangeE !l !u t = let (# lt, rt #) = split l u t in link l u lt rt
+ src/ghc/Data/RangeSet/Internal/Enum.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE BangPatterns, Safe #-}+module Data.RangeSet.Internal.Enum (module Data.RangeSet.Internal.Enum) where++import Prelude++import Data.RangeSet.Internal.Types (E, Size)++{-# INLINE range #-}+range :: Enum a => a -> a -> [a]+range l u = [l..u]++{-# INLINE diffE #-}+diffE :: E -> E -> Size+diffE !l !u = u - l + 1
+ src/ghc/Data/RangeSet/Internal/Extractors.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE BangPatterns, UnboxedTuples, Safe #-}+module Data.RangeSet.Internal.Extractors (module Data.RangeSet.Internal.Extractors) where++import Prelude++import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.SmartConstructors++{-# INLINEABLE minRange #-}+minRange :: E -> E -> RangeSet a -> (# E, E #)+minRange !l !u Tip                 = (# l, u #)+minRange _  _  (Fork _ _ l u lt _) = minRange l u lt++{-# INLINEABLE maxRange #-}+maxRange :: E -> E -> RangeSet a -> (# E, E #)+maxRange !l !u Tip                 = (# l, u #)+maxRange _  _  (Fork _ _ l u _ rt) = maxRange l u rt++{-# INLINE minDelete #-}+minDelete :: Size -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)+minDelete !sz !l !u !lt !rt = let (# !ml, !mu, !_, t' #) = go sz l u lt rt in (# ml, mu, t' #)+  where+    go :: Size -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, Size, RangeSet a #)+    go !sz !l !u Tip !rt = (# l, u, sz - size rt, rt #)+    go sz l u (Fork _ lsz ll lu llt lrt) rt =+      let (# !ml, !mu, !msz, lt' #) = go lsz ll lu llt lrt+      in (# ml, mu, msz, balanceR (sz - msz) l u lt' rt #)++{-# INLINE maxDelete #-}+maxDelete :: Size -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)+maxDelete !sz !l !u !lt !rt = let (# !ml, !mu, !_, t' #) = go sz l u lt rt in (# ml, mu, t' #)+  where+    go :: Size -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, Size, RangeSet a #)+    go !sz !l !u !lt Tip = (# l, u, sz - size lt, lt #)+    go sz l u lt (Fork _ rsz rl ru rlt rrt) =+      let (# !ml, !mu, !msz, rt' #) = go rsz rl ru rlt rrt+      in (# ml, mu, msz, balanceL (sz - msz) l u lt rt' #)
+ src/ghc/Data/RangeSet/Internal/Heuristics.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE BangPatterns, MagicHash, CPP #-}+#ifdef SAFE+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Unsafe #-}+#endif+module Data.RangeSet.Internal.Heuristics (stayedSame, ifStayedSame) where++import Prelude++#ifndef SAFE+import GHC.Exts (reallyUnsafePtrEquality#, isTrue#)+#endif++import Data.RangeSet.Internal.Types++#ifndef SAFE+{-# INLINE ptrEq #-}+ptrEq :: a -> a -> Bool+ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)+#endif++{-# INLINE stayedSame #-}+{-|+This should /only/ be used to compare a set that is modified+with its original value. The assumption is that a set as stayed+the same if its size hasn't changed.+-}+stayedSame :: RangeSet a -- ^ the original set+           -> RangeSet a -- ^ the same (?) set post modification+           -> Bool+stayedSame before after =+#ifdef SAFE+    size before == size after+#else+    before `ptrEq` after+#endif++{-# INLINE ifStayedSame #-}+ifStayedSame :: RangeSet a -> RangeSet a -> RangeSet a -> (RangeSet a -> RangeSet a) -> RangeSet a+ifStayedSame !x !x' y f = if size x == size x' then y else f x'
+ src/ghc/Data/RangeSet/Internal/Inserters.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns, UnboxedTuples, Safe #-}+module Data.RangeSet.Internal.Inserters (module Data.RangeSet.Internal.Inserters) where++import Prelude++import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.SmartConstructors+import Data.RangeSet.Internal.Extractors++{-|+Inserts an range at the left-most position in the tree.+It *must* not overlap with any other range within the tree.+It *must* be /known/ not to exist within the tree.+-}+{-# INLINEABLE unsafeInsertL #-}+unsafeInsertL :: Size -> E -> E -> RangeSet a -> RangeSet a+unsafeInsertL !newSz !l !u = go+  where+    go :: RangeSet a -> RangeSet a+    go Tip = single newSz l u+    go (Fork _ sz l' u' lt rt) = balanceL (sz + newSz) l' u' (go lt) rt++{-|+Inserts an range at the right-most position in the tree.+It *must* not overlap with any other range within the tree.+It *must* be /known/ not to exist within the tree.+-}+{-# INLINEABLE unsafeInsertR #-}+unsafeInsertR :: Size -> E -> E -> RangeSet a -> RangeSet a+unsafeInsertR !newSz !l !u = go+  where+    go :: RangeSet a -> RangeSet a+    go Tip = single newSz l u+    go (Fork _ sz l' u' lt rt) = balanceR (sz + newSz) l' u' lt (go rt)++{-# INLINEABLE insertLAdj #-}+insertLAdj :: Size -> E -> E -> Int -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+insertLAdj !newSz !l !u !th !tsz !tl !tu !tlt !trt = case minRange tl tu tlt of+  (# !l', _ #) | l' == succ u -> fuseL newSz l th tsz tl tu tlt trt+               | otherwise    -> balanceL (tsz + newSz) tl tu (unsafeInsertL newSz l u tlt) trt+  where+    {-# INLINEABLE fuseL #-}+    fuseL :: Size -> E -> Int -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+    fuseL !newSz !l' !h !sz !l !u lt rt = case lt of+      Tip -> Fork h (newSz + sz) l' u Tip rt+      Fork lh lsz ll lu llt lrt  -> Fork h (newSz + sz) l u (fuseL newSz l' lh lsz ll lu llt lrt) rt++{-# INLINEABLE insertRAdj #-}+insertRAdj :: Size -> E -> E -> Int -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+insertRAdj !newSz !l !u !th !tsz !tl !tu !tlt !trt = case maxRange tl tu trt of+  (# _, !u' #) | u' == pred l -> fuseR newSz u th tsz tl tu tlt trt+               | otherwise    -> balanceR (tsz + newSz) tl tu tlt (unsafeInsertR newSz l u trt)+  where+    {-# INLINEABLE fuseR #-}+    fuseR :: Size -> E -> Int -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+    fuseR !newSz !u' !h !sz !l !u lt rt = case rt of+      Tip -> Fork h (newSz + sz) l u' lt Tip+      Fork rh rsz rl ru rlt rrt  -> Fork h (newSz + sz) l u lt (fuseR newSz u' rh rsz rl ru rlt rrt)
+ src/ghc/Data/RangeSet/Internal/Lumpers.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE BangPatterns, UnboxedTuples, Safe #-}+module Data.RangeSet.Internal.Lumpers (module Data.RangeSet.Internal.Lumpers) where++import Prelude++import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.SmartConstructors+import Data.RangeSet.Internal.Inserters+import Data.RangeSet.Internal.Extractors+import Data.RangeSet.Internal.Enum++{-# INLINABLE link #-}+link :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a+link !l !u Tip Tip = single (diffE l u) l u+link l u Tip (Fork rh rsz rl ru rlt rrt) = insertLAdj (diffE l u) l u rh rsz rl ru rlt rrt+link l u (Fork lh lsz ll lu llt lrt) Tip = insertRAdj (diffE l u) l u lh lsz ll lu llt lrt+link l u lt@(Fork _ lsz ll lu llt lrt) rt@(Fork _ rsz rl ru rlt rrt) =+  disjointLink (diffE l' u') l' u' lt'' rt''+  where+    -- we have to check for fusion up front+    (# !lmaxl, !lmaxu, lt' #) = maxDelete lsz ll lu llt lrt+    (# !rminl, !rminu, rt' #) = minDelete rsz rl ru rlt rrt++    (# !l', !lt'' #) | lmaxu == pred l = (# lmaxl, lt' #)+                     | otherwise       = (# l, lt #)++    (# !u', !rt'' #) | rminl == succ u = (# rminu, rt' #)+                     | otherwise       = (# u, rt #)++{-# INLINEABLE disjointLink #-}+disjointLink :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+disjointLink !newSz !l !u Tip rt = unsafeInsertL newSz l u rt+disjointLink newSz l u lt Tip = unsafeInsertR newSz l u lt+disjointLink newSz l u lt@(Fork hl szl ll lu llt lrt) rt@(Fork hr szr rl ru rlt rrt)+  | hl < hr + 1 = balanceL (newSz + szl + szr) rl ru (disjointLink newSz l u lt rlt) rrt+  | hr < hl + 1 = balanceR (newSz + szl + szr) ll lu llt (disjointLink newSz l u lrt rt)+  | otherwise   = forkH (newSz + szl + szr) l u hl lt hr rt++-- This version checks for fusion between the two trees to be merged+{-{-# INLINEABLE merge #-}+merge :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a+merge Tip Tip = Tip+merge t Tip = t+merge Tip t = t+merge t1 t2 =+  let (# !_, !u1 #) = unsafeMaxRange t1+      (# !l2, !u2, t2' #) = unsafeMinDelete t2+  in if succ u1 == l2 then unsafeMerge (unsafeFuseR (diffE l2 u2) u2 t1) t2'+     else unsafeMerge t1 t2-}++-- This assumes that the trees are /totally/ disjoint+{-# INLINEABLE disjointMerge #-}+disjointMerge :: RangeSet a -> RangeSet a -> RangeSet a+disjointMerge Tip rt = rt+disjointMerge lt Tip = lt+disjointMerge lt@(Fork hl szl ll lu llt lrt) rt@(Fork hr szr rl ru rlt rrt)+  | hl < hr + 1 = balanceL (szl + szr) rl ru (disjointMerge lt rlt) rrt+  | hr < hl + 1 = balanceR (szl + szr) ll lu llt (disjointMerge lrt rt)+  | otherwise   = glue (szl + szr) lt rt++-- Trees must be balanced with respect to eachother, since we pull from the tallest, no balancing is required+{-# INLINEABLE glue #-}+glue :: Size -> RangeSet a -> RangeSet a -> RangeSet a+glue !_ Tip rt = rt+glue _ lt Tip  = lt+glue sz lt@(Fork lh lsz ll lu llt lrt) rt@(Fork rh rsz rl ru rlt rrt)+  | lh < rh = let (# !l, !u, !rt' #) = minDelete rsz rl ru rlt rrt in forkSz sz l u lt rt'+  | otherwise = let (# !l, !u, !lt' #) = maxDelete lsz ll lu llt lrt in forkSz sz l u lt' rt+
+ src/ghc/Data/RangeSet/Internal/SmartConstructors.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE BangPatterns, Safe #-}+module Data.RangeSet.Internal.SmartConstructors (+    single,+    fork, forkSz, forkH,+    balance, balanceL, balanceR,+    uncheckedBalanceL, uncheckedBalanceR+  ) where++import Prelude+import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.Enum++-- Basic tree constructors+{-# INLINE single #-}+single :: Size -> E -> E -> RangeSet a+single !sz !l !u = Fork 1 sz l u Tip Tip++{-# INLINE heightOfFork #-}+heightOfFork :: Int -> Int -> Int+heightOfFork lh rh = max lh rh + 1++{-# INLINE fork #-}+fork :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a+fork !l !u !lt !rt = forkSz (size lt + size rt + diffE l u) l u lt rt++--{-# INLINE forkSz #-} -- this does bad things+forkSz :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+forkSz !sz !l !u !lt !rt = forkH sz l u (height lt) lt (height rt) rt++{-# INLINE forkH #-}+forkH :: Size -> E -> E -> Int -> RangeSet a -> Int -> RangeSet a -> RangeSet a+forkH !sz !l !u !lh !lt !rh !rt =  Fork (heightOfFork lh rh) sz l u lt rt++-- Balancers+{-# NOINLINE balance #-}+balance :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+balance !sz !l !u Tip Tip = single sz l u+balance sz l u lt@(Fork lh lsz ll lu llt lrt) Tip+  | lh == 1   = Fork (lh + 1) sz l u lt Tip+  | otherwise = uncheckedBalanceL sz l u lsz ll lu llt lrt Tip+balance sz l u Tip rt@(Fork rh rsz rl ru rlt rrt)+  | rh == 1   = Fork (rh + 1) sz l u Tip rt+  | otherwise = uncheckedBalanceR sz l u Tip rsz rl ru rlt rrt+balance sz l u lt@(Fork lh lsz ll lu llt lrt) rt@(Fork rh rsz rl ru rlt rrt)+  | height lt > height rt + 1 = uncheckedBalanceL sz l u lsz ll lu llt lrt rt+  | height rt > height lt + 1 = uncheckedBalanceR sz l u lt rsz rl ru rlt rrt+  | otherwise = forkH sz l u lh lt rh rt++{-# INLINEABLE balanceL #-}+balanceL :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left+balanceL !sz !l1 !u1 lt@(Fork lh lsz l2 u2 llt lrt) !rt+  -- both sides are equal height or off by one+  | dltrt <= 1 = forkH sz l1 u1 lh lt rh rt+  -- The bias is 2 (dltrt == 2)+  | otherwise  = uncheckedBalanceL sz l1 u1 lsz l2 u2 llt lrt rt+  where+    !rh = height rt+    !dltrt = lh - rh+-- If the right shrank (or nothing changed), we have to be prepared to handle the Tip case for lt+balanceL sz l u Tip rt = Fork (height rt + 1) sz l u Tip rt++{-# INLINEABLE balanceR #-}+balanceR :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right+balanceR !sz !l1 !u1 !lt rt@(Fork rh rsz l2 u2 rlt rrt)+  -- both sides are equal height or off by one+  | dltrt <= 1 = forkH sz l1 u1 lh lt rh rt+  | otherwise  = uncheckedBalanceR sz l1 u1 lt rsz l2 u2 rlt rrt+  where+    !lh = height lt+    !dltrt = rh - lh+-- If the left shrank (or nothing changed), we have to be prepared to handle the Tip case for rt+balanceR sz l u lt Tip = Fork (height lt + 1) sz l u lt Tip++{-# NOINLINE uncheckedBalanceL #-}+-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left+uncheckedBalanceL :: Size -> E -> E -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> RangeSet a+uncheckedBalanceL !sz !l1 !u1 !szl !l2 !u2 !llt !lrt !rt+  -- The bias is 2 (dltrt == 2)+  | hllt >= hlrt = rotr' sz l1 u1 szl l2 u2 llt lrt rt+  | otherwise    = rotr sz l1 u1 (rotl szl l2 u2 llt lrt) rt+  where+    !hllt = height llt+    !hlrt = height lrt++{-# NOINLINE uncheckedBalanceR #-}+uncheckedBalanceR :: Size -> E -> E -> RangeSet a -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right+uncheckedBalanceR !sz !l1 !u1 !lt !szr !l2 !u2 !rlt !rrt+  -- The bias is 2 (drtlt == 2)+  | hrrt >= hrlt = rotl' sz l1 u1 lt szr l2 u2 rlt rrt+  | otherwise    = rotl sz l1 u1 lt (rotr szr l2 u2 rlt rrt)+  where+    !hrlt = height rlt+    !hrrt = height rrt++{-# INLINE rotr #-}+rotr :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+rotr !sz !l1 !u1 (Fork _ szl l2 u2 p q) !r = rotr' sz l1 u1 szl l2 u2 p q r+rotr _ _ _ _ _ = error "rotr on Tip"++{-# INLINE rotl #-}+rotl :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+rotl !sz !l1 !u1 !p (Fork _ szr l2 u2 q r) = rotl' sz l1 u1 p szr l2 u2 q r+rotl _ _ _ _ _ = error "rotr on Tip"++{-# INLINE rotr' #-}+rotr' :: Size -> E -> E -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> RangeSet a+rotr' !sz !l1 !u1 !szl !l2 !u2 !p !q !r = forkSz sz l2 u2 p (forkSz (sz - szl + size q) l1 u1 q r)++{-# INLINE rotl' #-}+rotl' :: Size -> E -> E -> RangeSet a -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a+rotl' !sz !l1 !u1 !p !szr !l2 !u2 !q !r = forkSz sz l2 u2 (forkSz (sz - szr + size q) l1 u1 p q) r
+ src/ghc/Data/RangeSet/Internal/Splitters.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE BangPatterns, UnboxedTuples, Safe #-}+module Data.RangeSet.Internal.Splitters (module Data.RangeSet.Internal.Splitters) where++import Prelude++import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.SmartConstructors+import Data.RangeSet.Internal.Inserters+import Data.RangeSet.Internal.Enum+import Data.RangeSet.Internal.Lumpers++{-# INLINEABLE allLessE #-}+allLessE :: E -> RangeSet a -> RangeSet a+allLessE !_ Tip = Tip+allLessE x (Fork _ _ l u lt rt) = case compare x l of+  EQ          -> lt+  LT          -> allLessE x lt+  GT | x <= u -> unsafeInsertR (diffE l (pred x)) l (pred x) (allLessE x lt)+  GT          -> link l u lt (allLessE x rt)++{-# INLINEABLE allMoreE #-}+allMoreE :: E -> RangeSet a -> RangeSet a+allMoreE !_ Tip = Tip+allMoreE x (Fork _ _ l u lt rt) = case compare u x of+  EQ          -> rt+  LT          -> allMoreE x rt+  GT | l <= x -> unsafeInsertL (diffE (succ x) u) (succ x) u (allMoreE x rt)+  GT          -> link l u (allMoreE x lt) rt++{-# INLINEABLE split #-}+split :: E -> E -> RangeSet a -> (# RangeSet a, RangeSet a #)+split !_ !_ Tip = (# Tip, Tip #)+split l u (Fork _ _ l' u' lt rt)+  | u < l' = let (# !llt, !lgt #) = split l u lt in (# llt, link l' u' lgt rt #)+  | u' < l = let (# !rlt, !rgt #) = split l u rt in (# link l' u' lt rlt, rgt #)+  -- The ranges overlap in some way+  | otherwise = let !lt' = case compare l' l of+                      EQ -> lt+                      LT -> unsafeInsertR (diffE l' (pred l)) l' (pred l) lt+                      GT -> allLessE l lt+                    !rt' = case compare u u' of+                      EQ -> rt+                      LT -> unsafeInsertL (diffE (succ u) u') (succ u) u' rt+                      GT -> allMoreE u rt+                in (# lt', rt' #)++{-# INLINE splitOverlap #-}+splitOverlap :: E -> E -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)+splitOverlap !l !u !t = let (# lt', rt' #) = split l u t in (# lt', overlapping l u t, rt' #)++{-# INLINABLE overlapping #-}+overlapping :: E -> E -> RangeSet a -> RangeSet a+overlapping !_ !_ Tip = Tip+overlapping x y (Fork _ sz l u lt rt) =+  case compare l x of+    -- range is outside to the left+    GT -> let !lt' = {-allMoreEqX-} overlapping x y lt+          in case cmpY of+               -- range is totally outside+               GT -> disjointLink nodeSz l u lt' rt'+               EQ -> unsafeInsertR nodeSz l u lt'+               LT | y >= l -> unsafeInsertR (diffE l y) l y lt'+               LT          -> lt' {-overlapping x y lt-}+    -- range is inside on the left+    EQ -> case cmpY of+      -- range is outside on the right+      GT -> unsafeInsertL nodeSz l u rt'+      LT -> t'+      EQ -> single nodeSz l u+    LT -> case cmpY of+      -- range is outside on the right+      GT | x <= u -> unsafeInsertL (diffE x u) x u rt'+      GT          -> rt' {-overlapping x y rt-}+      _           -> t'+  where+    !cmpY = compare y u+    !nodeSz = sz - size lt - size rt+    -- leave lazy!+    rt' = {-allLessEqY-} overlapping x y rt+    t' :: RangeSet a+    t' = single (diffE x y) x y++    {-allLessEqY Tip = Tip+    allLessEqY (Fork _ sz l u lt rt) = case compare y l of+      EQ         -> unsafeInsertR 1 y y lt+      LT         -> allLessEqY lt+      GT | y < u -> unsafeInsertR (diffE l y) l y (allLessEqY lt)+      GT         -> disjointLink (sz - size lt - size rt) l u lt (allLessEqY rt)++    allMoreEqX Tip = Tip+    allMoreEqX (Fork _ sz l u lt rt) = case compare u x of+      EQ         -> unsafeInsertL 1 x x rt+      LT         -> allMoreEqX rt+      GT | l < x -> unsafeInsertL (diffE x u) x u (allMoreEqX rt)+      GT         -> disjointLink (sz - size lt - size rt) l u (allMoreEqX lt) rt-}
+ src/ghc/Data/RangeSet/Internal/TestingUtils.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE Safe #-}+module Data.RangeSet.Internal.TestingUtils (module Data.RangeSet.Internal.TestingUtils) where++import Prelude++import Control.Applicative (liftA2)++import Data.RangeSet.Internal.Types+import Data.RangeSet.Internal.Enum (diffE)++-- Testing Utilities+valid :: RangeSet a -> Bool+valid t = balanced t && wellSized t && orderedNonOverlappingAndCompressed True t++balanced :: RangeSet a -> Bool+balanced Tip = True+balanced (Fork h _ _ _ lt rt) =+  h == max (height lt) (height rt) + 1 &&+  height rt < h &&+  abs (height lt - height rt) <= 1 &&+  balanced lt &&+  balanced rt++wellSized :: RangeSet a -> Bool+wellSized Tip = True+wellSized (Fork _ sz l u lt rt) = sz == size lt + size rt + diffE l u && wellSized lt && wellSized rt++orderedNonOverlappingAndCompressed :: Bool -> RangeSet a -> Bool+orderedNonOverlappingAndCompressed checkCompressed = bounded (const True) (const True)+  where+    bounded :: (E -> Bool) -> (E -> Bool) -> RangeSet a -> Bool+    bounded _ _ Tip = True+    bounded lo hi (Fork _ _ l u lt rt) =+      l <= u &&+      lo l &&+      hi u &&+      bounded lo (boundAbove l) lt &&+      bounded (boundBelow u) hi rt++    boundAbove :: E -> E -> Bool+    boundAbove l | checkCompressed = liftA2 (&&) (< l) (< pred l)+                 | otherwise = (< l)++    boundBelow :: E -> E -> Bool+    boundBelow u | checkCompressed = liftA2 (&&) (> u) (> succ u)+                 | otherwise = (> u)
+ src/ghc/Data/RangeSet/Internal/Types.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE DerivingStrategies, RoleAnnotations, CPP, Trustworthy #-}+#if __GLASGOW_HASKELL__ > 900+{-# LANGUAGE UnliftedDatatypes #-}+#endif+module Data.RangeSet.Internal.Types (module Data.RangeSet.Internal.Types) where++import Prelude++#if __GLASGOW_HASKELL__ > 900+import GHC.Exts (UnliftedType)+#endif++type Size = Int+type E = Int+{-|+A @Set@ type designed for types that are `Enum` as well as `Ord`. This allows the `RangeSet` to+compress the data when it is contiguous, reducing memory-footprint and enabling otherwise impractical+operations like `complement` for `Bounded` types.++@since 0.0.1.0+-}+data RangeSet a = Fork {-# UNPACK #-} !Int {-# UNPACK #-} !Size {-# UNPACK #-} !E {-# UNPACK #-} !E !(RangeSet a) !(RangeSet a)+                | Tip+                deriving stock Show+type role RangeSet nominal++{-|+Return the number of /elements/ in the set.++@since 0.0.1.0+-}+{-# INLINE size #-}+size :: RangeSet a -> Int+size Tip = 0+size (Fork _ sz _ _ _ _) = sz++{-# INLINE height #-}+height :: RangeSet a -> Int+height Tip = 0+height (Fork h _ _ _ _ _) = h++{-# INLINEABLE foldE #-}+foldE :: (E -> E -> b -> b -> b) -- ^ Function that combines the lower and upper values (inclusive) for a range with the folded left- and right-subtrees.+      -> b                       -- ^ Value to be substituted at the leaves.+      -> RangeSet a+      -> b+foldE _ tip Tip = tip+foldE fork tip (Fork _ _ l u lt rt) = fork l u (foldE fork tip lt) (foldE fork tip rt)++#if __GLASGOW_HASKELL__ > 900+type StrictMaybeE :: UnliftedType+#endif+data StrictMaybeE = SJust {-# UNPACK #-} !E | SNothing++#if __GLASGOW_HASKELL__ > 900+type SRangeList :: UnliftedType+#endif+data SRangeList = SRangeCons {-# UNPACK #-} !E {-# UNPACK #-} !E !SRangeList | SNil++-- Instances+instance Eq (RangeSet a) where+  {-# INLINABLE (==) #-}+  t1 == t2 = size t1 == size t2 && ranges t1 == ranges t2+    where+      {-# INLINE ranges #-}+      ranges :: RangeSet a -> [(E, E)]+      ranges t = foldE (\l u lt rt -> lt . ((l, u) :) . rt) id t []
+ src/ghc/Data/RangeSet/Primitives.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns, Safe #-}+module Data.RangeSet.Primitives (empty, member, insert, delete, fold) where++import Prelude+import Data.RangeSet.Internal++{-|+The empty `RangeSet`.++@since 0.0.1.0+-}+{-# INLINE empty #-}+empty :: RangeSet a+empty = Tip++{-|+Test whether or not a given value is found within the set.++@since 0.0.1.0+-}+{-# INLINEABLE member #-}+member :: Enum a => a -> RangeSet a -> Bool+member !x = go+  where+    !x' = fromEnum x+    go :: RangeSet a -> Bool+    go (Fork _ _ l u lt rt)+      | l <= x'   = x' <= u || go rt+      | otherwise = go lt+    go Tip = False++{-|+Insert a new element into the set.++@since 0.0.1.0+-}+{-# INLINEABLE insert #-}+insert :: Enum a => a -> RangeSet a -> RangeSet a+insert = insertE . fromEnum++{-|+Remove an element from the set, if it appears.++@since 0.0.1.0+-}+{-# INLINEABLE delete #-}+delete :: Enum a => a -> RangeSet a -> RangeSet a+delete = deleteE . fromEnum++{-|+Folds a range set.++@since 0.0.1.0+-}+{-# INLINEABLE fold #-}+fold :: Enum a+     => (a -> a -> b -> b -> b) -- ^ Function that combines the lower and upper values (inclusive) for a range with the folded left- and right-subtrees.+     -> b                       -- ^ Value to be substituted at the leaves.+     -> RangeSet a+     -> b+fold fork = foldE (\l u -> fork (toEnum l) (toEnum u))
+ src/ghc/Data/RangeSet/SetCrossSet.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE UnboxedTuples, BangPatterns, Safe #-}+module Data.RangeSet.SetCrossSet (union, intersection, difference, disjoint) where++import Prelude+import Data.RangeSet.Internal++{-|+Unions two sets together such that if and only if an element appears in either one of the sets, it+will appear in the result set.++@since 0.0.1.0+-}+{-# INLINABLE union #-}+union :: Enum a => RangeSet a -> RangeSet a -> RangeSet a+union t Tip = t+union Tip t = t+union t@(Fork _ _ l u lt rt) t' = case split l u t' of+  (# lt', rt' #)+    | stayedSame lt ltlt', stayedSame rt rtrt' -> t+    | otherwise                                -> link l u ltlt' rtrt'+    where !ltlt' = lt `union` lt'+          !rtrt' = rt `union` rt'++{-|+Intersects two sets such that an element appears in the result if and only if it is present in both+of the provided sets.++@since 0.0.1.0+-}+{-# INLINABLE intersection #-}+intersection :: Enum a => RangeSet a -> RangeSet a -> RangeSet a+intersection Tip _ = Tip+intersection _ Tip = Tip+intersection t1@(Fork _ _ l1 u1 lt1 rt1) t2 =+  case overlap of+    Tip -> disjointMerge lt1lt2 rt1rt2+    Fork 1 sz x y _ _+      | x == l1, y == u1+      , stayedSame lt1 lt1lt2, stayedSame rt1 rt1rt2 -> t1+      | otherwise -> disjointLink sz x y lt1lt2 rt1rt2+    Fork _ sz x y lt' rt' -> disjointLink (sz - size lt' - size rt') x y (disjointMerge lt1lt2 lt') (disjointMerge rt' rt1rt2)+  where+    (# !lt2, !overlap, !rt2 #) = splitOverlap l1 u1 t2+    !lt1lt2 = intersection lt1 lt2+    !rt1rt2 = intersection rt1 rt2++{-|+Do two sets have no elements in common?++@since 0.0.1.0+-}+{-# INLINE disjoint #-}+disjoint :: Enum a => RangeSet a -> RangeSet a -> Bool+disjoint Tip _ = True+disjoint _ Tip = True+disjoint (Fork _ _ l u lt rt) t = case splitOverlap l u t of+  (# lt', Tip, rt' #) -> disjoint lt lt' && disjoint rt rt'+  _                   -> False++{-|+Removes all elements from the first set that are found in the second set.++@since 0.0.1.0+-}+{-# INLINEABLE difference #-}+difference :: Enum a => RangeSet a -> RangeSet a -> RangeSet a+difference Tip _ = Tip+difference t Tip = t+difference t (Fork _ _ l u lt rt) = case split l u t of+  (# lt', rt' #)+    | size lt'lt + size rt'rt == size t -> t+    | otherwise -> disjointMerge lt'lt rt'rt+    where+      !lt'lt = difference lt' lt+      !rt'rt = difference rt' rt
+ test/RangeSet.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE TypeApplications, StandaloneDeriving, DeriveGeneric, MonoLocalBinds #-}+module Main where+import Test.Tasty (testGroup, defaultMain, TestTree)+import Test.Tasty.HUnit ( testCase, (@?=) )+import Test.Tasty.QuickCheck+  ( listOf, chooseEnum,+    (===),+    (==>),+    (.&&.),+    property,+    testProperty,+    elements,+    forAll,+    genericShrink,+    Arbitrary(arbitrary, shrink),+    Property )++import Prelude hiding (null)++import Data.RangeSet+import Data.RangeSet.Internal+import Data.RangeSet.Internal.TestingUtils+import Data.List (nub, sort, intersect)+import GHC.Generics (Generic)++import Data.Word (Word8)++main :: IO ()+main = defaultMain tests++deriving instance Generic (RangeSet a)++data Digit = Zero | One | Two | Three | Four | Five | Six | Seven | Eight | Nine deriving (Ord, Eq, Enum, Bounded, Show, Generic)++instance (Arbitrary a, Enum a, Ord a) => Arbitrary (RangeSet a) where+  arbitrary = fmap fromList (listOf arbitrary)+  shrink = filter valid . genericShrink++instance Arbitrary Digit where+  arbitrary = chooseEnum (Zero, Nine)+  shrink Zero = []+  shrink n = [Zero .. pred n]++tests :: TestTree+tests = testGroup "RangeSet" [+    testProperty "arbitrary RangeSets should be valid" $ valid @Word,+    emptyTests,+    memberTests,+    insertTests,+    deleteTests,+    fromListTests,+    testProperty "elems and unelems shoudld be disjoint" $ elemUnelemDisjoint @Word8,+    testProperty "complement . complement = id" $ complementInverse @Digit,+    testProperty "unelems == elems . complement" $ complementElemsInverse @Digit,+    testProperty "findMin should find the minimum" $ findMinMinimum @Word,+    testProperty "findMax should find the maximum" $ findMaxMaximum @Int,+    testProperty "allLess should find everything strictly less than a value" $ allLessMin @Word,+    testProperty "allMore should find everything strictly more than a value" $ allMoreMax @Word,+    testProperty "union should union" $ uncurry (unionProperty @Int),+    testProperty "intersection should intersect" $ uncurry (intersectionProperty @Digit),+    testProperty "difference should differentiate" $ uncurry (differenceProperty @Word)+  ]++emptyTests :: TestTree+emptyTests = testGroup "empty should" [+    testCase "be null" $ null empty @?= True,+    testCase "have size 0" $ size @Int empty @?= 0+  ]++-- member, notMember+memberTests :: TestTree+memberTests = testGroup "member should" [+    testCase "work when out of range" $ notMember 5 (fromRanges [(0, 4), (6, 9)]) @?= True,+    testCase "work when in range" $ member 5 (fromRanges [(0, 9)]) @?= True,+    testCase "work for exact" $ member 5 (fromRanges [(5, 5)]) @?= True,+    testProperty "perform like elem on elems" $ uncurry (memberElemProperty @Word)+  ]++-- insert+insertTests :: TestTree+insertTests =+  let t = fromList [6, 2, 7, 1, 5] -- 1-2, 5-7+  in testGroup "insert should" [+    testCase "add something in" $ member 3 (insert 3 t) @?= True,+    testCase "not affect membership for other items" $ member 4 (insert 3 t) @?= False,+    testCase "not remove membership" $ member 5 (insert 4 (insert 3 t)) @?= True+  ]++-- delete+deleteTests :: TestTree+deleteTests =+  let t = fromList [6, 2, 7, 1, 5] -- 1-2, 5-7+  in testGroup "delete should" [+    testCase "remove an element" $ notMember 2 (delete 2 t) @?= True,+    testCase "not affect membership for other items" $ member 1 (delete 2 t) @?= True,+    testCase "produce valid trees" $ all valid (scanr delete t (sort (elems t))) @?= True+  ]++fromListTests :: TestTree+fromListTests = testGroup "fromList" [+    testProperty "should compose with elems to form (sort . nub)" $ nubSortProperty @Int,+    testProperty "specifically, case 1" $ nubSortProperty [2,0,3,4,2,6],+    testProperty "specifically, case 2" $ nubSortProperty [6,7,4,0,6,10,2,12,8]+  ]++findMinMinimum :: (Ord a, Show a, Enum a) => RangeSet a -> Property+findMinMinimum t = findMin t === safeMinimum (elems t)+  where+    safeMinimum [] = Nothing+    safeMinimum xs = Just $ minimum xs++findMaxMaximum :: (Ord a, Show a, Enum a) => RangeSet a -> Property+findMaxMaximum t = findMax t === safeMaximum (elems t)+  where+    safeMaximum [] = Nothing+    safeMaximum xs = Just $ maximum xs++nubSortProperty :: (Enum a, Ord a, Show a) => [a] -> Property+nubSortProperty xs = sort (nub xs) === elems (fromList xs)++memberElemProperty :: (Enum a, Ord a, Show a) => a -> RangeSet a -> Property+memberElemProperty x t = member x t === elem x (elems t)++elemUnelemDisjoint :: (Enum a, Bounded a, Eq a, Show a) => RangeSet a -> Property+elemUnelemDisjoint t = intersect (elems t) (unelems t) === []++complementInverse :: (Enum a, Bounded a, Ord a, Show a) => RangeSet a -> Property+complementInverse t = elems (complement (complement t)) === elems t++complementElemsInverse :: (Enum a, Bounded a, Ord a, Show a) => RangeSet a -> Property+complementElemsInverse t = unelems t === elems (complement t)++unionProperty :: (Ord a, Enum a, Show a) => RangeSet a -> RangeSet a -> Property+unionProperty t1 t2 = not (null t1 && null t2) ==>+  forAll (elements (elems t1 ++ elems t2)) (\x ->+         member x (t1 `union` t2))+  .&&. valid (t1 `union` t2)++intersectionProperty :: (Ord a, Enum a, Show a) => RangeSet a -> RangeSet a -> Property+intersectionProperty t1 t2 = not (null t1 && null t2) ==>+  forAll (elements (elems t1 ++ elems t2)) (\x ->+         (member x t1 && member x t2) === member x (t1 `intersection` t2))+  .&&. valid (t1 `intersection` t2)++differenceProperty :: (Ord a, Enum a, Show a) => RangeSet a -> RangeSet a -> Property+differenceProperty t1 t2 = not (null t1 && null t2) ==>+  forAll (elements (elems t1 ++ elems t2)) (\x ->+         (member x t1 && not (member x t2)) === member x (t1 `difference` t2))+  .&&. valid (t1 `difference` t2)++allLessMin :: (Ord a, Enum a, Show a) => RangeSet a -> a -> Property+allLessMin t x = allLess x t === fromList (filter (< x) (elems t))++allMoreMax :: (Ord a, Enum a, Show a) => RangeSet a -> a -> Property+allMoreMax t x = allMore x t === fromList (filter (> x) (elems t))++{-+    fromRanges, insertRange+-}