containers 0.6.6 → 0.6.7

raw patch · 20 files changed

+783/−229 lines, 20 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +49/−1
• containers.cabal +3/−2
• src/Data/Graph.hs +127/−76
• src/Data/IntMap/Internal.hs +127/−24
• src/Data/IntMap/Lazy.hs +4/−0
• src/Data/IntMap/Strict.hs +4/−0
• src/Data/IntMap/Strict/Internal.hs +13/−4
• src/Data/IntSet.hs +5/−0
• src/Data/IntSet/Internal.hs +177/−37
• src/Data/Map.hs +1/−4
• src/Data/Map/Internal.hs +24/−22
• src/Data/Map/Internal/Debug.hs +3/−3
• src/Data/Map/Internal/DeprecatedShowTree.hs +1/−9
• src/Data/Map/Strict/Internal.hs +4/−4
• src/Data/Sequence.hs +0/−1
• src/Data/Sequence/Internal.hs +13/−7
• src/Data/Set/Internal.hs +53/−25
• src/Data/Tree.hs +154/−9
• src/Utils/Containers/Internal/Prelude.hs +18/−0
• src/Utils/Containers/Internal/State.hs +3/−1

@@ -1,6 +1,54 @@ # Changelog for [`containers` package](http://github.com/haskell/containers) -## FIXME+## 0.6.7++### Additions++* Add `takeWhileAntitone`, `dropWhileAntitone`, and `spanAntitone` for `IntMap`+  and `IntSet`. (Soumik Sarkar)++* Add a `Foldable1` instance for `Data.Tree`.++### Improvements++* Speed up splitting functions for `IntSet` and `IntMap`. (Soumik Sarkar)++* Speed up `Foldable` methods for `Data.Tree`. (Soumik Sarkar)++* Speed up `Data.Graph.dfs` (Soumik Sarkar)++* Inline a few functions in `Data.Graph` to enable list fusion. This+  immediately improves the performance of the `transposeG` and `scc` functions.+  Mark several others `INLINABLE` to allow specialization.  (Soumik Sarkar)++* Optimize `Data.Graph.bcc`, most notably replacing lists by difference lists+  to avoid quadratic complexity. (Soumik Sarkar)++### Documentation++* Improve various documentation and documentation formatting (Joseph C. Sible,+  konsumlamm, Soumik Sarkar, Alberto Fanton)++* Add and correct time complexity documentation. (Soumik Sarkar)++* Update `CONTRIBUTING.md` instructions for building with `stack` and `cabal`,+  and add a note about how to avoid unnecessary recompilations. (Melanie+  Phoenix)++### Miscellaneous/internal++* Remove now-redundant CPP. (Alexandre Esteves)+* Avoid `head` and `tail`. (Bodigrim)+* Fix build paths in `gitignore`. (Alexandre Esteves)+* Add extra implicit dependencies for `DeriveLift`. (Matthew Pickering)+* Work around `Prelude` changes for `liftA2`. (David Feuer)+* Add several property tests and too many benchmarks to count. (Soumik Sarkar)+* Add benchmarks for `Data.Set.powerSet`. (jwaldmann)+* Improve `Data.Set.powerSet` property test. (David Feuer)+* Fix test name. (Marcin Szamotulski)+* Fix error messages in internal `Data.Set` functions. (Erik de Castro Lopo)++## 0.6.6  * Drop support for GHC versions before 8.0.2. 

