Skip to content

Commit 24b0b3a

Browse files
augustssaugustss
authored
Various changes to make it compile with MicroHs (#1043)
* Mostly #ifdefs and some type signatures. * Add CI for MicroHs compilation.
1 parent a669855 commit 24b0b3a

File tree

15 files changed

+106
-34
lines changed

15 files changed

+106
-34
lines changed

‎.github/workflows/mhs-ci.yml‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
name: MicroHs CI for containers
2+
3+
on:
4+
push:
5+
branches: [ "master" ]
6+
pull_request:
7+
branches: [ "master" ]
8+
9+
jobs:
10+
build-mhs-containers:
11+
runs-on: ubuntu-latest
12+
steps:
13+
- name: checkout containers repo
14+
uses: actions/checkout@v4
15+
with:
16+
path: cont
17+
- name: checkout mhs repo
18+
uses: actions/checkout@v4
19+
with:
20+
repository: augustss/MicroHs
21+
ref: stable-1
22+
path: mhs
23+
- name: make mhs
24+
run: |
25+
cd mhs
26+
make
27+
# 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.
28+
# I'll make it nicer with mcabal later.
29+
- name: compile containers package
30+
run: |
31+
cd mhs
32+
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

‎containers/changelog.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@
2727

2828
### Bug fixes
2929

30+
* Make the package compile with MicroHs. (Lennart Augustsson)
31+
3032
* `Data.Map.Strict.mergeWithKey` now forces the result of the combining function
3133
to WHNF. (Soumik Sarkar)
3234

‎containers/containers.cabal‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,9 @@ source-repository head
3636

3737
Library
3838
default-language: Haskell2010
39-
build-depends: base >= 4.10 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.6, template-haskell
39+
build-depends: base >= 4.10 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.6
40+
if impl(ghc)
41+
build-depends: template-haskell
4042
hs-source-dirs: src
4143
ghc-options: -O2 -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates
4244

‎containers/include/containers.h‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,9 @@
66
#define HASKELL_CONTAINERS_H
77

88
/*
9-
* On GHC, include MachDeps.h to get WORD_SIZE_IN_BITS macro.
9+
* On GHC and MicroHs, include MachDeps.h to get WORD_SIZE_IN_BITS macro.
1010
*/
11-
#ifdef __GLASGOW_HASKELL__
11+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
1212
#include "MachDeps.h"
1313
#endif
1414

‎containers/src/Data/Graph.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -210,8 +210,10 @@ instance Show1 SCC where
210210
instance Read1 SCC where
211211
liftReadsPrec rp rl = readsData $
212212
readsUnaryWith rp "AcyclicSCC" AcyclicSCC <>
213-
readsUnaryWith (liftReadsPrec rp rl) "NECyclicSCC" NECyclicSCC <>
214-
readsUnaryWith (const rl) "CyclicSCC" CyclicSCC
213+
readsUnaryWith (liftReadsPrec rp rl) "NECyclicSCC" NECyclicSCC
214+
#ifdef __GLASGOW_HASKELL__
215+
<> readsUnaryWith (const rl) "CyclicSCC" CyclicSCC
216+
#endif
215217

216218
-- | @since 0.5.9
217219
instance F.Foldable SCC where

‎containers/src/Data/IntMap/Internal.hs‎

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -324,11 +324,13 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex,
324324
import qualified Data.Data as Data
325325
import GHC.Exts (build)
326326
import qualified GHC.Exts as GHCExts
327-
import Text.Read
328327
import Language.Haskell.TH.Syntax (Lift)
329328
-- See Note [ Template Haskell Dependencies ]
330329
import Language.Haskell.TH ()
331330
#endif
331+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
332+
import Text.Read
333+
#endif
332334
import qualified Control.Category as Category
333335

334336

@@ -395,8 +397,10 @@ data IntMap a = Bin {-# UNPACK #-} !Prefix
395397
type IntSetPrefix = Int
396398
type IntSetBitMap = Word
397399

400+
#ifdef __GLASGOW_HASKELL__
398401
-- | @since 0.6.6
399402
deriving instance Lift a => Lift (IntMap a)
403+
#endif
400404

401405
bitmapOf :: Int -> IntSetBitMap
402406
bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask)
@@ -2112,6 +2116,7 @@ mergeA
21122116
EQL -> binA p1 (go l1 l2) (go r1 r2)
21132117
NOM -> linkA (unPrefix p1) (g1t t1) (unPrefix p2) (g2t t2)
21142118

2119+
subsingletonBy :: Functor f => (Key -> a -> f (Maybe c)) -> Key -> a -> f (IntMap c)
21152120
subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x
21162121
{-# INLINE subsingletonBy #-}
21172122

@@ -3498,7 +3503,7 @@ instance Show1 IntMap where
34983503
Read
34993504
--------------------------------------------------------------------}
35003505
instance (Read e) => Read (IntMap e) where
3501-
#ifdef __GLASGOW_HASKELL__
3506+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
35023507
readPrec = parens $ prec 10 $ do
35033508
Ident "fromList" <- lexP
35043509
xs <- readPrec

‎containers/src/Data/IntSet/Internal.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1683,16 +1683,16 @@ takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Nat -> Nat
16831683
{-# INLINE foldr'Bits #-}
16841684
{-# INLINE takeWhileAntitoneBits #-}
16851685

1686+
lowestBitMask :: Nat -> Nat
1687+
lowestBitMask x = x .&. negate x
1688+
{-# INLINE lowestBitMask #-}
1689+
16861690
#if defined(__GLASGOW_HASKELL__)
16871691

16881692
lowestBitSet x = countTrailingZeros x
16891693

16901694
highestBitSet x = WORD_SIZE_IN_BITS - 1 - countLeadingZeros x
16911695

1692-
lowestBitMask :: Nat -> Nat
1693-
lowestBitMask x = x .&. negate x
1694-
{-# INLINE lowestBitMask #-}
1695-
16961696
-- Reverse the order of bits in the Nat.
16971697
revNat :: Nat -> Nat
16981698
#if WORD_SIZE_IN_BITS==32

‎containers/src/Data/Map/Internal.hs‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,8 @@
77
{-# LANGUAGE StandaloneDeriving #-}
88
{-# LANGUAGE Trustworthy #-}
99
{-# LANGUAGE TypeFamilies #-}
10-
#endif
1110
#define USE_MAGIC_PROXY 1
11+
#endif
1212

1313
#ifdef USE_MAGIC_PROXY
1414
{-# LANGUAGE MagicHash #-}
@@ -414,12 +414,13 @@ import Language.Haskell.TH ()
414414
import GHC.Exts (Proxy#, proxy# )
415415
# endif
416416
import qualified GHC.Exts as GHCExts
417-
import Text.Read hiding (lift)
418417
import Data.Data
419-
import qualified Control.Category as Category
420418
import Data.Coerce
421419
#endif
422-
420+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
421+
import Text.Read hiding (lift)
422+
#endif
423+
import qualified Control.Category as Category
423424

424425
{--------------------------------------------------------------------
425426
Operators
@@ -4479,7 +4480,7 @@ instance (NFData k, NFData a) => NFData (Map k a) where
44794480
Read
44804481
--------------------------------------------------------------------}
44814482
instance (Ord k, Read k, Read e) => Read (Map k e) where
4482-
#ifdef __GLASGOW_HASKELL__
4483+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
44834484
readPrec = parens $ prec 10 $ do
44844485
Ident "fromList" <- lexP
44854486
xs <- readPrec

‎containers/src/Data/Map/Strict/Internal.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -342,7 +342,9 @@ import Data.Map.Internal
342342
, argSet
343343
, assocs
344344
, atKeyImpl
345+
#ifdef __GLASGOW_HASKELL__
345346
, atKeyPlain
347+
#endif
346348
, balance
347349
, balanceL
348350
, balanceR

‎containers/src/Data/Sequence/Internal.hs‎

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -220,28 +220,31 @@ import Data.Functor.Classes
220220
import Data.Traversable
221221

222222
-- GHC specific stuff
223-
#ifdef __GLASGOW_HASKELL__
224-
import GHC.Exts (build)
223+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
225224
import Text.Read (Lexeme(Ident), lexP, parens, prec,
226225
readPrec, readListPrec, readListPrecDefault)
226+
#endif
227+
#ifdef __GLASGOW_HASKELL__
228+
import GHC.Exts (build)
227229
import Data.Data
228230
import Data.String (IsString(..))
229231
import qualified Language.Haskell.TH.Syntax as TH
230232
-- See Note [ Template Haskell Dependencies ]
231233
import Language.Haskell.TH ()
232234
import GHC.Generics (Generic, Generic1)
233-
#endif
234235

235236
-- Array stuff, with GHC.Arr on GHC
236-
import Data.Array (Ix, Array)
237-
import qualified Data.Array
238-
#ifdef __GLASGOW_HASKELL__
239237
import qualified GHC.Arr
238+
import Data.Coerce
239+
import qualified GHC.Exts
240+
#else
241+
import qualified Data.List
240242
#endif
241243

244+
import Data.Array (Ix, Array)
245+
import qualified Data.Array
246+
242247
import Utils.Containers.Internal.Coercions ((.#), (.^#))
243-
import Data.Coerce
244-
import qualified GHC.Exts
245248

246249
import Data.Functor.Identity (Identity(..))
247250

@@ -976,7 +979,7 @@ liftCmpLists cmp = go
976979
{-# INLINE liftCmpLists #-}
977980

978981
instance Read a => Read (Seq a) where
979-
#ifdef __GLASGOW_HASKELL__
982+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
980983
readPrec = parens $ prec 10 $ do
981984
Ident "fromList" <- lexP
982985
xs <- readPrec
@@ -4260,7 +4263,7 @@ fromList :: [a] -> Seq a
42604263
-- it gets a bit hard to read.
42614264
fromList = Seq . mkTree . map_elem
42624265
where
4263-
#ifdef __GLASGOW_HASKELL__
4266+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
42644267
mkTree :: forall a' . [Elem a'] -> FingerTree (Elem a')
42654268
#else
42664269
mkTree :: [Elem a] -> FingerTree (Elem a)
@@ -4308,7 +4311,7 @@ fromList = Seq . mkTree . map_elem
43084311
where
43094312
d2 = Three x1 x2 x3
43104313
d1 = Three (Node3 3 x4 x5 x6) (Node3 3 x7 x8 x9) (Node3 3 y0 y1 y2)
4311-
#ifdef __GLASGOW_HASKELL__
4314+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
43124315
cont :: (Digit (Node (Elem a')), Digit (Elem a')) -> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a')
43134316
#endif
43144317
cont (!r1, !r2) !sub =
@@ -4335,7 +4338,7 @@ fromList = Seq . mkTree . map_elem
43354338
!n10 = Node3 (3*s) n1 n2 n3
43364339

43374340
mkTreeC ::
4338-
#ifdef __GLASGOW_HASKELL__
4341+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
43394342
forall a b c .
43404343
#endif
43414344
(b -> FingerTree (Node a) -> c)
@@ -4377,7 +4380,7 @@ fromList = Seq . mkTree . map_elem
43774380
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)))))))))))))))) =
43784381
mkTreeC cont2 (9*s) (getNodesC (3*s) (Node3 (3*s) y3 y4 y5) y6 xs)
43794382
where
4380-
#ifdef __GLASGOW_HASKELL__
4383+
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
43814384
cont2 :: (b, Digit (Node (Node a)), Digit (Node a)) -> FingerTree (Node (Node (Node a))) -> c
43824385
#endif
43834386
cont2 (b, r1, r2) !sub =

0 commit comments

Comments
 (0)