From 89860fc8d45b2f76c1e89b71e419f15681c26190 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Thu, 19 Sep 2024 11:17:15 +0200
Subject: [PATCH 01/11] Various changes to make it compile with MicroHs.

Mostly #ifdefs and some type signatures.
---
 containers/changelog.md                       |  2 +
 containers/containers.cabal                   |  4 +-
 containers/include/containers.h               |  2 +-
 containers/src/Data/Graph.hs                  |  8 +-
 containers/src/Data/IntMap/Internal.hs        | 37 ++++++---
 containers/src/Data/IntSet/Internal.hs        |  8 +-
 containers/src/Data/Map/Internal.hs           | 25 +++++-
 containers/src/Data/Map/Strict/Internal.hs    |  2 +
 containers/src/Data/Sequence/Internal.hs      | 83 +++++++++++--------
 containers/src/Data/Set/Internal.hs           | 16 +++-
 containers/src/Data/Tree.hs                   |  8 +-
 .../src/Utils/Containers/Internal/Prelude.hs  | 13 +++
 .../Utils/Containers/Internal/StrictMaybe.hs  |  3 +
 .../Utils/Containers/Internal/TypeError.hs    |  5 ++
 14 files changed, 159 insertions(+), 57 deletions(-)

diff --git a/containers/changelog.md b/containers/changelog.md
index c0e00aa83..9186397a3 100644
--- a/containers/changelog.md
+++ b/containers/changelog.md
@@ -27,6 +27,8 @@
 
 ### Bug fixes
 
+* Make the package compile with MicroHs. (Lennart Augustsson)
+
 * `Data.Map.Strict.mergeWithKey` now forces the result of the combining function
   to WHNF. (Soumik Sarkar)
 
diff --git a/containers/containers.cabal b/containers/containers.cabal
index 3ab69d3ac..0eefaa8e7 100644
--- a/containers/containers.cabal
+++ b/containers/containers.cabal
@@ -36,7 +36,9 @@ source-repository head
 
 Library
     default-language: Haskell2010
-    build-depends: base >= 4.10 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.6, template-haskell
+    build-depends: base >= 4.10 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.6
+    if impl(ghc)
+       build-depends: template-haskell
     hs-source-dirs: src
     ghc-options: -O2 -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates
 
diff --git a/containers/include/containers.h b/containers/include/containers.h
index 4aa226e81..90f113165 100644
--- a/containers/include/containers.h
+++ b/containers/include/containers.h
@@ -8,7 +8,7 @@
 /*
  * On GHC, include MachDeps.h to get WORD_SIZE_IN_BITS macro.
  */
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
 #include "MachDeps.h"
 #endif
 
diff --git a/containers/src/Data/Graph.hs b/containers/src/Data/Graph.hs
index 2c6417f53..950d183b8 100644
--- a/containers/src/Data/Graph.hs
+++ b/containers/src/Data/Graph.hs
@@ -115,7 +115,7 @@ import Data.Tree (Tree(Node), Forest)
 
 -- std interfaces
 import Data.Foldable as F
-#if MIN_VERSION_base(4,18,0)
+#if MIN_VERSION_base(4,18,0) && defined(__GLASGOW_HASKELL__)
 import qualified Data.Foldable1 as F1
 #endif
 import Control.DeepSeq (NFData(rnf))
@@ -130,7 +130,9 @@ import qualified Data.Array as UA
 import qualified Data.List as L
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
+#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
+#endif
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup (..))
 #endif
@@ -194,6 +196,7 @@ instance Lift vertex => Lift (SCC vertex) where
 
 #endif
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Eq1 SCC where
   liftEq eq (AcyclicSCC v1) (AcyclicSCC v2) = eq v1 v2
@@ -209,13 +212,14 @@ instance Read1 SCC where
     readsUnaryWith rp "AcyclicSCC" AcyclicSCC <>
     readsUnaryWith (liftReadsPrec rp rl) "NECyclicSCC" NECyclicSCC <>
     readsUnaryWith (const rl) "CyclicSCC" CyclicSCC
+#endif
 
 -- | @since 0.5.9
 instance F.Foldable SCC where
   foldr c n (AcyclicSCC v) = c v n
   foldr c n (NECyclicSCC vs) = foldr c n vs
 
-#if MIN_VERSION_base(4,18,0)
+#if MIN_VERSION_base(4,18,0) && defined(__GLASGOW_HASKELL__)
 -- | @since 0.7.0
 instance F1.Foldable1 SCC where
   foldMap1 f (AcyclicSCC v) = f v
diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index d1d483b44..1dba18d11 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -292,7 +292,9 @@ import Data.Semigroup (Semigroup(stimes))
 import Data.Semigroup (Semigroup((<>)))
 #endif
 import Data.Semigroup (stimesIdempotentMonoid)
+#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
+#endif
 
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits
@@ -328,8 +330,8 @@ import Text.Read
 import Language.Haskell.TH.Syntax (Lift)
 -- See Note [ Template Haskell Dependencies ]
 import Language.Haskell.TH ()
-#endif
 import qualified Control.Category as Category
+#endif
 
 
 -- A "Nat" is a natural machine word (an unsigned Int)
@@ -395,8 +397,10 @@ data IntMap a = Bin {-# UNPACK #-} !Prefix
 type IntSetPrefix = Int
 type IntSetBitMap = Word
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.6.6
 deriving instance Lift a => Lift (IntMap a)
+#endif
 
 bitmapOf :: Int -> IntSetBitMap
 bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask)
@@ -1479,6 +1483,7 @@ instance (Applicative f, Monad f) => Functor (WhenMissing f x) where
   {-# INLINE fmap #-}
 
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Applicative f, Monad f) => Category.Category (WhenMissing f)
   where
