streaming-bytestring
has been undergoing some updates lately, and we’re wondering about the deeper difference between liftM
and fmap
(for IO
, in this case).
Here are the relevant definitions:
instance Functor IO where
fmap f x = x >>= (pure . f)
instance Monad IO where
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
(>>) = (*>)
(>>=) = bindIO
liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r
liftM f m1 = do { x1 <- m1; return (f x1) }
hlint
unilaterally suggests that liftM
be replaced with fmap
:
Char8.hs:203:27-31: Warning: Use fmap
Found:
liftM
Perhaps:
fmap
But we’re curious: would there ever be a reason not to?
2 Likes
It may be worth noting, that while IO
is the most typical Monad for streaming bytestrings, the code is polymorphic in the monad. So the question could be stated for general Monads. Should one use:
fmap f m
liftM f m
- m >>= return . f
- m >>= \x -> return $! f x
- …
Assuming that the result will ultimately be wanted strictly, and the code is doing low-level I/O where cycles per byte tend to matter.
Partly answering my own question, the first three variants generate identical optimised code (with GHC 8.8 or 8.10 and -O2). The last ($! annotated) variant does indeed produce slightly different code:
\r [s]
case m s of {
(#,#) ipv [Occ=Once] ipv1 [Occ=Once] ->
- let {
- sat [Occ=Once]
- :: Streaming.Internal.Stream
- (Data.ByteString.Streaming.Internal.ByteString GHC.Types.IO)
- GHC.Types.IO
- ()
- [LclId] =
- \u [] Main.main ipv1;
- } in (#,#) [ipv sat];
+ case Main.main ipv1 of vx [Occ=Once] {
+ _ -> (#,#) [ipv vx];
+ };
};
} in Streaming.Internal.Effect [sat];
};
but running it produced no obvious performance advantages either in memory allocations or CPU, indeed when “grouping” the bytes in a bytestream, the bang annotated version ran ~1% slower. So I’m inclined to conclude that fmap
vs. liftM
or just infix <$> seems just a matter of style not substance, and the hlint suggestion to use fmap has no obvious downside.
1 Like
We decided to trust hlint
and stick with fmap
after all.
1 Like
The reasoning behind this hint rule seems to indicate it has nothing to do with performance, so there’s that.
These are actually the same once the do-notation is desugared (and if pure == return
which it should be).
instance Functor IO where
fmap f x = x >>= (pure . f)
liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r
liftM f m1 = do { x1 <- m1; return (f x1) }
2 Likes