containers 0.6.7 → 0.6.8

raw patch · 17 files changed

+644/−184 lines, 17 filesdep ~basedep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, deepseq

API changes (from Hackage documentation)

Files

• changelog.md +26/−0
• containers.cabal +6/−3
• mkappend.hs +96/−0
• src/Data/Graph.hs +3/−11
• src/Data/IntMap/Internal.hs +56/−5
• src/Data/IntMap/Lazy.hs +2/−2
• src/Data/IntMap/Strict/Internal.hs +54/−3
• src/Data/IntSet.hs +3/−2
• src/Data/IntSet/Internal.hs +56/−1
• src/Data/Map/Internal.hs +128/−48
• src/Data/Map/Strict/Internal.hs +82/−38
• src/Data/Sequence/Internal.hs +9/−9
• src/Data/Set.hs +2/−2
• src/Data/Set/Internal.hs +106/−38
• src/Data/Tree.hs +11/−10
• src/Utils/Containers/Internal/Prelude.hs +4/−10
• src/Utils/Containers/Internal/State.hs +0/−2

@@ -1,5 +1,31 @@ # Changelog for [`containers` package](http://github.com/haskell/containers) +## 0.6.8++### Additions++* Add `Data.IntSet.fromRange`. (Soumik Sarkar)++### Improvements++* Speed up conversion from monotonic lists to `Set`s and+  `Map`s. (Soumik Sarkar)++### Documentation and other++* Add, improve, and correct documentation. (Niklas Hambüchen, Soumik Sarkar,+  tomjaguarpaw, Alice Rixte, Tom Smeding)++### Other/internal++* Remove the `stack.yaml` file. It was extremely stale, and its utility was a+  bit dubious in a GHC boot package. Closes #938.++* Add a bunch of new tests and benchmarks. (Soumik Sarkar)++* Future-proof test suite against export of `foldl'` from `Prelude`.+  (Teo Camarasu)+ ## 0.6.7  ### Additions

@@ -1,5 +1,5 @@ name: containers-version: 0.6.7+version: 0.6.8 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -24,8 +24,11 @@ extra-source-files:     include/containers.h     changelog.md+    mkappend.hs -tested-with: GHC==9.6.1, GHC==9.4.2, GHC==9.2.2, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+tested-with:+  GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 ||+      ==9.4.5 || ==9.6.2 || ==9.8.1  source-repository head     type:     git@@ -33,7 +36,7 @@  Library     default-language: Haskell2010-    build-depends: base >= 4.9.1 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, template-haskell+    build-depends: base >= 4.10 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.6, template-haskell     hs-source-dirs: src     ghc-options: -O2 -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates 

@@ -0,0 +1,96 @@+-- Generate appendTree<0..4> and addDigits<1..4> for Data.Sequence+module Main where++main :: IO ()+main = putStr (compose [showAppend n | n <- [0..4]] "")++showAppend :: Int -> ShowS+showAppend n =+    showChar '\n' .+    showString "appendTree" . shows n . showString " :: " .+        showFunType+            ([fingertree] ++ replicate n tyarg ++ [fingertree]) fingertree .+            showString "\n" .+    appendTreeClause "EmptyT" "xs" (showCons (args n) (showString "xs")) .+    appendTreeClause "xs" "EmptyT" (showSnoc (showString "xs") (args n)) .+    appendTreeClause "(Single x)" "xs"+        (showCons ('x':args n) (showString "xs")) .+    appendTreeClause "xs" "(Single x)"+        (showSnoc (showString "xs") (args n++"x")) .+    appendTreeClause "(Deep s1 pr1 m1 sf1)" "(Deep s2 pr2 m2 sf2)"+        (showString "Deep (s1" .+         compose [showString " + size " . showChar v | v <- args n] .+         showString " + s2) pr1 (addDigits" . shows n .+         showString " m1 sf1" . showArgList (args n) .+         showString " pr2 m2) sf2") .+    showChar '\n' .+    showString "addDigits" . shows n . showString " :: " .+        showFunType+            ([fingertree_node, digit] ++ replicate n tyarg ++ [digit, fingertree_node])+            fingertree_node .+        showString "\n" .+    compose [addDigitsClause n1 n2 | n1 <- [1..4], n2 <- [1..4]]+  where+    fingertree = tyapp "FingerTree" tyarg+    digit = tyapp "Digit" tyarg+    fingertree_node = tyapp "FingerTree" (tyapp "Node" tyarg)+    showFunType ts tr =+        compose [showString t . showString " -> " | t <- ts] . showString tr+    tyapp tc t = tc ++ " (" ++ t ++ ")"+    tyarg+      | n == 0 = "Elem a"+      | otherwise = "Node a"+    appendTreeClause t1 t2 rhs =+        showString "appendTree" . shows n .+            showChar ' ' . showString t1 . showArgList (args n) .+            showChar ' ' . showString t2 .+            showString " =\n    " . rhs . showChar '\n'+    addDigitsClause n1 n2 =+        showString "addDigits" . shows n .+            showString " m1 (" . showDigit vs1 . showChar ')' .+            showArgList vsm .+            showString " (" . showDigit vs2 . showString ") m2" .+            showString " =\n    " .+            showString "appendTree" . shows (length ns) .+            showString " m1" .+            compose [showString " (" .  showNode node . showChar ')' |+                node <- ns] .+            showString " m2" . showChar '\n'+      where+        vs = args (n1+n+n2)+        vs1 = take n1 vs+        vsm = take n (drop n1 vs)+        vs2 = drop (n1+n) vs+        ns = nodes vs++data Node a = Node2 a a | Node3 a a a++nodes :: [a] -> [Node a]+nodes [a, b] = [Node2 a b]+nodes [a, b, c] = [Node3 a b c]+nodes [a, b, c, d] = [Node2 a b, Node2 c d]+nodes (a:b:c:xs) = Node3 a b c : nodes xs++showNode (Node2 a b) =+    showString "node2 " . showChar a . showChar ' ' . showChar b+showNode (Node3 a b c) =+    showString "node3 " . showChar a . showChar ' ' . showChar b .+        showChar ' ' . showChar c++showDigit vs =+    showString (["One", "Two", "Three", "Four"]!!(length vs-1)) .+    showArgList vs++showArgList :: [Char] -> ShowS+showArgList vs = compose [showChar ' ' . showChar c | c <- vs]++args :: Int -> [Char]+args n = take n ['a'..]++showCons xs sf =+    compose [showChar x . showString " `consTree` " | x <- xs] . sf+showSnoc sf xs =+    sf . compose [showString " `snocTree` " . showChar x | x <- xs]++compose :: [a -> a] -> a -> a+compose = flip (foldr id)

