From 2370e0c2f2a28e9a382a57f38c7e372cfb213364 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Mon, 22 Jan 2018 12:37:43 +0000
Subject: [PATCH 01/16] much faster foldMap

---
 Data/Sequence/Internal.hs | 40 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 3c5dcf48c..1deb34984 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -386,7 +386,45 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
 #endif
 
 instance Foldable Seq where
-    foldMap f (Seq xs) = foldMap (foldMap f) xs
+    foldMap f' (Seq xs') = foldMapTreeE (lift_elem f') xs'
+      where
+        lift_elem :: (a -> m) -> (Elem a -> m)
+#if __GLASGOW_HASKELL__ >= 708
+        lift_elem g = coerce g
+#else
+        lift_elem g = \(Elem a) -> g a
+#endif
+        foldMapTreeE :: Monoid m => (Elem a -> m) -> FingerTree (Elem a) -> m
+        foldMapTreeE _ EmptyT = mempty
+        foldMapTreeE f (Single xs) = f xs
+        foldMapTreeE f (Deep _ pr m sf) = 
+            foldMapDigitE f pr <>
+            foldMapTreeN (foldMapNodeE f) m <>
+            foldMapDigitE f sf
+
+        foldMapTreeN :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
+        foldMapTreeN _ EmptyT = mempty
+        foldMapTreeN f (Single xs) = f xs
+        foldMapTreeN f (Deep _ pr m sf) = 
+            foldMapDigitN f pr <>
+            foldMapTreeN (foldMapNodeN f) m <>
+            foldMapDigitN f sf
+
+        foldMapDigitE :: Monoid m => (Elem a -> m) -> Digit (Elem a) -> m
+        foldMapDigitE f t = foldDigit (<>) f t
+
+        foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
+        foldMapDigitN f t = foldDigit (<>) f t
+
+        foldMapNodeE :: Monoid m => (Elem a -> m) -> Node (Elem a) -> m
+        foldMapNodeE f t = foldNode (<>) f t
+
+        foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
+        foldMapNodeN f t = foldNode (<>) f t
+#if __GLASGOW_HASKELL__
+    {-# INLINABLE foldMap #-}
+#endif
+
 #if __GLASGOW_HASKELL__ >= 708
     foldr f z (Seq xs) = foldr (coerce f) z xs
     foldr' f z (Seq xs) = foldr' (coerce f) z xs

From 2310306e2085a92537121d2805caedf067f0f2f9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 14:01:37 +0000
Subject: [PATCH 02/16] much faster foldl'

---
 Data/Sequence/Internal.hs | 39 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 37 insertions(+), 2 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 1deb34984..ac91427ed 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -390,10 +390,11 @@ instance Foldable Seq where
       where
         lift_elem :: (a -> m) -> (Elem a -> m)
 #if __GLASGOW_HASKELL__ >= 708
-        lift_elem g = coerce g
+        lift_elem = coerce
 #else
         lift_elem g = \(Elem a) -> g a
 #endif
+        {-# INLINE lift_elem #-}
         foldMapTreeE :: Monoid m => (Elem a -> m) -> FingerTree (Elem a) -> m
         foldMapTreeE _ EmptyT = mempty
         foldMapTreeE f (Single xs) = f xs
@@ -436,7 +437,39 @@ instance Foldable Seq where
 #endif
     foldl f z (Seq xs) = foldl (foldl f) z xs
 #if MIN_VERSION_base(4,6,0)
-    foldl' f z (Seq xs) = foldl' (foldl' f) z xs
+    {-# INLINE foldl' #-}
+    foldl' f z (Seq xs) = foldlTreeE (lift_elem f) z xs
+      where
+        lift_elem :: (b -> a -> b) -> b -> Elem a -> b
+#if __GLASGOW_HASKELL__ >= 708
+        lift_elem = coerce
+#else
+        lift_elem g = \bs (Elem a) -> g bs a
+#endif
+        {-# INLINE lift_elem #-}
+        foldlTreeE :: (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
+        foldlTreeE _ b EmptyT = b
+        foldlTreeE f b (Single xs) = (f $! b) xs
+        foldlTreeE f b (Deep _ pr m sf) =
+              (foldlDigitE f $! ((foldlTreeN (foldlNodeE f) $! ((foldlDigitE f $! b) pr)) m)) sf
+
+        foldlTreeN :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
+        foldlTreeN _ b EmptyT = b
+        foldlTreeN f b (Single xs) = f b xs
+        foldlTreeN f b (Deep _ pr m sf) =
+              (foldlDigitN f $! ((foldlTreeN (foldlNodeN f) $! (foldlDigitN f b pr)) m)) sf
+
+        foldlDigitE :: (b -> Elem a -> b) -> b -> Digit (Elem a) -> b
+        foldlDigitE f b t = foldl' f b t
+
+        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
+        foldlDigitN f b t = foldl' f b t
+
+        foldlNodeE :: (b -> Elem a -> b) -> b -> Node (Elem a) -> b
+        foldlNodeE f b t = foldl' f b t
+
+        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
+        foldlNodeN f b t = foldl' f b t
 #endif
 
     foldr1 f (Seq xs) = getElem (foldr1 f' xs)
@@ -1045,6 +1078,7 @@ instance Foldable Digit where
     foldl' f z (Two a b) = (f $! f z a) b
     foldl' f z (Three a b c) = (f $! (f $! f z a) b) c
     foldl' f z (Four a b c d) = (f $! (f $! (f $! f z a) b) c) d
+    {-# INLINE foldl' #-}
 #endif
 
     foldr1 _ (One a) = a
@@ -1126,6 +1160,7 @@ instance Foldable Node where
 
     foldl' f z (Node2 _ a b) = (f $! f z a) b
     foldl' f z (Node3 _ a b c) = (f $! (f $! f z a) b) c
+    {-# INLINE foldl' #-}
 #endif
 
 instance Functor Node where

From d2e275a6bf6e55f4b9d27eedfd4df979c08cdf20 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 14:30:05 +0000
Subject: [PATCH 03/16] pushed faster foldl' down into fingertree rather than
 seq

---
 Data/Sequence/Internal.hs | 54 ++++++++++++++++-----------------------
 1 file changed, 22 insertions(+), 32 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index ac91427ed..028c38ca0 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -438,7 +438,7 @@ instance Foldable Seq where
     foldl f z (Seq xs) = foldl (foldl f) z xs
 #if MIN_VERSION_base(4,6,0)
     {-# INLINE foldl' #-}
-    foldl' f z (Seq xs) = foldlTreeE (lift_elem f) z xs
+    foldl' f z (Seq xs) = foldl' (lift_elem f) z xs
       where
         lift_elem :: (b -> a -> b) -> b -> Elem a -> b
 #if __GLASGOW_HASKELL__ >= 708
@@ -447,29 +447,6 @@ instance Foldable Seq where
         lift_elem g = \bs (Elem a) -> g bs a
 #endif
         {-# INLINE lift_elem #-}
-        foldlTreeE :: (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
-        foldlTreeE _ b EmptyT = b
-        foldlTreeE f b (Single xs) = (f $! b) xs
-        foldlTreeE f b (Deep _ pr m sf) =
-              (foldlDigitE f $! ((foldlTreeN (foldlNodeE f) $! ((foldlDigitE f $! b) pr)) m)) sf
-
-        foldlTreeN :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
-        foldlTreeN _ b EmptyT = b
-        foldlTreeN f b (Single xs) = f b xs
-        foldlTreeN f b (Deep _ pr m sf) =
-              (foldlDigitN f $! ((foldlTreeN (foldlNodeN f) $! (foldlDigitN f b pr)) m)) sf
-
-        foldlDigitE :: (b -> Elem a -> b) -> b -> Digit (Elem a) -> b
-        foldlDigitE f b t = foldl' f b t
-
-        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
-        foldlDigitN f b t = foldl' f b t
-
-        foldlNodeE :: (b -> Elem a -> b) -> b -> Node (Elem a) -> b
-        foldlNodeE f b t = foldl' f b t
-
-        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
-        foldlNodeN f b t = foldl' f b t
 #endif
 
     foldr1 f (Seq xs) = getElem (foldr1 f' xs)
@@ -983,14 +960,27 @@ instance Foldable FingerTree where
     foldr' _ z EmptyT = z
     foldr' f z (Single x) = f x z
     foldr' f z (Deep _ pr m sf) = foldr' f mres pr
-        where !sfRes = foldr' f z sf
-              !mres = foldr' (flip (foldr' f)) sfRes m
-
-    foldl' _ z EmptyT = z
-    foldl' f z (Single x) = z `f` x
-    foldl' f z (Deep _ pr m sf) = foldl' f mres sf
-        where !prRes = foldl' f z pr
-              !mres = foldl' (foldl' f) prRes m
+      where
+        !sfRes = foldr' f z sf
+        !mres = foldr' (flip (foldr' f)) sfRes m
+
+    foldl' _ b EmptyT = b
+    foldl' f b (Single xs) = (f $! b) xs
+    foldl' f b (Deep _ pr m sf) =
+        (foldlDigit' f $!
+         (foldlTree' (foldlNode' f) $! (foldlDigit' f $! b) pr) m)
+            sf
+      where
+        foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
+        foldlTree' _ b EmptyT = b
+        foldlTree' f b (Single xs) = f b xs
+        foldlTree' f b (Deep _ pr m sf) =
+            (foldl' f $! (foldlTree' (foldl' f) $! foldl' f b pr) m) sf
+        foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
+        foldlDigit' f b t = foldl' f b t
+        foldlNode' :: (b -> a -> b) -> b -> Node a -> b
+        foldlNode' f b t = foldl' f b t
+    {-# INLINE foldl' #-}
 #endif
 
     foldr1 _ EmptyT = error "foldr1: empty sequence"

From c740b07091eff2166f2401302a0e231b44cc9795 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 14:44:11 +0000
Subject: [PATCH 04/16] push foldMap improvements down into fingertree

---
 Data/Sequence/Internal.hs | 60 +++++++++++++++++++--------------------
 1 file changed, 29 insertions(+), 31 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 028c38ca0..9b5da41e9 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -386,7 +386,7 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
 #endif
 
 instance Foldable Seq where
-    foldMap f' (Seq xs') = foldMapTreeE (lift_elem f') xs'
+    foldMap f' (Seq xs') = foldMap (lift_elem f') xs'
       where
         lift_elem :: (a -> m) -> (Elem a -> m)
 #if __GLASGOW_HASKELL__ >= 708
@@ -395,33 +395,6 @@ instance Foldable Seq where
         lift_elem g = \(Elem a) -> g a
 #endif
         {-# INLINE lift_elem #-}
-        foldMapTreeE :: Monoid m => (Elem a -> m) -> FingerTree (Elem a) -> m
-        foldMapTreeE _ EmptyT = mempty
-        foldMapTreeE f (Single xs) = f xs
-        foldMapTreeE f (Deep _ pr m sf) = 
-            foldMapDigitE f pr <>
-            foldMapTreeN (foldMapNodeE f) m <>
-            foldMapDigitE f sf
-
-        foldMapTreeN :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
-        foldMapTreeN _ EmptyT = mempty
-        foldMapTreeN f (Single xs) = f xs
-        foldMapTreeN f (Deep _ pr m sf) = 
-            foldMapDigitN f pr <>
-            foldMapTreeN (foldMapNodeN f) m <>
-            foldMapDigitN f sf
-
-        foldMapDigitE :: Monoid m => (Elem a -> m) -> Digit (Elem a) -> m
-        foldMapDigitE f t = foldDigit (<>) f t
-
-        foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
-        foldMapDigitN f t = foldDigit (<>) f t
-
-        foldMapNodeE :: Monoid m => (Elem a -> m) -> Node (Elem a) -> m
-        foldMapNodeE f t = foldNode (<>) f t
-
-        foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
-        foldMapNodeN f t = foldNode (<>) f t
 #if __GLASGOW_HASKELL__
     {-# INLINABLE foldMap #-}
 #endif
@@ -942,9 +915,34 @@ instance Sized a => Sized (FingerTree a) where
 
 instance Foldable FingerTree where
     foldMap _ EmptyT = mempty
-    foldMap f (Single x) = f x
-    foldMap f (Deep _ pr m sf) =
-        foldMap f pr <> foldMap (foldMap f) m <> foldMap f sf
+    foldMap f (Single xs) = f xs
+    foldMap f (Deep _ pr m sf) = 
+        foldMapDigit f pr <>
+        foldMapTree (foldMapNode f) m <>
+        foldMapDigit f sf
+      where
+        foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
+        foldMapTree _ EmptyT = mempty
+        foldMapTree f (Single xs) = f xs
+        foldMapTree f (Deep _ pr m sf) = 
+            foldMapDigitN f pr <>
+            foldMapTree (foldMapNodeN f) m <>
+            foldMapDigitN f sf
+
+        foldMapDigit :: Monoid m => (a -> m) -> Digit a -> m
+        foldMapDigit f t = foldDigit (<>) f t
+
+        foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
+        foldMapDigitN f t = foldDigit (<>) f t
+
+        foldMapNode :: Monoid m => (a -> m) -> Node a -> m
+        foldMapNode f t = foldNode (<>) f t
+
+        foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
+        foldMapNodeN f t = foldNode (<>) f t
+#if __GLASGOW_HASKELL__
+    {-# INLINABLE foldMap #-}
+#endif
 
     foldr _ z EmptyT = z
     foldr f z (Single x) = x `f` z

From d46a11931a05f916a3f636f1121de109be48207e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 15:02:55 +0000
Subject: [PATCH 05/16] much quicker foldr

---
 Data/Sequence/Internal.hs | 51 +++++++++++++++++++++++++++------------
 1 file changed, 35 insertions(+), 16 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 9b5da41e9..7a91de904 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -385,28 +385,25 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
  #-}
 #endif
 
-instance Foldable Seq where
-    foldMap f' (Seq xs') = foldMap (lift_elem f') xs'
-      where
-        lift_elem :: (a -> m) -> (Elem a -> m)
 #if __GLASGOW_HASKELL__ >= 708
-        lift_elem = coerce
+(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
+(.#) f _ = coerce f
 #else
-        lift_elem g = \(Elem a) -> g a
+(.#) :: (b -> c) -> (a -> b) -> a -> c
+(.#) f g = \x -> f (g x)
 #endif
-        {-# INLINE lift_elem #-}
+{-# INLINE (.#) #-}
+infixr 9 .#
+
+instance Foldable Seq where
+    foldMap f' (Seq xs') = foldMap (f' .# getElem) xs'
 #if __GLASGOW_HASKELL__
     {-# INLINABLE foldMap #-}
 #endif
-
-#if __GLASGOW_HASKELL__ >= 708
-    foldr f z (Seq xs) = foldr (coerce f) z xs
-    foldr' f z (Seq xs) = foldr' (coerce f) z xs
-#else
-    foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
+    foldr f z (Seq xs) = foldr (f .# getElem) z xs
+    {-# INLINE foldr #-}
 #if MIN_VERSION_base(4,6,0)
-    foldr' f z (Seq xs) = foldr' (flip (foldr' f)) z xs
-#endif
+    foldr' f z (Seq xs) = foldr' (f .# getElem) z xs
 #endif
     foldl f z (Seq xs) = foldl (foldl f) z xs
 #if MIN_VERSION_base(4,6,0)
@@ -947,7 +944,27 @@ instance Foldable FingerTree where
     foldr _ z EmptyT = z
     foldr f z (Single x) = x `f` z
     foldr f z (Deep _ pr m sf) =
-        foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr
+        foldrDigit f (foldrTree (foldrNode f) (foldrDigit f z sf) m) pr
+      where
+        foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
+        foldrTree _ z EmptyT = z
+        foldrTree f z (Single x) = x `f` z
+        foldrTree f z (Deep _ pr m sf) =
+            foldrDigitN f (foldrTree (foldrNodeN f) (foldrDigitN f z sf) m) pr
+
+        foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
+        foldrDigit f b t = foldr f b t
+
+        foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
+        foldrDigitN f b t = foldr f b t
+
+        foldrNode :: (a -> b -> b) -> Node a -> b -> b
+        foldrNode f t b = foldr f b t
+
+        foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
+        foldrNodeN f t b = foldr f b t
+    {-# INLINE foldr #-}
+
 
     foldl _ z EmptyT = z
     foldl f z (Single x) = z `f` x
@@ -1050,6 +1067,7 @@ instance Foldable Digit where
     foldr f z (Two a b) = a `f` (b `f` z)
     foldr f z (Three a b c) = a `f` (b `f` (c `f` z))
     foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
+    {-# INLINE foldr #-}
 
     foldl f z (One a) = z `f` a
     foldl f z (Two a b) = (z `f` a) `f` b
@@ -1138,6 +1156,7 @@ instance Foldable Node where
 
     foldr f z (Node2 _ a b) = a `f` (b `f` z)
     foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
+    {-# INLINE foldr #-}
 
     foldl f z (Node2 _ a b) = (z `f` a) `f` b
     foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c

From 4650953e079308ae90d91121817d26f8e2b9571a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 15:22:07 +0000
Subject: [PATCH 06/16] strictness matching list

---
 Data/Sequence/Internal.hs | 33 +++++++++++++++++++--------------
 1 file changed, 19 insertions(+), 14 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 7a91de904..6d1685154 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -396,15 +396,18 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
 infixr 9 .#
 
 instance Foldable Seq where
-    foldMap f' (Seq xs') = foldMap (f' .# getElem) xs'
+    foldMap f (Seq xs) = foldMap (f .# getElem) xs
 #if __GLASGOW_HASKELL__
     {-# INLINABLE foldMap #-}
 #endif
+
     foldr f z (Seq xs) = foldr (f .# getElem) z xs
     {-# INLINE foldr #-}
+
 #if MIN_VERSION_base(4,6,0)
     foldr' f z (Seq xs) = foldr' (f .# getElem) z xs
 #endif
+
     foldl f z (Seq xs) = foldl (foldl f) z xs
 #if MIN_VERSION_base(4,6,0)
     {-# INLINE foldl' #-}
@@ -973,7 +976,7 @@ instance Foldable FingerTree where
 
 #if MIN_VERSION_base(4,6,0)
     foldr' _ z EmptyT = z
-    foldr' f z (Single x) = f x z
+    foldr' f z (Single x) = f x $! z
     foldr' f z (Deep _ pr m sf) = foldr' f mres pr
       where
         !sfRes = foldr' f z sf
@@ -991,8 +994,10 @@ instance Foldable FingerTree where
         foldlTree' f b (Single xs) = f b xs
         foldlTree' f b (Deep _ pr m sf) =
             (foldl' f $! (foldlTree' (foldl' f) $! foldl' f b pr) m) sf
+
         foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
         foldlDigit' f b t = foldl' f b t
+
         foldlNode' :: (b -> a -> b) -> b -> Node a -> b
         foldlNode' f b t = foldl' f b t
     {-# INLINE foldl' #-}
@@ -1075,15 +1080,15 @@ instance Foldable Digit where
     foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
 
 #if MIN_VERSION_base(4,6,0)
-    foldr' f z (One a) = a `f` z
-    foldr' f z (Two a b) = f a $! f b z
-    foldr' f z (Three a b c) = f a $! f b $! f c z
-    foldr' f z (Four a b c d) = f a $! f b $! f c $! f d z
-
-    foldl' f z (One a) = f z a
-    foldl' f z (Two a b) = (f $! f z a) b
-    foldl' f z (Three a b c) = (f $! (f $! f z a) b) c
-    foldl' f z (Four a b c d) = (f $! (f $! (f $! f z a) b) c) d
+    foldr' f z (One a) = f a $! z
+    foldr' f z (Two a b) = f a $! f b $! z
+    foldr' f z (Three a b c) = f a $! f b $! f c $! z
+    foldr' f z (Four a b c d) = f a $! f b $! f c $! f d $! z
+
+    foldl' f z (One a) = (f $! z) a
+    foldl' f z (Two a b) = (f $! (f $! z) a) b
+    foldl' f z (Three a b c) = (f $! (f $! (f $! z) a) b) c
+    foldl' f z (Four a b c d) = (f $! (f $! (f $! (f $! z) a) b) c) d
     {-# INLINE foldl' #-}
 #endif
 
@@ -1162,11 +1167,11 @@ instance Foldable Node where
     foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
 
 #if MIN_VERSION_base(4,6,0)
-    foldr' f z (Node2 _ a b) = f a $! f b z
+    foldr' f z (Node2 _ a b) = f a $! f b $! z
     foldr' f z (Node3 _ a b c) = f a $! f b $! f c z
 
-    foldl' f z (Node2 _ a b) = (f $! f z a) b
-    foldl' f z (Node3 _ a b c) = (f $! (f $! f z a) b) c
+    foldl' f z (Node2 _ a b) = (f $! (f $! z) a) b
+    foldl' f z (Node3 _ a b c) = (f $! (f $! (f $! z) a) b) c
     {-# INLINE foldl' #-}
 #endif
 

From 81f23dabfd57304f4d4ed67f06c819913ef7432f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 18:32:20 +0000
Subject: [PATCH 07/16] more folds optimised

---
 Data/Sequence/Internal.hs | 82 +++++++++++++++++++++++++++++++--------
 1 file changed, 66 insertions(+), 16 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 6d1685154..1c8cd5deb 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -395,23 +395,30 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
 {-# INLINE (.#) #-}
 infixr 9 .#
 
+getSeq :: Seq a -> FingerTree (Elem a)
+getSeq (Seq xs) = xs
+
 instance Foldable Seq where
-    foldMap f (Seq xs) = foldMap (f .# getElem) xs
-#if __GLASGOW_HASKELL__
-    {-# INLINABLE foldMap #-}
+    foldMap f = foldMap (f .# getElem) .# getSeq
+    foldr f z = foldr (f .# getElem) z .# getSeq
+    foldl f z = foldl (lift_elem f) z .# getSeq
+      where
+        lift_elem :: (b -> a -> b) -> b -> Elem a -> b
+#if __GLASGOW_HASKELL__ >= 708
+        lift_elem = coerce
+#else
+        lift_elem g = \bs (Elem a) -> g bs a
 #endif
 
-    foldr f z (Seq xs) = foldr (f .# getElem) z xs
-    {-# INLINE foldr #-}
-
-#if MIN_VERSION_base(4,6,0)
-    foldr' f z (Seq xs) = foldr' (f .# getElem) z xs
+#if __GLASGOW_HASKELL__
+    {-# INLINABLE foldMap #-}
+    {-# INLINABLE foldr #-}
+    {-# INLINABLE foldl #-}
 #endif
 
-    foldl f z (Seq xs) = foldl (foldl f) z xs
 #if MIN_VERSION_base(4,6,0)
-    {-# INLINE foldl' #-}
-    foldl' f z (Seq xs) = foldl' (lift_elem f) z xs
+    foldr' f z = foldr' (f .# getElem) z .# getSeq
+    foldl' f z = foldl' (lift_elem f) z .# getSeq
       where
         lift_elem :: (b -> a -> b) -> b -> Elem a -> b
 #if __GLASGOW_HASKELL__ >= 708
@@ -419,7 +426,12 @@ instance Foldable Seq where
 #else
         lift_elem g = \bs (Elem a) -> g bs a
 #endif
-        {-# INLINE lift_elem #-}
+
+#if __GLASGOW_HASKELL__
+    {-# INLINABLE foldr' #-}
+    {-# INLINABLE foldl' #-}
+#endif
+
 #endif
 
     foldr1 f (Seq xs) = getElem (foldr1 f' xs)
@@ -972,15 +984,49 @@ instance Foldable FingerTree where
     foldl _ z EmptyT = z
     foldl f z (Single x) = z `f` x
     foldl f z (Deep _ pr m sf) =
-        foldl f (foldl (foldl f) (foldl f z pr) m) sf
+        foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
+      where
+        foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
+        foldlTree _ z EmptyT = z
+        foldlTree f z (Single x) = z `f` x
+        foldlTree f z (Deep _ pr m sf) =
+            foldlDigitN f (foldlTree (foldlNodeN f) (foldlDigitN f z pr) m) sf
+
+        foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
+        foldlDigit f b t = foldl f b t
+
+        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
+        foldlDigitN f b t = foldl f b t
+
+        foldlNode :: (b -> a -> b) -> b -> Node a -> b
+        foldlNode f b t = foldl f b t
+
+        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
+        foldlNodeN f b t = foldl f b t
+    {-# INLINE foldl #-}
+
 
 #if MIN_VERSION_base(4,6,0)
     foldr' _ z EmptyT = z
     foldr' f z (Single x) = f x $! z
-    foldr' f z (Deep _ pr m sf) = foldr' f mres pr
+    foldr' f z (Deep _ pr m sf) =
+        (foldrDigit' f $! (foldrTree' (foldrNode' f) $! (foldrDigit' f $! z) sf) m) pr
       where
-        !sfRes = foldr' f z sf
-        !mres = foldr' (flip (foldr' f)) sfRes m
+        foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
+        foldrTree' _ z EmptyT = z
+        foldrTree' f z (Single x) = f x $! z
+        foldrTree' f z (Deep _ pr m sf) =
+            (foldr' f $! (foldrTree' (foldrNodeN' f) $! (foldr' f $! z) sf) m) pr
+
+        foldrDigit' :: (a -> b -> b) -> b -> Digit a -> b
+        foldrDigit' f b t = foldr' f b t
+
+        foldrNode' :: (a -> b -> b) -> Node a -> b -> b
+        foldrNode' f t b = foldr' f b t
+
+        foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
+        foldrNodeN' f t b = foldr' f b t
+    {-# INLINE foldr' #-}
 
     foldl' _ b EmptyT = b
     foldl' f b (Single xs) = (f $! b) xs
@@ -1078,12 +1124,14 @@ instance Foldable Digit where
     foldl f z (Two a b) = (z `f` a) `f` b
     foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c
     foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
+    {-# INLINE foldl #-}
 
 #if MIN_VERSION_base(4,6,0)
     foldr' f z (One a) = f a $! z
     foldr' f z (Two a b) = f a $! f b $! z
     foldr' f z (Three a b c) = f a $! f b $! f c $! z
     foldr' f z (Four a b c d) = f a $! f b $! f c $! f d $! z
+    {-# INLINE foldr' #-}
 
     foldl' f z (One a) = (f $! z) a
     foldl' f z (Two a b) = (f $! (f $! z) a) b
@@ -1165,10 +1213,12 @@ instance Foldable Node where
 
     foldl f z (Node2 _ a b) = (z `f` a) `f` b
     foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
+    {-# INLINE foldl #-}
 
 #if MIN_VERSION_base(4,6,0)
     foldr' f z (Node2 _ a b) = f a $! f b $! z
     foldr' f z (Node3 _ a b c) = f a $! f b $! f c z
+    {-# INLINE foldr' #-}
 
     foldl' f z (Node2 _ a b) = (f $! (f $! z) a) b
     foldl' f z (Node3 _ a b c) = (f $! (f $! (f $! z) a) b) c

From d4fd071131f17ee3d433aff15f020c1a18de36ae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 19:52:50 +0000
Subject: [PATCH 08/16] name shadowing warnings

---
 Data/Sequence/Internal.hs | 32 ++++++++++++++++----------------
 benchmarks/Sequence.hs    | 16 ++++++++--------
 2 files changed, 24 insertions(+), 24 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 1c8cd5deb..b3440c841 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -927,11 +927,11 @@ instance Sized a => Sized (FingerTree a) where
 
 instance Foldable FingerTree where
     foldMap _ EmptyT = mempty
-    foldMap f (Single xs) = f xs
-    foldMap f (Deep _ pr m sf) = 
-        foldMapDigit f pr <>
-        foldMapTree (foldMapNode f) m <>
-        foldMapDigit f sf
+    foldMap f' (Single xs) = f' xs
+    foldMap f' (Deep _ pr' m' sf') = 
+        foldMapDigit f' pr' <>
+        foldMapTree (foldMapNode f') m' <>
+        foldMapDigit f' sf'
       where
         foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
         foldMapTree _ EmptyT = mempty
@@ -957,9 +957,9 @@ instance Foldable FingerTree where
 #endif
 
     foldr _ z EmptyT = z
-    foldr f z (Single x) = x `f` z
-    foldr f z (Deep _ pr m sf) =
-        foldrDigit f (foldrTree (foldrNode f) (foldrDigit f z sf) m) pr
+    foldr f' z' (Single x) = f' x z'
+    foldr f' z' (Deep _ pr' m' sf') =
+        foldrDigit f' (foldrTree (foldrNode f') (foldrDigit f' z' sf') m') pr'
       where
         foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
         foldrTree _ z EmptyT = z
@@ -983,8 +983,8 @@ instance Foldable FingerTree where
 
     foldl _ z EmptyT = z
     foldl f z (Single x) = z `f` x
-    foldl f z (Deep _ pr m sf) =
-        foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
+    foldl f' z' (Deep _ pr' m' sf') =
+        foldlDigit f' (foldlTree (foldlNode f') (foldlDigit f' z' pr') m') sf'
       where
         foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
         foldlTree _ z EmptyT = z
@@ -1009,8 +1009,8 @@ instance Foldable FingerTree where
 #if MIN_VERSION_base(4,6,0)
     foldr' _ z EmptyT = z
     foldr' f z (Single x) = f x $! z
-    foldr' f z (Deep _ pr m sf) =
-        (foldrDigit' f $! (foldrTree' (foldrNode' f) $! (foldrDigit' f $! z) sf) m) pr
+    foldr' f' z' (Deep _ pr' m' sf') =
+        (foldrDigit' f' $! (foldrTree' (foldrNode' f') $! (foldrDigit' f' $! z') sf') m') pr'
       where
         foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
         foldrTree' _ z EmptyT = z
@@ -1030,10 +1030,10 @@ instance Foldable FingerTree where
 
     foldl' _ b EmptyT = b
     foldl' f b (Single xs) = (f $! b) xs
-    foldl' f b (Deep _ pr m sf) =
-        (foldlDigit' f $!
-         (foldlTree' (foldlNode' f) $! (foldlDigit' f $! b) pr) m)
-            sf
+    foldl' f' b' (Deep _ pr' m' sf') =
+        (foldlDigit' f' $!
+         (foldlTree' (foldlNode' f') $! (foldlDigit' f' $! b') pr') m')
+            sf'
       where
         foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
         foldlTree' _ b EmptyT = b
diff --git a/benchmarks/Sequence.hs b/benchmarks/Sequence.hs
index 1fc930f0e..50ac9fdaa 100644
--- a/benchmarks/Sequence.hs
+++ b/benchmarks/Sequence.hs
@@ -159,15 +159,15 @@ main = do
          ]
       , bgroup "unstableSortOn"
          [ bgroup "already sorted"
-            [ bench "10" $ nf S.unstableSortOn id s10
-            , bench "100" $ nf S.unstableSortOn id s100
-            , bench "1000" $ nf S.unstableSortOn id s1000
-            , bench "10000" $ nf S.unstableSortOn id s10000]
+            [ bench "10"    $ nf (S.unstableSortOn id) s10
+            , bench "100"   $ nf (S.unstableSortOn id) s100
+            , bench "1000"  $ nf (S.unstableSortOn id) s1000
+            , bench "10000" $ nf (S.unstableSortOn id) s10000]
          , bgroup "random"
-            [ bench "10" $ nf S.unstableSortOn id rs10
-            , bench "100" $ nf S.unstableSortOn id rs100
-            , bench "1000" $ nf S.unstableSortOn id rs1000
-            , bench "10000" $ nf S.unstableSortOn id rs10000]
+            [ bench "10"    $ nf (S.unstableSortOn id) rs10
+            , bench "100"   $ nf (S.unstableSortOn id) rs100
+            , bench "1000"  $ nf (S.unstableSortOn id) rs1000
+            , bench "10000" $ nf (S.unstableSortOn id) rs10000]
          ]
       ]
 

From fc4b4151c620da4acf9de6b6ef219df555c00b81 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 21:24:54 +0000
Subject: [PATCH 09/16] put coercions in their own module

---
 Data/Sequence/Internal.hs              | 11 +----------
 Utils/Containers/Internal/Coercions.hs | 24 ++++++++++++++++++++++++
 containers.cabal                       |  1 +
 3 files changed, 26 insertions(+), 10 deletions(-)
 create mode 100644 Utils/Containers/Internal/Coercions.hs

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index b3440c841..c2fab3532 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -248,6 +248,7 @@ import qualified Data.Array
 import qualified GHC.Arr
 #endif
 
+import Utils.Containers.Internal.Coercions ((.#))
 -- Coercion on GHC 7.8+
 #if __GLASGOW_HASKELL__ >= 708
 import Data.Coerce
@@ -385,16 +386,6 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
  #-}
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
-(.#) f _ = coerce f
-#else
-(.#) :: (b -> c) -> (a -> b) -> a -> c
-(.#) f g = \x -> f (g x)
-#endif
-{-# INLINE (.#) #-}
-infixr 9 .#
-
 getSeq :: Seq a -> FingerTree (Elem a)
 getSeq (Seq xs) = xs
 
diff --git a/Utils/Containers/Internal/Coercions.hs b/Utils/Containers/Internal/Coercions.hs
new file mode 100644
index 000000000..bc2428d93
--- /dev/null
+++ b/Utils/Containers/Internal/Coercions.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE CPP #-}
+
+#include "containers.h"
+
+module Utils.Containers.Internal.Coercions where
+
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Coerce
+#endif
+
+infixr 9 .#, #.
+#if __GLASGOW_HASKELL__ >= 708
+(.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c
+(.#) f _ = coerce f
+(#.) :: Coercible c b => (b -> c) -> (a -> b) -> a -> c
+(#.) _ = coerce
+#else
+(.#) :: (b -> c) -> (a -> b) -> a -> c
+(.#) = (.)
+(#.) :: (b -> c) -> (a -> b) -> a -> c
+(#.) = (.)
+#endif
+{-# INLINE (.#) #-}
+{-# INLINE (#.) #-}
diff --git a/containers.cabal b/containers.cabal
index bb7554994..ec6b6ee5f 100644
--- a/containers.cabal
+++ b/containers.cabal
@@ -84,6 +84,7 @@ Library
         Utils.Containers.Internal.StrictFold
         Utils.Containers.Internal.StrictMaybe
         Utils.Containers.Internal.PtrEquality
+        Utils.Containers.Internal.Coercions
         Data.Map.Internal.DeprecatedShowTree
         Data.IntMap.Internal.DeprecatedDebug
 

From 6f69209ad8e6584a54c8a5cb90f7072207c02606 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 22:24:41 +0000
Subject: [PATCH 10/16] added hide pragma to coercions module

---
 Utils/Containers/Internal/Coercions.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/Utils/Containers/Internal/Coercions.hs b/Utils/Containers/Internal/Coercions.hs
index bc2428d93..9fcc7798a 100644
--- a/Utils/Containers/Internal/Coercions.hs
+++ b/Utils/Containers/Internal/Coercions.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_HADDOCK hide #-}
 
 #include "containers.h"
 

From 7e249f10d72d25b5669cf2d3c503c41c0e390f2e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 23:40:30 +0000
Subject: [PATCH 11/16] consistent naming

---
 Data/Sequence/Internal.hs | 58 +++++++++++++++++++--------------------
 1 file changed, 29 insertions(+), 29 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index c2fab3532..c3040184f 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -918,7 +918,7 @@ instance Sized a => Sized (FingerTree a) where
 
 instance Foldable FingerTree where
     foldMap _ EmptyT = mempty
-    foldMap f' (Single xs) = f' xs
+    foldMap f' (Single x') = f' x'
     foldMap f' (Deep _ pr' m' sf') = 
         foldMapDigit f' pr' <>
         foldMapTree (foldMapNode f') m' <>
@@ -926,7 +926,7 @@ instance Foldable FingerTree where
       where
         foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
         foldMapTree _ EmptyT = mempty
-        foldMapTree f (Single xs) = f xs
+        foldMapTree f (Single x) = f x
         foldMapTree f (Deep _ pr m sf) = 
             foldMapDigitN f pr <>
             foldMapTree (foldMapNodeN f) m <>
@@ -947,8 +947,8 @@ instance Foldable FingerTree where
     {-# INLINABLE foldMap #-}
 #endif
 
-    foldr _ z EmptyT = z
-    foldr f' z' (Single x) = f' x z'
+    foldr _ z' EmptyT = z'
+    foldr f' z' (Single x') = x' `f'` z'
     foldr f' z' (Deep _ pr' m' sf') =
         foldrDigit f' (foldrTree (foldrNode f') (foldrDigit f' z' sf') m') pr'
       where
@@ -959,21 +959,21 @@ instance Foldable FingerTree where
             foldrDigitN f (foldrTree (foldrNodeN f) (foldrDigitN f z sf) m) pr
 
         foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
-        foldrDigit f b t = foldr f b t
+        foldrDigit f z t = foldr f z t
 
         foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
-        foldrDigitN f b t = foldr f b t
+        foldrDigitN f z t = foldr f z t
 
         foldrNode :: (a -> b -> b) -> Node a -> b -> b
-        foldrNode f t b = foldr f b t
+        foldrNode f t z = foldr f z t
 
         foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
-        foldrNodeN f t b = foldr f b t
+        foldrNodeN f t z = foldr f z t
     {-# INLINE foldr #-}
 
 
-    foldl _ z EmptyT = z
-    foldl f z (Single x) = z `f` x
+    foldl _ z' EmptyT = z'
+    foldl f' z' (Single x') = z' `f'` x'
     foldl f' z' (Deep _ pr' m' sf') =
         foldlDigit f' (foldlTree (foldlNode f') (foldlDigit f' z' pr') m') sf'
       where
@@ -984,22 +984,22 @@ instance Foldable FingerTree where
             foldlDigitN f (foldlTree (foldlNodeN f) (foldlDigitN f z pr) m) sf
 
         foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
-        foldlDigit f b t = foldl f b t
+        foldlDigit f z t = foldl f z t
 
         foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
-        foldlDigitN f b t = foldl f b t
+        foldlDigitN f z t = foldl f z t
 
         foldlNode :: (b -> a -> b) -> b -> Node a -> b
-        foldlNode f b t = foldl f b t
+        foldlNode f z t = foldl f z t
 
         foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
-        foldlNodeN f b t = foldl f b t
+        foldlNodeN f z t = foldl f z t
     {-# INLINE foldl #-}
 
 
 #if MIN_VERSION_base(4,6,0)
-    foldr' _ z EmptyT = z
-    foldr' f z (Single x) = f x $! z
+    foldr' _ z' EmptyT = z'
+    foldr' f' z' (Single x') = f' x' $! z'
     foldr' f' z' (Deep _ pr' m' sf') =
         (foldrDigit' f' $! (foldrTree' (foldrNode' f') $! (foldrDigit' f' $! z') sf') m') pr'
       where
@@ -1010,33 +1010,33 @@ instance Foldable FingerTree where
             (foldr' f $! (foldrTree' (foldrNodeN' f) $! (foldr' f $! z) sf) m) pr
 
         foldrDigit' :: (a -> b -> b) -> b -> Digit a -> b
-        foldrDigit' f b t = foldr' f b t
+        foldrDigit' f z t = foldr' f z t
 
         foldrNode' :: (a -> b -> b) -> Node a -> b -> b
-        foldrNode' f t b = foldr' f b t
+        foldrNode' f t z = foldr' f z t
 
         foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
-        foldrNodeN' f t b = foldr' f b t
+        foldrNodeN' f t z = foldr' f z t
     {-# INLINE foldr' #-}
 
-    foldl' _ b EmptyT = b
-    foldl' f b (Single xs) = (f $! b) xs
-    foldl' f' b' (Deep _ pr' m' sf') =
+    foldl' _ z' EmptyT = z'
+    foldl' f' z' (Single x') = (f' $! z') x'
+    foldl' f' z' (Deep _ pr' m' sf') =
         (foldlDigit' f' $!
-         (foldlTree' (foldlNode' f') $! (foldlDigit' f' $! b') pr') m')
+         (foldlTree' (foldlNode' f') $! (foldlDigit' f' $! z') pr') m')
             sf'
       where
         foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
-        foldlTree' _ b EmptyT = b
-        foldlTree' f b (Single xs) = f b xs
-        foldlTree' f b (Deep _ pr m sf) =
-            (foldl' f $! (foldlTree' (foldl' f) $! foldl' f b pr) m) sf
+        foldlTree' _ z EmptyT = z
+        foldlTree' f z (Single xs) = f z xs
+        foldlTree' f z (Deep _ pr m sf) =
+            (foldl' f $! (foldlTree' (foldl' f) $! foldl' f z pr) m) sf
 
         foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
-        foldlDigit' f b t = foldl' f b t
+        foldlDigit' f z t = foldl' f z t
 
         foldlNode' :: (b -> a -> b) -> b -> Node a -> b
-        foldlNode' f b t = foldl' f b t
+        foldlNode' f z t = foldl' f z t
     {-# INLINE foldl' #-}
 #endif
 

From 580556febc99ae67ae7b7fa80480e42dd4b04ebe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 23:42:47 +0000
Subject: [PATCH 12/16] removed coersion that was causing trouble on GHC 7.8.
 (it's not being used anyway)

---
 Utils/Containers/Internal/Coercions.hs | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/Utils/Containers/Internal/Coercions.hs b/Utils/Containers/Internal/Coercions.hs
index 9fcc7798a..24e565013 100644
--- a/Utils/Containers/Internal/Coercions.hs
+++ b/Utils/Containers/Internal/Coercions.hs
@@ -9,17 +9,12 @@ module Utils.Containers.Internal.Coercions where
 import Data.Coerce
 #endif
 
-infixr 9 .#, #.
+infixr 9 .#
 #if __GLASGOW_HASKELL__ >= 708
 (.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c
 (.#) f _ = coerce f
-(#.) :: Coercible c b => (b -> c) -> (a -> b) -> a -> c
-(#.) _ = coerce
 #else
 (.#) :: (b -> c) -> (a -> b) -> a -> c
 (.#) = (.)
-(#.) :: (b -> c) -> (a -> b) -> a -> c
-(#.) = (.)
 #endif
 {-# INLINE (.#) #-}
-{-# INLINE (#.) #-}

From c295491d940908029daab684a74339ce0a2a6896 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 23:44:13 +0000
Subject: [PATCH 13/16] updated fixity of (.#) tomatch Data.Profunctor.Unsafe

---
 Utils/Containers/Internal/Coercions.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Utils/Containers/Internal/Coercions.hs b/Utils/Containers/Internal/Coercions.hs
index 24e565013..752c3f120 100644
--- a/Utils/Containers/Internal/Coercions.hs
+++ b/Utils/Containers/Internal/Coercions.hs
@@ -9,7 +9,7 @@ module Utils.Containers.Internal.Coercions where
 import Data.Coerce
 #endif
 
-infixr 9 .#
+infixl 8 .#
 #if __GLASGOW_HASKELL__ >= 708
 (.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c
 (.#) f _ = coerce f

From f999e9a1816a1156e0a8f1174ff882dec4de384f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Tue, 23 Jan 2018 23:53:55 +0000
Subject: [PATCH 14/16] added coercion operator that can be used in foldl

---
 Data/Sequence/Internal.hs              | 20 +++-----------------
 Utils/Containers/Internal/Coercions.hs | 24 ++++++++++++++++++++++++
 2 files changed, 27 insertions(+), 17 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index c3040184f..2eb41a94b 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -248,7 +248,7 @@ import qualified Data.Array
 import qualified GHC.Arr
 #endif
 
-import Utils.Containers.Internal.Coercions ((.#))
+import Utils.Containers.Internal.Coercions ((.#), (.^#))
 -- Coercion on GHC 7.8+
 #if __GLASGOW_HASKELL__ >= 708
 import Data.Coerce
@@ -392,14 +392,7 @@ getSeq (Seq xs) = xs
 instance Foldable Seq where
     foldMap f = foldMap (f .# getElem) .# getSeq
     foldr f z = foldr (f .# getElem) z .# getSeq
-    foldl f z = foldl (lift_elem f) z .# getSeq
-      where
-        lift_elem :: (b -> a -> b) -> b -> Elem a -> b
-#if __GLASGOW_HASKELL__ >= 708
-        lift_elem = coerce
-#else
-        lift_elem g = \bs (Elem a) -> g bs a
-#endif
+    foldl f z = foldl (f .^# getElem) z .# getSeq
 
 #if __GLASGOW_HASKELL__
     {-# INLINABLE foldMap #-}
@@ -409,14 +402,7 @@ instance Foldable Seq where
 
 #if MIN_VERSION_base(4,6,0)
     foldr' f z = foldr' (f .# getElem) z .# getSeq
-    foldl' f z = foldl' (lift_elem f) z .# getSeq
-      where
-        lift_elem :: (b -> a -> b) -> b -> Elem a -> b
-#if __GLASGOW_HASKELL__ >= 708
-        lift_elem = coerce
-#else
-        lift_elem g = \bs (Elem a) -> g bs a
-#endif
+    foldl' f z = foldl' (f .^# getElem) z .# getSeq
 
 #if __GLASGOW_HASKELL__
     {-# INLINABLE foldr' #-}
diff --git a/Utils/Containers/Internal/Coercions.hs b/Utils/Containers/Internal/Coercions.hs
index 752c3f120..6d76eaf2b 100644
--- a/Utils/Containers/Internal/Coercions.hs
+++ b/Utils/Containers/Internal/Coercions.hs
@@ -18,3 +18,27 @@ infixl 8 .#
 (.#) = (.)
 #endif
 {-# INLINE (.#) #-}
+
+infix 9 .^#
+
+-- | Coerce the second argument of a function. Conceptually,
+-- can be thought of as:
+--
+-- @
+--   (f .^# g) x y = f x (g y)
+-- @
+--
+-- However it is most useful when coercing the arguments to
+-- 'foldl':
+--
+-- @
+--   foldl f b . fmap g = foldl (f .^# g) b
+-- @
+#if __GLASGOW_HASKELL__ >= 708
+(.^#) :: Coercible c b => (a -> c -> d) -> (b -> c) -> (a -> b -> d)
+(.^#) f _ = coerce f
+#else
+(.^#) :: (a -> c -> d) -> (b -> c) -> (a -> b -> d)
+(f .^# g) x y = f x (g y)
+#endif
+{-# INLINE (.^#) #-}

From 0117e13a78ea802d8c7f9f5cc117a6e7bd59add1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Wed, 24 Jan 2018 19:04:26 +0000
Subject: [PATCH 15/16] back to the old strictness

---
 Data/Sequence/Internal.hs | 30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 2eb41a94b..05ce403e1 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -985,9 +985,9 @@ instance Foldable FingerTree where
 
 #if MIN_VERSION_base(4,6,0)
     foldr' _ z' EmptyT = z'
-    foldr' f' z' (Single x') = f' x' $! z'
+    foldr' f' z' (Single x') = f' x' z'
     foldr' f' z' (Deep _ pr' m' sf') =
-        (foldrDigit' f' $! (foldrTree' (foldrNode' f') $! (foldrDigit' f' $! z') sf') m') pr'
+        (foldrDigit' f' $! (foldrTree' (foldrNode' f') $! (foldrDigit' f' z') sf') m') pr'
       where
         foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
         foldrTree' _ z EmptyT = z
@@ -1006,10 +1006,10 @@ instance Foldable FingerTree where
     {-# INLINE foldr' #-}
 
     foldl' _ z' EmptyT = z'
-    foldl' f' z' (Single x') = (f' $! z') x'
+    foldl' f' z' (Single x') = f' z' x'
     foldl' f' z' (Deep _ pr' m' sf') =
         (foldlDigit' f' $!
-         (foldlTree' (foldlNode' f') $! (foldlDigit' f' $! z') pr') m')
+         (foldlTree' (foldlNode' f') $! (foldlDigit' f' z') pr') m')
             sf'
       where
         foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
@@ -1104,16 +1104,16 @@ instance Foldable Digit where
     {-# INLINE foldl #-}
 
 #if MIN_VERSION_base(4,6,0)
-    foldr' f z (One a) = f a $! z
-    foldr' f z (Two a b) = f a $! f b $! z
-    foldr' f z (Three a b c) = f a $! f b $! f c $! z
-    foldr' f z (Four a b c d) = f a $! f b $! f c $! f d $! z
+    foldr' f z (One a) = f a z
+    foldr' f z (Two a b) = f a $! f b z
+    foldr' f z (Three a b c) = f a $! f b $! f c z
+    foldr' f z (Four a b c d) = f a $! f b $! f c $! f d z
     {-# INLINE foldr' #-}
 
-    foldl' f z (One a) = (f $! z) a
-    foldl' f z (Two a b) = (f $! (f $! z) a) b
-    foldl' f z (Three a b c) = (f $! (f $! (f $! z) a) b) c
-    foldl' f z (Four a b c d) = (f $! (f $! (f $! (f $! z) a) b) c) d
+    foldl' f z (One a) = f z a
+    foldl' f z (Two a b) = (f $! f z a) b
+    foldl' f z (Three a b c) = (f $! (f $! f z a) b) c
+    foldl' f z (Four a b c d) = (f $! (f $! (f $! f z a) b) c) d
     {-# INLINE foldl' #-}
 #endif
 
@@ -1193,12 +1193,12 @@ instance Foldable Node where
     {-# INLINE foldl #-}
 
 #if MIN_VERSION_base(4,6,0)
-    foldr' f z (Node2 _ a b) = f a $! f b $! z
+    foldr' f z (Node2 _ a b) = f a $! f b z
     foldr' f z (Node3 _ a b c) = f a $! f b $! f c z
     {-# INLINE foldr' #-}
 
-    foldl' f z (Node2 _ a b) = (f $! (f $! z) a) b
-    foldl' f z (Node3 _ a b c) = (f $! (f $! (f $! z) a) b) c
+    foldl' f z (Node2 _ a b) = (f $! f z a) b
+    foldl' f z (Node3 _ a b c) = (f $! (f $! f z a) b) c
     {-# INLINE foldl' #-}
 #endif
 

From 88a2c7544154bb96171d8755f63b39bf643e20c4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Donnacha=20Ois=C3=ADn=20Kidney?= <mail@doisinkidney.com>
Date: Wed, 24 Jan 2018 19:31:16 +0000
Subject: [PATCH 16/16] Added tests for the laziness of foldr' and foldl'

---
 tests/seq-properties.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs
index d420b1b65..828bb2954 100644
--- a/tests/seq-properties.hs
+++ b/tests/seq-properties.hs
@@ -54,9 +54,11 @@ main = defaultMain
        , testProperty "(<$)" prop_constmap
        , testProperty "foldr" prop_foldr
        , testProperty "foldr'" prop_foldr'
+       , testProperty "lazy foldr'" prop_lazyfoldr'
        , testProperty "foldr1" prop_foldr1
        , testProperty "foldl" prop_foldl
        , testProperty "foldl'" prop_foldl'
+       , testProperty "lazy foldl'" prop_lazyfoldl'
        , testProperty "foldl1" prop_foldl1
        , testProperty "(==)" prop_equals
        , testProperty "compare" prop_compare
@@ -306,6 +308,16 @@ prop_foldr' xs =
     f = (:)
     z = []
 
+prop_lazyfoldr' :: Seq () -> Property
+prop_lazyfoldr' xs =
+    not (null xs) ==>
+    foldr'
+        (\e _ ->
+              e)
+        (error "Data.Sequence.foldr': should be lazy in initial accumulator")
+        xs ===
+    ()
+
 prop_foldr1 :: Seq Int -> Property
 prop_foldr1 xs =
     not (null xs) ==> foldr1 f xs == Data.List.foldr1 f (toList xs)
@@ -325,6 +337,16 @@ prop_foldl' xs =
     f = flip (:)
     z = []
 
+prop_lazyfoldl' :: Seq () -> Property
+prop_lazyfoldl' xs =
+    not (null xs) ==>
+    foldl'
+        (\_ e ->
+              e)
+        (error "Data.Sequence.foldl': should be lazy in initial accumulator")
+        xs ===
+    ()
+
 prop_foldl1 :: Seq Int -> Property
 prop_foldl1 xs =
     not (null xs) ==> foldl1 f xs == Data.List.foldl1 f (toList xs)