@@ -1,5 +1,5 @@ name: containers-version: 0.6.6+version: 0.6.7 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -25,7 +25,7 @@     include/containers.h     changelog.md -tested-with: 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==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  source-repository head     type:     git@@ -71,6 +71,7 @@         Utils.Containers.Internal.StrictPair      other-modules:+        Utils.Containers.Internal.Prelude         Utils.Containers.Internal.State         Utils.Containers.Internal.StrictMaybe         Utils.Containers.Internal.PtrEquality

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} #if __GLASGOW_HASKELL__ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-}@@ -92,6 +93,8 @@      ) where +import Utils.Containers.Internal.Prelude+import Prelude () #if USE_ST_MONAD import Control.Monad.ST import Data.Array.ST.Safe (newArray, readArray, writeArray)@@ -107,7 +110,6 @@ import Data.Tree (Tree(Node), Forest)  -- std interfaces-import Control.Applicative import Data.Foldable as F import Control.DeepSeq (NFData(rnf)) import Data.Maybe@@ -127,6 +129,8 @@ import GHC.Generics (Generic, Generic1) import Data.Data (Data) import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #endif  -- Make sure we don't use Integer by mistake.@@ -162,7 +166,7 @@ -- | @since 0.5.9 deriving instance Generic (SCC vertex) --- | @since FIXME+-- | @since 0.6.6 deriving instance Lift vertex => Lift (SCC vertex) #endif @@ -213,8 +217,8 @@ flattenSCC (AcyclicSCC v) = [v] flattenSCC (CyclicSCC vs) = vs --- | The strongly connected components of a directed graph, reverse topologically--- sorted.+-- | \(O((V+E) \log V)\). The strongly connected components of a directed graph,+-- reverse topologically sorted. -- -- ==== __Examples__ --@@ -234,10 +238,11 @@   where     get_node (AcyclicSCC (n, _, _)) = AcyclicSCC n     get_node (CyclicSCC triples)     = CyclicSCC [n | (n,_,_) <- triples]+{-# INLINABLE stronglyConnComp #-} --- | The strongly connected components of a directed graph, reverse topologically--- sorted.  The function is the same as 'stronglyConnComp', except that--- all the information about each node retained.+-- | \(O((V+E) \log V)\). The strongly connected components of a directed graph,+-- reverse topologically sorted.  The function is the same as+-- 'stronglyConnComp', except that all the information about each node retained. -- This interface is used when you expect to apply 'SCC' to -- (some of) the result of 'SCC', so you don't want to lose the -- dependency information.@@ -267,6 +272,7 @@                  where                    dec (Node v ts) vs = vertex_fn v : foldr dec vs ts     mentions_itself v = v `elem` (graph ! v)+{-# INLINABLE stronglyConnCompR #-}  ------------------------------------------------------------------------- --                                                                      -@@ -292,7 +298,7 @@ type UArray i a = Array i a #endif --- | Returns the list of vertices in the graph.+-- | \(O(V)\). Returns the list of vertices in the graph. -- -- ==== __Examples__ --@@ -301,8 +307,10 @@ -- > vertices (buildG (0,2) [(0,1),(1,2)]) == [0,1,2] vertices :: Graph -> [Vertex] vertices  = indices+-- See Note [Inline for fusion]+{-# INLINE vertices #-} --- | Returns the list of edges in the graph.+-- | \(O(V+E)\). Returns the list of edges in the graph. -- -- ==== __Examples__ --@@ -311,8 +319,10 @@ -- > edges (buildG (0,2) [(0,1),(1,2)]) == [(0,1),(1,2)] edges    :: Graph -> [Edge] edges g   = [ (v, w) | v <- vertices g, w <- g!v ]+-- See Note [Inline for fusion]+{-# INLINE edges #-} --- | Build a graph from a list of edges.+-- | \(O(V+E)\). Build a graph from a list of edges. -- -- Warning: This function will cause a runtime exception if a vertex in the edge -- list is not within the given @Bounds@.@@ -323,9 +333,11 @@ -- > buildG (0,2) [(0,1), (1,2)] == array (0,1) [(0,[1]),(1,[2])] -- > buildG (0,2) [(0,1), (0,2), (1,2)] == array (0,2) [(0,[2,1]),(1,[2]),(2,[])] buildG :: Bounds -> [Edge] -> Graph-buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 edges0+buildG = accumArray (flip (:)) []+-- See Note [Inline for fusion]+{-# INLINE buildG #-} --- | The graph obtained by reversing all edges.+-- | \(O(V+E)\). The graph obtained by reversing all edges. -- -- ==== __Examples__ --@@ -335,8 +347,10 @@  reverseE    :: Graph -> [Edge] reverseE g   = [ (w, v) | (v, w) <- edges g ]+-- See Note [Inline for fusion]+{-# INLINE reverseE #-} --- | A table of the count of edges from each node.+-- | \(O(V+E)\). A table of the count of edges from each node. -- -- ==== __Examples__ --@@ -350,7 +364,7 @@ -- out. Note that we *can't* be so lazy with indegree. outdegree  = fmap length --- | A table of the count of edges into each node.+-- | \(O(V+E)\). A table of the count of edges into each node. -- -- ==== __Examples__ --@@ -360,8 +374,8 @@ indegree :: Graph -> Array Vertex Int indegree g = accumArray (+) 0 (bounds g) [(v, 1) | (_, outs) <- assocs g, v <- outs] --- | Identical to 'graphFromEdges', except that the return value--- does not include the function which maps keys to vertices.  This+-- | \(O((V+E) \log V)\). Identical to 'graphFromEdges', except that the return+-- value does not include the function which maps keys to vertices. This -- version of 'graphFromEdges' is for backwards compatibility. graphFromEdges'         :: Ord key@@ -369,9 +383,10 @@         -> (Graph, Vertex -> (node, key, [key])) graphFromEdges' x = (a,b) where     (a,b,_) = graphFromEdges x+{-# INLINABLE graphFromEdges' #-} --- | Build a graph from a list of nodes uniquely identified by keys,--- with a list of keys of nodes this node should have edges to.+-- | \(O((V+E) \log V)\). Build a graph from a list of nodes uniquely identified+-- by keys, with a list of keys of nodes this node should have edges to. -- -- This function takes an adjacency list representing a graph with vertices of -- type @key@ labeled by values of type @node@ and produces a @Graph@-based@@ -383,9 +398,11 @@ -- -- * @graph :: Graph@ is the raw, array based adjacency list for the graph. -- * @nodeFromVertex :: Vertex -> (node, key, [key])@ returns the node---   associated with the given 0-based @Int@ vertex; see /warning/ below.+--   associated with the given 0-based @Int@ vertex; see /warning/ below. This+--   runs in \(O(1)\) time. -- * @vertexFromKey :: key -> Maybe Vertex@ returns the @Int@ vertex for the---   key if it exists in the graph, @Nothing@ otherwise.+--   key if it exists in the graph, @Nothing@ otherwise. This runs in+--   \(O(\log V)\) time. -- -- To safely use this API you must either extract the list of vertices directly -- from the graph or first call @vertexFromKey k@ to check if a vertex@@ -456,6 +473,7 @@                                    GT -> findVertex (mid+1) b                               where                                 mid = a + (b - a) `div` 2+{-# INLINABLE graphFromEdges #-}  ------------------------------------------------------------------------- --                                                                      -@@ -463,35 +481,32 @@ --                                                                      - ------------------------------------------------------------------------- --- | A spanning forest of the graph, obtained from a depth-first search of--- the graph starting from each vertex in an unspecified order.-dff          :: Graph -> Forest Vertex+-- | \(O(V+E)\). A spanning forest of the graph, obtained from a depth-first+-- search of the graph starting from each vertex in an unspecified order.+dff          :: Graph -> [Tree Vertex] dff g         = dfs g (vertices g) --- | A spanning forest of the part of the graph reachable from the listed--- vertices, obtained from a depth-first search of the graph starting at+-- | \(O(V+E)\). A spanning forest of the part of the graph reachable from the+-- listed vertices, obtained from a depth-first search of the graph starting at -- each of the listed vertices in order.-dfs          :: Graph -> [Vertex] -> Forest Vertex-dfs g vs      = prune (bounds g) (map (generate g) vs) -generate     :: Graph -> Vertex -> Tree Vertex-generate g v  = Node v (map (generate g) (g!v))--prune        :: Bounds -> Forest Vertex -> Forest Vertex-prune bnds ts = run bnds (chop ts)--chop         :: Forest Vertex -> SetM s (Forest Vertex)-chop []       = return []-chop (Node v ts : us)-              = do-                visited <- contains v-                if visited then-                  chop us-                 else do-                  include v-                  as <- chop ts-                  bs <- chop us-                  return (Node v as : bs)+-- 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 g vs0 = run (bounds g) $ go vs0+  where+    go :: [Vertex] -> SetM s (Forest Vertex)+    go [] = pure []+    go (v:vs) = do+      visited <- contains v+      if visited+      then go vs+      else do+        include v+        as <- go (g!v)+        bs <- go vs+        pure $ Node v as : bs  -- A monad holding a set of vertices visited so far. #if USE_ST_MONAD@@ -576,10 +591,10 @@ preorder' :: Tree a -> [a] -> [a] preorder' (Node a ts) = (a :) . preorderF' ts -preorderF' :: Forest a -> [a] -> [a]+preorderF' :: [Tree a] -> [a] -> [a] preorderF' ts = foldr (.) id $ map preorder' ts -preorderF :: Forest a -> [a]+preorderF :: [Tree a] -> [a] preorderF ts = preorderF' ts []  tabulate        :: Bounds -> [Vertex] -> UArray Vertex Int@@ -589,7 +604,7 @@ -- away, and these days that only happens when it's the first -- list argument. -preArr          :: Bounds -> Forest Vertex -> UArray Vertex Int+preArr          :: Bounds -> [Tree Vertex] -> UArray Vertex Int preArr bnds      = tabulate bnds . preorderF  ------------------------------------------------------------@@ -599,20 +614,26 @@ postorder :: Tree a -> [a] -> [a] postorder (Node a ts) = postorderF ts . (a :) -postorderF   :: Forest a -> [a] -> [a]+postorderF   :: [Tree a] -> [a] -> [a] postorderF ts = foldr (.) id $ map postorder ts  postOrd :: Graph -> [Vertex] postOrd g = postorderF (dff g) [] --- | A topological sort of the graph.+-- | \(O(V+E)\). A topological sort of the graph. -- The order is partially specified by the condition that a vertex /i/ -- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa.+--+-- Note: A topological sort exists only when there are no cycles in the graph.+-- If the graph has cycles, the output of this function will not be a+-- topological sort. In such a case consider using 'scc'. topSort      :: Graph -> [Vertex] topSort       = reverse . postOrd --- | Reverse ordering of `topSort`.+-- | \(O(V+E)\). Reverse ordering of `topSort`. --+-- See note in 'topSort'.+-- -- @since 0.6.4 reverseTopSort :: Graph -> [Vertex] reverseTopSort = postOrd@@ -621,10 +642,10 @@ -- Algorithm 3: connected components ------------------------------------------------------------ --- | The connected components of a graph.+-- | \(O(V+E)\). The connected components of a graph. -- Two vertices are connected if there is a path between them, traversing -- edges in either direction.-components   :: Graph -> Forest Vertex+components   :: Graph -> [Tree Vertex] components    = dff . undirected  undirected   :: Graph -> Graph@@ -632,7 +653,8 @@  -- Algorithm 4: strongly connected components --- | The strongly connected components of a graph, in reverse topological order.+-- | \(O(V+E)\). The strongly connected components of a graph, in reverse+-- topological order. -- -- ==== __Examples__ --@@ -640,7 +662,7 @@ -- >   == [Node {rootLabel = 0, subForest = [Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []}]}]} -- >      ,Node {rootLabel = 3, subForest = []}] -scc  :: Graph -> Forest Vertex+scc  :: Graph -> [Tree Vertex] scc g = dfs g (reverse (postOrd (transposeG g)))  ------------------------------------------------------------@@ -675,7 +697,7 @@ -- Algorithm 6: Finding reachable vertices ------------------------------------------------------------ --- | Returns the list of vertices reachable from a given vertex.+-- | \(O(V+E)\). Returns the list of vertices reachable from a given vertex. -- -- ==== __Examples__ --@@ -685,7 +707,7 @@ reachable :: Graph -> Vertex -> [Vertex] reachable g v = preorderF (dfs g [v]) --- | Returns @True@ if the second vertex reachable from the first.+-- | \(O(V+E)\). Returns @True@ if the second vertex reachable from the first. -- -- ==== __Examples__ --@@ -701,27 +723,56 @@ -- Algorithm 7: Biconnected components ------------------------------------------------------------ --- | The biconnected components of a graph.+-- | \(O(V+E)\). The biconnected components of a graph. -- An undirected graph is biconnected if the deletion of any vertex -- leaves it connected.-bcc :: Graph -> Forest [Vertex]-bcc g = (concat . map bicomps . map (do_label g dnum)) forest- where forest = dff g-       dnum   = preArr (bounds g) forest+--+-- The input graph is expected to be undirected, i.e. for every edge in the+-- graph the reverse edge is also in the graph. If the graph is not undirected+-- the output is arbitrary.+bcc :: Graph -> [Tree [Vertex]]+bcc g = concatMap bicomps forest+  where+    -- The algorithm here is the same as given by King and Launchbury, which is+    -- an adaptation of Hopcroft and Tarjan's. The implementation, however, has+    -- been modified from King and Launchbury to make it efficient. -do_label :: Graph -> UArray Vertex Int -> Tree Vertex -> Tree (Vertex,Int,Int)-do_label g dnum (Node v ts) = Node (v, dnum UA.! v, lv) us- where us = map (do_label g dnum) ts-       lv = minimum ([dnum UA.! v] ++ [dnum UA.! w | w <- g!v]-                     ++ [lu | Node (_,_,lu) _ <- us])+    forest = dff g -bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]-bicomps (Node (v,_,_) ts)-      = [ Node (v:vs) us | (_,Node vs us) <- map collect ts]+    -- dnum!v is the index of vertex v in the dfs preorder of vertices+    dnum = preArr (bounds g) forest -collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex])-collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)- where collected = map collect ts-       vs = concat [ ws | (lw, Node ws _) <- collected, lw<dv]-       cs = concat [ if lw<dv then us else [Node (v:ws) us]-                        | (lw, Node ws us) <- collected ]+    -- Wraps up the component of every child of the root+    bicomps :: Tree Vertex -> Forest [Vertex]+    bicomps (Node v tws) =+      [Node (v : curw []) (donew []) | (_, curw, donew) <- map collect tws]++    -- Returns a triple of+    -- * lowpoint of v+    -- * difference list of vertices in v's component+    -- * difference list of trees of components, whose root components are+    --   adjacent to v's component+    collect :: Tree Vertex+            -> (Int, [Vertex] -> [Vertex], [Tree [Vertex]] -> [Tree [Vertex]])+    collect (Node v tws) = (lowv, (v:) . curv, donev)+      where+        dv = dnum UA.! v+        accf (lowv', curv', donev') tw+          | loww < dv  -- w's component extends through v+            = (lowv'', curv' . curw, donev' . donew)+          | otherwise  -- w's component ends with v as an articulation point+            = (lowv'', curv', donev' . (Node (v : curw []) (donew []) :))+          where+            (loww, curw, donew) = collect tw+            !lowv'' = min lowv' loww+        !lowv0 = F.foldl' min dv [dnum UA.! w | w <- g!v]+        !(lowv, curv, donev) = F.foldl' accf (lowv0, id, id) tws++--------------------------------------------------------------------------------++-- Note [Inline for fusion]+-- ~~~~~~~~~~~~~~~~~~~~~~~~+--+-- We inline simple functions that produce or consume lists so that list fusion+-- can fire. transposeG is a function where this is particularly useful; it has+-- two intermediate lists in its definition which get fused away.