@@ -6,11 +6,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE StandaloneDeriving #-}-#  if __GLASGOW_HASKELL__ >= 802 {-# LANGUAGE Safe #-}-#  else-{-# LANGUAGE Trustworthy #-}-#  endif #endif  #include "containers.h"@@ -147,14 +143,10 @@                                         -- in any cycle.                 | CyclicSCC  [vertex]   -- ^ A maximal set of mutually                                         -- reachable vertices.-#if __GLASGOW_HASKELL__ >= 802   deriving ( Eq   -- ^ @since 0.5.9            , Show -- ^ @since 0.5.9            , Read -- ^ @since 0.5.9            )-#else-  deriving (Eq, Show, Read)-#endif  #ifdef __GLASGOW_HASKELL__ -- | @since 0.5.9@@ -493,10 +485,10 @@ -- This function deviates from King and Launchbury's implementation by -- bundling together the functions generate, prune, and chop for efficiency -- reasons.-dfs :: Graph -> [Vertex] -> Forest Vertex+dfs :: Graph -> [Vertex] -> [Tree Vertex] dfs g vs0 = run (bounds g) $ go vs0   where-    go :: [Vertex] -> SetM s (Forest Vertex)+    go :: [Vertex] -> SetM s [Tree Vertex]     go [] = pure []     go (v:vs) = do       visited <- contains v@@ -743,7 +735,7 @@     dnum = preArr (bounds g) forest      -- Wraps up the component of every child of the root-    bicomps :: Tree Vertex -> Forest [Vertex]+    bicomps :: Tree Vertex -> [Tree [Vertex]]     bicomps (Node v tws) =       [Node (v : curw []) (donew []) | (_, curw, donew) <- map collect tws] 

