Skip to content

Commit

Permalink
lint free benchmarks
Browse files Browse the repository at this point in the history
  • Loading branch information
harendra-kumar committed Oct 13, 2018
1 parent 8b8fd22 commit bf39d27
Show file tree
Hide file tree
Showing 11 changed files with 57 additions and 83 deletions.
2 changes: 1 addition & 1 deletion benchmark/Adaptive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
randomVar = run (low,high) (low,high)

main :: IO ()
main = do
main =
defaultMain
[
bgroup "serialConstantSlowConsumer"
Expand Down
2 changes: 1 addition & 1 deletion benchmark/BaseStreams.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
-}

main :: IO ()
main = do
main =
defaultMain
[ bgroup "streamD"
[ bgroup "generation"
Expand Down
18 changes: 9 additions & 9 deletions benchmark/Chart.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,10 +55,10 @@ parseBench = do
Just "nested" -> setBenchType Nested
Just "base" -> setBenchType Base
Just str -> do
liftIO $ putStrLn $ "unrecognized benchmark type " ++ str
liftIO $ putStrLn $ "unrecognized benchmark type " <> str
mzero
Nothing -> do
liftIO $ putStrLn $ "please provide a benchmark type "
liftIO $ putStrLn "please provide a benchmark type "
mzero

-- totally imperative style option parsing
Expand All @@ -71,13 +71,13 @@ parseOptions = do
Just "--graphs" -> setGenGraphs True
Just "--benchmark" -> parseBench
Just str -> do
liftIO $ putStrLn $ "Unrecognized option " ++ str
liftIO $ putStrLn $ "Unrecognized option " <> str
mzero
Nothing -> return ()
fmap snd get

ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
putStrLn $ "Failed with error:\n" ++ err ++ "\nSkipping.")
putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")

------------------------------------------------------------------------------
-- Linear composition charts
Expand All @@ -88,7 +88,7 @@ makeLinearGraphs cfg inputFile = do
ignoringErr $ graph inputFile "operations" $ cfg
{ title = Just "Streamly operations"
, classifyBenchmark = \b ->
if (not $ "serially/" `isPrefixOf` b)
if not ("serially/" `isPrefixOf` b)
|| "/generation" `isInfixOf` b
|| "/compose" `isInfixOf` b
|| "/concat" `isSuffixOf` b
Expand Down Expand Up @@ -120,7 +120,7 @@ makeLinearGraphs cfg inputFile = do
------------------------------------------------------------------------------

makeNestedGraphs :: Config -> String -> IO ()
makeNestedGraphs cfg inputFile = do
makeNestedGraphs cfg inputFile =
ignoringErr $ graph inputFile "nested-serial-diff" $ cfg
{ title = Just "Nested serial"
, classifyBenchmark = \b ->
Expand Down Expand Up @@ -165,10 +165,10 @@ benchShow Options{..} cfg func inp out =
{ selectBenchmarks =
\f ->
reverse
$ map fst
$ fmap fst
$ either
(const $ either error id $ f $ ColumnIndex 0)
(sortBy (comparing snd))
(sortOn snd)
$ f $ ColumnIndex 1
}

Expand All @@ -181,7 +181,7 @@ main = do
Nothing -> do
putStrLn "cannot parse options"
return ()
Just opts@Options{..} -> do
Just opts@Options{..} ->
case benchType of
Linear -> benchShow opts cfg makeLinearGraphs
"charts/linear/results.csv"
Expand Down
10 changes: 5 additions & 5 deletions benchmark/Linear.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,12 +37,12 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
-}

main :: IO ()
main = do
main =
defaultMain
[ bgroup "serially"
[ bgroup "generation"
[ -- Most basic, barely stream continuations running
benchSrcIO serially "unfoldr" $ Ops.sourceUnfoldr
benchSrcIO serially "unfoldr" Ops.sourceUnfoldr
, benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM
, benchSrcIO serially "fromList" Ops.sourceFromList
, benchSrcIO serially "fromListM" Ops.sourceFromListM
Expand Down Expand Up @@ -91,7 +91,7 @@ main = do
, benchIO "mapMaybe" Ops.mapMaybe
, benchIO "mapMaybeM" Ops.mapMaybeM
, bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
(Ops.sequence serially) (Ops.sourceUnfoldrMAction n)
Ops.sequence serially (Ops.sourceUnfoldrMAction n)
, benchIO "findIndices" Ops.findIndices
, benchIO "elemIndices" Ops.elemIndices
-- , benchIO "concat" Ops.concat
Expand All @@ -107,8 +107,8 @@ main = do
, benchIO "dropWhile-true" Ops.dropWhileTrue
, benchIO "dropWhileM-true" Ops.dropWhileMTrue
]
, benchIO "zip" $ Ops.zip
, benchIO "zipM" $ Ops.zipM
, benchIO "zip" Ops.zip
, benchIO "zipM" Ops.zipM
, bgroup "compose"
[ benchIO "mapM" Ops.composeMapM
, benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter
Expand Down
6 changes: 3 additions & 3 deletions benchmark/LinearAsync.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
-}

main :: IO ()
main = do
main =
defaultMain
[ bgroup "asyncly"
[ -- benchIO "unfoldr" $ Ops.toNull asyncly
Expand Down Expand Up @@ -86,7 +86,7 @@ main = do
, benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM
, benchIO "mapM" $ Ops.mapM parallely
-- Zip has only one parallel flavor
, benchIO "zip" $ Ops.zipAsync
, benchIO "zipM" $ Ops.zipAsyncM
, benchIO "zip" Ops.zipAsync
, benchIO "zipM" Ops.zipAsyncM
]
]
36 changes: 12 additions & 24 deletions benchmark/LinearOps.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,10 +10,11 @@

module LinearOps where

import Control.Monad (when)
import Data.Maybe (fromJust)
import Prelude
(Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),
subtract, undefined, Maybe(..), odd, Bool, not)
subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry)

import qualified Streamly as S
import qualified Streamly.Prelude as S
Expand Down Expand Up @@ -74,7 +75,7 @@ sourceUnfoldr n = S.unfoldr step n
step cnt =
if cnt > n + value
then Nothing
else (Just (cnt, cnt + 1))
else Just (cnt, cnt + 1)

{-# INLINE sourceUnfoldrM #-}
sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
Expand Down Expand Up @@ -154,32 +155,19 @@ uncons s = do

{-# INLINE init #-}
init :: Monad m => Stream m a -> m ()
init s = do
r <- S.init s
case r of
Nothing -> return ()
Just x -> S.runStream x
init s = S.init s >>= Prelude.mapM_ S.runStream

{-# INLINE tail #-}
tail :: Monad m => Stream m a -> m ()
tail s = do
r <- S.tail s
case r of
Nothing -> return ()
Just x -> tail x
tail s = S.tail s >>= Prelude.mapM_ tail

{-# INLINE nullHeadTail #-}
nullHeadTail :: Monad m => Stream m Int -> m ()
nullHeadTail s = do
r <- S.null s
if not r
then do
when (not r) $ do
_ <- S.head s
t <- S.tail s
case t of
Nothing -> return ()
Just x -> nullHeadTail x
else return ()
S.tail s >>= Prelude.mapM_ nullHeadTail

mapM_ = S.mapM_ (\_ -> return ())
toList = S.toList
Expand Down Expand Up @@ -254,7 +242,7 @@ mapM t = transform . t . S.mapM return
mapMaybe = transform . S.mapMaybe
(\x -> if Prelude.odd x then Nothing else Just ())
mapMaybeM = transform . S.mapMaybeM
(\x -> if Prelude.odd x then (return Nothing) else return $ Just ())
(\x -> if Prelude.odd x then return Nothing else return $ Just ())
sequence t = transform . t . S.sequence
filterEven = transform . S.filter even
filterAllOut = transform . S.filter (> maxValue)
Expand Down Expand Up @@ -285,19 +273,19 @@ zipAsync, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
zip src = do
r <- S.tail src
let src1 = fromJust r
transform $ (S.zipWith (,) src src1)
transform (S.zipWith (,) src src1)
zipM src = do
r <- S.tail src
let src1 = fromJust r
transform $ (S.zipWithM (\a b -> return (a,b)) src src1)
transform (S.zipWithM (curry return) src src1)
zipAsync src = do
r <- S.tail src
let src1 = fromJust r
transform $ (S.zipAsyncWith (,) src src1)
transform (S.zipAsyncWith (,) src src1)
zipAsyncM src = do
r <- S.tail src
let src1 = fromJust r
transform $ (S.zipAsyncWithM (\a b -> return (a,b)) src src1)
transform (S.zipAsyncWithM (curry return) src src1)
concat _n = return ()

-------------------------------------------------------------------------------
Expand Down
2 changes: 1 addition & 1 deletion benchmark/LinearRate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
-}

main :: IO ()
main = do
main =
defaultMain
-- XXX arbitrarily large rate should be the same as rate Nothing
[ bgroup "avgrate"
Expand Down
2 changes: 1 addition & 1 deletion benchmark/Nested.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ _benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark
_benchId name f = bench name $ nf (\g -> runIdentity (g 1)) f

main :: IO ()
main = do
main =
-- TBD Study scaling with 10, 100, 1000 loop iterations
defaultMain
[ bgroup "serially"
Expand Down
10 changes: 5 additions & 5 deletions benchmark/NestedOps.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ sourceUnfoldr start n = S.unfoldr step start
step cnt =
if cnt > start + n
then Nothing
else (Just (cnt, cnt + 1))
else Just (cnt, cnt + 1)

{-# INLINE runStream #-}
runStream :: Monad m => Stream m a -> m ()
Expand Down Expand Up @@ -98,7 +98,7 @@ filterAllOut t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if (s < 0)
if s < 0
then return s
else S.nil

Expand All @@ -110,7 +110,7 @@ filterAllIn t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if (s > 0)
if s > 0
then return s
else S.nil

Expand All @@ -122,7 +122,7 @@ filterSome t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if (s > 1100000)
if s > 1100000
then return s
else S.nil

Expand All @@ -135,7 +135,7 @@ breakAfterSome t start = do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if (s > 1100000)
if s > 1100000
then error "break"
else return s
return ()
18 changes: 7 additions & 11 deletions benchmark/StreamDOps.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,10 @@

module StreamDOps where

import Control.Monad (when)
import Prelude
(Monad, Int, (+), ($), (.), return, (>), even, (<=),
subtract, undefined, Maybe(..), not)
subtract, undefined, Maybe(..), not, mapM_, (>>=))

import qualified Streamly.Streams.StreamD as S

Expand Down Expand Up @@ -76,7 +77,7 @@ sourceUnfoldr n = S.unfoldr step n
step cnt =
if cnt > n + value
then Nothing
else (Just (cnt, cnt + 1))
else Just (cnt, cnt + 1)

{-# INLINE sourceUnfoldrM #-}
sourceUnfoldrM :: Monad m => Int -> Stream m Int
Expand All @@ -97,7 +98,7 @@ sourceFromList n = S.fromList [n..n+value]

{-# INLINE source #-}
source :: Monad m => Int -> Stream m Int
source n = sourceUnfoldrM n
source = sourceUnfoldrM

-------------------------------------------------------------------------------
-- Elimination
Expand All @@ -115,14 +116,9 @@ uncons s = do
Just (_, t) -> uncons t
nullHeadTail s = do
r <- S.null s
if not r
then do
when (not r) $ do
_ <- S.head s
t <- S.tail s
case t of
Nothing -> return ()
Just x -> nullHeadTail x
else return ()
S.tail s >>= mapM_ nullHeadTail
toList = S.toList
foldl = S.foldl' (+) 0
last = S.last
Expand Down Expand Up @@ -151,7 +147,7 @@ dropWhileTrue = transform . S.dropWhile (<= maxValue)
-- Zipping and concat
-------------------------------------------------------------------------------

zip src = transform $ (S.zipWith (,) src src)
zip src = transform $ S.zipWith (,) src src
-- concat _n = return ()

-------------------------------------------------------------------------------
Expand Down
Loading

0 comments on commit bf39d27

Please sign in to comment.