[commit: packages/containers] zip-devel: Direct implementation of fromFunction. (ce7f531)

[git at git.haskell.org]

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

On branch  : zip-devel
Link       : http://git.haskell.org/packages/containers.git/commitdiff/ce7f531605b5f2bb350f36c51a74d9ebd84ff8b6

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

commit ce7f531605b5f2bb350f36c51a74d9ebd84ff8b6
Author: Milan Straka <fox at ucw.cz>
Date:   Sun Dec 7 16:16:59 2014 +0100

    Direct implementation of fromFunction.
    
    We avoid using Four Digit, so that elements can be added to the
    new Seq without forcing a large rebuild.


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

ce7f531605b5f2bb350f36c51a74d9ebd84ff8b6
 Data/Sequence.hs | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index f7d551c..4f7eb86 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -1429,7 +1429,28 @@ mapWithIndex# f (Seq xs) = Seq $ mapWithIndexTree# (\s (Elem a) -> Elem (f s a))
 -- | /O(n)/. Convert a given sequence length and a function representing that
 -- sequence into a sequence.
 fromFunction :: Int -> (Int -> a) -> Seq a
-fromFunction len f = mapWithIndex (\i _ -> f i) (replicate len ())
+fromFunction len f | len < 0 = error "Data.Sequence.fromFunction called with negative len"
+                   | len == 0 = empty
+                   | otherwise = Seq $ create (Elem . f) 1 0 len
+ where
+  create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
+  create b{-tree_builder-} s{-tree_size-} i{-start_index-} trees = case trees of
+    1 -> Single $ b i
+    2 -> Deep (2*s) (One (b i)) Empty (One (b (i+s)))
+    3 -> Deep (3*s) (Two (b i) (b (i+s))) Empty (One (b (i+2*s)))
+    4 -> Deep (4*s) (Two (b i) (b (i+s))) Empty (Two (b (i+2*s)) (b (i+3*s)))
+    5 -> Deep (5*s) (Three (b i) (b (i+s)) (b (i+2*s))) Empty (Two (b (i+3*s)) (b (i+4*s)))
+    6 -> Deep (5*s) (Three (b i) (b (i+s)) (b (i+2*s))) Empty (Three (b (i+3*s)) (b (i+4*s)) (b (i+5*s)))
+    _ -> case trees `quotRem` 3 of
+      (trees',1) -> Deep (trees*s) (Two (b i) (b (i+s)))
+                         (create (\j -> Node3 (3*s) (b j) (b (j+s)) (b (j+2*s))) (3*s) (i+2*s) (trees'-1))
+                         (Two (b (i+(2+3*(trees'-1))*s)) (b (i+(3+3*(trees'-1))*s)))
+      (trees',2) -> Deep (trees*s) (Three (b i) (b (i+s)) (b (i+2*s)))
+                         (create (\j -> Node3 (3*s) (b j) (b (j+s)) (b (j+2*s))) (3*s) (i+3*s) (trees'-1))
+                         (Two (b (i+(3+3*(trees'-1))*s)) (b (i+(4+3*(trees'-1))*s)))
+      (trees',0) -> Deep (trees*s) (Three (b i) (b (i+s)) (b (i+2*s)))
+                         (create (\j -> Node3 (3*s) (b j) (b (j+s)) (b (j+2*s))) (3*s) (i+3*s) (trees'-2))
+                         (Three (b (i+(3+3*(trees'-2))*s)) (b (i+(4+3*(trees'-2))*s)) (b (i+(5+3*(trees'-2))*s)))
 
 -- Splitting