@@ -311,7 +311,7 @@ import qualified Data.Foldable as Foldable import Data.Maybe (fromMaybe) import Utils.Containers.Internal.Prelude hiding-  (lookup, map, filter, foldr, foldl, null)+  (lookup, map, filter, foldr, foldl, foldl', null) import Prelude ()  import Data.IntSet.Internal (Key)@@ -830,6 +830,8 @@ -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")] -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWith f k x t@@ -845,6 +847,8 @@ -- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")] -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWithKey f !k x t@(Bin p m l r)@@ -870,6 +874,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a) insertLookupWithKey f !k x t@(Bin p m l r)@@ -1085,6 +1091,8 @@ -- | \(O(n+m)\). The union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWith f m1 m2@@ -1094,6 +1102,8 @@ -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWithKey f m1 m2@@ -2540,12 +2550,14 @@ -- -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab" -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a mapKeysWith c f   = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) [] --- | \(O(n \min(n,W))\).+-- | \(O(n)\). -- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ -- is strictly monotonic. -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.@@ -3063,7 +3075,7 @@ assocs :: IntMap a -> [(Key,a)] assocs = toAscList --- | \(O(n \min(n,W))\). The set of all keys of the map.+-- | \(O(n)\). The set of all keys of the map. -- -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5] -- > keysSet empty == Data.IntSet.empty@@ -3195,10 +3207,41 @@   where     ins t (k,x)  = insert k x t --- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "ab"), (5, "cba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromListWith f xs@@ -3209,6 +3252,8 @@ -- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs@@ -3231,6 +3276,8 @@ -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y)@@ -3242,6 +3289,8 @@ -- -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "5:b|a")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWithKey f = fromMonoListWithKey Nondistinct f@@ -3263,6 +3312,8 @@ -- The precise conditions under which this function works are subtle: -- For any branch mask, keys with the same prefix w.r.t. the branch -- mask must occur consecutively in the list.+--+-- Also see the performance note on 'fromListWith'.  fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromMonoListWithKey distinct f = go

@@ -172,8 +172,8 @@     , foldMapWithKey      -- ** Strict folds-    , foldr'-    , foldl'+    , IM.foldr'+    , IM.foldl'     , foldrWithKey'     , foldlWithKey' 

@@ -260,7 +260,7 @@     ) where  import Utils.Containers.Internal.Prelude hiding-  (lookup,map,filter,foldr,foldl,null)+  (lookup,map,filter,foldr,foldl,foldl',null) import Prelude ()  import Data.Bits@@ -425,6 +425,8 @@ -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")] -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWith f k x t@@ -443,6 +445,8 @@ -- -- If the key exists in the map, this function is lazy in @value@ but strict -- in the result of @f@.+--+-- Also see the performance note on 'fromListWith'.  insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a insertWithKey f !k x t =@@ -470,6 +474,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a) insertLookupWithKey f0 !k0 x0 t0 = toPair $ go f0 k0 x0 t0@@ -660,6 +666,8 @@ -- | \(O(n+m)\). The union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWith f m1 m2@@ -669,6 +677,8 @@ -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a unionWithKey f m1 m2@@ -986,6 +996,8 @@ -- -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab" -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []@@ -1095,10 +1107,41 @@   where     ins t (k,x)  = insert k x t --- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromListWith f xs@@ -1109,6 +1152,8 @@ -- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs@@ -1131,6 +1176,8 @@ -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y)@@ -1141,6 +1188,8 @@ -- /The precondition (input list is ascending) is not checked./ -- -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromAscListWithKey f = fromMonoListWithKey Nondistinct f@@ -1162,6 +1211,8 @@ -- The precise conditions under which this function works are subtle: -- For any branch mask, keys with the same prefix w.r.t. the branch -- mask must occur consecutively in the list.+--+-- Also see the performance note on 'fromListWith'.  fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromMonoListWithKey distinct f = go

@@ -76,6 +76,7 @@             , empty             , singleton             , fromList+            , fromRange             , fromAscList             , fromDistinctAscList @@ -128,8 +129,8 @@             , IS.foldr             , IS.foldl             -- ** Strict folds-            , foldr'-            , foldl'+            , IS.foldr'+            , IS.foldl'             -- ** Legacy folds             , fold 

@@ -123,6 +123,7 @@     -- * Construction     , empty     , singleton+    , fromRange     , insert     , delete     , alterF@@ -204,7 +205,7 @@ #endif import Data.Semigroup (stimesIdempotentMonoid) import Utils.Containers.Internal.Prelude hiding-  (filter, foldr, foldl, null, map)+  (filter, foldr, foldl, foldl', null, map) import Prelude ()  import Utils.Containers.Internal.BitUtil@@ -1214,6 +1215,60 @@   = Foldable.foldl' ins empty xs   where     ins t x  = insert x t++-- | \(O(n / W)\). Create a set from a range of integers.+--+-- > fromRange (low, high) == fromList [low..high]+--+-- @since 0.7+fromRange :: (Key, Key) -> IntSet+fromRange (lx,rx)+  | lx > rx  = empty+  | lp == rp = Tip lp (bitmapOf rx `shiftLL` 1 - bitmapOf lx)+  | otherwise =+      let m = branchMask lx rx+          p = mask lx m+      in if m < 0  -- handle negative numbers+         then Bin 0 m (goR 0) (goL 0)+         else Bin p m (goL (p .|. m)) (goR (p .|. m))+  where+    lp = prefixOf lx+    rp = prefixOf rx+    -- goL p0 = fromList [lx .. p0-1]+    -- Expected: p0 is lx where one 0-bit is flipped to 1 and all bits lower than that are 0.+    --           p0 can be 0 (pretend that bit WORD_SIZE is flipped to 1).+    goL :: Prefix -> IntSet+    goL !p0 = go (Tip lp (- bitmapOf lx)) (lp + lbm prefixBitMask)+      where+        go !l p | p == p0 = l+        go l p =+          let m = lbm p+              p' = p `xor` m+              l' = Bin p' m l (goFull p (shr1 m))+          in go l' (p + m)+    -- goR p0 = fromList [p0 .. rx]+    -- Expected: p0 is a prefix of rx+    goR :: Prefix -> IntSet+    goR !p0 = go (Tip rp (bitmapOf rx `shiftLL` 1 - 1)) rp+      where+        go !r p | p == p0 = r+        go r p =+          let m = lbm p+              p' = p `xor` m+              r' = Bin p' m (goFull p' (shr1 m)) r+          in go r' p'+    -- goFull p m = fromList [p .. p+2*m-1]+    -- Expected: popCount m == 1, p == mask p m+    goFull :: Prefix -> Mask -> IntSet+    goFull p m+      | m < suffixBitMask = Tip p (complement 0)+      | otherwise         = Bin p m (goFull p (shr1 m)) (goFull (p .|. m) (shr1 m))+    lbm :: Prefix -> Prefix+    lbm p = intFromNat (lowestBitMask (natFromInt p))+    {-# INLINE lbm #-}+    shr1 :: Mask -> Mask+    shr1 m = intFromNat (natFromInt m `shiftRL` 1)+    {-# INLINE shr1 #-}  -- | \(O(n)\). Build a set from an ascending list of elements. -- /The precondition (input list is ascending) is not checked./

@@ -355,8 +355,15 @@     , link     , link2     , glue+    , fromDistinctAscList_linkTop+    , fromDistinctAscList_linkAll+    , fromDistinctDescList_linkTop+    , fromDistinctDescList_linkAll     , MaybeS(..)     , Identity(..)+    , FromDistinctMonoState(..)+    , Stack(..)+    , foldl'Stack      -- Used by Map.Merge.Lazy     , mapWhenMissing@@ -380,11 +387,9 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR) import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0) import Data.Bifoldable-#endif import Utils.Containers.Internal.Prelude hiding-  (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)+  (lookup, map, filter, foldr, foldl, foldl', null, splitAt, take, drop) import Prelude ()  import qualified Data.Set.Internal as Set@@ -848,6 +853,8 @@ -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")] -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith = go@@ -874,6 +881,8 @@ -- the map, the key is left alone, not replaced. The combining -- function is flipped--it is applied to the old value and then the -- new value.+--+-- Also see the performance note on 'fromListWith'.  insertWithR :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithR = go@@ -902,6 +911,8 @@ -- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")] -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  -- See Note: Type of local 'go' function insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a@@ -924,6 +935,9 @@ -- the map, the key is left alone, not replaced. The combining -- function is flipped--it is applied to the old value and then the -- new value.+--+-- Also see the performance note on 'fromListWith'.+ insertWithKeyR :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a insertWithKeyR = go   where@@ -955,6 +969,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  -- See Note: Type of local 'go' function insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a@@ -1806,7 +1822,7 @@ {-# INLINABLE unionsWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when duplicate keys are encountered, -- i.e. (@'union' == 'unionWith' 'const'@).@@ -1830,9 +1846,11 @@ {--------------------------------------------------------------------   Union with a combining function --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a -- QuickCheck says pointer equality never happens here.@@ -1850,11 +1868,13 @@ {-# INLINABLE unionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- Union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey _f t1 Tip = t1@@ -1881,7 +1901,7 @@ -- relies on doing it the way we do, and it's not clear whether that -- bound holds the other way. --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Difference of two maps.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Difference of two maps. -- Return elements of the first map not existing in the second map. -- -- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"@@ -1900,7 +1920,7 @@ {-# INLINABLE difference #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Remove all keys in a 'Set' from a 'Map'.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Remove all keys in a 'Set' from a 'Map'. -- -- @ -- m \`withoutKeys\` s = 'filterWithKey' (\\k _ -> k ``Set.notMember`` s) m@@ -1959,7 +1979,7 @@ {--------------------------------------------------------------------   Intersection --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection of two maps.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection of two maps. -- Return data in the first map for the keys existing in both maps. -- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). --@@ -1981,7 +2001,7 @@ {-# INLINABLE intersection #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Restrict a 'Map' to only those keys+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Restrict a 'Map' to only those keys -- found in a 'Set'. -- -- @@@ -2006,7 +2026,7 @@ {-# INLINABLE restrictKeys #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -2026,7 +2046,7 @@ {-# INLINABLE intersectionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -2048,7 +2068,7 @@ {--------------------------------------------------------------------   Disjoint --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Check whether the key sets of two+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Check whether the key sets of two -- maps are disjoint (i.e., their 'intersection' is empty). -- -- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())])   == True@@ -2747,7 +2767,7 @@ {--------------------------------------------------------------------   Submap --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). -- isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool@@ -2756,7 +2776,7 @@ {-# INLINABLE isSubmapOf #-} #endif -{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+{- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\).  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if  all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when  applied to their respective values. For example, the following@@ -2805,7 +2825,7 @@ {-# INLINABLE submap' #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Is this a proper submap? (ie. a submap but not equal). -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@). isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool isProperSubmapOf m1 m2@@ -2814,7 +2834,7 @@ {-# INLINABLE isProperSubmapOf #-} #endif -{- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Is this a proper submap? (ie. a submap but not equal).+{- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Is this a proper submap? (ie. a submap but not equal).  The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when  @keys m1@ and @keys m2@ are not equal,  all keys in @m1@ are in @m2@, and when @f@ returns 'True' when@@ -3165,6 +3185,8 @@ -- -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab" -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []@@ -3410,8 +3432,7 @@ -- If the list contains more than one value for the same key, the last value -- for the key is retained. ----- If the keys of the list are ordered, linear-time implementation is used,--- with the performance equal to 'fromDistinctAscList'.+-- If the keys of the list are ordered, a linear-time implementation is used. -- -- > fromList [] == empty -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]@@ -3460,8 +3481,39 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith f xs@@ -3475,6 +3527,8 @@ -- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs@@ -3627,6 +3681,8 @@ -- > valid (fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False --+-- Also see the performance note on 'fromListWith'.+-- -- @since 0.5.8  fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a@@ -3644,6 +3700,8 @@ -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")] -- > valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) == True -- > valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromAscListWithKey f xs@@ -3672,6 +3730,9 @@ -- > fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "5:b5:ba")] -- > valid (fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.+ fromDescListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromDescListWithKey f xs   = fromDistinctDescList (combineEq f xs)@@ -3701,23 +3762,27 @@  -- For some reason, when 'singleton' is used in fromDistinctAscList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctAscList :: [(k,a)] -> Map k a-fromDistinctAscList [] = Tip-fromDistinctAscList ((kx0, x0) : xs0) = go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctAscList = fromDistinctAscList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s l ((kx, x) : xs) = case create s xs of-                                (r :*: ys) -> let !t' = link kx x l r-                                              in go (s `shiftL` 1) t' ys+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, x) = fromDistinctAscList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 l stk) (kx, x) = State0 (Push kx x l stk)+{-# INLINE fromDistinctAscList #-}  -- INLINE for fusion -    create !_ [] = (Tip :*: [])-    create s xs@(x' : xs')-      | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                        (r :*: zs) -> (link ky y l r :*: zs)+fromDistinctAscList_linkTop :: Map k a -> Stack k a -> FromDistinctMonoState k a+fromDistinctAscList_linkTop r@(Bin rsz _ _ _ _) (Push kx x l@(Bin lsz _ _ _ _) stk)+  | rsz == lsz = fromDistinctAscList_linkTop (bin kx x l r) stk+fromDistinctAscList_linkTop l stk = State1 l stk+{-# INLINABLE fromDistinctAscList_linkTop #-} +fromDistinctAscList_linkAll :: FromDistinctMonoState k a -> Map k a+fromDistinctAscList_linkAll (State0 stk)    = foldl'Stack (\r kx x l -> link kx x l r) Tip stk+fromDistinctAscList_linkAll (State1 r0 stk) = foldl'Stack (\r kx x l -> link kx x l r) r0 stk+{-# INLINABLE fromDistinctAscList_linkAll #-}+ -- | \(O(n)\). Build a map from a descending list of distinct elements in linear time. -- /The precondition is not checked./ --@@ -3729,23 +3794,40 @@  -- For some reason, when 'singleton' is used in fromDistinctDescList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctDescList :: [(k,a)] -> Map k a-fromDistinctDescList [] = Tip-fromDistinctDescList ((kx0, x0) : xs0) = go (1 :: Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctDescList = fromDistinctDescList_linkAll . Foldable.foldl' next (State0 Nada)   where-     go !_ t [] = t-     go s r ((kx, x) : xs) = case create s xs of-                               (l :*: ys) -> let !t' = link kx x l r-                                             in go (s `shiftL` 1) t' ys+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, x) = fromDistinctDescList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 r stk) (kx, x) = State0 (Push kx x r stk)+{-# INLINE fromDistinctDescList #-}  -- INLINE for fusion -     create !_ [] = (Tip :*: [])-     create s xs@(x' : xs')-       | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip :*: xs')-       | otherwise = case create (s `shiftR` 1) xs of-                       res@(_ :*: []) -> res-                       (r :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                         (l :*: zs) -> (link ky y l r :*: zs)+fromDistinctDescList_linkTop :: Map k a -> Stack k a -> FromDistinctMonoState k a+fromDistinctDescList_linkTop l@(Bin lsz _ _ _ _) (Push kx x r@(Bin rsz _ _ _ _) stk)+  | lsz == rsz = fromDistinctDescList_linkTop (bin kx x l r) stk+fromDistinctDescList_linkTop r stk = State1 r stk+{-# INLINABLE fromDistinctDescList_linkTop #-} +fromDistinctDescList_linkAll :: FromDistinctMonoState k a -> Map k a+fromDistinctDescList_linkAll (State0 stk)    = foldl'Stack (\l kx x r -> link kx x l r) Tip stk+fromDistinctDescList_linkAll (State1 l0 stk) = foldl'Stack (\l kx x r -> link kx x l r) l0 stk+{-# INLINABLE fromDistinctDescList_linkAll #-}++data FromDistinctMonoState k a+  = State0 !(Stack k a)+  | State1 !(Map k a) !(Stack k a)++data Stack k a = Push !k a !(Map k a) !(Stack k a) | Nada++foldl'Stack :: (b -> k -> a -> Map k a -> b) -> b -> Stack k a -> b+foldl'Stack f = go+  where+    go !z Nada = z+    go z (Push kx x t stk) = go (f z kx x t) stk+{-# INLINE foldl'Stack #-}+ {- -- Functions very similar to these were used to implement -- hedge union, intersection, and difference algorithms that we no@@ -4256,7 +4338,6 @@   product = foldl' (*) 1   {-# INLINABLE product #-} -#if MIN_VERSION_base(4,10,0) -- | @since 0.6.3.1 instance Bifoldable Map where   bifold = go@@ -4277,7 +4358,6 @@           go (Bin 1 k v _ _) = f k `mappend` g v           go (Bin _ k v l r) = go l `mappend` (f k `mappend` (g v `mappend` go r))   {-# INLINE bifoldMap #-}-#endif  instance (NFData k, NFData a) => NFData (Map k a) where     rnf Tip = ()

@@ -308,7 +308,9 @@     , valid     ) where -import Prelude hiding (lookup,map,filter,foldr,foldl,null,take,drop,splitAt)+import Utils.Containers.Internal.Prelude hiding+  (lookup,map,filter,foldr,foldl,foldl',null,take,drop,splitAt)+import Prelude ()  import Data.Map.Internal   ( Map (..)@@ -326,6 +328,12 @@   , filterAMissing   , merge   , mergeA+  , fromDistinctAscList_linkTop+  , fromDistinctAscList_linkAll+  , fromDistinctDescList_linkTop+  , fromDistinctDescList_linkAll+  , FromDistinctMonoState (..)+  , Stack (..)   , (!)   , (!?)   , (\\)@@ -538,6 +546,8 @@ -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")] -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a insertWith = go@@ -582,6 +592,8 @@ -- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")] -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"+--+-- Also see the performance note on 'fromListWith'.  -- See Map.Internal.Note: Type of local 'go' function insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a@@ -637,6 +649,8 @@ -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")]) -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])+--+-- Also see the performance note on 'fromListWith'.  -- See Map.Internal.Note: Type of local 'go' function insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a@@ -972,9 +986,11 @@ {--------------------------------------------------------------------   Union with a combining function --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Union with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Union with a combining function. -- -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWith _f t1 Tip = t1@@ -988,11 +1004,13 @@ {-# INLINABLE unionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- Union with a combining function. -- -- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]+--+-- Also see the performance note on 'fromListWith'.  unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey _f t1 Tip = t1@@ -1046,7 +1064,7 @@   Intersection --------------------------------------------------------------------} --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" @@ -1064,7 +1082,7 @@ {-# INLINABLE intersectionWith #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Intersection with a combining function.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Intersection with a combining function. -- -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"@@ -1450,6 +1468,8 @@ -- -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab" -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"+--+-- Also see the performance note on 'fromListWith'.  mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []@@ -1487,8 +1507,7 @@ -- If the list contains more than one value for the same key, the last value -- for the key is retained. ----- If the keys of the list are ordered, linear-time implementation is used,--- with the performance equal to 'fromDistinctAscList'.+-- If the keys of the list are ordered, a linear-time implementation is used. -- -- > fromList [] == empty -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]@@ -1537,8 +1556,39 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"x"), (5,"c")] == fromList [(3, "x"), (5, "cba")] -- > fromListWith (++) [] == empty+--+-- Note the reverse ordering of @"cba"@ in the example.+--+-- The symmetric combining function @f@ is applied in a left-fold over the list, as @f new old@.+--+-- === Performance+--+-- You should ensure that the given @f@ is fast with this order of arguments.+--+-- Symmetric functions may be slow in one order, and fast in another.+-- For the common case of collecting values of matching keys in a list, as above:+--+-- The complexity of @(++) a b@ is \(O(a)\), so it is fast when given a short list as its first argument.+-- Thus:+--+-- > fromListWith       (++)  (replicate 1000000 (3, "x"))   -- O(n),  fast+-- > fromListWith (flip (++)) (replicate 1000000 (3, "x"))   -- O(n²), extremely slow+--+-- because they evaluate as, respectively:+--+-- > fromList [(3, "x" ++ ("x" ++ "xxxxx..xxxxx"))]   -- O(n)+-- > fromList [(3, ("xxxxx..xxxxx" ++ "x") ++ "x")]   -- O(n²)+--+-- Thus, to get good performance with an operation like @(++)@ while also preserving+-- the same order as in the input list, reverse the input:+--+-- > fromListWith (++) (reverse [(5,"a"), (5,"b"), (5,"c")]) == fromList [(5, "abc")]+--+-- and it is always fast to combine singleton-list values @[v]@ with @fromListWith (++)@, as in:+--+-- > fromListWith (++) $ reverse $ map (\(k, v) -> (k, [v])) someListOfTuples  fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith f xs@@ -1552,6 +1602,8 @@ -- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")] -- > fromListWithKey f [] == empty+--+-- Also see the performance note on 'fromListWith'.  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs@@ -1608,6 +1660,8 @@ -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")] -- > valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) == True -- > valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a fromAscListWith f xs@@ -1622,6 +1676,8 @@ -- > fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "ba")] -- > valid (fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a fromDescListWith f xs@@ -1638,6 +1694,8 @@ -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")] -- > valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) == True -- > valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromAscListWithKey f xs@@ -1666,6 +1724,8 @@ -- > fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "5:b5:ba")] -- > valid (fromDescListWithKey f [(5,"a"), (5,"b"), (5,"b"), (3,"b")]) == True -- > valid (fromDescListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) == False+--+-- Also see the performance note on 'fromListWith'.  fromDescListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromDescListWithKey f xs@@ -1695,23 +1755,15 @@  -- For some reason, when 'singleton' is used in fromDistinctAscList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctAscList :: [(k,a)] -> Map k a-fromDistinctAscList [] = Tip-fromDistinctAscList ((kx0, x0) : xs0) = x0 `seq` go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctAscList = fromDistinctAscList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s l ((kx, x) : xs) =-      case create s xs of-        (r :*: ys) -> x `seq` let !t' = link kx x l r-                           in go (s `shiftL` 1) t' ys--    create !_ [] = (Tip :*: [])-    create s xs@(x' : xs')-      | s == 1 = case x' of (kx, x) -> x `seq` (Bin 1 kx x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                        (r :*: zs) -> y `seq` (link ky y l r :*: zs)+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, !x) = fromDistinctAscList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 l stk) (kx, x) = State0 (Push kx x l stk)+{-# INLINE fromDistinctAscList #-}  -- INLINE for fusion  -- | \(O(n)\). Build a map from a descending list of distinct elements in linear time. -- /The precondition is not checked./@@ -1722,20 +1774,12 @@  -- For some reason, when 'singleton' is used in fromDistinctDescList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] in Data.Set.Internal. fromDistinctDescList :: [(k,a)] -> Map k a-fromDistinctDescList [] = Tip-fromDistinctDescList ((kx0, x0) : xs0) = x0 `seq` go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0+fromDistinctDescList = fromDistinctDescList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s r ((kx, x) : xs) =-      case create s xs of-        (l :*: ys) -> x `seq` let !t' = link kx x l r-                              in go (s `shiftL` 1) t' ys--    create !_ [] = (Tip :*: [])-    create s xs@(x' : xs')-      | s == 1 = case x' of (kx, x) -> x `seq` (Bin 1 kx x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (r :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of-                        (l :*: zs) -> y `seq` (link ky y l r :*: zs)+    next :: FromDistinctMonoState k a -> (k,a) -> FromDistinctMonoState k a+    next (State0 stk) (!kx, !x) = fromDistinctDescList_linkTop (Bin 1 kx x Tip Tip) stk+    next (State1 r stk) (kx, x) = State0 (Push kx x r stk)+{-# INLINE fromDistinctDescList #-}  -- INLINE for fusion

@@ -199,8 +199,8 @@ #if MIN_VERSION_base(4,11,0)     (<>), #endif-    (<$>), foldMap, Monoid,-    null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,+    (<$>), Monoid,+    null, length, lookup, take, drop, splitAt,     scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,     unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all) import Prelude ()@@ -212,7 +212,7 @@ import Data.Monoid (Monoid(..)) import Data.Functor (Functor(..)) import Utils.Containers.Internal.State (State(..), execState)-import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)+import Data.Foldable (foldr', toList) import qualified Data.Foldable as F  import qualified Data.Semigroup as Semigroup@@ -275,10 +275,8 @@ infixr 5 :<| infixl 5 :|> -#if __GLASGOW_HASKELL__ >= 801 {-# COMPLETE (:<|), Empty #-} {-# COMPLETE (:|>), Empty #-}-#endif  -- | A bidirectional pattern synonym matching an empty sequence. --@@ -529,9 +527,7 @@     pure = singleton     xs *> ys = cycleNTimes (length xs) ys     (<*>) = apSeq-#if MIN_VERSION_base(4,10,0)     liftA2 = liftA2Seq-#endif     xs <* ys = beforeSeq xs ys  apSeq :: Seq (a -> b) -> Seq a -> Seq b@@ -1711,7 +1707,8 @@   | otherwise   = error "replicateA takes a nonnegative integer argument" {-# SPECIALIZE replicateA :: Int -> State a b -> State a (Seq b) #-} --- | 'replicateM' is a sequence counterpart of 'Control.Monad.replicateM'.+-- | 'replicateM' is the @Seq@ counterpart of+-- @Control.Monad.'Control.Monad.replicateM'@. -- -- > replicateM n x = sequence (replicate n x) --@@ -1888,7 +1885,8 @@ (><)            :: Seq a -> Seq a -> Seq a Seq xs >< Seq ys = Seq (appendTree0 xs ys) --- The appendTree/addDigits gunk below is machine generated+-- The appendTree/addDigits gunk below was originally machine generated via mkappend.hs,+-- but has since been manually edited to include strictness annotations.  appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) appendTree0 EmptyT xs =@@ -4659,6 +4657,8 @@ -- | @ 'mzipWith' = 'zipWith' @ -- -- @ 'munzip' = 'unzip' @+--+-- @since 0.5.10.1 instance MonadZip Seq where   mzipWith = zipWith   munzip = unzip

@@ -141,8 +141,8 @@             , S.foldr             , S.foldl             -- ** Strict folds-            , foldr'-            , foldl'+            , S.foldr'+            , S.foldl'             -- ** Legacy folds             , fold 

@@ -233,7 +233,7 @@             ) where  import Utils.Containers.Internal.Prelude hiding-  (filter,foldl,foldr,null,map,take,drop,splitAt)+  (filter,foldl,foldl',foldr,null,map,take,drop,splitAt) import Prelude () import Control.Applicative (Const(..)) import qualified Data.List as List@@ -269,7 +269,7 @@ --------------------------------------------------------------------} infixl 9 \\ -- --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). See 'difference'.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). See 'difference'. (\\) :: Ord a => Set a -> Set a -> Set a m1 \\ m2 = difference m1 m2 #if __GLASGOW_HASKELL__@@ -654,7 +654,7 @@ {--------------------------------------------------------------------   Subset --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- @(s1 \`isProperSubsetOf\` s2)@ indicates whether @s1@ is a -- proper subset of @s2@. --@@ -669,7 +669,7 @@ #endif  --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\).+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). -- @(s1 \`isSubsetOf\` s2)@ indicates whether @s1@ is a subset of @s2@. -- -- @@@ -724,7 +724,7 @@ {--------------------------------------------------------------------   Disjoint --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Check whether two sets are disjoint+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Check whether two sets are disjoint -- (i.e., their intersection is empty). -- -- > disjoint (fromList [2,4,6])   (fromList [1,3])     == True@@ -815,7 +815,7 @@ {-# INLINABLE unions #-} #endif --- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). The union of two sets, preferring the first set when+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). The union of two sets, preferring the first set when -- equal elements are encountered. union :: Ord a => Set a -> Set a -> Set a union t1 Tip  = t1@@ -835,7 +835,7 @@ {--------------------------------------------------------------------   Difference --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Difference of two sets.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Difference of two sets. -- -- Return elements of the first set not existing in the second set. --@@ -856,7 +856,7 @@ {--------------------------------------------------------------------   Intersection --------------------------------------------------------------------}--- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). The intersection of two sets.+-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). The intersection of two sets. -- Elements of the result come from the first set, so for example -- -- > import qualified Data.Set as S@@ -1085,8 +1085,7 @@  -- | \(O(n \log n)\). Create a set from a list of elements. ----- If the elements are ordered, a linear-time implementation is used,--- with the performance equal to 'fromDistinctAscList'.+-- If the elements are ordered, a linear-time implementation is used.  -- For some reason, when 'singleton' is used in fromList or in -- create, it is not inlined, so we inline it manually.@@ -1172,47 +1171,68 @@  -- For some reason, when 'singleton' is used in fromDistinctAscList or in -- create, it is not inlined, so we inline it manually.++-- See Note [fromDistinctAscList implementation] fromDistinctAscList :: [a] -> Set a-fromDistinctAscList [] = Tip-fromDistinctAscList (x0 : xs0) = go (1::Int) (Bin 1 x0 Tip Tip) xs0+fromDistinctAscList = fromDistinctAscList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s l (x : xs) = case create s xs of-                        (r :*: ys) -> let !t' = link x l r-                                      in go (s `shiftL` 1) t' ys+    next :: FromDistinctMonoState a -> a -> FromDistinctMonoState a+    next (State0 stk) !x = fromDistinctAscList_linkTop (Bin 1 x Tip Tip) stk+    next (State1 l stk) x = State0 (Push x l stk)+{-# INLINE fromDistinctAscList #-}  -- INLINE for fusion -    create !_ [] = (Tip :*: [])-    create s xs@(x : xs')-      | s == 1 = (Bin 1 x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (l :*: (y:ys)) -> case create (s `shiftR` 1) ys of-                        (r :*: zs) -> (link y l r :*: zs)+fromDistinctAscList_linkTop :: Set a -> Stack a -> FromDistinctMonoState a+fromDistinctAscList_linkTop r@(Bin rsz _ _ _) (Push x l@(Bin lsz _ _ _) stk)+  | rsz == lsz = fromDistinctAscList_linkTop (bin x l r) stk+fromDistinctAscList_linkTop l stk = State1 l stk+{-# INLINABLE fromDistinctAscList_linkTop #-} +fromDistinctAscList_linkAll :: FromDistinctMonoState a -> Set a+fromDistinctAscList_linkAll (State0 stk)    = foldl'Stack (\r x l -> link x l r) Tip stk+fromDistinctAscList_linkAll (State1 r0 stk) = foldl'Stack (\r x l -> link x l r) r0 stk+{-# INLINABLE fromDistinctAscList_linkAll #-}+ -- | \(O(n)\). Build a set from a descending list of distinct elements in linear time. -- /The precondition (input list is strictly descending) is not checked./+--+-- @since 0.5.8  -- For some reason, when 'singleton' is used in fromDistinctDescList or in -- create, it is not inlined, so we inline it manually.------ @since 0.5.8++-- See Note [fromDistinctAscList implementation] fromDistinctDescList :: [a] -> Set a-fromDistinctDescList [] = Tip-fromDistinctDescList (x0 : xs0) = go (1::Int) (Bin 1 x0 Tip Tip) xs0+fromDistinctDescList = fromDistinctDescList_linkAll . Foldable.foldl' next (State0 Nada)   where-    go !_ t [] = t-    go s r (x : xs) = case create s xs of-                        (l :*: ys) -> let !t' = link x l r-                                      in go (s `shiftL` 1) t' ys+    next :: FromDistinctMonoState a -> a -> FromDistinctMonoState a+    next (State0 stk) !x = fromDistinctDescList_linkTop (Bin 1 x Tip Tip) stk+    next (State1 r stk) x = State0 (Push x r stk)+{-# INLINE fromDistinctDescList #-}  -- INLINE for fusion -    create !_ [] = (Tip :*: [])-    create s xs@(x : xs')-      | s == 1 = (Bin 1 x Tip Tip :*: xs')-      | otherwise = case create (s `shiftR` 1) xs of-                      res@(_ :*: []) -> res-                      (r :*: (y:ys)) -> case create (s `shiftR` 1) ys of-                        (l :*: zs) -> (link y l r :*: zs)+fromDistinctDescList_linkTop :: Set a -> Stack a -> FromDistinctMonoState a+fromDistinctDescList_linkTop l@(Bin lsz _ _ _) (Push x r@(Bin rsz _ _ _) stk)+  | lsz == rsz = fromDistinctDescList_linkTop (bin x l r) stk+fromDistinctDescList_linkTop r stk = State1 r stk+{-# INLINABLE fromDistinctDescList_linkTop #-} +fromDistinctDescList_linkAll :: FromDistinctMonoState a -> Set a+fromDistinctDescList_linkAll (State0 stk)    = foldl'Stack (\l x r -> link x l r) Tip stk+fromDistinctDescList_linkAll (State1 l0 stk) = foldl'Stack (\l x r -> link x l r) l0 stk+{-# INLINABLE fromDistinctDescList_linkAll #-}++data FromDistinctMonoState a+  = State0 !(Stack a)+  | State1 !(Set a) !(Stack a)++data Stack a = Push !a !(Set a) !(Stack a) | Nada++foldl'Stack :: (b -> a -> Set a -> b) -> b -> Stack a -> b+foldl'Stack f = go+  where+    go !z Nada = z+    go z (Push x t stk) = go (f z x t) stk+{-# INLINE foldl'Stack #-}+ {--------------------------------------------------------------------   Eq converts the set to a list. In a lazy setting, this   actually seems one of the faster methods to compare two trees@@ -2054,3 +2074,51 @@           Bin sz _ l r -> case (realsize l,realsize r) of                             (Just n,Just m)  | n+m+1 == sz  -> Just sz                             _                -> Nothing++--------------------------------------------------------------------++-- Note [fromDistinctAscList implementation]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- fromDistinctAscList is implemented by building up perfectly balanced trees+-- while we consume elements from the list one by one. A stack of+-- (root, perfectly balanced left branch) pairs is maintained, in increasing+-- order of size from top to bottom.+--+-- When we get an element from the list, we attempt to link it as the right+-- branch with the top (root, perfect left branch) of the stack to create a new+-- perfect tree. We can only do this if the left branch has size 1. If we link+-- it, we get a perfect tree of size 3. We repeat this process, merging with the+-- top of the stack as long as the sizes match. When we can't link any more, the+-- perfect tree we built so far is a potential left branch. The next element+-- we find becomes the root, and we push this new (root, left branch) on the+-- stack.+--+-- When we are out of elements, we link the (root, left branch)s in the stack+-- top to bottom to get the final tree.+--+-- How long does this take? We do O(1) work per element excluding the links.+-- Over n elements, we build trees with at most n nodes total, and each link is+-- done in O(1) using `bin`. The final linking of the stack is done in O(log n)+-- using `link`  (proof below). The total time is thus O(n).+--+-- Additionally, the implemention is written using foldl' over the input list,+-- which makes it participate as a good consumer in list fusion.+--+-- fromDistinctDescList is implemented similarly, adapted for left and right+-- sides being swapped.+--+-- ~~~+--+-- A `link` operation links trees L and R with a root in+-- O(|log(size(L)) - log(size(R))|). Let's say there are m (root, tree) in the+-- stack, the size of the ith tree being 2^{k_i} - 1. We also know that+-- k_i > k_j for i > j, and n = \sum_{i=1}^m 2^{k_i}. With this information, we+-- can calculate the total time to link everything on the stack:+--+--   O(\sum_{i=2}^m |log(2^{k_i} - 1) - log(\sum_{j=1}^{i-1} 2^{k_j})|)+-- = O(\sum_{i=2}^m log(2^{k_i} - 1) - log(\sum_{j=1}^{i-1} 2^{k_j}))+-- = O(\sum_{i=2}^m log(2^{k_i} - 1) - log(2^{k_{i-1}}))+-- = O(\sum_{i=2}^m k_i - k_{i-1})+-- = O(k_m - k_1)+-- = O(log n)

@@ -55,7 +55,7 @@  import Utils.Containers.Internal.Prelude as Prelude import Prelude ()-import Data.Foldable (fold, foldl', toList)+import Data.Foldable (fold, toList) import Data.Traversable (foldMapDefault) import Control.Monad (liftM) import Control.Monad.Fix (MonadFix (..), fix)@@ -162,10 +162,8 @@     pure x = Node x []     Node f tfs <*> tx@(Node x txs) =         Node (f x) (map (f <$>) txs ++ map (<*> tx) tfs)-#if MIN_VERSION_base(4,10,0)     liftA2 f (Node x txs) ty@(Node y tys) =         Node (f x y) (map (f x <$>) tys ++ map (\tx -> liftA2 f tx ty) txs)-#endif     Node x txs <* ty@(Node _ tys) =         Node x (map (x <$) tys ++ map (<* ty) txs)     Node _ txs *> ty@(Node y tys) =@@ -302,6 +300,7 @@ instance NFData a => NFData (Tree a) where     rnf (Node x ts) = rnf x `seq` rnf ts +-- | @since 0.5.10.1 instance MonadZip Tree where   mzipWith f (Node a as) (Node b bs)     = Node (f a b) (mzipWith (mzipWith f) as bs)@@ -489,8 +488,9 @@ -- -- See 'unfoldTree' for more info. ----- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons--- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/.+-- Implemented using an algorithm adapted from+-- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,+-- by Chris Okasaki, /ICFP'00/. unfoldTreeM_BF :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a) unfoldTreeM_BF f b = liftM getElement $ unfoldForestQ f (singleton b)   where@@ -502,8 +502,9 @@ -- -- See 'unfoldForest' for more info. ----- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons--- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/.+-- Implemented using an algorithm adapted from+-- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,+-- by Chris Okasaki, /ICFP'00/. unfoldForestM_BF :: Monad m => (b -> m (a, [b])) -> [b] -> m ([Tree a]) unfoldForestM_BF f = liftM toList . unfoldForestQ f . fromList @@ -549,9 +550,9 @@ -- -- Implemented: ----- foldrMap1, foldlMap1': Basic functions--- foldMap, foldMap1': Implemented same as the default definition, but--- INLINABLE to allow specialization.+-- foldMap, foldrMap1, foldlMap1': Basic functions+-- foldMap1': Implemented same as the default definition, but INLINABLE to+-- allow specialization. -- toNonEmpty, foldlMap1: Implemented more efficiently than default. -- maximum, minimum: Uses Foldable's implementation. --

@@ -1,18 +1,12 @@-{-# LANGUAGE CPP #-} -- | This hideous module lets us avoid dealing with the fact that--- @liftA2@ wasn't previously exported from the standard prelude.+-- @liftA2@ and @foldl'@ were not previously exported from the standard prelude. module Utils.Containers.Internal.Prelude   ( module Prelude   , Applicative (..)-#if !MIN_VERSION_base(4,10,0)-  , liftA2-#endif+  , Foldable (..)   )   where -import Prelude hiding (Applicative(..))+import Prelude hiding (Applicative(..), Foldable(..)) import Control.Applicative(Applicative(..))--#if !MIN_VERSION_base(4,10,0)-import Control.Applicative(liftA2)-#endif+import Data.Foldable (Foldable(elem, foldMap, foldr, foldl, foldl', foldr1, foldl1, maximum, minimum, product, sum, null, length))

@@ -28,9 +28,7 @@     (<*>) = ap     m *> n = State $ \s -> case runState m s of       (s', _) -> runState n s'-#if MIN_VERSION_base(4,10,0)     liftA2 = liftM2-#endif  execState :: State s a -> s -> a execState m x = snd (runState m x)