forked from GitHub/gf-core
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core into hleiss/master
This commit is contained in:
@@ -30,6 +30,7 @@ AM_PROG_CC_C_O
|
||||
-Wall\
|
||||
-Wextra\
|
||||
-Wno-missing-field-initializers\
|
||||
-fpermissive\
|
||||
-Wno-unused-parameter\
|
||||
-Wno-unused-value"
|
||||
fi]
|
||||
|
||||
@@ -114,7 +114,7 @@ instance Semigroup Builder where
|
||||
instance Monoid Builder where
|
||||
mempty = empty
|
||||
{-# INLINE mempty #-}
|
||||
mappend = append
|
||||
mappend = (<>)
|
||||
{-# INLINE mappend #-}
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user