diff options
Diffstat (limited to 'src/runtime/haskell/Data/Binary')
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Builder.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Get.hs | 4 | ||||
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Put.hs | 14 |
3 files changed, 11 insertions, 9 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 |