@@ -72,6 +72,7 @@ -- constructors are ordered by frequency. -- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil -- improves the benchmark by circa 10%.+--  module Data.IntMap.Internal (     -- * Map type@@ -228,6 +229,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither@@ -294,7 +299,6 @@     ) where  import Data.Functor.Identity (Identity (..))-import Control.Applicative (liftA2) import Data.Semigroup (Semigroup(stimes)) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>)))@@ -306,7 +310,9 @@ import Data.Bits import qualified Data.Foldable as Foldable import Data.Maybe (fromMaybe)-import Prelude hiding (lookup, map, filter, foldr, foldl, null)+import Utils.Containers.Internal.Prelude hiding+  (lookup, map, filter, foldr, foldl, null)+import Prelude ()  import Data.IntSet.Internal (Key) import qualified Data.IntSet.Internal as IntSet@@ -321,6 +327,8 @@ import qualified GHC.Exts as GHCExts import Text.Read import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #endif import qualified Control.Category as Category @@ -371,7 +379,7 @@ type IntSetPrefix = Int type IntSetBitMap = Word --- | @since FIXME+-- | @since 0.6.6 deriving instance Lift a => Lift (IntMap a)  bitmapOf :: Int -> IntSetBitMap@@ -610,7 +618,7 @@                   | otherwise = def     go Nil = def --- | \(O(\log n)\). Find largest key smaller than the given one and return the+-- | \(O(\min(n,W))\). Find largest key smaller than the given one and return the -- corresponding (key, value) pair. -- -- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -631,7 +639,7 @@       | otherwise = Just (ky, y)     go def Nil = unsafeFindMax def --- | \(O(\log n)\). Find smallest key greater than the given one and return the+-- | \(O(\min(n,W))\). Find smallest key greater than the given one and return the -- corresponding (key, value) pair. -- -- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')@@ -652,7 +660,7 @@       | otherwise = Just (ky, y)     go def Nil = unsafeFindMin def --- | \(O(\log n)\). Find largest key smaller or equal to the given one and return+-- | \(O(\min(n,W))\). Find largest key smaller or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing@@ -674,7 +682,7 @@       | otherwise = Just (ky, y)     go def Nil = unsafeFindMax def --- | \(O(\log n)\). Find smallest key greater or equal to the given one and return+-- | \(O(\min(n,W))\). Find smallest key greater or equal to the given one and return -- the corresponding (key, value) pair. -- -- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')@@ -1004,7 +1012,7 @@                       Just x -> Tip k x                       Nothing -> Nil --- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at+-- | \(O(\min(n,W))\). The expression (@'alterF' f k map@) alters the value @x@ at -- @k@, or absence thereof.  'alterF' can be used to inspect, insert, delete, -- or update a value in an 'IntMap'.  In short : @'lookup' k <$> 'alterF' f k m = f -- ('lookup' k m)@.@@ -1130,7 +1138,7 @@ -- | \(O(n+m)\). Remove all the keys in a given set from a map. -- -- @--- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.notMember`` s) m+-- m \`withoutKeys\` s = 'filterWithKey' (\\k _ -> k ``IntSet.notMember`` s) m -- @ -- -- @since 0.5.8@@ -1208,7 +1216,7 @@ -- | \(O(n+m)\). The restriction of a map to the keys in a set. -- -- @--- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.member`` s) m+-- m \`restrictKeys\` s = 'filterWithKey' (\\k _ -> k ``IntSet.member`` s) m -- @ -- -- @since 0.5.8@@ -2615,6 +2623,101 @@           | otherwise     -> (Nil :*: t)         Nil -> (Nil :*: Nil) +-- | \(O(\min(n,W))\). Take while a predicate on the keys holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' (p . fst) . 'toList'+-- takeWhileAntitone p = 'filterWithKey' (\\k _ -> p k)+-- @+--+-- @since 0.6.7+takeWhileAntitone :: (Key -> Bool) -> IntMap a -> IntMap a+takeWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then bin p m (go predicate l) r+        else go predicate r+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = bin p m l (go predicate' r)+      | otherwise         = go predicate' l+    go predicate' t'@(Tip ky _)+      | predicate' ky = t'+      | otherwise     = Nil+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Drop while a predicate on the keys holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'+-- dropWhileAntitone p = 'filterWithKey' (\\k _ -> not (p k))+-- @+--+-- @since 0.6.7+dropWhileAntitone :: (Key -> Bool) -> IntMap a -> IntMap a+dropWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then go predicate l+        else bin p m l (go predicate r)+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = go predicate' r+      | otherwise         = bin p m (go predicate' l) r+    go predicate' t'@(Tip ky _)+      | predicate' ky = Nil+      | otherwise     = t'+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Divide a map at the point where a predicate on the keys stops holding.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+--+-- @+-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)+-- spanAntitone p xs = 'partitionWithKey' (\\k _ -> p k) xs+-- @+--+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map+-- at some /unspecified/ point.+--+-- @since 0.6.7+spanAntitone :: (Key -> Bool) -> IntMap a -> (IntMap a, IntMap a)+spanAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then+          case go predicate l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go predicate r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go predicate t of+          (lt :*: gt) -> (lt, gt)+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = case go predicate' r of (lt :*: gt) -> bin p m l lt :*: gt+      | otherwise         = case go predicate' l of (lt :*: gt) -> lt :*: bin p m gt r+    go predicate' t'@(Tip ky _)+      | predicate' ky = (t' :*: Nil)+      | otherwise     = (Nil :*: t')+    go _ Nil = (Nil :*: Nil)+ -- | \(O(n)\). Map values and collect the 'Just' results. -- -- > let f x = if x == "a" then Just "new a" else Nothing@@ -2684,26 +2787,26 @@ split :: Key -> IntMap a -> (IntMap a, IntMap a) split k t =   case t of-    Bin _ m l r+    Bin p m l r       | m < 0 ->         if k >= 0 -- handle negative numbers.         then           case go k l of             (lt :*: gt) ->-              let !lt' = union r lt+              let !lt' = bin p m lt r               in (lt', gt)         else           case go k r of             (lt :*: gt) ->-              let !gt' = union gt l+              let !gt' = bin p m l gt               in (lt, gt')     _ -> case go k t of           (lt :*: gt) -> (lt, gt)   where     go k' t'@(Bin p m l r)       | nomatch k' p m = if k' > p then t' :*: Nil else Nil :*: t'-      | zero k' m = case go k' l of (lt :*: gt) -> lt :*: union gt r-      | otherwise = case go k' r of (lt :*: gt) -> union l lt :*: gt+      | zero k' m = case go k' l of (lt :*: gt) -> lt :*: bin p m gt r+      | otherwise = case go k' r of (lt :*: gt) -> bin p m l lt :*: gt     go k' t'@(Tip ky _)       | k' > ky   = (t' :*: Nil)       | k' < ky   = (Nil :*: t')@@ -2734,11 +2837,11 @@ splitLookup k t =   case     case t of-      Bin _ m l r+      Bin p m l r         | m < 0 ->           if k >= 0 -- handle negative numbers.-          then mapLT (union r) (go k l)-          else mapGT (`union` l) (go k r)+          then mapLT (flip (bin p m) r) (go k l)+          else mapGT (bin p m l) (go k r)       _ -> go k t   of SplitLookup lt fnd gt -> (lt, fnd, gt)   where@@ -2747,8 +2850,8 @@           if k' > p           then SplitLookup t' Nothing Nil           else SplitLookup Nil Nothing t'-      | zero k' m = mapGT (`union` r) (go k' l)-      | otherwise = mapLT (union l) (go k' r)+      | zero k' m = mapGT (flip (bin p m) r) (go k' l)+      | otherwise = mapLT (bin p m l) (go k' r)     go k' t'@(Tip ky y)       | k' > ky   = SplitLookup t'  Nothing  Nil       | k' < ky   = SplitLookup Nil Nothing  t'@@ -3103,7 +3206,7 @@  -- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. ----- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > 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 @@ -3449,14 +3552,14 @@   Debugging --------------------------------------------------------------------} --- | \(O(n)\). Show the tree that implements the map. The tree is shown+-- | \(O(n \min(n,W))\). Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. showTree :: Show a => IntMap a -> String showTree s   = showTreeWith True False s  -{- | \(O(n)\). The expression (@'showTreeWith' hang wide map@) shows+{- | \(O(n \min(n,W))\). The expression (@'showTreeWith' hang wide map@) shows  the tree that implements the map. If @hang@ is  'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If  @wide@ is 'True', an extra wide version is shown.@@ -3505,7 +3608,7 @@ showsBars bars   = case bars of       [] -> id-      _  -> showString (concat (reverse (tail bars))) . showString node+      _ : tl -> showString (concat (reverse tl)) . showString node  node :: String node = "+--"

