From 3117213bd977bb19a15a2e07fb416ee92ac25130 Mon Sep 17 00:00:00 2001
From: Soumik Sarkar <soumiksarkar.3120@gmail.com>
Date: Fri, 6 Dec 2024 00:26:26 +0530
Subject: [PATCH] Implement Seq folds as coerced FingerTree folds (#1076)

* foldr1 and foldl1 are now implemented as coercions.
* Other folds were implemented using coercions in a complicated manner,
  which is now simplified. GHC is smart enough to compile these to the
  same Core, so there is no change in runtime behavior.
---
 containers-tests/containers-tests.cabal       |  1 -
 containers/containers.cabal                   |  1 -
 containers/src/Data/Sequence/Internal.hs      | 49 ++++++++++++-------
 .../Utils/Containers/Internal/Coercions.hs    | 44 -----------------
 4 files changed, 30 insertions(+), 65 deletions(-)
 delete mode 100644 containers/src/Utils/Containers/Internal/Coercions.hs

diff --git a/containers-tests/containers-tests.cabal b/containers-tests/containers-tests.cabal
index 1c1e3086d..f88c489c1 100644
--- a/containers-tests/containers-tests.cabal
+++ b/containers-tests/containers-tests.cabal
@@ -116,7 +116,6 @@ library
 
   other-modules:
     Utils.Containers.Internal.Prelude
-    Utils.Containers.Internal.Coercions
     Utils.Containers.Internal.PtrEquality
     Utils.Containers.Internal.State
     Utils.Containers.Internal.StrictMaybe
diff --git a/containers/containers.cabal b/containers/containers.cabal
index 12185a9f5..3f7f43b45 100644
--- a/containers/containers.cabal
+++ b/containers/containers.cabal
@@ -81,7 +81,6 @@ Library
         Utils.Containers.Internal.State
         Utils.Containers.Internal.StrictMaybe
         Utils.Containers.Internal.PtrEquality
-        Utils.Containers.Internal.Coercions
         Utils.Containers.Internal.EqOrdUtil
     if impl(ghc)
       other-modules:
diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index 48f7c47e3..89dae7fa1 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE Trustworthy #-}
@@ -244,8 +245,6 @@ import qualified Data.List
 import Data.Array (Ix, Array)
 import qualified Data.Array
 
-import Utils.Containers.Internal.Coercions ((.#), (.^#))
-
 import Data.Functor.Identity (Identity(..))
 
 import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair)
@@ -395,33 +394,45 @@ fmapSeq f (Seq xs) = Seq (fmap (fmap f) xs)
  #-}
 #endif
 
-getSeq :: Seq a -> FingerTree (Elem a)
-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 (f .^# getElem) z .# getSeq
+#ifdef __GLASGOW_HASKELL__
+    foldMap :: forall m a. Monoid m => (a -> m) -> Seq a -> m
+    foldMap = coerce (foldMap :: (Elem a -> m) -> FingerTree (Elem a) -> m)
 
-#if __GLASGOW_HASKELL__
-    {-# INLINABLE foldMap #-}
-    {-# INLINABLE foldr #-}
-    {-# INLINABLE foldl #-}
-#endif
+    foldr :: forall a b. (a -> b -> b) -> b -> Seq a -> b
+    foldr = coerce (foldr :: (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b)
 
-    foldr' f z = foldr' (f .# getElem) z .# getSeq
-    foldl' f z = foldl' (f .^# getElem) z .# getSeq
+    foldl :: forall b a. (b -> a -> b) -> b -> Seq a -> b
+    foldl = coerce (foldl :: (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b)
 
-#if __GLASGOW_HASKELL__
-    {-# INLINABLE foldr' #-}
-    {-# INLINABLE foldl' #-}
-#endif
+    foldr' :: forall a b. (a -> b -> b) -> b -> Seq a -> b
+    foldr' = coerce (foldr' :: (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b)
+
+    foldl' :: forall b a. (b -> a -> b) -> b -> Seq a -> b
+    foldl' = coerce (foldl' :: (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b)
+
+    foldr1 :: forall a. (a -> a -> a) -> Seq a -> a
+    foldr1 = coerce (foldr1 :: (Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a)
+
+    foldl1 :: forall a. (a -> a -> a) -> Seq a -> a
+    foldl1 = coerce (foldl1 :: (Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a)
+#else
+    foldMap f (Seq xs) = foldMap (f . getElem) xs
+
+    foldr f z (Seq xs) = foldr (f . getElem) z xs
+
+    foldl f z (Seq xs) = foldl (\z' x -> f z' (getElem x)) z xs
+
+    foldr' f z (Seq xs) = foldr' (f . getElem) z xs
+
+    foldl' f z (Seq xs) = foldl' (\z' x -> f z' (getElem x)) z xs
 
     foldr1 f (Seq xs) = getElem (foldr1 f' xs)
       where f' (Elem x) (Elem y) = Elem (f x y)
 
     foldl1 f (Seq xs) = getElem (foldl1 f' xs)
       where f' (Elem x) (Elem y) = Elem (f x y)
+#endif
 
     length = length
     {-# INLINE length #-}
diff --git a/containers/src/Utils/Containers/Internal/Coercions.hs b/containers/src/Utils/Containers/Internal/Coercions.hs
deleted file mode 100644
index 6f1aa26ab..000000000
--- a/containers/src/Utils/Containers/Internal/Coercions.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_HADDOCK hide #-}
-
-#include "containers.h"
-
-module Utils.Containers.Internal.Coercions where
-
-#ifdef __GLASGOW_HASKELL__
-import Data.Coerce
-#endif
-
-infixl 8 .#
-#ifdef __GLASGOW_HASKELL__
-(.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c
-(.#) f _ = coerce f
-#else
-(.#) :: (b -> c) -> (a -> b) -> a -> c
-(.#) = (.)
-#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
--- @
-#ifdef __GLASGOW_HASKELL__
-(.^#) :: 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 (.^#) #-}