Make it compile with MicroHs (#553)

Author: augustss

.github/workflows/mhs-ci.yml

@@ -0,0 +1,37 @@
+name: mhs-ci
+
+on:
+  push:
+    branches: [ "master" ]
+  pull_request:
+    branches: [ "master" ]
+
+jobs:
+  build-mhs-pretty:
+    runs-on: ubuntu-latest
+    steps:
+
+    - name: checkout mhs repo
+      uses: actions/checkout@v4
+      with:
+        repository: augustss/MicroHs
+        ref: v0.14.23.1
+        path: mhs
+    - name: make and install mhs
+      run: |
+        cd mhs
+        make minstall
+
+    - name: checkout unordered-containers repo
+      uses: actions/checkout@v4
+      with:
+        path: unordered-containers
+    - name: compile and install unordered-containers package
+      run: |
+        PATH="$HOME/.mcabal/bin:$PATH"
+        cd unordered-containers
+        mcabal -r install
+
+    - name: cleanup
+      run: |
+        rm -rf $HOME/.mcabal

Data/HashMap/Internal.hs

@@ -149,6 +149,9 @@ module Data.HashMap.Internal
     , adjust#
     ) where
 
+import Data.Traversable           -- MicroHs needs this since its Prelude does not have Foldable&Traversable.
+                                  -- It's harmless for GHC, and putting it first avoid a warning.
+
 import Control.Applicative        (Const (..))
 import Control.DeepSeq            (NFData (..), NFData1 (..), NFData2 (..))
 import Control.Monad.ST           (ST, runST)
@@ -192,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(__GLASGOW_HASKELL__)
 -- | @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
@@ -701,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(__GLASGOW_HASKELL__)
   forall rep (r :: TYPE rep) k v.
+#else
+  forall r k v.
+#endif
      Eq k
   => ((# #) -> r)    -- Absent continuation
   -> (v -> Int -> r) -- Present continuation
@@ -915,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
@@ -2588,7 +2598,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(__GLASGOW_HASKELL__)
   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
@@ -2841,9 +2855,11 @@ otherOfOneOrZero :: Int -> Int
 otherOfOneOrZero i = 1 - i
 {-# INLINE otherOfOneOrZero #-}
 
+#if defined(__GLASGOW_HASKELL__)
 ------------------------------------------------------------------------
 -- 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

@@ -465,14 +465,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
@@ -482,14 +483,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
@@ -498,7 +500,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
@@ -509,6 +511,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
@@ -520,14 +523,15 @@ filter f = \ ary ->
           else go_filter ary mary (iAry + 1) iMary n
 {-# INLINE filter #-}
 
-mapMaybe :: (a -> Maybe b) -> Array a -> Array b
+mapMaybe :: forall a b . (a -> Maybe b) -> Array a -> Array b
 mapMaybe f = \ ary ->
     let !n = length ary
     in run $ do
       mary <- new_ n
       len <- go_mapMaybe ary mary 0 0 n
       shrink mary len
   where
+    go_mapMaybe :: forall s . Array a -> MArray s b -> Int -> Int -> Int -> ST s Int
     go_mapMaybe !ary !mary !iAry !iMary !n
       | iAry >= n = return iMary
       | otherwise = do
@@ -539,36 +543,40 @@ mapMaybe f = \ ary ->
             go_mapMaybe ary mary (iAry + 1) (iMary + 1) n
 {-# INLINE mapMaybe #-}
 
-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(__GLASGOW_HASKELL__)
 -- | @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

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase    #-}
 {-# LANGUAGE MagicHash     #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE Trustworthy   #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# OPTIONS_HADDOCK not-home #-}
@@ -124,7 +125,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 (..))
@@ -228,11 +229,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(__GLASGOW_HASKELL__)
 instance (Eq a, Hashable a) => Exts.IsList (HashSet a) where
     type Item (HashSet a) = a
     fromList = fromList
     toList   = toList
+#endif

unordered-containers.cabal

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