@@ -198,6 +198,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither

@@ -217,6 +217,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither

@@ -217,6 +217,10 @@     , partition     , partitionWithKey +    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , mapMaybe     , mapMaybeWithKey     , mapEither@@ -255,7 +259,9 @@ #endif     ) where -import Prelude hiding (lookup,map,filter,foldr,foldl,null)+import Utils.Containers.Internal.Prelude hiding+  (lookup,map,filter,foldr,foldl,null)+import Prelude ()  import Data.Bits import qualified Data.IntMap.Internal as L@@ -327,6 +333,9 @@   , null   , partition   , partitionWithKey+  , takeWhileAntitone+  , dropWhileAntitone+  , spanAntitone   , restrictKeys   , size   , split@@ -345,7 +354,6 @@ import qualified Data.IntSet.Internal as IntSet import Utils.Containers.Internal.BitUtil import Utils.Containers.Internal.StrictPair-import Control.Applicative (Applicative (..), liftA2) import qualified Data.Foldable as Foldable  {--------------------------------------------------------------------@@ -1098,8 +1106,9 @@  -- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'. ----- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]--- > fromListWith (++) [] == empty+-- > 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  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs

@@ -111,6 +111,11 @@             -- * Filter             , IS.filter             , partition++            , takeWhileAntitone+            , dropWhileAntitone+            , spanAntitone+             , split             , splitMember             , splitRoot

