-
Notifications
You must be signed in to change notification settings - Fork 30
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
How to fight undesirable sharing: redux #110
Comments
Cleaned up the code a little and turned it into a benchmark using ❯ cat AvoidSharing.hs
{-# language
ImportQualifiedPost
, UnboxedTuples
#-}
{-# options_ghc -fno-warn-orphans #-}
module Main where
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import GHC.Exts (oneShot)
import Streaming.Internal (Stream(..))
import Streaming.Prelude (Of(..))
import Streaming.Prelude qualified as S
import Control.Exception (evaluate)
import Test.Tasty.Bench (defaultMain, env, bgroup, bench, nf)
import Control.DeepSeq (NFData(..))
main :: IO ()
main = do
defaultMain
[ bgroup "Of"
[ bench "sum stream" $ nf (S.sum . streamOf) big
, bench "sum (drop 1 stream)" $ nf (S.sum . S.drop 1 . streamOf) big
]
, bgroup "Compose (Of Integer) Unit"
[ bench "sum stream" $ nf (sumUnit . streamUnit) big
, bench "sum (drop 1 stream)" $ nf (sumUnit . dropUnit 1 . streamUnit) big
]
, bgroup "Compose (Of Integer) NoMemo"
[ bench "sum stream" $ nf (sumNoMemo . streamNoMemo) big
, bench "sum (drop 1 stream)" $ nf (sumNoMemo . dropNoMemo 1 . streamNoMemo) big
]
]
newtype NoMemo a = NoMemo ((# #) -> a)
noMemo :: a -> NoMemo a
noMemo x = NoMemo (oneShot (\(# #) -> x))
unNoMemo :: NoMemo a -> a
unNoMemo (NoMemo f) = f (# #)
instance Functor NoMemo where
fmap f = noMemo . f . unNoMemo
instance Applicative NoMemo where
pure = noMemo
f <*> x = noMemo (unNoMemo f (unNoMemo x))
newtype Unit a = Unit (() -> a)
unit :: a -> Unit a
unit a = Unit (oneShot (\() -> a))
unUnit :: Unit a -> a
unUnit (Unit a) = a ()
instance Functor Unit where
fmap f = unit . f . unUnit
instance Applicative Unit where
pure = unit
f <*> x = unit (unUnit f (unUnit x))
big :: Int
big = 4_000_000
enumFromNoMemo :: (Monad m, Enum n)
=> n -> Stream (Compose (Of n) NoMemo) m r
enumFromNoMemo = loop where
loop !n = Effect (return (Step (Compose (n :> pure (loop (succ n))))))
enumFromUnit :: (Monad m, Enum n)
=> n -> Stream (Compose (Of n) Unit) m r
enumFromUnit = loop where
loop !n = Effect (return (Step (Compose (n :> pure (loop (succ n))))))
streamOf :: Int -> Stream (Of Integer) Identity ()
streamOf n = S.take n (S.enumFrom 0)
streamNoMemo :: Int -> Stream (Compose (Of Integer) NoMemo) Identity ()
streamNoMemo n = S.take n (enumFromNoMemo 0)
streamUnit :: Int -> Stream (Compose (Of Integer) Unit) Identity ()
streamUnit n = S.take n (enumFromUnit 0)
foldNoMemo :: Monad m => (x -> a -> x) -> x -> (x -> b)
-> Stream (Compose (Of a) NoMemo) m r
-> m (Of b r)
foldNoMemo step begin done str = fold_loop str begin
where
fold_loop stream !x = case stream of
Return r -> return (done x :> r)
Effect m -> m >>= \str' -> fold_loop str' x
Step (Compose (a :> rest)) -> fold_loop (unNoMemo rest) $! step x a
foldUnit :: Monad m => (x -> a -> x) -> x -> (x -> b)
-> Stream (Compose (Of a) Unit) m r
-> m (Of b r)
foldUnit step begin done str = fold_loop str begin
where
fold_loop stream !x = case stream of
Return r -> return (done x :> r)
Effect m -> m >>= \str' -> fold_loop str' x
Step (Compose (a :> rest)) -> fold_loop (unUnit rest) $! step x a
sumOf :: Monad m
=> Stream (Of Integer) m r
-> m (Of Integer r)
sumOf = S.fold (+) 0 id
sumNoMemo :: Monad m
=> Stream (Compose (Of Integer) NoMemo) m r
-> m (Of Integer r)
sumNoMemo = foldNoMemo (+) 0 id
sumUnit :: Monad m
=> Stream (Compose (Of Integer) Unit) m r
-> m (Of Integer r)
sumUnit = foldUnit (+) 0 id
dropNoMemo :: (Monad m) => Int
-> Stream (Compose (Of a) NoMemo) m r
-> Stream (Compose (Of a) NoMemo) m r
dropNoMemo n str | n <= 0 = str
dropNoMemo n str = loop n str where
loop 0 stream = stream
loop m stream = case stream of
Return r -> Return r
Effect ma -> Effect (fmap (loop m) ma)
Step (Compose (_ :> as)) -> loop (m-1) (unNoMemo as)
dropUnit :: (Monad m) => Int
-> Stream (Compose (Of a) Unit) m r
-> Stream (Compose (Of a) Unit) m r
dropUnit n str | n <= 0 = str
dropUnit n str = loop n str where
loop 0 stream = stream
loop m stream = case stream of
Return r -> Return r
Effect ma -> Effect (fmap (loop m) ma)
Step (Compose (_ :> as)) -> loop (m-1) (unUnit as)
instance (NFData a, NFData b) => NFData (Of a b) where
rnf (a :> b) = rnf a `seq` rnf b `seq` () Results:
|
Thanks! So this is showing more like a 70% slowdown? That's unfortunate. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This is a follow up from michaelt/streaming#6, wherein it was observed that it is hard to fight undesirable sharing without turning off
full-laziness
. Well, I think I've found a way!It seems like it's possible to avoid this problem without invoking
no-full-laziness
(which is a very blunt instrument) by taking advantage ofoneShot
. Futhermore,(# #) ->
is somewhat faster than() ->
. The former has about an 8% slowdown compared to currentOf
(i.e.Of
with no adjustment to second component). The latter has about an 11% slowdown.NoMemo
?I still believe it's better to make the
full-laziness
transformation faster, but in the absence of that, the approach elaborated here might work. I welcome others' thoughts.The text was updated successfully, but these errors were encountered: