Make it compile with MicroHs

Author: augustss

Data/HashMap/Internal.hs

@@ -181,6 +181,10 @@ import qualified Data.List                   as List
 import qualified GHC.Exts                    as Exts
 import qualified Language.Haskell.TH.Syntax  as TH
 
+#if defined(__MHS__)
+import Data.Traversable
+#endif
+
 -- | Convenience function.  Compute a hash value for the given value.
 hash :: H.Hashable a => a -> Hash
 hash = fromIntegral . H.hash
@@ -191,9 +195,11 @@ data Leaf k v = L !k v
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
 
+#if !defined(__MHS__)
 -- | @since 0.2.17.0
 instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
   liftTyped (L k v) = [|| L k $! v ||]
+#endif
 
 -- | @since 0.2.14.0
 instance NFData k => NFData1 (Leaf k) where
@@ -700,7 +706,11 @@ lookupRecordCollision# h k m =
 -- this whole thing is always inlined, we don't have to worry about
 -- any extra CPS overhead.
 lookupCont ::
+#if !defined(__MHS__)
   forall rep (r :: TYPE rep) k v.
+#else
+  forall r k v.
+#endif
      Eq k
   => ((# #) -> r)    -- Absent continuation
   -> (v -> Int -> r) -- Present continuation
@@ -914,10 +924,11 @@ setAtPosition i k x ary = A.update ary i (L k x)
 
 
 -- | In-place update version of insert
-unsafeInsert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
+unsafeInsert :: forall k v. (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
 unsafeInsert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
+    go :: forall s. Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
     go !h !k x !_ Empty = return $! Leaf h (L k x)
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
@@ -2413,7 +2424,11 @@ fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey (\k' a b -> (
 -- | \(O(n)\) Look up the value associated with the given key in an
 -- array.
 lookupInArrayCont ::
+#if !defined(__MHS__)
   forall rep (r :: TYPE rep) k v.
+#else
+  forall r k v.
+#endif
   Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
 lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0)
   where
@@ -2666,9 +2681,11 @@ otherOfOneOrZero :: Int -> Int
 otherOfOneOrZero i = 1 - i
 {-# INLINE otherOfOneOrZero #-}
 
+#if !defined(__MHS__)
 ------------------------------------------------------------------------
 -- IsList instance
 instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where
     type Item (HashMap k v) = (k, v)
     fromList = fromList
     toList   = toList
+#endif

Data/HashMap/Internal/Array.hs

@@ -464,14 +464,15 @@ deleteM ary idx = do
   where !count = length ary
 {-# INLINE deleteM #-}
 
-map :: (a -> b) -> Array a -> Array b
+map :: forall a b . (a -> b) -> Array a -> Array b
 map f = \ ary ->
     let !n = length ary
     in run $ do
         mary <- new_ n
         go ary mary 0 n
         return mary
   where
+    go :: forall s. Array a -> MArray s b -> Int -> Int -> ST s ()
     go ary mary i n
         | i >= n    = return ()
         | otherwise = do
@@ -481,14 +482,15 @@ map f = \ ary ->
 {-# INLINE map #-}
 
 -- | Strict version of 'map'.
-map' :: (a -> b) -> Array a -> Array b
+map' :: forall a b . (a -> b) -> Array a -> Array b
 map' f = \ ary ->
     let !n = length ary
     in run $ do
         mary <- new_ n
         go ary mary 0 n
         return mary
   where
+    go :: forall s . Array a -> MArray s b -> Int -> Int -> ST s ()
     go ary mary i n
         | i >= n    = return ()
         | otherwise = do
@@ -497,7 +499,7 @@ map' f = \ ary ->
              go ary mary (i+1) n
 {-# INLINE map' #-}
 
-filter :: (a -> Bool) -> Array a -> Array a
+filter :: forall a . (a -> Bool) -> Array a -> Array a
 filter f = \ ary ->
     let !n = length ary
     in run $ do
@@ -508,6 +510,7 @@ filter f = \ ary ->
     -- Without the @!@ on @ary@ we end up reboxing the array when using
     -- 'differenceCollisions'. See
     -- https://gitlab.haskell.org/ghc/ghc/-/issues/26525.
+    go_filter :: forall s . Array a -> MArray s a -> Int -> Int -> Int -> ST s Int
     go_filter !ary !mary !iAry !iMary !n
       | iAry >= n = return iMary
       | otherwise = do
@@ -519,36 +522,40 @@ filter f = \ ary ->
           else go_filter ary mary (iAry + 1) iMary n
 {-# INLINE filter #-}
 
-fromList :: Int -> [a] -> Array a
+fromList :: forall a . Int -> [a] -> Array a
 fromList n xs0 =
     CHECK_EQ("fromList", n, Prelude.length xs0)
         run $ do
             mary <- new_ n
             go xs0 mary 0
             return mary
   where
+    go :: forall s . [a] -> MArray s a -> Int -> ST s ()
     go []     !_   !_ = return ()
     go (x:xs) mary i  = do write mary i x
                            go xs mary (i+1)
 
-fromList' :: Int -> [a] -> Array a
+fromList' :: forall a . Int -> [a] -> Array a
 fromList' n xs0 =
     CHECK_EQ("fromList'", n, Prelude.length xs0)
         run $ do
             mary <- new_ n
             go xs0 mary 0
             return mary
   where
+    go :: forall s . [a] -> MArray s a -> Int -> ST s ()
     go []      !_   !_ = return ()
     go (!x:xs) mary i  = do write mary i x
                             go xs mary (i+1)
 
+#if !defined(__MHS__)
 -- | @since 0.2.17.0
 instance TH.Lift a => TH.Lift (Array a) where
   liftTyped ar = [|| fromList' arlen arlist ||]
     where
       arlen = length ar
       arlist = toList ar
+#endif
 
 toList :: Array a -> [a]
 toList = foldr (:) []

Data/HashMap/Internal/Strict.hs

@@ -123,7 +123,7 @@ module Data.HashMap.Internal.Strict
     ) where
 
 import Control.Applicative   (Const (..))
-import Control.Monad.ST      (runST)
+import Control.Monad.ST      (runST, ST)
 import Data.Bits             ((.&.), (.|.))
 import Data.Coerce           (coerce)
 import Data.Functor.Identity (Identity (..))
@@ -227,11 +227,12 @@ unsafeInsertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
 unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0
 {-# INLINABLE unsafeInsertWith #-}
 
-unsafeInsertWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> k -> v -> HashMap k v
+unsafeInsertWithKey :: forall k v. (Eq k, Hashable k) => (k -> v -> v -> v) -> k -> v -> HashMap k v
                     -> HashMap k v
 unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
+    go :: forall s. Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
     go !h !k x !_ Empty = return $! leaf h k x
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k

Data/HashSet/Internal.hs

@@ -450,7 +450,9 @@ fromList :: (Eq a, Hashable a) => [a] -> HashSet a
 fromList = HashSet . List.foldl' (\ m k -> H.unsafeInsert k () m) H.empty
 {-# INLINE fromList #-}
 
+#if !defined(__MHS__)
 instance (Eq a, Hashable a) => Exts.IsList (HashSet a) where
     type Item (HashSet a) = a
     fromList = fromList
     toList   = toList
+#endif

unordered-containers.cabal

@@ -58,7 +58,9 @@ library
     base >= 4.14 && < 5,
     deepseq >= 1.4.3,
     hashable >= 1.4 && < 1.6,
-    template-haskell >= 2.16 && < 2.24
+  if impl(ghc)
+    build-depends:
+      template-haskell >= 2.16 && < 2.24
 
   default-language: Haskell2010