@@ -136,6 +136,11 @@     -- * Filter     , filter     , partition++    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone+     , split     , splitMember     , splitRoot@@ -198,7 +203,9 @@ import Data.Semigroup (Semigroup((<>))) #endif import Data.Semigroup (stimesIdempotentMonoid)-import Prelude hiding (filter, foldr, foldl, null, map)+import Utils.Containers.Internal.Prelude hiding+  (filter, foldr, foldl, null, map)+import Prelude ()  import Utils.Containers.Internal.BitUtil import Utils.Containers.Internal.StrictPair@@ -215,6 +222,8 @@ import qualified GHC.Int #  endif import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #endif  import qualified Data.Foldable as Foldable@@ -272,7 +281,7 @@ type Key    = Int  #ifdef __GLASGOW_HASKELL__--- | @since FIXME+-- | @since 0.6.6 deriving instance Lift IntSet #endif @@ -345,7 +354,7 @@ notMember :: Key -> IntSet -> Bool notMember k = not . member k --- | \(O(\log n)\). Find largest element smaller than the given one.+-- | \(O(\min(n,W))\). Find largest element smaller than the given one. -- -- > lookupLT 3 (fromList [3, 5]) == Nothing -- > lookupLT 5 (fromList [3, 5]) == Just 3@@ -366,7 +375,7 @@     go def Nil = unsafeFindMax def  --- | \(O(\log n)\). Find smallest element greater than the given one.+-- | \(O(\min(n,W))\). Find smallest element greater than the given one. -- -- > lookupGT 4 (fromList [3, 5]) == Just 5 -- > lookupGT 5 (fromList [3, 5]) == Nothing@@ -387,7 +396,7 @@     go def Nil = unsafeFindMin def  --- | \(O(\log n)\). Find largest element smaller or equal to the given one.+-- | \(O(\min(n,W))\). Find largest element smaller or equal to the given one. -- -- > lookupLE 2 (fromList [3, 5]) == Nothing -- > lookupLE 4 (fromList [3, 5]) == Just 3@@ -409,7 +418,7 @@     go def Nil = unsafeFindMax def  --- | \(O(\log n)\). Find smallest element greater or equal to the given one.+-- | \(O(\min(n,W))\). Find smallest element greater or equal to the given one. -- -- > lookupGE 3 (fromList [3, 5]) == Just 3 -- > lookupGE 4 (fromList [3, 5]) == Just 5@@ -779,7 +788,96 @@                              | otherwise           = bm             {-# INLINE bitPred #-} +-- | \(O(\min(n,W))\). Take while a predicate on the elements holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' p . 'toList'+-- takeWhileAntitone p = 'filter' p+-- @+--+-- @since 0.6.7+takeWhileAntitone :: (Key -> Bool) -> IntSet -> IntSet+takeWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then bin p m (go predicate l) r+        else go predicate r+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = bin p m l (go predicate' r)+      | otherwise         = go predicate' l+    go predicate' (Tip kx bm) = tip kx (takeWhileAntitoneBits kx predicate' bm)+    go _ Nil = Nil +-- | \(O(\min(n,W))\). Drop while a predicate on the elements holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' p . 'toList'+-- dropWhileAntitone p = 'filter' (not . p)+-- @+--+-- @since 0.6.7+dropWhileAntitone :: (Key -> Bool) -> IntSet -> IntSet+dropWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then go predicate l+        else bin p m l (go predicate r)+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = go predicate' r+      | otherwise         = bin p m (go predicate' l) r+    go predicate' (Tip kx bm) = tip kx (bm `xor` takeWhileAntitoneBits kx predicate' bm)+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Divide a set at the point where a predicate on the elements stops holding.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+--+-- @+-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)+-- spanAntitone p xs = 'partition' p xs+-- @+--+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the set+-- at some /unspecified/ point.+--+-- @since 0.6.7+spanAntitone :: (Key -> Bool) -> IntSet -> (IntSet, IntSet)+spanAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then+          case go predicate l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go predicate r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go predicate t of+          (lt :*: gt) -> (lt, gt)+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = case go predicate' r of (lt :*: gt) -> bin p m l lt :*: gt+      | otherwise         = case go predicate' l of (lt :*: gt) -> lt :*: bin p m gt r+    go predicate' (Tip kx bm) = let bm' = takeWhileAntitoneBits kx predicate' bm+                                in (tip kx bm' :*: tip kx (bm `xor` bm'))+    go _ Nil = (Nil :*: Nil)+ -- | \(O(\min(n,W))\). The expression (@'split' x set@) is a pair @(set1,set2)@ -- where @set1@ comprises the elements of @set@ less than @x@ and @set2@ -- comprises the elements of @set@ greater than @x@.@@ -788,23 +886,26 @@ split :: Key -> IntSet -> (IntSet,IntSet) split x t =   case t of-      Bin _ m l r-          | m < 0 -> if x >= 0  -- handle negative numbers.-                     then case go x l of (lt :*: gt) -> let !lt' = union lt r-                                                        in (lt', gt)-                     else case go x r of (lt :*: gt) -> let !gt' = union gt l-                                                        in (lt, gt')-      _ -> case go x t of+    Bin p m l r+      | m < 0 ->+        if x >= 0  -- handle negative numbers.+        then+          case go x l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go x r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go x t of           (lt :*: gt) -> (lt, gt)   where     go !x' t'@(Bin p m l r)-        | match x' p m = if zero x' m-                         then case go x' l of-                             (lt :*: gt) -> lt :*: union gt r-                         else case go x' r of-                             (lt :*: gt) -> union lt l :*: gt-        | otherwise   = if x' < p then (Nil :*: t')-                        else (t' :*: Nil)+        | nomatch x' p m = if x' < p then (Nil :*: t') else (t' :*: Nil)+        | zero x' m      = case go x' l of (lt :*: gt) -> lt :*: bin p m gt r+        | otherwise      = case go x' r of (lt :*: gt) -> bin p m l lt :*: gt     go x' t'@(Tip kx' bm)         | kx' > x'          = (Nil :*: t')           -- equivalent to kx' > prefixOf x'@@ -819,22 +920,33 @@ splitMember :: Key -> IntSet -> (IntSet,Bool,IntSet) splitMember x t =   case t of-      Bin _ m l r | m < 0 -> if x >= 0-                             then case go x l of-                                 (lt, fnd, gt) -> let !lt' = union lt r-                                                  in (lt', fnd, gt)-                             else case go x r of-                                 (lt, fnd, gt) -> let !gt' = union gt l-                                                  in (lt, fnd, gt')-      _ -> go x t+    Bin p m l r+      | m < 0 ->+        if x >= 0 -- handle negative numbers.+        then+          case go x l of+            (lt, fnd, gt) ->+              let !lt' = bin p m lt r+              in (lt', fnd, gt)+        else+          case go x r of+            (lt, fnd, gt) ->+              let !gt' = bin p m l gt+              in (lt, fnd, gt')+    _ -> go x t   where     go x' t'@(Bin p m l r)-        | match x' p m = if zero x' m-                         then case go x' l of-                             (lt, fnd, gt) -> (lt, fnd, union gt r)-                         else case go x' r of-                             (lt, fnd, gt) -> (union lt l, fnd, gt)-        | otherwise   = if x' < p then (Nil, False, t') else (t', False, Nil)+        | nomatch x' p m = if x' < p then (Nil, False, t') else (t', False, Nil)+        | zero x' m =+          case go x' l of+            (lt, fnd, gt) ->+              let !gt' = bin p m gt r+              in (lt, fnd, gt')+        | otherwise =+          case go x' r of+            (lt, fnd, gt) ->+              let !lt' = bin p m l lt+              in (lt', fnd, gt)     go x' t'@(Tip kx' bm)         | kx' > x'          = (Nil, False, t')           -- equivalent to kx' > prefixOf x'@@ -1243,14 +1355,14 @@ {--------------------------------------------------------------------   Debugging --------------------------------------------------------------------}--- | \(O(n)\). Show the tree that implements the set. The tree is shown+-- | \(O(n \min(n,W))\). Show the tree that implements the set. The tree is shown -- in a compressed, hanging format. showTree :: IntSet -> String showTree s   = showTreeWith True False s  -{- | \(O(n)\). The expression (@'showTreeWith' hang wide map@) shows+{- | \(O(n \min(n,W))\). The expression (@'showTreeWith' hang wide map@) shows  the tree that implements the set. If @hang@ is  'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If  @wide@ is 'True', an extra wide version is shown.@@ -1299,7 +1411,7 @@  showsBars :: [String] -> ShowS showsBars [] = id-showsBars bars = showString (concat (reverse (tail bars))) . showString node+showsBars (_ : tl) = showString (concat (reverse tl)) . showString node  showsBitMap :: Word -> ShowS showsBitMap = showString . showBitMap@@ -1441,6 +1553,7 @@ foldl'Bits :: Int -> (a -> Int -> a) -> a -> Nat -> a foldrBits :: Int -> (Int -> a -> a) -> a -> Nat -> a foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a+takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Nat -> Nat  {-# INLINE lowestBitSet #-} {-# INLINE highestBitSet #-}@@ -1448,6 +1561,7 @@ {-# INLINE foldl'Bits #-} {-# INLINE foldrBits #-} {-# INLINE foldr'Bits #-}+{-# INLINE takeWhileAntitoneBits #-}  #if defined(__GLASGOW_HASKELL__) && (WORD_SIZE_IN_BITS==32 || WORD_SIZE_IN_BITS==64) indexOfTheOnlyBit :: Nat -> Int@@ -1545,6 +1659,27 @@           where !bitmask = lowestBitMask bm                 !bi = indexOfTheOnlyBit bitmask +takeWhileAntitoneBits prefix predicate bitmap =+  -- Binary search for the first index where the predicate returns false, but skip a predicate+  -- call if the high half of the current range is empty. This ensures+  -- min (log2 WORD_SIZE_IN_BITS + 1) (popcount bitmap) predicate calls.+  let next d h (n',b') =+        if n' .&. h /= 0 && (predicate $! prefix+b'+d) then (n' `shiftRL` d, b'+d) else (n',b')+      {-# INLINE next #-}+      (_,b) = next 1  0x2 $+              next 2  0xC $+              next 4  0xF0 $+              next 8  0xFF00 $+              next 16 0xFFFF0000 $+#if WORD_SIZE_IN_BITS==64+              next 32 0xFFFFFFFF00000000 $+#endif+              (bitmap,0)+      m = if b /= 0 || (bitmap .&. 0x1 /= 0 && predicate prefix)+          then ((2 `shiftLL` b) - 1)+          else ((1 `shiftLL` b) - 1)+  in bitmap .&. m+ #else {----------------------------------------------------------------------   In general case we use logarithmic implementation of@@ -1595,6 +1730,11 @@         go !_ 0 = z         go bi n | n `testBit` 0 = f bi $! go (bi + 1) (n `shiftRL` 1)                 | otherwise     =         go (bi + 1) (n `shiftRL` 1)++takeWhileAntitoneBits prefix predicate = foldl'Bits prefix f 0 -- Does not use antitone property+  where+    f acc bi | predicate bi = acc .|. bitmapOf bi+             | otherwise    = acc  #endif 

@@ -4,10 +4,7 @@ #endif  #ifdef __GLASGOW_HASKELL__-{-# LANGUAGE DataKinds, FlexibleContexts #-}-#endif-#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE DataKinds, FlexibleContexts, MonoLocalBinds #-} #endif  #include "containers.h"

