1
0
forked from GitHub/gf-core

Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core into hleiss/master

This commit is contained in:
Arianna Masciolini
2025-08-02 19:02:30 +02:00
21 changed files with 93 additions and 59 deletions

View File

@@ -30,6 +30,7 @@ AM_PROG_CC_C_O
-Wall\
-Wextra\
-Wno-missing-field-initializers\
-fpermissive\
-Wno-unused-parameter\
-Wno-unused-value"
fi]

View File

@@ -114,7 +114,7 @@ instance Semigroup Builder where
instance Monoid Builder where
mempty = empty
{-# INLINE mempty #-}
mappend = append
mappend = (<>)
{-# INLINE mappend #-}
------------------------------------------------------------------------

View File

@@ -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

View File

@@ -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

View File

@@ -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