-
Notifications
You must be signed in to change notification settings - Fork 178
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Various changes to make it compile with MicroHs. #1043
base: master
Are you sure you want to change the base?
Changes from all commits
89860fc
e9651ef
4d8fe61
393076b
e7b38be
b07386e
7699dce
fb05d9c
a7e6f04
ee28edc
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -324,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 | ||
augustss marked this conversation as resolved.
Show resolved
Hide resolved
|
||
import Text.Read | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. We should use |
||
import qualified Control.Category as Category | ||
|
||
|
||
|
@@ -395,8 +395,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) | ||
|
@@ -2112,6 +2114,7 @@ mergeA | |
EQL -> binA p1 (go l1 l2) (go r1 r2) | ||
NOM -> linkA (unPrefix p1) (g1t t1) (unPrefix p2) (g2t t2) | ||
|
||
subsingletonBy :: Functor f => (Key -> a -> f (Maybe c)) -> Key -> a -> f (IntMap c) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Is the signature required for MHS? |
||
subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x | ||
{-# INLINE subsingletonBy #-} | ||
|
||
|
@@ -3498,7 +3501,7 @@ instance Show1 IntMap where | |
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 | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -7,8 +7,8 @@ | |
{-# LANGUAGE StandaloneDeriving #-} | ||
{-# LANGUAGE Trustworthy #-} | ||
{-# LANGUAGE TypeFamilies #-} | ||
#endif | ||
#define USE_MAGIC_PROXY 1 | ||
#endif | ||
|
||
#ifdef USE_MAGIC_PROXY | ||
{-# LANGUAGE MagicHash #-} | ||
|
@@ -414,12 +414,11 @@ 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 qualified Control.Category as Category | ||
import Data.Coerce | ||
#endif | ||
|
||
import Text.Read hiding (lift) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Same here. |
||
import qualified Control.Category as Category | ||
|
||
{-------------------------------------------------------------------- | ||
Operators | ||
|
@@ -4479,7 +4478,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 | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -220,28 +220,31 @@ import Data.Functor.Classes | |
import Data.Traversable | ||
|
||
-- GHC specific stuff | ||
#ifdef __GLASGOW_HASKELL__ | ||
import GHC.Exts (build) | ||
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__) | ||
import Text.Read (Lexeme(Ident), lexP, parens, prec, | ||
readPrec, readListPrec, readListPrecDefault) | ||
#endif | ||
#ifdef __GLASGOW_HASKELL__ | ||
import GHC.Exts (build) | ||
import Data.Data | ||
import Data.String (IsString(..)) | ||
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 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Is this import used somewhere? |
||
#endif | ||
|
||
-- Array stuff, with GHC.Arr on GHC | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Can |
||
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(..)) | ||
|
||
|
@@ -976,7 +979,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 | ||
|
@@ -4260,7 +4263,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 +4311,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 +4338,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 +4380,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 = | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -73,8 +73,9 @@ import Language.Haskell.TH () | |
|
||
import Control.Monad.Zip (MonadZip (..)) | ||
|
||
#ifdef __GLASGOW_HASKELL__ | ||
import Data.Coerce | ||
|
||
#endif | ||
import Data.Functor.Classes | ||
|
||
#if !MIN_VERSION_base(4,11,0) | ||
|
@@ -233,7 +234,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__) || defined(__MHS__)) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. We can drop the compiler checks here. Let's assume Foldable1 will be around, or we'd be doing the same for Eq1, Ord1, etc. |
||
-- | Folds in preorder | ||
-- | ||
-- @since 0.6.7 | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. NonEmpty seems a little odd, is it required? |
||
, 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)) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Should this check out a particular version?
We wouldn't want containers CI to break in there is an issue with MHS head.
We can update the version periodically, as we do for GHC.