mirror of
https://github.com/ilyakooo0/streamly.git
synced 2024-07-07 04:06:22 +03:00
Fix hlint issues in benchmarks
This commit is contained in:
parent
ce86302f08
commit
a067d53632
|
@ -31,6 +31,7 @@ benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
|
|||
benchmark/Streamly/Benchmark/Data/Unfold.hs
|
||||
benchmark/Streamly/Benchmark/FileSystem/Handle.hs
|
||||
benchmark/Streamly/Benchmark/Prelude/Async.hs
|
||||
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs
|
||||
benchmark/Streamly/Benchmark/Prelude/Merge.hs
|
||||
benchmark/Streamly/Benchmark/Prelude/Parallel.hs
|
||||
benchmark/Streamly/Benchmark/Prelude/Rate.hs
|
||||
|
|
|
@ -269,13 +269,13 @@ unzip = Stream.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
|
|||
{-# INLINE unzipWithFstM #-}
|
||||
unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int)
|
||||
unzipWithFstM = do
|
||||
let f = \a -> return (a + 1, a)
|
||||
let f a = return (a + 1, a)
|
||||
Stream.fold (FL.unzipWithFstM f FL.sum FL.length)
|
||||
|
||||
{-# INLINE unzipWithMinM #-}
|
||||
unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)
|
||||
unzipWithMinM = do
|
||||
let f = \a -> return (a + 1, a)
|
||||
let f a = return (a + 1, a)
|
||||
Stream.fold (FL.unzipWithMinM f FL.sum FL.length)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{- HLINT ignore -}
|
||||
|
||||
#undef FUSION_CHECK
|
||||
#ifdef FUSION_CHECK
|
||||
|
@ -18,6 +19,7 @@ module Main (main) where
|
|||
-------------------------------------------------------------------------------
|
||||
|
||||
import Control.DeepSeq (NFData(..), deepseq)
|
||||
import Control.Monad (when, void)
|
||||
import GHC.Generics (Generic)
|
||||
import System.Random (randomRIO)
|
||||
#ifndef USE_UNBOX
|
||||
|
@ -264,13 +266,13 @@ $(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])
|
|||
instance NFData a => NFData (BinTree a) where
|
||||
{-# INLINE rnf #-}
|
||||
rnf (Leaf a) = rnf a `seq` ()
|
||||
rnf (Tree l r) = rnf l `seq` rnf r `seq` ()
|
||||
rnf (Tree l r) = rnf l `seq` rnf r
|
||||
|
||||
instance Arbitrary a => Arbitrary (BinTree a) where
|
||||
arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
|
||||
|
||||
mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)
|
||||
mkBinTree = go (generate $ arbitrary)
|
||||
mkBinTree = go (generate arbitrary)
|
||||
|
||||
where
|
||||
|
||||
|
@ -295,16 +297,14 @@ getSize = addSizeTo 0
|
|||
-- Common helpers
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{- HLINT ignore "Eta reduce" -}
|
||||
-- Parts of "f" that are dependent on val will not be optimized out.
|
||||
{-# INLINE loop #-}
|
||||
loop :: Int -> (a -> IO b) -> a -> IO ()
|
||||
loop count f val = go count val
|
||||
where
|
||||
|
||||
go n x = do
|
||||
if n > 0
|
||||
then f x >> go (n-1) x
|
||||
else return ()
|
||||
go n x = when (n > 0) $ f x >> go (n-1) x
|
||||
|
||||
-- The first arg of "f" is the environment which is not threaded around in the
|
||||
-- loop.
|
||||
|
@ -313,10 +313,7 @@ loopWith :: Int -> (e -> a -> IO b) -> e -> a -> IO ()
|
|||
loopWith count f e val = go count val
|
||||
where
|
||||
|
||||
go n x = do
|
||||
if n > 0
|
||||
then f e x >> go (n-1) x
|
||||
else return ()
|
||||
go n x = when (n > 0) $ f e x >> go (n-1) x
|
||||
|
||||
benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
|
||||
benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
|
||||
|
@ -342,7 +339,7 @@ pokeTimesWithSize val times = do
|
|||
|
||||
{-# INLINE poke #-}
|
||||
poke :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()
|
||||
poke arr val = SERIALIZE_OP 0 arr val >> return ()
|
||||
poke arr val = void (SERIALIZE_OP 0 arr val)
|
||||
|
||||
{-# INLINE pokeTimes #-}
|
||||
pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
|
||||
|
@ -356,7 +353,7 @@ encode :: SERIALIZE_CLASS a => a -> IO ()
|
|||
encode val = do
|
||||
let n = getSize val
|
||||
arr <- MBA.new n
|
||||
SERIALIZE_OP 0 arr val >> return ()
|
||||
void (SERIALIZE_OP 0 arr val)
|
||||
|
||||
{-# INLINE encodeTimes #-}
|
||||
encodeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
|
||||
|
|
|
@ -18,7 +18,7 @@ import Control.DeepSeq (NFData(..))
|
|||
genLargeRecord :: String -> Int -> Q [Dec]
|
||||
genLargeRecord tyName numFields =
|
||||
sequence
|
||||
([ dataD
|
||||
[ dataD
|
||||
(pure [])
|
||||
(mkName tyName)
|
||||
[]
|
||||
|
@ -28,7 +28,7 @@ genLargeRecord tyName numFields =
|
|||
, mkValueSigDec
|
||||
, mkValueDec
|
||||
, nfDataInstance tyName
|
||||
])
|
||||
]
|
||||
|
||||
where
|
||||
|
||||
|
@ -64,7 +64,7 @@ genLargeRecord tyName numFields =
|
|||
(foldl
|
||||
(\b a -> [|$(b) $(a)|])
|
||||
(conE (mkName tyName))
|
||||
(const (conE '()) <$> [0 .. (numFields - 1)])))
|
||||
(conE '() <$ [0 .. (numFields - 1)])))
|
||||
[]
|
||||
]
|
||||
mkCon nm = recC (mkName nm) (mkField <$> [0 .. (numFields - 1)])
|
||||
|
|
|
@ -132,12 +132,14 @@ foldableAny :: Int -> Int -> Bool
|
|||
foldableAny value n =
|
||||
Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
|
||||
|
||||
{- HLINT ignore "Use all"-}
|
||||
{-# INLINE foldableAnd #-}
|
||||
foldableAnd :: Int -> Int -> Bool
|
||||
foldableAnd value n =
|
||||
Prelude.and $ fmap
|
||||
(<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
|
||||
|
||||
{- HLINT ignore "Use any"-}
|
||||
{-# INLINE foldableOr #-}
|
||||
foldableOr :: Int -> Int -> Bool
|
||||
foldableOr value n =
|
||||
|
|
|
@ -452,4 +452,4 @@ o_1_space =
|
|||
]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain $ concat [o_1_space]
|
||||
main = defaultMain [o_1_space]
|
||||
|
|
|
@ -120,7 +120,7 @@ fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
|
|||
{-# INLINE fromFoldableM #-}
|
||||
fromFoldableM :: Monad m => Int -> Int -> Stream m Int
|
||||
fromFoldableM streamLen n =
|
||||
Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
|
||||
Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]
|
||||
|
||||
{-
|
||||
{-# INLINABLE concatMapFoldableWith #-}
|
||||
|
|
Loading…
Reference in New Issue
Block a user