diff options
| author | Arianna Masciolini <uzkamascio@gmail.com> | 2025-08-02 19:02:30 +0200 |
|---|---|---|
| committer | Arianna Masciolini <uzkamascio@gmail.com> | 2025-08-02 19:02:30 +0200 |
| commit | 5170668ff27f2149b43d479b5d702124b04c1d98 (patch) | |
| tree | 5f3f85c169ab23f2cbc4cacdabebfbd482fe948c /src/runtime/haskell/Data/Binary/Put.hs | |
| parent | 5776b567a2aa78902bf5e4b40cf0bbb69bdbde9a (diff) | |
| parent | 65e85c5a3cba4df82547a018b4135ac63551d8df (diff) | |
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core into hleiss/master
Diffstat (limited to 'src/runtime/haskell/Data/Binary/Put.hs')
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Put.hs | 14 |
1 files changed, 8 insertions, 6 deletions
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 |
