[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Data.Sequence.fromList: Reimplement using FinalList (099a2c1)

[git at git.haskell.org]

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/099a2c18edac207041dc313c1cc5deac9e2e70a6

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

commit 099a2c18edac207041dc313c1cc5deac9e2e70a6
Author: Lennart Spitzner <lsp at informatik.uni-kiel.de>
Date:   Mon Jun 13 16:40:16 2016 +0200

    Data.Sequence.fromList: Reimplement using FinalList


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

099a2c18edac207041dc313c1cc5deac9e2e70a6
 Data/Sequence.hs | 80 +++++++++++++++++++++++++++++++-------------------------
 1 file changed, 44 insertions(+), 36 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 9b8ce23..799e167 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -3553,39 +3553,49 @@ fromList        :: [a] -> Seq a
 -- 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
-
-    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
+fromList = Seq . mkTree 1 . map_elem
+  where
+    mkTree :: Int -> [Elem a] -> FingerTree (Elem 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) = mkTreeC cont (3*s) (getNodes (3*s) x4 xs)
+      where
+        -- cont :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Elem a)
+        cont d sub = Deep (3*size x1 + size d + size sub) (Three x1 x2 x3) sub d
+
+    getNodes :: Int
+             -> a
+             -> [a]
+             -> ListFinal (Node a) (Digit a)
+    getNodes !_ x1 [] = LFinal (One x1)
+    getNodes _ x1 [x2] = LFinal (Two x1 x2)
+    getNodes _ x1 [x2, x3] = LFinal (Three x1 x2 x3)
+    getNodes s x1 (x2:x3:x4:xs) = LCons (Node3 s x1 x2 x3) (getNodes s x4 xs)
+
+    mkTreeC :: (b -> FingerTree (Node a) -> c)
+            -> Int
+            -> ListFinal (Node a) b
+            -> c
+    mkTreeC cont !_ (LFinal b) = cont b EmptyT
+    mkTreeC cont _  (LCons x1 (LFinal b)) = cont b (Single x1)
+    mkTreeC cont s  (LCons x1 (LCons x2 (LFinal b))) = cont b (Deep (2*s) (One x1) EmptyT (One x2))
+    mkTreeC cont s  (LCons x1 (LCons x2 (LCons x3 (LFinal b)))) = cont b (Deep (3*s) (One x1) EmptyT (Two x2 x3))
+    mkTreeC cont s  (LCons x1 (LCons x2 (LCons x3 (LCons x4 xs)))) = mkTreeC cont2 (3*s) (getNodesC (3*s) x4 xs)
+      where
+        d1 = Three x1 x2 x3
+        -- cont2 :: (b, Digit (Node a)) -> FingerTree (Node (Node a)) -> c
+        cont2 (b, !d) !sub = cont b $ Deep (3*size x1 + size d + size sub) d1 sub d
+
+    getNodesC :: Int
+              -> a
+              -> ListFinal a b
+              -> ListFinal (Node a) (b, Digit a)
+    getNodesC !_ x1 (LFinal b) = LFinal (b, (One x1))
+    getNodesC _ x1 (LCons x2 (LFinal b)) = LFinal (b, (Two x1 x2))
+    getNodesC _ x1 (LCons x2 (LCons x3 (LFinal b))) = LFinal (b, (Three x1 x2 x3))
+    getNodesC s x1 (LCons x2 (LCons x3 (LCons x4 xs))) = LCons (Node3 s x1 x2 x3) (getNodesC s x4 xs)
 
     map_elem :: [a] -> [Elem a]
 #if __GLASGOW_HASKELL__ >= 708
@@ -3595,9 +3605,7 @@ fromList = Seq . mkTreeE 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)
+data ListFinal a cont = LFinal !cont | LCons !a (ListFinal a cont)
 
 #if __GLASGOW_HASKELL__ >= 708
 instance GHC.Exts.IsList (Seq a) where