[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Fuse fmap with reverse for Data.Sequence (1a48b85)

[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/1a48b85c309c30242a7c9729d0fc8b89cae4fc75

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

commit 1a48b85c309c30242a7c9729d0fc8b89cae4fc75
Author: David Feuer <David.Feuer at gmail.com>
Date:   Thu May 19 23:11:43 2016 -0400

    Fuse fmap with reverse for Data.Sequence
    
    Add rules fusing `fmap f . reverse` and `reverse . fmap f`
    for `Data.Sequence`. These make mapping over a sequence and
    reversing it simultaneously as cheap as just mapping over it.
    
    Closes #238.


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

1a48b85c309c30242a7c9729d0fc8b89cae4fc75
 Data/Sequence.hs | 35 +++++++++++++++++++++++++++++------
 changelog.md     |  2 ++
 2 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index fdc0c42..0003062 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -2632,14 +2632,37 @@ instance IsString (Seq Char) where
 
 -- | /O(n)/. The reverse of a sequence.
 reverse :: Seq a -> Seq a
-reverse (Seq xs) = Seq (reverseTree id xs)
+reverse (Seq xs) = Seq (fmapReverseTree id xs)
 
-reverseTree :: (a -> b) -> FingerTree a -> FingerTree b
-reverseTree _ EmptyT = EmptyT
-reverseTree f (Single x) = Single (f x)
-reverseTree f (Deep s pr m sf) =
+#ifdef __GLASGOW_HASKELL__
+{-# NOINLINE [1] reverse #-}
+
+-- | /O(n)/. Reverse a sequence while mapping over it. This is not
+-- currently experted, but is used in rewrite rules.
+fmapReverse :: (a -> b) -> Seq a -> Seq b
+fmapReverse f (Seq xs) = Seq (fmapReverseTree (lift_elem f) xs)
+  where
+    lift_elem :: (a -> b) -> (Elem a -> Elem b)
+#if __GLASGOW_HASKELL__ >= 708
+    lift_elem = coerce
+#else
+    lift_elem f (Elem a) = Elem (f a)
+#endif
+
+-- If we're mapping over a sequence, we can reverse it at the same time
+-- at no extra charge.
+{-# RULES
+"fmapSeq/reverse" forall f xs . fmapSeq f (reverse xs) = fmapReverse f xs
+"reverse/fmapSeq" forall f xs . reverse (fmapSeq f xs) = fmapReverse f xs
+ #-}
+#endif
+
+fmapReverseTree :: (a -> b) -> FingerTree a -> FingerTree b
+fmapReverseTree _ EmptyT = EmptyT
+fmapReverseTree f (Single x) = Single (f x)
+fmapReverseTree f (Deep s pr m sf) =
     Deep s (reverseDigit f sf)
-        (reverseTree (reverseNode f) m)
+        (fmapReverseTree (reverseNode f) m)
         (reverseDigit f pr)
 
 {-# INLINE reverseDigit #-}
diff --git a/changelog.md b/changelog.md
index 6d67bc1..faa69e6 100644
--- a/changelog.md
+++ b/changelog.md
@@ -31,6 +31,8 @@
     are greatest for small sequences, but meaningful even for long ones.
     Reimplement `take` and `drop` to avoid building and then discarding trees.
 
+  * Add rewrite rules to fuse `fmap` with `reverse` for `Data.Sequence`.
+
   * Speed up `adjust` for `Data.Map`.
 
   * Remove non-essential laziness in `Data.Map.Lazy` implementation.