@@ -1491,6 +1496,7 @@ instance (Applicative f, Monad f) => Category.Category (WhenMissing f)
           Just q  -> missingKey f k q
     {-# INLINE id #-}
     {-# INLINE (.) #-}
+#endif
 
 
 -- | Equivalent to @ReaderT k (ReaderT x (MaybeT f))@.
@@ -1639,6 +1645,7 @@ instance Functor f => Functor (WhenMatched f x y) where
   {-# INLINE fmap #-}
 
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Monad f, Applicative f) => Category.Category (WhenMatched f x)
   where
@@ -1651,6 +1658,7 @@ instance (Monad f, Applicative f) => Category.Category (WhenMatched f x)
           Just r  -> runWhenMatched f k x r
     {-# INLINE id #-}
     {-# INLINE (.) #-}
+#endif
 
 
 -- | Equivalent to @ReaderT Key (ReaderT x (ReaderT y (MaybeT f)))@
@@ -2067,7 +2075,7 @@ merge g1 g2 f m1 m2 =
 --
 -- @since 0.5.9
 mergeA
-  :: (Applicative f)
+  :: forall f a b c . (Applicative f)
   => WhenMissing f a c -- ^ What to do with keys in @m1@ but not @m2@
   -> WhenMissing f b c -- ^ What to do with keys in @m2@ but not @m1@
   -> WhenMatched f a b c -- ^ What to do with keys in both @m1@ and @m2@
@@ -2112,6 +2120,7 @@ mergeA
       EQL -> binA p1 (go l1 l2) (go r1 r2)
       NOM -> linkA (unPrefix p1) (g1t t1) (unPrefix p2) (g2t t2)
 
+    subsingletonBy :: forall a' . (Key -> a' -> f (Maybe c)) -> Key -> a' -> f (IntMap c)
     subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x
     {-# INLINE subsingletonBy #-}
 
@@ -2133,10 +2142,10 @@ mergeA
     -- | A variant of 'link_' which makes sure to execute side-effects
     -- in the right order.
     linkA
-        :: Applicative f
-        => Int -> f (IntMap a)
-        -> Int -> f (IntMap a)
-        -> f (IntMap a)
+        :: forall a' . Applicative f
+        => Int -> f (IntMap a')
+        -> Int -> f (IntMap a')
+        -> f (IntMap a')
     linkA k1 t1 k2 t2
       | natFromInt k1 < natFromInt k2 = binA p t1 t2
       | otherwise = binA p t2 t1
@@ -2148,11 +2157,11 @@ mergeA
     -- A variant of 'bin' that ensures that effects for negative keys are executed
     -- first.
     binA
-        :: Applicative f
+        :: forall a' . Applicative f
         => Prefix
-        -> f (IntMap a)
-        -> f (IntMap a)
-        -> f (IntMap a)
+        -> f (IntMap a')
+        -> f (IntMap a')
+        -> f (IntMap a')
     binA p a b
       | signBranch p = liftA2 (flip (bin p)) b a
       | otherwise = liftA2 (bin p) a b
@@ -3444,6 +3453,7 @@ equal Nil Nil = True
 equal _   _   = False
 {-# INLINABLE equal #-}
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Eq1 IntMap where
   liftEq eq (Bin p1 l1 r1) (Bin p2 l2 r2)
@@ -3452,6 +3462,7 @@ instance Eq1 IntMap where
     = (kx == ky) && (eq x y)
   liftEq _eq Nil Nil = True
   liftEq _eq _   _   = False
+#endif
 
 {--------------------------------------------------------------------
   Ord
@@ -3460,10 +3471,12 @@ instance Eq1 IntMap where
 instance Ord a => Ord (IntMap a) where
     compare m1 m2 = compare (toList m1) (toList m2)
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Ord1 IntMap where
   liftCompare cmp m n =
     liftCompare (liftCompare cmp) (toList m) (toList n)
+#endif
 
 {--------------------------------------------------------------------
   Functor
@@ -3486,6 +3499,7 @@ instance Show a => Show (IntMap a) where
   showsPrec d m   = showParen (d > 10) $
     showString "fromList " . shows (toList m)
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Show1 IntMap where
     liftShowsPrec sp sl d m =
@@ -3493,6 +3507,7 @@ instance Show1 IntMap where
       where
         sp' = liftShowsPrec sp sl
         sl' = liftShowList sp sl
+#endif
 
 {--------------------------------------------------------------------
   Read
@@ -3512,6 +3527,7 @@ instance (Read e) => Read (IntMap e) where
     return (fromList xs,t)
 #endif
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Read1 IntMap where
     liftReadsPrec rp rl = readsData $
@@ -3519,6 +3535,7 @@ instance Read1 IntMap where
       where
         rp' = liftReadsPrec rp rl
         rl' = liftReadList rp rl
+#endif
 
 {--------------------------------------------------------------------
   Helpers
diff --git a/containers/src/Data/IntSet/Internal.hs b/containers/src/Data/IntSet/Internal.hs
index 0af00e4aa..21b15e562 100644
--- a/containers/src/Data/IntSet/Internal.hs
+++ b/containers/src/Data/IntSet/Internal.hs
@@ -1641,16 +1641,16 @@ takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Nat -> Nat
 {-# INLINE foldr'Bits #-}
 {-# INLINE takeWhileAntitoneBits #-}
 
+lowestBitMask :: Nat -> Nat
+lowestBitMask x = x .&. negate x
+{-# INLINE lowestBitMask #-}
+
 #if defined(__GLASGOW_HASKELL__)
 
 lowestBitSet x = countTrailingZeros x
 
 highestBitSet x = WORD_SIZE_IN_BITS - 1 - countLeadingZeros x
 
-lowestBitMask :: Nat -> Nat
-lowestBitMask x = x .&. negate x
-{-# INLINE lowestBitMask #-}
-
 -- Reverse the order of bits in the Nat.
 revNat :: Nat -> Nat
 #if WORD_SIZE_IN_BITS==32
diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
index 2dc30a929..7e196fccb 100644
--- a/containers/src/Data/Map/Internal.hs
+++ b/containers/src/Data/Map/Internal.hs
@@ -7,8 +7,8 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeFamilies #-}
-#endif
 #define USE_MAGIC_PROXY 1
+#endif
 
 #ifdef USE_MAGIC_PROXY
 {-# LANGUAGE MagicHash #-}
@@ -379,7 +379,9 @@ module Data.Map.Internal (
 
 import Data.Functor.Identity (Identity (..))
 import Control.Applicative (liftA3)
+#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
+#endif
 import Data.Semigroup (stimesIdempotentMonoid)
 import Data.Semigroup (Arg(..), Semigroup(stimes))
 #if !(MIN_VERSION_base(4,11,0))
@@ -389,7 +391,9 @@ import Control.Applicative (Const (..))
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits (shiftL, shiftR)
 import qualified Data.Foldable as Foldable
+#ifdef __GLASGOW_HASKELL__
 import Data.Bifoldable
+#endif
 import Utils.Containers.Internal.Prelude hiding
   (lookup, map, filter, foldr, foldl, foldl', null, splitAt, take, drop)
 import Prelude ()
@@ -420,7 +424,6 @@ import qualified Control.Category as Category
 import Data.Coerce
 #endif
 
-
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
@@ -2205,6 +2208,7 @@ instance (Applicative f, Monad f) => Functor (WhenMissing f k x) where
   fmap = mapWhenMissing
   {-# INLINE fmap #-}
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Applicative f, Monad f)
          => Category.Category (WhenMissing f k) where
@@ -2216,6 +2220,7 @@ instance (Applicative f, Monad f)
            Just q -> missingKey f k q
   {-# INLINE id #-}
   {-# INLINE (.) #-}
+#endif
 
 -- | Equivalent to @ ReaderT k (ReaderT x (MaybeT f)) @.
 --
@@ -2340,6 +2345,7 @@ instance Functor f => Functor (WhenMatched f k x y) where
   fmap = mapWhenMatched
   {-# INLINE fmap #-}
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
   id = zipWithMatched (\_ _ y -> y)
@@ -2351,6 +2357,7 @@ instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
                 Just r -> runWhenMatched f k x r
   {-# INLINE id #-}
   {-# INLINE (.) #-}
+#endif
 
 -- | Equivalent to @ ReaderT k (ReaderT x (ReaderT y (MaybeT f))) @
 --
@@ -4303,6 +4310,7 @@ bin k x l r
   Eq
 --------------------------------------------------------------------}
 
+#ifdef __GLASGOW_HASKELL__
 instance (Eq k,Eq a) => Eq (Map k a) where
   m1 == m2 = liftEq2 (==) (==) m1 m2
   {-# INLINABLE (==) #-}
@@ -4327,11 +4335,16 @@ sameSizeLiftEq2 keq eq m1 m2 =
       Nothing -> False :*: it
       Just (KeyValue ky y :*: it') -> (keq kx ky && eq x y) :*: it'
 {-# INLINE sameSizeLiftEq2 #-}
+#else
+instance (Eq k,Eq a) => Eq (Map k a) where
+  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
+#endif
 
 {--------------------------------------------------------------------
   Ord
 --------------------------------------------------------------------}
 
+#ifdef __GLASGOW_HASKELL__
 instance (Ord k, Ord v) => Ord (Map k v) where
   compare m1 m2 = liftCmp2 compare compare m1 m2
   {-# INLINABLE compare #-}
@@ -4359,11 +4372,16 @@ liftCmp2 kcmp cmp m1 m2 = case runOrdM (foldMapWithKey f m1) (iterator m2) of
       Nothing -> GT :*: it
       Just (KeyValue ky y :*: it') -> (kcmp kx ky <> cmp x y) :*: it'
 {-# INLINE liftCmp2 #-}
+#else
+instance (Ord k, Ord v) => Ord (Map k v) where
+    compare m1 m2 = compare (toAscList m1) (toAscList m2)
+#endif
 
 {--------------------------------------------------------------------
   Lifted instances
 --------------------------------------------------------------------}
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Show2 Map where
     liftShowsPrec2 spk slk spv slv d m =
@@ -4383,6 +4401,7 @@ instance (Ord k, Read k) => Read1 (Map k) where
       where
         rp' = liftReadsPrec rp rl
         rl' = liftReadList rp rl
+#endif
 
 {--------------------------------------------------------------------
   Functor
@@ -4448,6 +4467,7 @@ instance Foldable.Foldable (Map k) where
   product = foldl' (*) 1
   {-# INLINABLE product #-}
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.6.3.1
 instance Bifoldable Map where
   bifold = go
@@ -4468,6 +4488,7 @@ instance Bifoldable Map where
           go (Bin 1 k v _ _) = f k `mappend` g v
           go (Bin _ k v l r) = go l `mappend` (f k `mappend` (g v `mappend` go r))
   {-# INLINE bifoldMap #-}
+#endif
 
 instance (NFData k, NFData a) => NFData (Map k a) where
     rnf Tip = ()
diff --git a/containers/src/Data/Map/Strict/Internal.hs b/containers/src/Data/Map/Strict/Internal.hs
index c93003e27..c49bca04d 100644
--- a/containers/src/Data/Map/Strict/Internal.hs
+++ b/containers/src/Data/Map/Strict/Internal.hs
@@ -342,7 +342,9 @@ import Data.Map.Internal
   , argSet
   , assocs
   , atKeyImpl
+#ifdef __GLASGOW_HASKELL__
   , atKeyPlain
+#endif
   , balance
   , balanceL
   , balanceR
diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index d3222d869..430c00fc3 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -216,11 +216,11 @@ import Data.Foldable (foldr', toList)
 import qualified Data.Foldable as F
 
 import qualified Data.Semigroup as Semigroup
-import Data.Functor.Classes
 import Data.Traversable
 
 -- GHC specific stuff
 #ifdef __GLASGOW_HASKELL__
+import Data.Functor.Classes
 import GHC.Exts (build)
 import Text.Read (Lexeme(Ident), lexP, parens, prec,
     readPrec, readListPrec, readListPrecDefault)
@@ -230,18 +230,19 @@ import qualified Language.Haskell.TH.Syntax as TH
 -- See Note [ Template Haskell Dependencies ]
 import Language.Haskell.TH ()
 import GHC.Generics (Generic, Generic1)
+
+import qualified GHC.Arr
+import Data.Coerce
+import qualified GHC.Exts
+#else
+import qualified Data.List
 #endif
 
 -- Array stuff, with GHC.Arr on GHC
 import Data.Array (Ix, Array)
 import qualified Data.Array
-#ifdef __GLASGOW_HASKELL__
-import qualified GHC.Arr
-#endif
 
 import Utils.Containers.Internal.Coercions ((.#), (.^#))
-import Data.Coerce
-import qualified GHC.Exts
 
 import Data.Functor.Identity (Identity(..))
 
@@ -907,14 +908,6 @@ instance Alternative Seq where
     empty = empty
     (<|>) = (><)
 
-instance Eq a => Eq (Seq a) where
-  xs == ys = liftEq (==) xs ys
-  {-# INLINABLE (==) #-}
-
-instance Ord a => Ord (Seq a) where
-  compare xs ys = liftCompare compare xs ys
-  {-# INLINABLE compare #-}
-
 #ifdef TESTING
 instance Show a => Show (Seq a) where
     showsPrec p (Seq x) = showsPrec p x
@@ -924,6 +917,15 @@ instance Show a => Show (Seq a) where
         showString "fromList " . shows (toList xs)
 #endif
 
+#ifdef __GLASGOW_HASKELL__
+instance Eq a => Eq (Seq a) where
+  xs == ys = liftEq (==) xs ys
+  {-# INLINABLE (==) #-}
+
+instance Ord a => Ord (Seq a) where
+  compare xs ys = liftCompare compare xs ys
+  {-# INLINABLE compare #-}
+
 -- | @since 0.5.9
 instance Show1 Seq where
   liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $
@@ -939,6 +941,14 @@ instance Eq1 Seq where
 instance Ord1 Seq where
   liftCompare f xs ys = liftCmpLists f (toList xs) (toList ys)
   {-# INLINE liftCompare #-}
+#else
+instance Eq a => Eq (Seq a) where
+    xs == ys = length xs == length ys && F.toList xs == F.toList ys
+
+instance Ord a => Ord (Seq a) where
+    compare xs ys = compare (F.toList xs) (F.toList ys)
+
+#endif
 
 -- Note [Eq and Ord]
 -- ~~~~~~~~~~~~~~~~~
@@ -990,6 +1000,7 @@ instance Read a => Read (Seq a) where
         return (fromList xs,t)
 #endif
 
+#if __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Read1 Seq where
   liftReadsPrec _rp readLst p = readParen (p > 10) $ \r -> do
@@ -1000,6 +1011,7 @@ instance Read1 Seq where
 instance Monoid (Seq a) where
     mempty = empty
     mappend = (Semigroup.<>)
+#endif
 
 -- | @since 0.5.7
 instance Semigroup.Semigroup (Seq a) where
@@ -3094,12 +3106,12 @@ delDigit f i (Four a b c d)
 -- | A generalization of 'fmap', 'mapWithIndex' takes a mapping
 -- function that also depends on the element's index, and applies it to every
 -- element in the sequence.
-mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
+mapWithIndex :: forall a b . (Int -> a -> b) -> Seq a -> Seq b
 mapWithIndex f' (Seq xs') = Seq $ mapWithIndexTree (\s (Elem a) -> Elem (f' s a)) 0 xs'
  where
   {-# SPECIALIZE mapWithIndexTree :: (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> FingerTree b #-}
   {-# SPECIALIZE mapWithIndexTree :: (Int -> Node y -> b) -> Int -> FingerTree (Node y) -> FingerTree b #-}
-  mapWithIndexTree :: Sized a => (Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
+  mapWithIndexTree :: forall a' b' . Sized a' => (Int -> a' -> b') -> Int -> FingerTree a' -> FingerTree b'
   mapWithIndexTree _ !_s EmptyT = EmptyT
   mapWithIndexTree f s (Single xs) = Single $ f s xs
   mapWithIndexTree f s (Deep n pr m sf) =
@@ -3113,7 +3125,7 @@ mapWithIndex f' (Seq xs') = Seq $ mapWithIndexTree (\s (Elem a) -> Elem (f' s a)
 
   {-# SPECIALIZE mapWithIndexDigit :: (Int -> Elem y -> b) -> Int -> Digit (Elem y) -> Digit b #-}
   {-# SPECIALIZE mapWithIndexDigit :: (Int -> Node y -> b) -> Int -> Digit (Node y) -> Digit b #-}
-  mapWithIndexDigit :: Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
+  mapWithIndexDigit :: forall a' b' . Sized a' => (Int -> a' -> b') -> Int -> Digit a' -> Digit b'
   mapWithIndexDigit f !s (One a) = One (f s a)
   mapWithIndexDigit f s (Two a b) = Two (f s a) (f sPsa b)
     where
@@ -3132,7 +3144,7 @@ mapWithIndex f' (Seq xs') = Seq $ mapWithIndexTree (\s (Elem a) -> Elem (f' s a)
 
   {-# SPECIALIZE mapWithIndexNode :: (Int -> Elem y -> b) -> Int -> Node (Elem y) -> Node b #-}
   {-# SPECIALIZE mapWithIndexNode :: (Int -> Node y -> b) -> Int -> Node (Node y) -> Node b #-}
-  mapWithIndexNode :: Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
+  mapWithIndexNode :: forall a' b' . Sized a' => (Int -> a' -> b') -> Int -> Node a' -> Node b'
   mapWithIndexNode f s (Node2 ns a b) = Node2 ns (f s a) (f sPsa b)
     where
       !sPsa = s + size a
@@ -3200,7 +3212,7 @@ foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs'
 -- GHC does not specialize until *all* instances are determined.
 -- Although the Sized instance is known at compile time, the Monoid
 -- instance generally is not.
-  foldMapWithIndexTreeE :: Monoid m => (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
+  foldMapWithIndexTreeE :: forall m a . Monoid m => (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
   foldMapWithIndexTreeE _ !_s EmptyT = mempty
   foldMapWithIndexTreeE f s (Single xs) = f s xs
   foldMapWithIndexTreeE f s (Deep _ pr m sf) =
@@ -3211,7 +3223,7 @@ foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs'
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
 
-  foldMapWithIndexTreeN :: Monoid m => (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
+  foldMapWithIndexTreeN :: forall m a . Monoid m => (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
   foldMapWithIndexTreeN _ !_s EmptyT = mempty
   foldMapWithIndexTreeN f s (Single xs) = f s xs
   foldMapWithIndexTreeN f s (Deep _ pr m sf) =
@@ -3249,7 +3261,7 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
 -- GHC does not specialize until *all* instances are determined.
 -- Although the Sized instance is known at compile time, the Applicative
 -- instance generally is not.
-  traverseWithIndexTreeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
+  traverseWithIndexTreeE :: forall f a b . Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
   traverseWithIndexTreeE _ !_s EmptyT = pure EmptyT
   traverseWithIndexTreeE f s (Single xs) = Single <$> f s xs
   traverseWithIndexTreeE f s (Deep n pr m sf) =
@@ -3261,7 +3273,7 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
 
-  traverseWithIndexTreeN :: Applicative f => (Int -> Node a -> f b) -> Int -> FingerTree (Node a) -> f (FingerTree b)
+  traverseWithIndexTreeN :: forall f a b . Applicative f => (Int -> Node a -> f b) -> Int -> FingerTree (Node a) -> f (FingerTree b)
   traverseWithIndexTreeN _ !_s EmptyT = pure EmptyT
   traverseWithIndexTreeN f s (Single xs) = Single <$> f s xs
   traverseWithIndexTreeN f s (Deep n pr m sf) =
@@ -3273,14 +3285,14 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
 
-  traverseWithIndexDigitE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
+  traverseWithIndexDigitE :: forall f a b . Applicative f => (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
   traverseWithIndexDigitE f i t = traverseWithIndexDigit f i t
 
-  traverseWithIndexDigitN :: Applicative f => (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
+  traverseWithIndexDigitN :: forall f a b . Applicative f => (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
   traverseWithIndexDigitN f i t = traverseWithIndexDigit f i t
 
   {-# INLINE traverseWithIndexDigit #-}
-  traverseWithIndexDigit :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
+  traverseWithIndexDigit :: forall f a b . (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
   traverseWithIndexDigit f !s (One a) = One <$> f s a
   traverseWithIndexDigit f s (Two a b) = liftA2 Two (f s a) (f sPsa b)
     where
@@ -3297,14 +3309,14 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
       !sPsab = sPsa + size b
       !sPsabc = sPsab + size c
 
-  traverseWithIndexNodeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
+  traverseWithIndexNodeE :: forall f a b . Applicative f => (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
   traverseWithIndexNodeE f i t = traverseWithIndexNode f i t
 
-  traverseWithIndexNodeN :: Applicative f => (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
+  traverseWithIndexNodeN :: forall f a b . Applicative f => (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
   traverseWithIndexNodeN f i t = traverseWithIndexNode f i t
 
   {-# INLINE traverseWithIndexNode #-}
-  traverseWithIndexNode :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
+  traverseWithIndexNode :: forall f a b . (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
   traverseWithIndexNode f !s (Node2 ns a b) = liftA2 (Node2 ns) (f s a) (f sPsa b)
     where
       !sPsa = s + size a
@@ -3360,7 +3372,7 @@ fromFunction len f | len < 0 = error "Data.Sequence.fromFunction called with neg
                    | len == 0 = empty
                    | otherwise = Seq $ create (lift_elem f) 1 0 len
   where
-    create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
+    create :: forall a . (Int -> a) -> Int -> Int -> Int -> FingerTree a
     create b{-tree_builder-} !s{-tree_size-} !i{-start_index-} trees = case trees of
        1 -> Single $ b i
        2 -> Deep (2*s) (One (b i)) EmptyT (One (b (i+s)))
@@ -4260,7 +4272,7 @@ fromList        :: [a] -> Seq a
 -- it gets a bit hard to read.
 fromList = Seq . mkTree . map_elem
   where
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
     mkTree :: forall a' . [Elem a'] -> FingerTree (Elem a')
 #else
     mkTree :: [Elem a] -> FingerTree (Elem a)
@@ -4308,7 +4320,7 @@ fromList = Seq . mkTree . map_elem
       where
         d2 = Three x1 x2 x3
         d1 = Three (Node3 3 x4 x5 x6) (Node3 3 x7 x8 x9) (Node3 3 y0 y1 y2)
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
         cont :: (Digit (Node (Elem a')), Digit (Elem a')) -> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a')
 #endif
         cont (!r1, !r2) !sub =
@@ -4335,7 +4347,7 @@ fromList = Seq . mkTree . map_elem
             !n10 = Node3 (3*s) n1 n2 n3
 
     mkTreeC ::
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
                forall a b c .
 #endif
                (b -> FingerTree (Node a) -> c)
@@ -4377,7 +4389,7 @@ fromList = Seq . mkTree . map_elem
     mkTreeC cont s (LCons x1 (LCons x2 (LCons x3 (LCons x4 (LCons x5 (LCons x6 (LCons x7 (LCons x8 (LCons x9 (LCons y0 (LCons y1 (LCons y2 (LCons y3 (LCons y4 (LCons y5 (LCons y6 xs)))))))))))))))) =
       mkTreeC cont2 (9*s) (getNodesC (3*s) (Node3 (3*s) y3 y4 y5) y6 xs)
       where
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
         cont2 :: (b, Digit (Node (Node a)), Digit (Node a)) -> FingerTree (Node (Node (Node a))) -> c
 #endif
         cont2 (b, r1, r2) !sub =
@@ -4386,7 +4398,8 @@ fromList = Seq . mkTree . map_elem
               !sub1 = Deep (9*s + size r1 + size sub) d1 sub r1
           in cont b $! Deep (3*s + size r2 + size sub1) d2 sub1 r2
 
-    getNodesC :: Int
+    getNodesC :: forall a b .
+                 Int
               -> Node a
               -> a
               -> ListFinal a b
@@ -4421,7 +4434,7 @@ fromList = Seq . mkTree . map_elem
             !n3 = Node3 s x4 x5 x6
             !n10 = Node3 (3*s) n1 n2 n3
 
-    map_elem :: [a] -> [Elem a]
+    map_elem :: forall a . [a] -> [Elem a]
 #ifdef __GLASGOW_HASKELL__
     map_elem xs = coerce xs
 #else
diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
index 805f5c361..b17778ab2 100644
--- a/containers/src/Data/Set/Internal.hs
+++ b/containers/src/Data/Set/Internal.hs
@@ -245,7 +245,9 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Semigroup (Semigroup((<>)))
 #endif
 import Data.Semigroup (stimesIdempotentMonoid, stimesIdempotent)
+#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
+#endif
 import Data.Functor.Identity (Identity)
 import qualified Data.Foldable as Foldable
 import Control.DeepSeq (NFData(rnf))
@@ -291,10 +293,10 @@ type Size     = Int
 
 #ifdef __GLASGOW_HASKELL__
 type role Set nominal
-#endif
 
 -- | @since 0.6.6
 deriving instance Lift a => Lift (Set a)
+#endif
 
 instance Ord a => Monoid (Set a) where
     mempty  = empty
@@ -1307,6 +1309,7 @@ iterNull Nada = True
   Eq
 --------------------------------------------------------------------}
 
+#ifdef __GLASGOW_HASKELL__
 instance Eq a => Eq (Set a) where
   s1 == s2 = liftEq (==) s1 s2
   {-# INLINABLE (==) #-}
@@ -1325,11 +1328,16 @@ sameSizeLiftEq eq s1 s2 =
       Nothing -> False :*: it
       Just (y :*: it') -> eq x y :*: it'
 {-# INLINE sameSizeLiftEq #-}
+#else
+instance Eq a => Eq (Set a) where
+  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
+#endif
 
 {--------------------------------------------------------------------
   Ord
 --------------------------------------------------------------------}
 
+#ifdef __GLASGOW_HASKELL__
 instance Ord a => Ord (Set a) where
   compare s1 s2 = liftCmp compare s1 s2
   {-# INLINABLE compare #-}
@@ -1347,6 +1355,10 @@ liftCmp cmp s1 s2 = case runOrdM (foldMap f s1) (iterator s2) of
       Nothing -> GT :*: it
       Just (y :*: it') -> cmp x y :*: it'
 {-# INLINE liftCmp #-}
+#else
+instance Ord a => Ord (Set a) where
+    compare s1 s2 = compare (toAscList s1) (toAscList s2)
+#endif
 
 {--------------------------------------------------------------------
   Show
@@ -1355,10 +1367,12 @@ instance Show a => Show (Set a) where
   showsPrec p xs = showParen (p > 10) $
     showString "fromList " . shows (toList xs)
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Show1 Set where
     liftShowsPrec sp sl d m =
         showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)
+#endif
 
 {--------------------------------------------------------------------
   Read
diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs
index a03926c27..b6d11e4b2 100644
--- a/containers/src/Data/Tree.hs
+++ b/containers/src/Data/Tree.hs
@@ -73,16 +73,20 @@ import Language.Haskell.TH ()
 
 import Control.Monad.Zip (MonadZip (..))
 
+#ifdef __GLASGOW_HASKELL__
 import Data.Coerce
 
 import Data.Functor.Classes
+#endif
 
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup (..))
 #endif
 
 #if MIN_VERSION_base(4,18,0)
+#ifdef __GLASGOW_HASKELL__
 import qualified Data.Foldable1 as Foldable1
+#endif
 import Data.List.NonEmpty (NonEmpty(..))
 #endif
 
@@ -109,6 +113,7 @@ data Tree a = Node {
 -- reasons.
 type Forest a = [Tree a]
 
+#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Eq1 Tree where
   liftEq eq = leq
@@ -143,6 +148,7 @@ instance Read1 Tree where
       (fr, s9) <- liftReadList rd rdl s8
       ("}", s10) <- lex s9
       pure (Node a fr, s10)
+#endif
 
 instance Functor Tree where
     fmap = fmapTree
@@ -233,7 +239,7 @@ instance Foldable Tree where
     product = foldlMap1' id (*)
     {-# INLINABLE product #-}
 
-#if MIN_VERSION_base(4,18,0)
+#if MIN_VERSION_base(4,18,0) && defined(__GLASGOW_HASKELL__)
 -- | Folds in preorder
 --
 -- @since 0.6.7
diff --git a/containers/src/Utils/Containers/Internal/Prelude.hs b/containers/src/Utils/Containers/Internal/Prelude.hs
index d8e0a1465..71d0929f1 100644
--- a/containers/src/Utils/Containers/Internal/Prelude.hs
+++ b/containers/src/Utils/Containers/Internal/Prelude.hs
@@ -1,12 +1,25 @@
+{-# LANGUAGE CPP #-}
 -- | This hideous module lets us avoid dealing with the fact that
 -- @liftA2@ and @foldl'@ were not previously exported from the standard prelude.
 module Utils.Containers.Internal.Prelude
   ( module Prelude
   , Applicative (..)
   , Foldable (..)
+#ifdef __MHS__
+  , Traversable(..)
+  , NonEmpty
+  , any, concatMap
+#endif
   )
   where
 
+#ifdef __MHS__
+import Prelude hiding (elem, foldr, foldl, foldr1, foldl1, maximum, minimum, product, sum, null, length, mapM, any, concatMap)
+import Data.Traversable
+import Data.List.NonEmpty(NonEmpty)
+import Data.Foldable(any, concatMap)
+#else
 import Prelude hiding (Applicative(..), Foldable(..))
+#endif
 import Control.Applicative(Applicative(..))
 import Data.Foldable (Foldable(elem, foldMap, foldr, foldl, foldl', foldr1, foldl1, maximum, minimum, product, sum, null, length))
diff --git a/containers/src/Utils/Containers/Internal/StrictMaybe.hs b/containers/src/Utils/Containers/Internal/StrictMaybe.hs
index 22611cd45..e1a37c5c0 100644
--- a/containers/src/Utils/Containers/Internal/StrictMaybe.hs
+++ b/containers/src/Utils/Containers/Internal/StrictMaybe.hs
@@ -6,6 +6,9 @@
 -- | Strict 'Maybe'
 
 module Utils.Containers.Internal.StrictMaybe (MaybeS (..), maybeS, toMaybe, toMaybeS) where
+#ifdef __MHS__
+import Data.Foldable
+#endif
 
 data MaybeS a = NothingS | JustS !a
 
diff --git a/containers/src/Utils/Containers/Internal/TypeError.hs b/containers/src/Utils/Containers/Internal/TypeError.hs
index 3bbdbb4fc..34694ecd4 100644
--- a/containers/src/Utils/Containers/Internal/TypeError.hs
+++ b/containers/src/Utils/Containers/Internal/TypeError.hs
@@ -8,6 +8,7 @@
 -- | Unsatisfiable constraints for functions being removed.
 
 module Utils.Containers.Internal.TypeError where
+#ifdef __GLASGOW_HASKELL__
 import GHC.TypeLits
 
 -- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s@.  Trying
@@ -42,3 +43,7 @@ instance TypeError ('Text a) => Whoops a
 -- reducing the constraint because it knows someone could (theoretically)
 -- define an overlapping instance of Whoops. It doesn't commit to
 -- the polymorphic one until it has to, at the call site.
+
+#else
+class Whoops (a :: Symbol)
+#endif

From e9651ef44675db2536f87ead2a69ca5f04d338c3 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Thu, 19 Sep 2024 16:35:50 +0200
Subject: [PATCH 02/11] Add CI for MicroHs compilation.

---
 .github/workflows/mhs-ci.yml | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)
 create mode 100644 .github/workflows/mhs-ci.yml

diff --git a/.github/workflows/mhs-ci.yml b/.github/workflows/mhs-ci.yml
new file mode 100644
index 000000000..2a772e50d
--- /dev/null
+++ b/.github/workflows/mhs-ci.yml
@@ -0,0 +1,31 @@
+name: MicroHs CI for containers
+
+on:
+  push:
+    branches: [ "master" ]
+  pull_request:
+    branches: [ "master" ]
+
+jobs:
+  build-mhs-containers:
+    runs-on: ubuntu-latest
+    steps:
+    - name: checkout containers repo
+      uses: actions/checkout@v4
+      with:
+        path: cont
+    - name: checkout mhs repo
+      uses: actions/checkout@v4
+      with:
+        repository: augustss/MicroHs
+        path: mhs
+    - name: make mhs
+      run: |
+        cd mhs
+        make
+# It's pretty ugly with the list of modules here, but I don't know a nice way of getting it from the cabal file.
+# I'll make it nicer with mcabal later.
+    - name: compile containers package
+      run: |
+        cd mhs
+        MHSCPPHS=./bin/cpphs ./bin/mhs -Pcontainers-test -ocontainers-test.pkg -i../cont/containers/src -XCPP -I../cont/containers/include Data.Containers.ListUtils Data.IntMap Data.IntMap.Lazy Data.IntMap.Strict Data.IntMap.Strict.Internal Data.IntMap.Internal Data.IntMap.Internal.Debug Data.IntMap.Merge.Lazy Data.IntMap.Merge.Strict Data.IntSet.Internal Data.IntSet.Internal.IntTreeCommons Data.IntSet Data.Map Data.Map.Lazy Data.Map.Merge.Lazy Data.Map.Strict.Internal Data.Map.Strict Data.Map.Merge.Strict Data.Map.Internal Data.Map.Internal.Debug Data.Set.Internal Data.Set Data.Graph Data.Sequence Data.Sequence.Internal Data.Sequence.Internal.Sorting Data.Tree Utils.Containers.Internal.BitUtil Utils.Containers.Internal.BitQueue Utils.Containers.Internal.StrictPair

From 4d8fe616afda423e90d7352a1c3258f80c08a538 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Thu, 19 Sep 2024 08:38:32 -0600
Subject: [PATCH 03/11] Update containers/include/containers.h

Co-authored-by: David Feuer <David.Feuer@gmail.com>
---
 containers/include/containers.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/containers/include/containers.h b/containers/include/containers.h
index 90f113165..1f35b96af 100644
--- a/containers/include/containers.h
+++ b/containers/include/containers.h
@@ -6,7 +6,7 @@
 #define HASKELL_CONTAINERS_H
 
 /*
- * On GHC, include MachDeps.h to get WORD_SIZE_IN_BITS macro.
+ * On GHC and MicroHs, include MachDeps.h to get WORD_SIZE_IN_BITS macro.
  */
 #if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
 #include "MachDeps.h"

From 393076bd7bcca5b6d754b9f8d3e6f226f9d638c3 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Thu, 19 Sep 2024 17:05:17 +0200
Subject: [PATCH 04/11] Get rid of #ifdef for Control.Category

---
 containers/src/Data/IntMap/Internal.hs | 6 +-----
 containers/src/Data/Map/Internal.hs    | 4 +---
 2 files changed, 2 insertions(+), 8 deletions(-)

diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index 1dba18d11..da7917774 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -330,8 +330,8 @@ import Text.Read
 import Language.Haskell.TH.Syntax (Lift)
 -- See Note [ Template Haskell Dependencies ]
 import Language.Haskell.TH ()
-import qualified Control.Category as Category
 #endif
+import qualified Control.Category as Category
 
 
 -- A "Nat" is a natural machine word (an unsigned Int)
@@ -1483,7 +1483,6 @@ instance (Applicative f, Monad f) => Functor (WhenMissing f x) where
   {-# INLINE fmap #-}
 
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Applicative f, Monad f) => Category.Category (WhenMissing f)
   where
@@ -1496,7 +1495,6 @@ instance (Applicative f, Monad f) => Category.Category (WhenMissing f)
           Just q  -> missingKey f k q
     {-# INLINE id #-}
     {-# INLINE (.) #-}
-#endif
 
 
 -- | Equivalent to @ReaderT k (ReaderT x (MaybeT f))@.
@@ -1645,7 +1643,6 @@ instance Functor f => Functor (WhenMatched f x y) where
   {-# INLINE fmap #-}
 
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Monad f, Applicative f) => Category.Category (WhenMatched f x)
   where
@@ -1658,7 +1655,6 @@ instance (Monad f, Applicative f) => Category.Category (WhenMatched f x)
           Just r  -> runWhenMatched f k x r
     {-# INLINE id #-}
     {-# INLINE (.) #-}
-#endif
 
 
 -- | Equivalent to @ReaderT Key (ReaderT x (ReaderT y (MaybeT f)))@
diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
index 7e196fccb..eb73444fb 100644
--- a/containers/src/Data/Map/Internal.hs
+++ b/containers/src/Data/Map/Internal.hs
@@ -420,9 +420,9 @@ import GHC.Exts (Proxy#, proxy# )
 import qualified GHC.Exts as GHCExts
 import Text.Read hiding (lift)
 import Data.Data
-import qualified Control.Category as Category
 import Data.Coerce
 #endif
+import qualified Control.Category as Category
 
 {--------------------------------------------------------------------
   Operators
@@ -2208,7 +2208,6 @@ instance (Applicative f, Monad f) => Functor (WhenMissing f k x) where
   fmap = mapWhenMissing
   {-# INLINE fmap #-}
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Applicative f, Monad f)
          => Category.Category (WhenMissing f k) where
@@ -2220,7 +2219,6 @@ instance (Applicative f, Monad f)
            Just q -> missingKey f k q
   {-# INLINE id #-}
   {-# INLINE (.) #-}
-#endif
 
 -- | Equivalent to @ ReaderT k (ReaderT x (MaybeT f)) @.
 --

From e7b38bee29130793b464ed7a4d85ada95518befd Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Mon, 23 Sep 2024 01:04:46 +0200
Subject: [PATCH 05/11] Remove some MHS stuff

---
 containers/src/Data/Graph.hs           | 12 ++++-----
 containers/src/Data/IntMap/Internal.hs | 34 +++++++++-----------------
 2 files changed, 17 insertions(+), 29 deletions(-)

diff --git a/containers/src/Data/Graph.hs b/containers/src/Data/Graph.hs
index 950d183b8..7e1189a63 100644
--- a/containers/src/Data/Graph.hs
+++ b/containers/src/Data/Graph.hs
@@ -115,7 +115,7 @@ import Data.Tree (Tree(Node), Forest)
 
 -- std interfaces
 import Data.Foldable as F
-#if MIN_VERSION_base(4,18,0) && defined(__GLASGOW_HASKELL__)
+#if MIN_VERSION_base(4,18,0)
 import qualified Data.Foldable1 as F1
 #endif
 import Control.DeepSeq (NFData(rnf))
@@ -130,9 +130,7 @@ import qualified Data.Array as UA
 import qualified Data.List as L
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
-#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
-#endif
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup (..))
 #endif
@@ -196,7 +194,6 @@ instance Lift vertex => Lift (SCC vertex) where
 
 #endif
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Eq1 SCC where
   liftEq eq (AcyclicSCC v1) (AcyclicSCC v2) = eq v1 v2
@@ -210,8 +207,9 @@ instance Show1 SCC where
 instance Read1 SCC where
   liftReadsPrec rp rl = readsData $
     readsUnaryWith rp "AcyclicSCC" AcyclicSCC <>
-    readsUnaryWith (liftReadsPrec rp rl) "NECyclicSCC" NECyclicSCC <>
-    readsUnaryWith (const rl) "CyclicSCC" CyclicSCC
+    readsUnaryWith (liftReadsPrec rp rl) "NECyclicSCC" NECyclicSCC
+#ifdef __GLASGOW_HASKELL__
+    <> readsUnaryWith (const rl) "CyclicSCC" CyclicSCC
 #endif
 
 -- | @since 0.5.9
@@ -219,7 +217,7 @@ instance F.Foldable SCC where
   foldr c n (AcyclicSCC v) = c v n
   foldr c n (NECyclicSCC vs) = foldr c n vs
 
-#if MIN_VERSION_base(4,18,0) && defined(__GLASGOW_HASKELL__)
+#if MIN_VERSION_base(4,18,0)
 -- | @since 0.7.0
 instance F1.Foldable1 SCC where
   foldMap1 f (AcyclicSCC v) = f v
diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index da7917774..a21d8461b 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -292,9 +292,7 @@ import Data.Semigroup (Semigroup(stimes))
 import Data.Semigroup (Semigroup((<>)))
 #endif
 import Data.Semigroup (stimesIdempotentMonoid)
-#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
-#endif
 
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits
@@ -326,11 +324,11 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex,
 import qualified Data.Data as Data
 import GHC.Exts (build)
 import qualified GHC.Exts as GHCExts
-import Text.Read
 import Language.Haskell.TH.Syntax (Lift)
 -- See Note [ Template Haskell Dependencies ]
 import Language.Haskell.TH ()
 #endif
+import Text.Read
 import qualified Control.Category as Category
 
 
@@ -2071,7 +2069,7 @@ merge g1 g2 f m1 m2 =
 --
 -- @since 0.5.9
 mergeA
-  :: forall f a b c . (Applicative f)
+  :: (Applicative f)
   => WhenMissing f a c -- ^ What to do with keys in @m1@ but not @m2@
   -> WhenMissing f b c -- ^ What to do with keys in @m2@ but not @m1@
   -> WhenMatched f a b c -- ^ What to do with keys in both @m1@ and @m2@
@@ -2116,7 +2114,7 @@ mergeA
       EQL -> binA p1 (go l1 l2) (go r1 r2)
       NOM -> linkA (unPrefix p1) (g1t t1) (unPrefix p2) (g2t t2)
 
-    subsingletonBy :: forall a' . (Key -> a' -> f (Maybe c)) -> Key -> a' -> f (IntMap c)
+    subsingletonBy :: (Key -> a -> f (Maybe c)) -> Key -> a -> f (IntMap c)
     subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x
     {-# INLINE subsingletonBy #-}
 
@@ -2138,10 +2136,10 @@ mergeA
     -- | A variant of 'link_' which makes sure to execute side-effects
     -- in the right order.
     linkA
-        :: forall a' . Applicative f
-        => Int -> f (IntMap a')
-        -> Int -> f (IntMap a')
-        -> f (IntMap a')
+        :: Applicative f
+        => Int -> f (IntMap a)
+        -> Int -> f (IntMap a)
+        -> f (IntMap a)
     linkA k1 t1 k2 t2
       | natFromInt k1 < natFromInt k2 = binA p t1 t2
       | otherwise = binA p t2 t1
@@ -2153,11 +2151,11 @@ mergeA
     -- A variant of 'bin' that ensures that effects for negative keys are executed
     -- first.
     binA
-        :: forall a' . Applicative f
+        :: Applicative f
         => Prefix
-        -> f (IntMap a')
-        -> f (IntMap a')
-        -> f (IntMap a')
+        -> f (IntMap a)
+        -> f (IntMap a)
+        -> f (IntMap a)
     binA p a b
       | signBranch p = liftA2 (flip (bin p)) b a
       | otherwise = liftA2 (bin p) a b
@@ -3449,7 +3447,6 @@ equal Nil Nil = True
 equal _   _   = False
 {-# INLINABLE equal #-}
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Eq1 IntMap where
   liftEq eq (Bin p1 l1 r1) (Bin p2 l2 r2)
@@ -3458,7 +3455,6 @@ instance Eq1 IntMap where
     = (kx == ky) && (eq x y)
   liftEq _eq Nil Nil = True
   liftEq _eq _   _   = False
-#endif
 
 {--------------------------------------------------------------------
   Ord
@@ -3467,12 +3463,10 @@ instance Eq1 IntMap where
 instance Ord a => Ord (IntMap a) where
     compare m1 m2 = compare (toList m1) (toList m2)
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Ord1 IntMap where
   liftCompare cmp m n =
     liftCompare (liftCompare cmp) (toList m) (toList n)
-#endif
 
 {--------------------------------------------------------------------
   Functor
@@ -3495,7 +3489,6 @@ instance Show a => Show (IntMap a) where
   showsPrec d m   = showParen (d > 10) $
     showString "fromList " . shows (toList m)
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Show1 IntMap where
     liftShowsPrec sp sl d m =
@@ -3503,13 +3496,12 @@ instance Show1 IntMap where
       where
         sp' = liftShowsPrec sp sl
         sl' = liftShowList sp sl
-#endif
 
 {--------------------------------------------------------------------
   Read
 --------------------------------------------------------------------}
 instance (Read e) => Read (IntMap e) where
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
   readPrec = parens $ prec 10 $ do
     Ident "fromList" <- lexP
     xs <- readPrec
@@ -3523,7 +3515,6 @@ instance (Read e) => Read (IntMap e) where
     return (fromList xs,t)
 #endif
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Read1 IntMap where
     liftReadsPrec rp rl = readsData $
@@ -3531,7 +3522,6 @@ instance Read1 IntMap where
       where
         rp' = liftReadsPrec rp rl
         rl' = liftReadList rp rl
-#endif
 
 {--------------------------------------------------------------------
   Helpers

From b07386ecab1cfe7a3f532fb4fd0eb76ecca3e37f Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Mon, 23 Sep 2024 12:20:01 +0200
Subject: [PATCH 06/11] More GHC compatibility.

---
 containers/src/Data/Map/Internal.hs      | 24 ++----------------------
 containers/src/Data/Sequence/Internal.hs | 17 +++--------------
 2 files changed, 5 insertions(+), 36 deletions(-)

diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
index eb73444fb..edaf04839 100644
--- a/containers/src/Data/Map/Internal.hs
+++ b/containers/src/Data/Map/Internal.hs
@@ -379,9 +379,7 @@ module Data.Map.Internal (
 
 import Data.Functor.Identity (Identity (..))
 import Control.Applicative (liftA3)
-#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
-#endif
 import Data.Semigroup (stimesIdempotentMonoid)
 import Data.Semigroup (Arg(..), Semigroup(stimes))
 #if !(MIN_VERSION_base(4,11,0))
@@ -391,9 +389,7 @@ import Control.Applicative (Const (..))
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits (shiftL, shiftR)
 import qualified Data.Foldable as Foldable
-#ifdef __GLASGOW_HASKELL__
 import Data.Bifoldable
-#endif
 import Utils.Containers.Internal.Prelude hiding
   (lookup, map, filter, foldr, foldl, foldl', null, splitAt, take, drop)
 import Prelude ()
@@ -418,10 +414,10 @@ import Language.Haskell.TH ()
 import GHC.Exts (Proxy#, proxy# )
 #  endif
 import qualified GHC.Exts as GHCExts
-import Text.Read hiding (lift)
 import Data.Data
 import Data.Coerce
 #endif
+import Text.Read hiding (lift)
 import qualified Control.Category as Category
 
 {--------------------------------------------------------------------
@@ -2343,7 +2339,6 @@ instance Functor f => Functor (WhenMatched f k x y) where
   fmap = mapWhenMatched
   {-# INLINE fmap #-}
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
   id = zipWithMatched (\_ _ y -> y)
@@ -2355,7 +2350,6 @@ instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
                 Just r -> runWhenMatched f k x r
   {-# INLINE id #-}
   {-# INLINE (.) #-}
-#endif
 
 -- | Equivalent to @ ReaderT k (ReaderT x (ReaderT y (MaybeT f))) @
 --
@@ -4308,7 +4302,6 @@ bin k x l r
   Eq
 --------------------------------------------------------------------}
 
-#ifdef __GLASGOW_HASKELL__
 instance (Eq k,Eq a) => Eq (Map k a) where
   m1 == m2 = liftEq2 (==) (==) m1 m2
   {-# INLINABLE (==) #-}
@@ -4333,16 +4326,11 @@ sameSizeLiftEq2 keq eq m1 m2 =
       Nothing -> False :*: it
       Just (KeyValue ky y :*: it') -> (keq kx ky && eq x y) :*: it'
 {-# INLINE sameSizeLiftEq2 #-}
-#else
-instance (Eq k,Eq a) => Eq (Map k a) where
-  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
-#endif
 
 {--------------------------------------------------------------------
   Ord
 --------------------------------------------------------------------}
 
-#ifdef __GLASGOW_HASKELL__
 instance (Ord k, Ord v) => Ord (Map k v) where
   compare m1 m2 = liftCmp2 compare compare m1 m2
   {-# INLINABLE compare #-}
@@ -4370,16 +4358,11 @@ liftCmp2 kcmp cmp m1 m2 = case runOrdM (foldMapWithKey f m1) (iterator m2) of
       Nothing -> GT :*: it
       Just (KeyValue ky y :*: it') -> (kcmp kx ky <> cmp x y) :*: it'
 {-# INLINE liftCmp2 #-}
-#else
-instance (Ord k, Ord v) => Ord (Map k v) where
-    compare m1 m2 = compare (toAscList m1) (toAscList m2)
-#endif
 
 {--------------------------------------------------------------------
   Lifted instances
 --------------------------------------------------------------------}
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Show2 Map where
     liftShowsPrec2 spk slk spv slv d m =
@@ -4399,7 +4382,6 @@ instance (Ord k, Read k) => Read1 (Map k) where
       where
         rp' = liftReadsPrec rp rl
         rl' = liftReadList rp rl
-#endif
 
 {--------------------------------------------------------------------
   Functor
@@ -4465,7 +4447,6 @@ instance Foldable.Foldable (Map k) where
   product = foldl' (*) 1
   {-# INLINABLE product #-}
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.6.3.1
 instance Bifoldable Map where
   bifold = go
@@ -4486,7 +4467,6 @@ instance Bifoldable Map where
           go (Bin 1 k v _ _) = f k `mappend` g v
           go (Bin _ k v l r) = go l `mappend` (f k `mappend` (g v `mappend` go r))
   {-# INLINE bifoldMap #-}
-#endif
 
 instance (NFData k, NFData a) => NFData (Map k a) where
     rnf Tip = ()
@@ -4496,7 +4476,7 @@ instance (NFData k, NFData a) => NFData (Map k a) where
   Read
 --------------------------------------------------------------------}
 instance (Ord k, Read k, Read e) => Read (Map k e) where
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
   readPrec = parens $ prec 10 $ do
     Ident "fromList" <- lexP
     xs <- readPrec
diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index 430c00fc3..cf2b9de48 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -219,11 +219,11 @@ import qualified Data.Semigroup as Semigroup
 import Data.Traversable
 
 -- GHC specific stuff
-#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
-import GHC.Exts (build)
 import Text.Read (Lexeme(Ident), lexP, parens, prec,
     readPrec, readListPrec, readListPrecDefault)
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts (build)
 import Data.Data
 import Data.String (IsString(..))
 import qualified Language.Haskell.TH.Syntax as TH
@@ -917,7 +917,6 @@ instance Show a => Show (Seq a) where
         showString "fromList " . shows (toList xs)
 #endif
 
-#ifdef __GLASGOW_HASKELL__
 instance Eq a => Eq (Seq a) where
   xs == ys = liftEq (==) xs ys
   {-# INLINABLE (==) #-}
@@ -941,14 +940,6 @@ instance Eq1 Seq where
 instance Ord1 Seq where
   liftCompare f xs ys = liftCmpLists f (toList xs) (toList ys)
   {-# INLINE liftCompare #-}
-#else
-instance Eq a => Eq (Seq a) where
-    xs == ys = length xs == length ys && F.toList xs == F.toList ys
-
-instance Ord a => Ord (Seq a) where
-    compare xs ys = compare (F.toList xs) (F.toList ys)
-
-#endif
 
 -- Note [Eq and Ord]
 -- ~~~~~~~~~~~~~~~~~
@@ -986,7 +977,7 @@ liftCmpLists cmp = go
 {-# INLINE liftCmpLists #-}
 
 instance Read a => Read (Seq a) where
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
     readPrec = parens $ prec 10 $ do
         Ident "fromList" <- lexP
         xs <- readPrec
@@ -1000,7 +991,6 @@ instance Read a => Read (Seq a) where
         return (fromList xs,t)
 #endif
 
-#if __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Read1 Seq where
   liftReadsPrec _rp readLst p = readParen (p > 10) $ \r -> do
@@ -1011,7 +1001,6 @@ instance Read1 Seq where
 instance Monoid (Seq a) where
     mempty = empty
     mappend = (Semigroup.<>)
-#endif
 
 -- | @since 0.5.7
 instance Semigroup.Semigroup (Seq a) where

From 7699dcea4c3fa10cfe562e75e9bca513decaf2b2 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Mon, 23 Sep 2024 12:36:16 +0200
Subject: [PATCH 07/11] More GHC compat.

---
 containers/src/Data/Sequence/Internal.hs | 55 ++++++++++++------------
 containers/src/Data/Set/Internal.hs      | 23 +++-------
 containers/src/Data/Tree.hs              |  5 +--
 3 files changed, 33 insertions(+), 50 deletions(-)

diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index cf2b9de48..16b577d0a 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -216,12 +216,12 @@ import Data.Foldable (foldr', toList)
 import qualified Data.Foldable as F
 
 import qualified Data.Semigroup as Semigroup
+import Data.Functor.Classes
 import Data.Traversable
 
--- GHC specific stuff
-import Data.Functor.Classes
 import Text.Read (Lexeme(Ident), lexP, parens, prec,
     readPrec, readListPrec, readListPrecDefault)
+-- GHC specific stuff
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
 import Data.Data
@@ -908,6 +908,14 @@ instance Alternative Seq where
     empty = empty
     (<|>) = (><)
 
+instance Eq a => Eq (Seq a) where
+  xs == ys = liftEq (==) xs ys
+  {-# INLINABLE (==) #-}
+
+instance Ord a => Ord (Seq a) where
+  compare xs ys = liftCompare compare xs ys
+  {-# INLINABLE compare #-}
+
 #ifdef TESTING
 instance Show a => Show (Seq a) where
     showsPrec p (Seq x) = showsPrec p x
@@ -917,14 +925,6 @@ instance Show a => Show (Seq a) where
         showString "fromList " . shows (toList xs)
 #endif
 
-instance Eq a => Eq (Seq a) where
-  xs == ys = liftEq (==) xs ys
-  {-# INLINABLE (==) #-}
-
-instance Ord a => Ord (Seq a) where
-  compare xs ys = liftCompare compare xs ys
-  {-# INLINABLE compare #-}
-
 -- | @since 0.5.9
 instance Show1 Seq where
   liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $
@@ -3095,12 +3095,12 @@ delDigit f i (Four a b c d)
 -- | A generalization of 'fmap', 'mapWithIndex' takes a mapping
 -- function that also depends on the element's index, and applies it to every
 -- element in the sequence.
-mapWithIndex :: forall a b . (Int -> a -> b) -> Seq a -> Seq b
+mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
 mapWithIndex f' (Seq xs') = Seq $ mapWithIndexTree (\s (Elem a) -> Elem (f' s a)) 0 xs'
  where
   {-# SPECIALIZE mapWithIndexTree :: (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> FingerTree b #-}
   {-# SPECIALIZE mapWithIndexTree :: (Int -> Node y -> b) -> Int -> FingerTree (Node y) -> FingerTree b #-}
-  mapWithIndexTree :: forall a' b' . Sized a' => (Int -> a' -> b') -> Int -> FingerTree a' -> FingerTree b'
+  mapWithIndexTree :: Sized a => (Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
   mapWithIndexTree _ !_s EmptyT = EmptyT
   mapWithIndexTree f s (Single xs) = Single $ f s xs
   mapWithIndexTree f s (Deep n pr m sf) =
@@ -3114,7 +3114,7 @@ mapWithIndex f' (Seq xs') = Seq $ mapWithIndexTree (\s (Elem a) -> Elem (f' s a)
 
   {-# SPECIALIZE mapWithIndexDigit :: (Int -> Elem y -> b) -> Int -> Digit (Elem y) -> Digit b #-}
   {-# SPECIALIZE mapWithIndexDigit :: (Int -> Node y -> b) -> Int -> Digit (Node y) -> Digit b #-}
-  mapWithIndexDigit :: forall a' b' . Sized a' => (Int -> a' -> b') -> Int -> Digit a' -> Digit b'
+  mapWithIndexDigit :: Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
   mapWithIndexDigit f !s (One a) = One (f s a)
   mapWithIndexDigit f s (Two a b) = Two (f s a) (f sPsa b)
     where
@@ -3133,7 +3133,7 @@ mapWithIndex f' (Seq xs') = Seq $ mapWithIndexTree (\s (Elem a) -> Elem (f' s a)
 
   {-# SPECIALIZE mapWithIndexNode :: (Int -> Elem y -> b) -> Int -> Node (Elem y) -> Node b #-}
   {-# SPECIALIZE mapWithIndexNode :: (Int -> Node y -> b) -> Int -> Node (Node y) -> Node b #-}
-  mapWithIndexNode :: forall a' b' . Sized a' => (Int -> a' -> b') -> Int -> Node a' -> Node b'
+  mapWithIndexNode :: Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
   mapWithIndexNode f s (Node2 ns a b) = Node2 ns (f s a) (f sPsa b)
     where
       !sPsa = s + size a
@@ -3201,7 +3201,7 @@ foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs'
 -- GHC does not specialize until *all* instances are determined.
 -- Although the Sized instance is known at compile time, the Monoid
 -- instance generally is not.
-  foldMapWithIndexTreeE :: forall m a . Monoid m => (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
+  foldMapWithIndexTreeE :: Monoid m => (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
   foldMapWithIndexTreeE _ !_s EmptyT = mempty
   foldMapWithIndexTreeE f s (Single xs) = f s xs
   foldMapWithIndexTreeE f s (Deep _ pr m sf) =
@@ -3212,7 +3212,7 @@ foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs'
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
 
-  foldMapWithIndexTreeN :: forall m a . Monoid m => (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
+  foldMapWithIndexTreeN :: Monoid m => (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
   foldMapWithIndexTreeN _ !_s EmptyT = mempty
   foldMapWithIndexTreeN f s (Single xs) = f s xs
   foldMapWithIndexTreeN f s (Deep _ pr m sf) =
@@ -3250,7 +3250,7 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
 -- GHC does not specialize until *all* instances are determined.
 -- Although the Sized instance is known at compile time, the Applicative
 -- instance generally is not.
-  traverseWithIndexTreeE :: forall f a b . Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
+  traverseWithIndexTreeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
   traverseWithIndexTreeE _ !_s EmptyT = pure EmptyT
   traverseWithIndexTreeE f s (Single xs) = Single <$> f s xs
   traverseWithIndexTreeE f s (Deep n pr m sf) =
@@ -3262,7 +3262,7 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
 
-  traverseWithIndexTreeN :: forall f a b . Applicative f => (Int -> Node a -> f b) -> Int -> FingerTree (Node a) -> f (FingerTree b)
+  traverseWithIndexTreeN :: Applicative f => (Int -> Node a -> f b) -> Int -> FingerTree (Node a) -> f (FingerTree b)
   traverseWithIndexTreeN _ !_s EmptyT = pure EmptyT
   traverseWithIndexTreeN f s (Single xs) = Single <$> f s xs
   traverseWithIndexTreeN f s (Deep n pr m sf) =
@@ -3274,14 +3274,14 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
 
-  traverseWithIndexDigitE :: forall f a b . Applicative f => (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
+  traverseWithIndexDigitE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
   traverseWithIndexDigitE f i t = traverseWithIndexDigit f i t
 
-  traverseWithIndexDigitN :: forall f a b . Applicative f => (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
+  traverseWithIndexDigitN :: Applicative f => (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
   traverseWithIndexDigitN f i t = traverseWithIndexDigit f i t
 
   {-# INLINE traverseWithIndexDigit #-}
-  traverseWithIndexDigit :: forall f a b . (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
+  traverseWithIndexDigit :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
   traverseWithIndexDigit f !s (One a) = One <$> f s a
   traverseWithIndexDigit f s (Two a b) = liftA2 Two (f s a) (f sPsa b)
     where
@@ -3298,14 +3298,14 @@ traverseWithIndex f' (Seq xs') = Seq <$> traverseWithIndexTreeE (\s (Elem a) ->
       !sPsab = sPsa + size b
       !sPsabc = sPsab + size c
 
-  traverseWithIndexNodeE :: forall f a b . Applicative f => (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
+  traverseWithIndexNodeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
   traverseWithIndexNodeE f i t = traverseWithIndexNode f i t
 
-  traverseWithIndexNodeN :: forall f a b . Applicative f => (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
+  traverseWithIndexNodeN :: Applicative f => (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
   traverseWithIndexNodeN f i t = traverseWithIndexNode f i t
 
   {-# INLINE traverseWithIndexNode #-}
-  traverseWithIndexNode :: forall f a b . (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
+  traverseWithIndexNode :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
   traverseWithIndexNode f !s (Node2 ns a b) = liftA2 (Node2 ns) (f s a) (f sPsa b)
     where
       !sPsa = s + size a
@@ -3361,7 +3361,7 @@ fromFunction len f | len < 0 = error "Data.Sequence.fromFunction called with neg
                    | len == 0 = empty
                    | otherwise = Seq $ create (lift_elem f) 1 0 len
   where
-    create :: forall a . (Int -> a) -> Int -> Int -> Int -> FingerTree a
+    create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
     create b{-tree_builder-} !s{-tree_size-} !i{-start_index-} trees = case trees of
        1 -> Single $ b i
        2 -> Deep (2*s) (One (b i)) EmptyT (One (b (i+s)))
@@ -4387,8 +4387,7 @@ fromList = Seq . mkTree . map_elem
               !sub1 = Deep (9*s + size r1 + size sub) d1 sub r1
           in cont b $! Deep (3*s + size r2 + size sub1) d2 sub1 r2
 
-    getNodesC :: forall a b .
-                 Int
+    getNodesC :: Int
               -> Node a
               -> a
               -> ListFinal a b
@@ -4423,7 +4422,7 @@ fromList = Seq . mkTree . map_elem
             !n3 = Node3 s x4 x5 x6
             !n10 = Node3 (3*s) n1 n2 n3
 
-    map_elem :: forall a . [a] -> [Elem a]
+    map_elem :: [a] -> [Elem a]
 #ifdef __GLASGOW_HASKELL__
     map_elem xs = coerce xs
 #else
diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
index b17778ab2..62de3ac27 100644
--- a/containers/src/Data/Set/Internal.hs
+++ b/containers/src/Data/Set/Internal.hs
@@ -245,9 +245,7 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Semigroup (Semigroup((<>)))
 #endif
 import Data.Semigroup (stimesIdempotentMonoid, stimesIdempotent)
-#ifdef __GLASGOW_HASKELL__
 import Data.Functor.Classes
-#endif
 import Data.Functor.Identity (Identity)
 import qualified Data.Foldable as Foldable
 import Control.DeepSeq (NFData(rnf))
@@ -256,11 +254,13 @@ import Utils.Containers.Internal.StrictPair
 import Utils.Containers.Internal.PtrEquality
 import Utils.Containers.Internal.EqOrdUtil (EqM(..), OrdM(..))
 
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
+import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec
+                 , lexP, readListPrecDefault )
+#endif
 #if __GLASGOW_HASKELL__
 import GHC.Exts ( build, lazy )
 import qualified GHC.Exts as GHCExts
-import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec
-                 , lexP, readListPrecDefault )
 import Data.Data
 import Language.Haskell.TH.Syntax (Lift)
 -- See Note [ Template Haskell Dependencies ]
@@ -1309,7 +1309,6 @@ iterNull Nada = True
   Eq
 --------------------------------------------------------------------}
 
-#ifdef __GLASGOW_HASKELL__
 instance Eq a => Eq (Set a) where
   s1 == s2 = liftEq (==) s1 s2
   {-# INLINABLE (==) #-}
@@ -1327,17 +1326,11 @@ sameSizeLiftEq eq s1 s2 =
     f x = EqM $ \it -> case iterNext it of
       Nothing -> False :*: it
       Just (y :*: it') -> eq x y :*: it'
-{-# INLINE sameSizeLiftEq #-}
-#else
-instance Eq a => Eq (Set a) where
-  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
-#endif
 
 {--------------------------------------------------------------------
   Ord
 --------------------------------------------------------------------}
 
-#ifdef __GLASGOW_HASKELL__
 instance Ord a => Ord (Set a) where
   compare s1 s2 = liftCmp compare s1 s2
   {-# INLINABLE compare #-}
@@ -1355,10 +1348,6 @@ liftCmp cmp s1 s2 = case runOrdM (foldMap f s1) (iterator s2) of
       Nothing -> GT :*: it
       Just (y :*: it') -> cmp x y :*: it'
 {-# INLINE liftCmp #-}
-#else
-instance Ord a => Ord (Set a) where
-    compare s1 s2 = compare (toAscList s1) (toAscList s2)
-#endif
 
 {--------------------------------------------------------------------
   Show
@@ -1367,18 +1356,16 @@ instance Show a => Show (Set a) where
   showsPrec p xs = showParen (p > 10) $
     showString "fromList " . shows (toList xs)
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Show1 Set where
     liftShowsPrec sp sl d m =
         showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)
-#endif
 
 {--------------------------------------------------------------------
   Read
 --------------------------------------------------------------------}
 instance (Read a, Ord a) => Read (Set a) where
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
   readPrec = parens $ prec 10 $ do
     Ident "fromList" <- lexP
     xs <- readPrec
diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs
index b6d11e4b2..1fa34484e 100644
--- a/containers/src/Data/Tree.hs
+++ b/containers/src/Data/Tree.hs
@@ -75,9 +75,8 @@ import Control.Monad.Zip (MonadZip (..))
 
 #ifdef __GLASGOW_HASKELL__
 import Data.Coerce
-
-import Data.Functor.Classes
 #endif
+import Data.Functor.Classes
 
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup (..))
@@ -113,7 +112,6 @@ data Tree a = Node {
 -- reasons.
 type Forest a = [Tree a]
 
-#ifdef __GLASGOW_HASKELL__
 -- | @since 0.5.9
 instance Eq1 Tree where
   liftEq eq = leq
@@ -148,7 +146,6 @@ instance Read1 Tree where
       (fr, s9) <- liftReadList rd rdl s8
       ("}", s10) <- lex s9
       pure (Node a fr, s10)
-#endif
 
 instance Functor Tree where
     fmap = fmapTree

From a7e6f04db7415be774e246add5dcc171fdd0b353 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Mon, 23 Sep 2024 12:55:32 +0200
Subject: [PATCH 08/11] A few more GHC compat fixes.

---
 containers/src/Data/Sequence/Internal.hs | 4 +++-
 containers/src/Data/Set/Internal.hs      | 1 +
 containers/src/Data/Tree.hs              | 4 +---
 3 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index 16b577d0a..8b43cff4f 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -219,9 +219,11 @@ import qualified Data.Semigroup as Semigroup
 import Data.Functor.Classes
 import Data.Traversable
 
+-- GHC specific stuff
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
 import Text.Read (Lexeme(Ident), lexP, parens, prec,
     readPrec, readListPrec, readListPrecDefault)
--- GHC specific stuff
+#endif
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
 import Data.Data
diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
index 4701603d7..02bdd8612 100644
--- a/containers/src/Data/Set/Internal.hs
+++ b/containers/src/Data/Set/Internal.hs
@@ -1347,6 +1347,7 @@ sameSizeLiftEq eq s1 s2 =
     f x = EqM $ \it -> case iterNext it of
       Nothing -> False :*: it
       Just (y :*: it') -> eq x y :*: it'
+{-# INLINE sameSizeLiftEq #-}
 
 {--------------------------------------------------------------------
   Ord
diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs
index 1fa34484e..f559aeb7c 100644
--- a/containers/src/Data/Tree.hs
+++ b/containers/src/Data/Tree.hs
@@ -83,9 +83,7 @@ import Data.Semigroup (Semigroup (..))
 #endif
 
 #if MIN_VERSION_base(4,18,0)
-#ifdef __GLASGOW_HASKELL__
 import qualified Data.Foldable1 as Foldable1
-#endif
 import Data.List.NonEmpty (NonEmpty(..))
 #endif
 
@@ -236,7 +234,7 @@ instance Foldable Tree where
     product = foldlMap1' id (*)
     {-# INLINABLE product #-}
 
-#if MIN_VERSION_base(4,18,0) && defined(__GLASGOW_HASKELL__)
+#if MIN_VERSION_base(4,18,0) && (defined(__GLASGOW_HASKELL__) || defined(__MHS__))
 -- | Folds in preorder
 --
 -- @since 0.6.7

From ee28edcd778fcea1aaf6da118d153fcce56a032d Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Mon, 23 Sep 2024 13:00:10 +0200
Subject: [PATCH 09/11] Fix build error.

---
 containers/src/Data/IntMap/Internal.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index a21d8461b..6b80af0fa 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -2114,7 +2114,7 @@ mergeA
       EQL -> binA p1 (go l1 l2) (go r1 r2)
       NOM -> linkA (unPrefix p1) (g1t t1) (unPrefix p2) (g2t t2)
 
-    subsingletonBy :: (Key -> a -> f (Maybe c)) -> Key -> a -> f (IntMap c)
+    subsingletonBy :: Functor f => (Key -> a -> f (Maybe c)) -> Key -> a -> f (IntMap c)
     subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x
     {-# INLINE subsingletonBy #-}
 

From fc6a7d302676922c3f3c0e07752acf3155efee46 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Fri, 27 Sep 2024 14:23:15 +0200
Subject: [PATCH 10/11] Minor portability fixes.

---
 .github/workflows/mhs-ci.yml                        | 2 +-
 containers/src/Data/IntMap/Internal.hs              | 2 ++
 containers/src/Data/Map/Internal.hs                 | 2 ++
 containers/src/Data/Sequence/Internal.hs            | 2 +-
 containers/src/Data/Tree.hs                         | 2 +-
 containers/src/Utils/Containers/Internal/Prelude.hs | 1 -
 6 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/mhs-ci.yml b/.github/workflows/mhs-ci.yml
index 2a772e50d..5893748d4 100644
--- a/.github/workflows/mhs-ci.yml
+++ b/.github/workflows/mhs-ci.yml
@@ -17,7 +17,7 @@ jobs:
     - name: checkout mhs repo
       uses: actions/checkout@v4
       with:
-        repository: augustss/MicroHs
+        repository: augustss/MicroHs@stable-1
         path: mhs
     - name: make mhs
       run: |
diff --git a/containers/src/Data/IntMap/Internal.hs b/containers/src/Data/IntMap/Internal.hs
index 6b80af0fa..ad9213bff 100644
--- a/containers/src/Data/IntMap/Internal.hs
+++ b/containers/src/Data/IntMap/Internal.hs
@@ -328,7 +328,9 @@ import Language.Haskell.TH.Syntax (Lift)
 -- See Note [ Template Haskell Dependencies ]
 import Language.Haskell.TH ()
 #endif
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
 import Text.Read
+#endif
 import qualified Control.Category as Category
 
 
diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs
index 2ddef889c..25b814769 100644
--- a/containers/src/Data/Map/Internal.hs
+++ b/containers/src/Data/Map/Internal.hs
@@ -417,7 +417,9 @@ import qualified GHC.Exts as GHCExts
 import Data.Data
 import Data.Coerce
 #endif
+#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
 import Text.Read hiding (lift)
+#endif
 import qualified Control.Category as Category
 
 {--------------------------------------------------------------------
diff --git a/containers/src/Data/Sequence/Internal.hs b/containers/src/Data/Sequence/Internal.hs
index 8b43cff4f..ed93c162f 100644
--- a/containers/src/Data/Sequence/Internal.hs
+++ b/containers/src/Data/Sequence/Internal.hs
@@ -233,6 +233,7 @@ import qualified Language.Haskell.TH.Syntax as TH
 import Language.Haskell.TH ()
 import GHC.Generics (Generic, Generic1)
 
+-- Array stuff, with GHC.Arr on GHC
 import qualified GHC.Arr
 import Data.Coerce
 import qualified GHC.Exts
@@ -240,7 +241,6 @@ import qualified GHC.Exts
 import qualified Data.List
 #endif
 
--- Array stuff, with GHC.Arr on GHC
 import Data.Array (Ix, Array)
 import qualified Data.Array
 
diff --git a/containers/src/Data/Tree.hs b/containers/src/Data/Tree.hs
index f559aeb7c..2e3765394 100644
--- a/containers/src/Data/Tree.hs
+++ b/containers/src/Data/Tree.hs
@@ -234,7 +234,7 @@ instance Foldable Tree where
     product = foldlMap1' id (*)
     {-# INLINABLE product #-}
 
-#if MIN_VERSION_base(4,18,0) && (defined(__GLASGOW_HASKELL__) || defined(__MHS__))
+#if MIN_VERSION_base(4,18,0)
 -- | Folds in preorder
 --
 -- @since 0.6.7
diff --git a/containers/src/Utils/Containers/Internal/Prelude.hs b/containers/src/Utils/Containers/Internal/Prelude.hs
index 71d0929f1..dc1e0ad1a 100644
--- a/containers/src/Utils/Containers/Internal/Prelude.hs
+++ b/containers/src/Utils/Containers/Internal/Prelude.hs
@@ -7,7 +7,6 @@ module Utils.Containers.Internal.Prelude
   , Foldable (..)
 #ifdef __MHS__
   , Traversable(..)
-  , NonEmpty
   , any, concatMap
 #endif
   )

From 906c825084b915ea8f5ae0ff23d45b8ef5331047 Mon Sep 17 00:00:00 2001
From: Lennart Augustsson <lennart@augustsson.net>
Date: Fri, 27 Sep 2024 15:44:27 +0200
Subject: [PATCH 11/11] Try with different syntax for repo branch

---
 .github/workflows/mhs-ci.yml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/mhs-ci.yml b/.github/workflows/mhs-ci.yml
index 5893748d4..b7a93e187 100644
--- a/.github/workflows/mhs-ci.yml
+++ b/.github/workflows/mhs-ci.yml
@@ -17,7 +17,8 @@ jobs:
     - name: checkout mhs repo
       uses: actions/checkout@v4
       with:
-        repository: augustss/MicroHs@stable-1
+        repository: augustss/MicroHs
+        ref: stable-1
         path: mhs
     - name: make mhs
       run: |