[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Make Data.Sequence.fromList more eager (3731bd3)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:43:37 UTC 2017 

Repository : ssh://git@git.haskell.org/containers

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/3731bd34720e9c41c052f8e725399f5c10a3b56c

>---------------------------------------------------------------

commit 3731bd34720e9c41c052f8e725399f5c10a3b56c
Author: David Feuer <David.Feuer at gmail.com>
Date:   Fri Jun 10 21:41:39 2016 -0400

    Make Data.Sequence.fromList more eager
    
    `fromList` previously suspended most of its work,
    storing the structure in thunks rather than trees.
    Now it builds everything.
    
    Old:
    
    benchmarking fromList/10
    time                 175.2 ns   (174.7 ns .. 175.7 ns)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 175.2 ns   (174.8 ns .. 175.6 ns)
    std dev              1.383 ns   (1.124 ns .. 1.775 ns)
    
    benchmarking fromList/100
    time                 2.712 μs   (2.707 μs .. 2.720 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 2.732 μs   (2.717 μs .. 2.779 μs)
    std dev              76.64 ns   (40.38 ns .. 147.1 ns)
    variance introduced by outliers: 35% (moderately inflated)
    
    benchmarking fromList/1000
    time                 32.24 μs   (32.18 μs .. 32.33 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 32.26 μs   (32.22 μs .. 32.35 μs)
    std dev              194.7 ns   (100.0 ns .. 371.4 ns)
    
    benchmarking fromList/10000
    time                 510.3 μs   (508.2 μs .. 511.9 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 508.1 μs   (506.2 μs .. 509.8 μs)
    std dev              5.787 μs   (4.788 μs .. 7.175 μs)
    
    New:
    
    benchmarking fromList/10
    time                 139.8 ns   (139.5 ns .. 140.2 ns)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 139.8 ns   (139.6 ns .. 140.3 ns)
    std dev              1.023 ns   (547.5 ps .. 1.573 ns)
    
    benchmarking fromList/100
    time                 1.520 μs   (1.517 μs .. 1.525 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 1.522 μs   (1.518 μs .. 1.529 μs)
    std dev              16.53 ns   (10.57 ns .. 24.26 ns)
    
    benchmarking fromList/1000
    time                 16.00 μs   (15.97 μs .. 16.05 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 15.99 μs   (15.97 μs .. 16.04 μs)
    std dev              89.39 ns   (39.63 ns .. 151.2 ns)
    
    benchmarking fromList/10000
    time                 262.8 μs   (262.3 μs .. 263.5 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 262.8 μs   (262.4 μs .. 264.7 μs)
    std dev              2.559 μs   (757.4 ns .. 5.482 μs)


>---------------------------------------------------------------

3731bd34720e9c41c052f8e725399f5c10a3b56c
 Data/Sequence.hs       | 55 ++++++++++++++++++++++++++++++++++----------------
 benchmarks/Sequence.hs |  6 ++++++
 changelog.md           | 20 ++++++++++++------
 3 files changed, 58 insertions(+), 23 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 4ea1c57..d0d7ff1 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -3530,25 +3530,42 @@ findIndicesR p xs = foldlWithIndex g [] xs
 -- There is a function 'toList' in the opposite direction for all
 -- instances of the 'Foldable' class, including 'Seq'.
 fromList        :: [a] -> Seq a
-fromList = Seq . mkTree 1 . map_elem
-  where
-    {-# SPECIALIZE mkTree :: Int -> [Elem a] -> FingerTree (Elem a) #-}
-    {-# SPECIALIZE mkTree :: Int -> [Node a] -> FingerTree (Node a) #-}
-    mkTree :: (Sized a) => Int -> [a] -> FingerTree a
-    mkTree !_ [] = EmptyT
-    mkTree _ [x1] = Single x1
-    mkTree s [x1, x2] = Deep (2*s) (One x1) EmptyT (One x2)
-    mkTree s [x1, x2, x3] = Deep (3*s) (One x1) EmptyT (Two x2 x3)
-    mkTree s (x1:x2:x3:x4:xs) = case getNodes (3*s) x4 xs of
-      (ns, sf) -> case mkTree (3*s) ns of
+-- Note: we can avoid map_elem if we wish by scattering
+-- Elem applications throughout mkTreeE and getNodesE, but
+-- it gets a bit hard to read.
+fromList = Seq . mkTreeE 1 . map_elem
+  where
+    mkTreeE :: Int -> [Elem a] -> FingerTree (Elem a)
+    mkTreeE !_ [] = EmptyT
+    mkTreeE _ [x1] = Single x1
+    mkTreeE s [x1, x2] = Deep (2*s) (One x1) EmptyT (One x2)
+    mkTreeE s [x1, x2, x3] = Deep (3*s) (One x1) EmptyT (Two x2 x3)
+    mkTreeE s (x1:x2:x3:x4:xs) = case getNodesE (3*s) x4 xs of
+      ns :*: sf -> case mkTreeN (3*s) ns of
         !m -> Deep (3*size x1 + size m + size sf) (Three x1 x2 x3) m sf
 
-    getNodes :: Int -> a -> [a] -> ([Node a], Digit a)
-    getNodes !_ x1 [] = ([], One x1)
-    getNodes _ x1 [x2] = ([], Two x1 x2)
-    getNodes _ x1 [x2, x3] = ([], Three x1 x2 x3)
-    getNodes s x1 (x2:x3:x4:xs) = (Node3 s x1 x2 x3:ns, d)
-       where (ns, d) = getNodes s x4 xs
+    mkTreeN :: Int -> SList (Node a) -> FingerTree (Node a)
+    mkTreeN !_ SNil = EmptyT
+    mkTreeN _ (SCons x1 SNil) = Single x1
+    mkTreeN s (SCons x1 (SCons x2 SNil)) = Deep (2*s) (One x1) EmptyT (One x2)
+    mkTreeN s (SCons x1 (SCons x2 (SCons x3 SNil))) = Deep (3*s) (One x1) EmptyT (Two x2 x3)
+    mkTreeN s (SCons x1 (SCons x2 (SCons x3 (SCons x4 xs)))) = case getNodesN (3*s) x4 xs of
+      ns :*: sf -> case mkTreeN (3*s) ns of
+        !m -> Deep (3*size x1 + size m + size sf) (Three x1 x2 x3) m sf
+
+    getNodesE :: Int -> a -> [a] -> StrictPair (SList (Node a)) (Digit a)
+    getNodesE !_ x1 [] = SNil :*: One x1
+    getNodesE _ x1 [x2] = SNil :*: Two x1 x2
+    getNodesE _ x1 [x2, x3] = SNil :*: Three x1 x2 x3
+    getNodesE s x1 (x2:x3:x4:xs) = SCons (Node3 s x1 x2 x3) ns :*: d
+       where !(ns :*: d) = getNodesE s x4 xs
+
+    getNodesN :: Int -> Node a -> SList (Node a) -> StrictPair (SList (Node (Node a))) (Digit (Node a))
+    getNodesN !_ x1 SNil = SNil :*: One x1
+    getNodesN _ x1 (SCons x2 SNil) = SNil :*: Two x1 x2
+    getNodesN _ x1 (SCons x2 (SCons x3 SNil)) = SNil :*: Three x1 x2 x3
+    getNodesN s x1 (SCons x2 (SCons x3 (SCons x4 xs))) = SCons (Node3 s x1 x2 x3) ns :*: d
+       where !(ns :*: d) = getNodesN s x4 xs
 
     map_elem :: [a] -> [Elem a]
 #if __GLASGOW_HASKELL__ >= 708
@@ -3558,6 +3575,10 @@ fromList = Seq . mkTree 1 . map_elem
 #endif
     {-# INLINE map_elem #-}
 
+-- A list strict in both its spine and elements. This seems to help
+-- GHC avoid forcing things that are already forced in fromList.
+data SList a = SNil | SCons !a !(SList a)
+
 #if __GLASGOW_HASKELL__ >= 708
 instance GHC.Exts.IsList (Seq a) where
     type Item (Seq a) = a
diff --git a/benchmarks/Sequence.hs b/benchmarks/Sequence.hs
index 1d23929..527020b 100644
--- a/benchmarks/Sequence.hs
+++ b/benchmarks/Sequence.hs
@@ -35,6 +35,12 @@ main = do
          , bench "100" $ nf (shuffle r100) s100
          , bench "1000" $ nf (shuffle r1000) s1000
          ]
+      , bgroup "fromList"
+         [ bench "10" $ nf S.fromList [(0 :: Int)..9]
+         , bench "100" $ nf S.fromList [(0 :: Int)..99]
+         , bench "1000" $ nf S.fromList [(0 :: Int)..999]
+         , bench "10000" $ nf S.fromList [(0 :: Int)..9999]
+         ]
       , bgroup "partition"
          [ bench "10" $ nf (S.partition even) s10
          , bench "100" $ nf (S.partition even) s100
diff --git a/changelog.md b/changelog.md
index 9200dae..d520020 100644
--- a/changelog.md
+++ b/changelog.md
@@ -32,15 +32,23 @@
 
   * Derive `Generic` and `Generic1` for `Data.Tree`.
 
-  * Add `foldTree` for `Data.Tree`.
+  * Add `foldTree` for `Data.Tree`. (Thanks, Daniel Wagner!)
+
+  * Make `drawTree` handle newlines better. (Thanks, recursion-ninja!)
 
   * Slightly optimize `replicateA` and `traverse` for `Data.Sequence`.
   
-  * Substantially speed up `splitAt` and (consequently) `zipWith` for
-    `Data.Sequence` by building the result sequences eagerly and rearranging
-    code to avoid allocating unnecessary intermediate structures. The
-    improvements are greatest for small sequences, but large even for long
-    ones. Reimplement `take` and `drop` to avoid building trees only to discard them.
+  * Substantially speed up `splitAt`, `zipWith`, `take`, `drop`,
+    `fromList`, and `partition` in `Data.Sequence`.
+
+  * Most operations in `Data.Sequence` advertised as taking logarithmic
+    time (including `><` and `adjust`) now use their full allotted time
+    to avoid potentially building up chains of thunks in the tree. In general,
+    the only remaining operations that avoid doing more than they
+    really need are bulk creation and transformation functions that
+    really benefit from the extra laziness. There are some situations
+    where this change may slow programs down, but I think having more
+    predictable and usually better performance more than makes up for that.
 
   * Roughly double the speeds of `foldl'` and `foldr'` for `Data.Sequence`
     by writing custom definitions instead of using the defaults.

More information about the ghc-commits mailing list