[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394: Clean up <*> development artifacts (f1e0f8e)

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


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

On branches: changelog-foldtree,cleaned_bugfix394,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/f1e0f8e2b5df2be6852fb35ff2dd9559aaa4c830

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

commit f1e0f8e2b5df2be6852fb35ff2dd9559aaa4c830
Author: David Feuer <David.Feuer at gmail.com>
Date:   Sat Dec 27 21:35:36 2014 -0500

    Clean up <*> development artifacts
    
    Some silly remnants of my thought process remained in the code.
    Remove them.


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

f1e0f8e2b5df2be6852fb35ff2dd9559aaa4c830
 Data/Sequence.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 0a64c3e..34504f5 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -338,15 +338,18 @@ aptyMiddle firstf
                        (Deep s (squashL pr prm) mm (squashR sfm sf)))
            (fmap (fmap lastf) sfm)
 
--- At the bottom
+-- At the bottom. Note that these appendTree0 calls are very cheap, because in
+-- each case, one of the arguments is guaranteed to be Empty or Single.
 aptyMiddle firstf
            lastf
            map23
            fs
            (Deep s pr m sf)
-      = (fmap (fmap firstf) m `snocTree` fmap firstf (digitToNode sf))
-        `appendTree0` middle `appendTree0`
-        (fmap lastf (digitToNode pr) `consTree`  fmap (fmap lastf) m)
+      = fmap (fmap firstf) m `appendTree0`
+        ((fmap firstf (digitToNode sf)
+            `consTree` middle)
+            `snocTree` fmap lastf (digitToNode pr))
+        `appendTree0`  fmap (fmap lastf) m
     where middle = case trimTree $ mapMulFT s (\(Elem f) -> fmap (fmap (map23 f)) converted) fs of
                      (firstMapped, restMapped, lastMapped) ->
                         Deep (size firstMapped + size restMapped + size lastMapped)
@@ -469,17 +472,16 @@ rigidify Single{} = error "rigidify: singleton"
 -- | /O(log n)/ (incremental) Rejigger a finger tree so the digits are all ones
 -- and twos.
 thin :: Sized a => FingerTree a -> FingerTree a
--- Note that 'thin' may call itself at most once before passing the job on to
--- 'thin12'. 'thin12' will produce a 'Deep' constructor immediately before
--- calling 'thin'.
+-- Note that 'thin12' will produce a 'Deep' constructor immediately before
+-- recursively calling 'thin'.
 thin Empty = Empty
 thin (Single a) = Single a
 thin t@(Deep s pr m sf) =
   case pr of
     One{} -> thin12 t
     Two{} -> thin12 t
-    Three a b c  -> thin $ Deep s (One a) (node2 b c `consTree` m) sf
-    Four a b c d -> thin $ Deep s (Two a b) (node2 c d `consTree` m) sf
+    Three a b c  -> thin12 $ Deep s (One a) (node2 b c `consTree` m) sf
+    Four a b c d -> thin12 $ Deep s (Two a b) (node2 c d `consTree` m) sf
 
 thin12 :: Sized a => FingerTree a -> FingerTree a
 thin12 (Deep s pr m sf at One{}) = Deep s pr (thin m) sf



More information about the ghc-commits mailing list