[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394: Use a top-down version of fromList (51a1f7c)

[git at git.haskell.org]

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

On branches: changelog-foldtree,cleaned_bugfix394,develop-0.6,develop-0.6-questionable,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/51a1f7c6670058ed4feefd1ef86170ddef173e63

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

commit 51a1f7c6670058ed4feefd1ef86170ddef173e63
Author: David Feuer <David.Feuer at gmail.com>
Date:   Tue Dec 9 14:56:53 2014 -0500

    Use a top-down version of fromList
    
    Ross Paterson came up with a version of fromList that avoids the
    tree rebuilding inherent in the `(|>)`-based approach. This
    version is somewhat strictified and rearranged. It reduces
    allocation substantially over the old version. Mutator time goes
    down too, but for some reason GC time rises to match it.


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

51a1f7c6670058ed4feefd1ef86170ddef173e63
 Data/Sequence.hs | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 4c281fc..651dd5e 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -1752,11 +1752,34 @@ findIndicesR p xs = foldlWithIndex g [] xs
 -- Lists
 ------------------------------------------------------------------------
 
+-- The implementation below, by Ross Paterson, avoids the rebuilding
+-- the previous (|>)-based implementation suffered from.
+
 -- | /O(n)/. Create a sequence from a finite list of elements.
 -- There is a function 'toList' in the opposite direction for all
 -- instances of the 'Foldable' class, including 'Seq'.
 fromList        :: [a] -> Seq a
-fromList        =  Data.List.foldl' (|>) empty
+fromList xs = Seq $ mkTree 1 $ Data.List.map Elem xs
+  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 s [] = s `seq` Empty
+    mkTree s [x1] = s `seq` Single x1
+    mkTree s [x1, x2] = Deep (2*s) (One x1) Empty (One x2)
+    mkTree s [x1, x2, x3] = Deep (3*s) (One x1) Empty (Two x2 x3)
+    mkTree s (x1:x2:x3:xs) = s `seq` case getNodes (3*s) xs of
+                                       (ns, sf) -> m `seq` deep' (Three x1 x2 x3) m sf
+                                           where m = mkTree (3*s) ns
+
+    deep' pr@(Three x1 _ _) m sf = Deep (3*size x1 + size m + size sf) pr m sf
+    
+    getNodes :: Int -> [a] -> ([Node a], Digit a)
+    getNodes s [x1] = s `seq` ([], One x1)
+    getNodes s [x1, x2] = s `seq` ([], Two x1 x2)
+    getNodes s [x1, x2, x3] = s `seq` ([], Three x1 x2 x3)
+    getNodes s (x1:x2:x3:xs) = s `seq` (Node3 s x1 x2 x3:ns, d)
+       where (ns, d) = getNodes s xs
 
 #if __GLASGOW_HASKELL__ >= 708
 instance GHC.Exts.IsList (Seq a) where