summaryrefslogtreecommitdiff
path: root/src/runtime/haskell
diff options
context:
space:
mode:
authorInari Listenmaa <inari.listenmaa@gmail.com>2025-08-02 18:59:07 +0200
committerGitHub <noreply@github.com>2025-08-02 18:59:07 +0200
commit65e85c5a3cba4df82547a018b4135ac63551d8df (patch)
tree33a842b24b9e3851c6b6cf095f11f562b0fd6b7f /src/runtime/haskell
parent981d6b9bddacee6a204ac48f2a4e27f4cca1bd47 (diff)
parent01c4f82e077b93cb2318830c56070c0ec15a20e6 (diff)
Merge pull request #175 from inariksit/new-ghc
Changes to make it work with newer stack/GHC: - unix library changed API in 2.8 - Monad of no return & Semigroup as a superclass of Monoid - import Control.Monad (join, when, (<=<)) - fixed CI issues
Diffstat (limited to 'src/runtime/haskell')
-rw-r--r--src/runtime/haskell/Data/Binary/Builder.hs2
-rw-r--r--src/runtime/haskell/Data/Binary/Get.hs4
-rw-r--r--src/runtime/haskell/Data/Binary/Put.hs14
-rw-r--r--src/runtime/haskell/PGF/TypeCheck.hs4
4 files changed, 13 insertions, 11 deletions
diff --git a/src/runtime/haskell/Data/Binary/Builder.hs b/src/runtime/haskell/Data/Binary/Builder.hs
index 8dc46f816..e22fa4a4c 100644
--- a/src/runtime/haskell/Data/Binary/Builder.hs
+++ b/src/runtime/haskell/Data/Binary/Builder.hs
@@ -114,7 +114,7 @@ instance Semigroup Builder where
instance Monoid Builder where
mempty = empty
{-# INLINE mempty #-}
- mappend = append
+ mappend = (<>)
{-# INLINE mappend #-}
------------------------------------------------------------------------
diff --git a/src/runtime/haskell/Data/Binary/Get.hs b/src/runtime/haskell/Data/Binary/Get.hs
index a33c5c5a3..ec6309fae 100644
--- a/src/runtime/haskell/Data/Binary/Get.hs
+++ b/src/runtime/haskell/Data/Binary/Get.hs
@@ -127,11 +127,11 @@ instance Functor Get where
{-# INLINE fmap #-}
instance Applicative Get where
- pure = return
+ pure a = Get (\s -> (a, s))
(<*>) = ap
instance Monad Get where
- return a = Get (\s -> (a, s))
+ return = pure
{-# INLINE return #-}
m >>= k = Get (\s -> case unGet m s of
diff --git a/src/runtime/haskell/Data/Binary/Put.hs b/src/runtime/haskell/Data/Binary/Put.hs
index 189cf806f..05d23fba6 100644
--- a/src/runtime/haskell/Data/Binary/Put.hs
+++ b/src/runtime/haskell/Data/Binary/Put.hs
@@ -77,15 +77,20 @@ instance Functor PutM where
{-# INLINE fmap #-}
instance Applicative PutM where
- pure = return
+ pure a = Put $ PairS a mempty
m <*> k = Put $
let PairS f w = unPut m
PairS x w' = unPut k
in PairS (f x) (w `mappend` w')
+ m *> k = Put $
+ let PairS _ w = unPut m
+ PairS b w' = unPut k
+ in PairS b (w `mappend` w')
+ {-# INLINE (*>) #-}
-- Standard Writer monad, with aggressive inlining
instance Monad PutM where
- return a = Put $ PairS a mempty
+ return = pure
{-# INLINE return #-}
m >>= k = Put $
@@ -94,10 +99,7 @@ instance Monad PutM where
in PairS b (w `mappend` w')
{-# INLINE (>>=) #-}
- m >> k = Put $
- let PairS _ w = unPut m
- PairS b w' = unPut k
- in PairS b (w `mappend` w')
+ (>>) = (*>)
{-# INLINE (>>) #-}
tell :: Builder -> Put
diff --git a/src/runtime/haskell/PGF/TypeCheck.hs b/src/runtime/haskell/PGF/TypeCheck.hs
index 82bd47b7a..f02986fc0 100644
--- a/src/runtime/haskell/PGF/TypeCheck.hs
+++ b/src/runtime/haskell/PGF/TypeCheck.hs
@@ -94,11 +94,11 @@ class Selector s where
select :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType)
instance Applicative (TcM s) where
- pure = return
+ pure x = TcM (\abstr k h -> k x)
(<*>) = ap
instance Monad (TcM s) where
- return x = TcM (\abstr k h -> k x)
+ return = pure
f >>= g = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h)
instance Selector s => Alternative (TcM s) where