@@ -383,7 +383,9 @@ #if MIN_VERSION_base(4,10,0) import Data.Bifoldable #endif-import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)+import Utils.Containers.Internal.Prelude hiding+  (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)+import Prelude ()  import qualified Data.Set.Internal as Set import Data.Set.Internal (Set)@@ -398,6 +400,8 @@ #if __GLASGOW_HASKELL__ import GHC.Exts (build, lazy) import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #  ifdef USE_MAGIC_PROXY import GHC.Exts (Proxy#, proxy# ) #  endif@@ -468,7 +472,7 @@ #endif  #ifdef __GLASGOW_HASKELL__--- | @since FIXME+-- | @since 0.6.6 deriving instance (Lift k, Lift a) => Lift (Map k a) #endif @@ -1487,7 +1491,7 @@   where     sizeL = size l --- | Take a given number of entries in key order, beginning+-- | \(O(\log n)\). Take a given number of entries in key order, beginning -- with the smallest keys. -- -- @@@ -1509,7 +1513,7 @@         EQ -> l       where sizeL = size l --- | Drop a given number of entries in key order, beginning+-- | \(O(\log n)\). Drop a given number of entries in key order, beginning -- with the smallest keys. -- -- @@@ -1629,11 +1633,6 @@   | Just r <- lookupMin t = r   | otherwise = error "Map.findMin: empty map has no minimal element" --- | \(O(\log n)\). The maximal key of the map. Calls 'error' if the map is empty.------ > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")--- > findMax empty                            Error: empty map has no maximal element- lookupMaxSure :: k -> a -> Map k a -> (k, a) lookupMaxSure k a Tip = (k, a) lookupMaxSure _ _ (Bin _ k a _ r) = lookupMaxSure k a r@@ -1649,6 +1648,11 @@ lookupMax Tip = Nothing lookupMax (Bin _ k x _ r) = Just $! lookupMaxSure k x r +-- | \(O(\log n)\). The maximal key of the map. Calls 'error' if the map is empty.+--+-- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")+-- > findMax empty                            Error: empty map has no maximal element+ findMax :: Map k a -> (k,a) findMax t   | Just r <- lookupMax t = r@@ -1899,7 +1903,7 @@ -- | \(O\bigl(m \log\bigl(\frac{n+1}{m+1}\bigr)\bigr), \; m \leq n\). Remove all keys in a 'Set' from a 'Map'. -- -- @--- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m+-- m \`withoutKeys\` s = 'filterWithKey' (\\k _ -> k ``Set.notMember`` s) m -- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s -- @ --@@ -1981,7 +1985,7 @@ -- found in a 'Set'. -- -- @--- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m+-- m \`restrictKeys\` s = 'filterWithKey' (\\k _ -> k ``Set.member`` s) m -- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s -- @ --@@ -2467,10 +2471,8 @@ -- | Filter the entries whose keys are missing from the other map -- using some 'Applicative' action. ----- @--- filterAMissing f = Merge.Lazy.traverseMaybeMissing $---   \k x -> (\b -> guard b *> Just x) <$> f k x--- @+-- > filterAMissing f = Merge.Lazy.traverseMaybeMissing $+-- >   \k x -> (\b -> guard b *> Just x) <$> f k x -- -- but this should be a little faster. --@@ -2899,7 +2901,7 @@ -- -- @ -- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'--- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k))+-- dropWhileAntitone p = 'filterWithKey' (\\k _ -> not (p k)) -- @ -- -- @since 0.5.8@@ -2916,7 +2918,7 @@ -- -- @ -- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)--- spanAntitone p xs = partitionWithKey (\k _ -> p k) xs+-- spanAntitone p xs = partitionWithKey (\\k _ -> p k) xs -- @ -- -- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map@@ -3082,7 +3084,7 @@ #endif  -- | \(O(n)\).--- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@+-- @'traverseWithKey' f m == 'fromList' \<$\> 'traverse' (\\(k, v) -> (,) k \<$\> f k v) ('toList' m)@ -- That is, behaves exactly like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value. --@@ -3383,7 +3385,7 @@ fromSet _ Set.Tip = Tip fromSet f (Set.Bin sz x l r) = Bin sz x (f x) (fromSet f l) (fromSet f r) --- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.+-- | \(O(n)\). Build a map from a set of elements contained inside 'Arg's. -- -- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")] -- > fromArgSet Data.Set.empty == empty@@ -3470,8 +3472,8 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. ----- > let f k a1 a2 = (show k) ++ a1 ++ a2--- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]+-- > 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  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a@@ -3831,7 +3833,7 @@ {-# INLINABLE splitLookup #-} #endif --- | A variant of 'splitLookup' that indicates only whether the+-- | \(O(\log n)\). A variant of 'splitLookup' that indicates only whether the -- key was present, rather than producing its value. This is used to -- implement 'intersection' to avoid allocating unnecessary 'Just' -- constructors.

@@ -6,7 +6,7 @@ import Data.Map.Internal (Map (..), size, delta) import Control.Monad (guard) --- | \(O(n)\). Show the tree that implements the map. The tree is shown+-- | \(O(n \log n)\). Show the tree that implements the map. The tree is shown -- in a compressed, hanging format. See 'showTreeWith'. showTree :: (Show k,Show a) => Map k a -> String showTree m@@ -15,7 +15,7 @@     showElem k x  = show k ++ ":=" ++ show x  -{- | \(O(n)\). The expression (@'showTreeWith' showelem hang wide map@) shows+{- | \(O(n \log n)\). The expression (@'showTreeWith' showelem hang wide map@) shows  the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is  'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If  @wide@ is 'True', an extra wide version is shown.@@ -91,7 +91,7 @@ showsBars bars   = case bars of       [] -> id-      _  -> showString (concat (reverse (tail bars))) . showString node+      _ : tl -> showString (concat (reverse tl)) . showString node  node :: String node           = "+--"

@@ -1,12 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts, DataKinds #-}-#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE MonoLocalBinds #-}-#endif-#if __GLASGOW_HASKELL__ < 710--- Why do we need this? Guess it doesn't matter; this is all--- going away soon.-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE CPP, FlexibleContexts, DataKinds, MonoLocalBinds #-}  #include "containers.h" 

@@ -1385,7 +1385,7 @@ #endif  -- | \(O(n)\).--- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (\v' -> v' \`seq\` (k,v')) <$> f k v) ('toList' m)@+-- @'traverseWithKey' f m == 'fromList' \<$\> 'traverse' (\\(k, v) -> (\v' -> v' \`seq\` (k,v')) \<$\> f k v) ('toList' m)@ -- That is, it behaves much like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value and the values are -- forced before they are installed in the result map.@@ -1471,7 +1471,7 @@ fromSet _ Set.Tip = Tip fromSet f (Set.Bin sz x l r) = case f x of v -> v `seq` Bin sz x v (fromSet f l) (fromSet f r) --- | /O(n)/. Build a map from a set of elements contained inside 'Arg's.+-- | \(O(n)\). Build a map from a set of elements contained inside 'Arg's. -- -- > fromArgSet (Data.Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) == fromList [(5,"aaaaa"), (3,"aaa")] -- > fromArgSet Data.Set.empty == empty@@ -1549,8 +1549,8 @@  -- | \(O(n \log n)\). Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'. ----- > let f k a1 a2 = (show k) ++ a1 ++ a2--- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]+-- > 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  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a

@@ -250,7 +250,6 @@ import Prelude () #ifdef __HADDOCK_VERSION__ import Control.Monad (Monad (..))-import Control.Applicative (Applicative (..)) import Data.Functor (Functor (..)) #endif 

@@ -194,17 +194,18 @@ #endif     ) where -import Prelude hiding (+import Utils.Containers.Internal.Prelude hiding (     Functor(..), #if MIN_VERSION_base(4,11,0)     (<>), #endif-    Applicative, (<$>), foldMap, Monoid,+    (<$>), foldMap, Monoid,     null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,     scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,     unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)-import Control.Applicative (Applicative(..), (<$>), (<**>),  Alternative,-                            liftA2, liftA3)+import Prelude ()+import Control.Applicative ((<$>), (<**>),  Alternative,+                            liftA3) import qualified Control.Applicative as Applicative import Control.DeepSeq (NFData(rnf)) import Control.Monad (MonadPlus(..))@@ -226,6 +227,8 @@ import Data.Data import Data.String (IsString(..)) import qualified Language.Haskell.TH.Syntax as TH+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () import GHC.Generics (Generic, Generic1) #endif @@ -341,7 +344,7 @@ newtype Seq a = Seq (FingerTree (Elem a))  #ifdef __GLASGOW_HASKELL__--- | @since FIXME+-- | @since 0.6.6 instance TH.Lift a => TH.Lift (Seq a) where #  if MIN_VERSION_template_haskell(2,16,0)   liftTyped t = [|| coerceFT z ||]@@ -1011,6 +1014,7 @@ -- | @since 0.6.1 deriving instance Generic (FingerTree a) +-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (FingerTree a) #endif @@ -1204,6 +1208,7 @@ -- | @since 0.6.1 deriving instance Generic (Digit a) +-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (Digit a) #endif @@ -1307,6 +1312,7 @@ -- | @since 0.6.1 deriving instance Generic (Node a) +-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (Node a) #endif @@ -2174,7 +2180,7 @@ -- | @since 0.5.8 deriving instance Generic (ViewL a) --- | @since FIXME+-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (ViewL a) #endif @@ -2241,7 +2247,7 @@ -- | @since 0.5.8 deriving instance Generic (ViewR a) --- | @since FIXME+-- | @since 0.6.6 deriving instance TH.Lift a => TH.Lift (ViewR a) #endif 

@@ -155,14 +155,10 @@             , unions             , difference             , intersection-#if (MIN_VERSION_base(4,9,0))             , intersections-#endif             , cartesianProduct             , disjointUnion-#if (MIN_VERSION_base(4,9,0))             , Intersection(..)-#endif               -- * Filter@@ -236,7 +232,9 @@             , merge             ) where -import Prelude hiding (filter,foldl,foldr,null,map,take,drop,splitAt)+import Utils.Containers.Internal.Prelude hiding+  (filter,foldl,foldr,null,map,take,drop,splitAt)+import Prelude () import Control.Applicative (Const(..)) import qualified Data.List as List import Data.Bits (shiftL, shiftR)@@ -261,6 +259,8 @@                  , lexP, readListPrecDefault ) import Data.Data import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #endif  @@ -291,7 +291,7 @@ type role Set nominal #endif --- | @since FIXME+-- | @since 0.6.6 deriving instance Lift a => Lift (Set a)  instance Ord a => Monoid (Set a) where@@ -883,7 +883,6 @@ {-# INLINABLE intersection #-} #endif -#if (MIN_VERSION_base(4,9,0)) -- | The intersection of a series of sets. Intersections are performed left-to-right. intersections :: Ord a => NonEmpty (Set a) -> Set a intersections (s0 :| ss) = List.foldr go id ss s0@@ -899,7 +898,6 @@ instance (Ord a) => Semigroup (Intersection a) where     (Intersection a) <> (Intersection b) = Intersection $ intersection a b     stimes = stimesIdempotent-#endif  {--------------------------------------------------------------------   Filter and partition@@ -1411,7 +1409,7 @@       where         sizeL = size l --- | Take a given number of elements in order, beginning+-- | \(O(\log n)\). Take a given number of elements in order, beginning -- with the smallest ones. -- -- @@@ -1432,7 +1430,7 @@         EQ -> l       where sizeL = size l --- | Drop a given number of elements in order, beginning+-- | \(O(\log n)\). Drop a given number of elements in order, beginning -- with the smallest ones. -- -- @@@ -1743,7 +1741,7 @@                    (Bin lls _ _ _, Bin lrs lrx lrl lrr)                      | lrs < ratio*lls -> Bin (1+ls+rs) lx ll (Bin (1+rs+lrs) x lr r)                      | otherwise -> Bin (1+ls+rs) lrx (Bin (1+lls+size lrl) lx ll lrl) (Bin (1+rs+size lrr) x lrr r)-                   (_, _) -> error "Failure in Data.Map.balanceL"+                   (_, _) -> error "Failure in Data.Set.balanceL"               | otherwise -> Bin (1+ls+rs) x l r {-# NOINLINE balanceL #-} @@ -1768,7 +1766,7 @@                    (Bin rls rlx rll rlr, Bin rrs _ _ _)                      | rls < ratio*rrs -> Bin (1+ls+rs) rx (Bin (1+ls+rls) x l rl) rr                      | otherwise -> Bin (1+ls+rs) rlx (Bin (1+ls+size rll) x l rll) (Bin (1+rrs+size rlr) rx rlr rr)-                   (_, _) -> error "Failure in Data.Map.balanceR"+                   (_, _) -> error "Failure in Data.Set.balanceR"               | otherwise -> Bin (1+ls+rs) x l r {-# NOINLINE balanceR #-} @@ -1813,7 +1811,7 @@ {-# INLINE splitRoot #-}  --- | Calculate the power set of a set: the set of all its subsets.+-- | \(O(2^n \log n)\). Calculate the power set of a set: the set of all its subsets. -- -- @ -- t ``member`` powerSet s == t ``isSubsetOf`` s@@ -1827,11 +1825,22 @@ -- @ -- -- @since 0.5.11++-- Proof of complexity: step executes n times. At the ith step,+-- "insertMin x `mapMonotonic` pxs" takes O(2^i log i) time since pxs has size+-- 2^i - 1 and we insertMin into its elements which are sets of size <= i.+-- "insertMin (singleton x)" and "`glue` pxs" are cheaper operations that both+-- take O(i) time. Over n steps, we have a total cost of+--+--   O(\sum_{i=1}^{n-1} 2^i log i)+-- = O(log n * \sum_{i=1}^{n-1} 2^i)+-- = O(2^n log n)+ powerSet :: Set a -> Set (Set a) powerSet xs0 = insertMin empty (foldr' step Tip xs0) where   step x pxs = insertMin (singleton x) (insertMin x `mapMonotonic` pxs) `glue` pxs --- | \(O(mn)\) (conjectured). Calculate the Cartesian product of two sets.+-- | \(O(nm)\). Calculate the Cartesian product of two sets. -- -- @ -- cartesianProduct xs ys = fromList $ liftA2 (,) (toList xs) (toList ys)@@ -1846,11 +1855,7 @@ -- -- @since 0.5.11 cartesianProduct :: Set a -> Set b -> Set (a, b)--- I don't know for sure if this implementation (slightly modified from one--- that Edward Kmett hacked together) is optimal. TODO: try to prove or--- refute it.------ We could definitely get big-O optimal (O(m * n)) in a rather simple way:+-- The obvious big-O optimal (O(nm)) implementation would be -- --   cartesianProduct _as Tip = Tip --   cartesianProduct as bs = fromDistinctAscList@@ -1859,8 +1864,31 @@ -- Unfortunately, this is much slower in practice, at least when the sets are -- constructed from ascending lists. I tried doing the same thing using a -- known-length (perfect balancing) variant of fromDistinctAscList, but it--- still didn't come close to the performance of Kmett's version in my very--- informal tests.+-- still didn't come close to the performance of the implementation we use in my+-- very informal tests.+--+-- The implementation we use (slightly modified from one that Edward Kmett+-- hacked together) is also optimal but performs better in practice. We map+-- each element a in as to a set made up of (a,b) for every element b in bs,+-- taking O(nm) overall. Then we merge these sets up the tree of as, which takes+-- O(n log m). A brief sketch of proof for the latter:+--+-- Consider all nodes in the tree at the same distance from the root to be at+-- the same "level". The nodes farthest from the root are at level 0, with+-- levels increasing by 1 towards the root. Being a balanced tree, there are+-- O(n/2^i) nodes at level i. At every node at level i, we merge the merged left+-- set, current set, and merged right set into a set of size O(2^i*m) in+-- O(log (2^i*m)) = O(i + log m) time. Over all levels, we do a total work of+--+--   O(\sum_{i=0}^{root_level} n * (i + log m) / 2^i)+-- = O(  \sum_{i=0}^{root_level} n * i / 2^i+--     + \sum_{i=0}^{root_level} n * log m / 2^i)+-- = O(  n * \sum_{i=0}^{root_level} i/2^i+--     + n * log m * \sum_{i=0}^{root_level} 1/2^i)+-- = O(  n * \sum_{i=0}^{inf} i/2^i+--     + n * log m * \sum_{i=0}^{inf} 1/2^i)+--+-- The sum terms converge, and we get O(n log m).  -- When the second argument has at most one element, we can be a little -- clever.@@ -1883,7 +1911,7 @@    mappend = (<>) --- | Calculate the disjoint union of two sets.+-- | \(O(n+m)\). Calculate the disjoint union of two sets. -- -- @ disjointUnion xs ys = map Left xs ``union`` map Right ys @ --@@ -1901,14 +1929,14 @@ {--------------------------------------------------------------------   Debugging --------------------------------------------------------------------}--- | \(O(n)\). Show the tree that implements the set. The tree is shown+-- | \(O(n \log n)\). Show the tree that implements the set. The tree is shown -- in a compressed, hanging format. showTree :: Show a => Set a -> String showTree s   = showTreeWith True False s  -{- | \(O(n)\). The expression (@showTreeWith hang wide map@) shows+{- | \(O(n \log n)\). The expression (@showTreeWith hang wide map@) shows  the tree that implements the set. If @hang@ is  @True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If  @wide@ is 'True', an extra wide version is shown.@@ -1983,7 +2011,7 @@ showsBars bars   = case bars of       [] -> id-      _  -> showString (concat (reverse (tail bars))) . showString node+      _ : tl -> showString (concat (reverse tl)) . showString node  node :: String node           = "+--"

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__@@ -52,8 +53,10 @@      ) where -import Data.Foldable (toList)-import Control.Applicative (Applicative(..), liftA2)+import Utils.Containers.Internal.Prelude as Prelude+import Prelude ()+import Data.Foldable (fold, foldl', toList)+import Data.Traversable (foldMapDefault) import Control.Monad (liftM) import Control.Monad.Fix (MonadFix (..), fix) import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList,@@ -64,6 +67,8 @@ import Data.Data (Data) import GHC.Generics (Generic, Generic1) import Language.Haskell.TH.Syntax (Lift)+-- See Note [ Template Haskell Dependencies ]+import Language.Haskell.TH () #endif  import Control.Monad.Zip (MonadZip (..))@@ -76,6 +81,10 @@ import Data.Semigroup (Semigroup (..)) #endif +#if MIN_VERSION_base(4,18,0)+import qualified Data.Foldable1 as Foldable1+import Data.List.NonEmpty (NonEmpty(..))+#endif  -- | Non-empty, possibly infinite, multi-way trees; also known as /rose trees/. data Tree a = Node {@@ -90,7 +99,7 @@            , Data            , Generic  -- ^ @since 0.5.8            , Generic1 -- ^ @since 0.5.8-           , Lift -- ^ @since FIXME+           , Lift -- ^ @since 0.6.6            ) #else   deriving (Eq, Ord, Read, Show)@@ -178,17 +187,118 @@                     [0..] children)  instance Traversable Tree where-    traverse f (Node x ts) = liftA2 Node (f x) (traverse (traverse f) ts)+  traverse f = go+    where go (Node x ts) = liftA2 Node (f x) (traverse go ts)+  {-# INLINE traverse #-} +-- | Folds in preorder++-- See Note [Implemented Foldable Tree functions] instance Foldable Tree where-    foldMap f (Node x ts) = f x `mappend` foldMap (foldMap f) ts+    fold = foldMap id+    {-# INLINABLE fold #-} +    foldMap = foldMapDefault+    {-# INLINE foldMap #-}++    foldr f z = \t -> go t z  -- Use a lambda to allow inlining with two arguments+      where+        go (Node x ts) = f x . foldr (\t k -> go t . k) id ts+        -- This is equivalent to the following simpler definition, but has been found to optimize+        -- better in benchmarks:+        -- go (Node x ts) z' = f x (foldr go z' ts)+    {-# INLINE foldr #-}++    foldl' f = go+      where go !z (Node x ts) = foldl' go (f z x) ts+    {-# INLINE foldl' #-}++    foldr1 = foldrMap1 id++    foldl1 = foldlMap1 id+     null _ = False     {-# INLINE null #-} -    toList = flatten-    {-# INLINE toList #-}+    elem = any . (==)+    {-# INLINABLE elem #-} +    maximum = foldlMap1' id max+    {-# INLINABLE maximum #-}++    minimum = foldlMap1' id min+    {-# INLINABLE minimum #-}++    sum = foldlMap1' id (+)+    {-# INLINABLE sum #-}++    product = foldlMap1' id (*)+    {-# INLINABLE product #-}++#if MIN_VERSION_base(4,18,0)+-- | Folds in preorder+--+-- @since 0.6.7++-- See Note [Implemented Foldable1 Tree functions]+instance Foldable1.Foldable1 Tree where+  foldMap1 f = go+    where+      -- We'd like to write+      --+      -- go (Node x (t : ts)) = f x <> Foldable1.foldMap1 go (t :| ts)+      --+      -- but foldMap1 for NonEmpty isn't very good, so we don't. See+      -- https://github.com/haskell/containers/pull/921#issuecomment-1410398618+      go (Node x []) = f x+      go (Node x (t : ts)) =+        f x <> Foldable1.foldrMap1 go (\t' z -> go t' <> z) (t :| ts)+  {-# INLINABLE foldMap1 #-}++  foldMap1' f = foldlMap1' f (\z x -> z <> f x)+  {-# INLINABLE foldMap1' #-}++  toNonEmpty (Node x ts) = x :| concatMap toList ts++  maximum = maximum+  {-# INLINABLE maximum #-}++  minimum = minimum+  {-# INLINABLE minimum #-}++  foldrMap1 = foldrMap1++  foldlMap1' = foldlMap1'++  foldlMap1 = foldlMap1+#endif++foldrMap1 :: (a -> b) -> (a -> b -> b) -> Tree a -> b+foldrMap1 f g = go+  where+    go (Node x [])     = f x+    go (Node x (t:ts)) = g x (foldrMap1NE go (\t' z -> foldr g z t') t ts)+{-# INLINE foldrMap1 #-}++-- This is foldrMap1 for Data.List.NonEmpty, but is not available before+-- base 4.18.+foldrMap1NE :: (a -> b) -> (a -> b -> b) -> a -> [a] -> b+foldrMap1NE f g = go+  where+    go x []      = f x+    go x (x':xs) = g x (go x' xs)+{-# INLINE foldrMap1NE #-}++foldlMap1' :: (a -> b) -> (b -> a -> b) -> Tree a -> b+foldlMap1' f g =  -- Use a lambda to allow inlining with two arguments+  \(Node x ts) -> foldl' (foldl' g) (f x) ts+{-# INLINE foldlMap1' #-}++foldlMap1 :: (a -> b) -> (b -> a -> b) -> Tree a -> b+foldlMap1 f g =  -- Use a lambda to allow inlining with two arguments+  \(Node x ts) -> foldl (foldl g) (f x) ts+{-# INLINE foldlMap1 #-}+ instance NFData a => NFData (Tree a) where     rnf (Node x ts) = rnf x `seq` rnf ts @@ -261,8 +371,7 @@ -- -- > flatten (Node 1 [Node 2 [], Node 3 []]) == [1,2,3] flatten :: Tree a -> [a]-flatten t = squish t []-  where squish (Node x ts) xs = x:Prelude.foldr squish xs ts+flatten = toList  -- | Returns the list of nodes at each level of the tree. --@@ -414,3 +523,39 @@     splitOnto as (_:bs) q = case viewr q of         q' :> a -> splitOnto (a:as) bs q'         EmptyR -> error "unfoldForestQ"++--------------------------------------------------------------------------------++-- Note [Implemented Foldable Tree functions]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- Implemented:+--+-- foldMap, foldr, foldl': Basic functions.+-- fold, elem: Implemented same as the default definition, but INLINABLE to+-- allow specialization.+-- foldr1, foldl1, null, maximum, minimum: Implemented more efficiently than+-- defaults since trees are non-empty.+-- sum, product: Implemented as strict left folds. Defaults use the lazy foldMap+-- before base 4.15.1.+--+-- Not implemented:+--+-- foldMap', toList, length: Defaults perform well.+-- foldr', foldl: Unlikely to be used.++-- Note [Implemented Foldable1 Tree functions]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- Implemented:+--+-- foldrMap1, foldlMap1': Basic functions+-- foldMap, 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.+--+-- Not implemented:+--+-- fold1, head: Defaults perform well.+-- foldrMap1': Unlikely to be used.

@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+-- | This hideous module lets us avoid dealing with the fact that+-- @liftA2@ wasn't previously exported from the standard prelude.+module Utils.Containers.Internal.Prelude+  ( module Prelude+  , Applicative (..)+#if !MIN_VERSION_base(4,10,0)+  , liftA2+#endif+  )+  where++import Prelude hiding (Applicative(..))+import Control.Applicative(Applicative(..))++#if !MIN_VERSION_base(4,10,0)+import Control.Applicative(liftA2)+#endif

@@ -6,7 +6,9 @@ module Utils.Containers.Internal.State where  import Control.Monad (ap, liftM2)-import Control.Applicative (Applicative(..), liftA)+import Control.Applicative (liftA)+import Utils.Containers.Internal.Prelude+import Prelude ()  newtype State s a = State {runState :: s -> (s, a)}