@@ -34,6 +34,7 @@ import Prelude hiding (concatMap, mapM_, init, last, elem, notElem, all, any,
3434 and, or, length, sum, product, maximum, minimum, reverse, fmap, map,
3535 sequence, mapM, tail)
3636
37+import qualified Control.Applicative as AP
3738import qualified Prelude as P
3839import qualified Data.Foldable as F
3940import qualified GHC.Exts as GHC
@@ -1534,28 +1535,112 @@ o_1_space_concat value = sqrtVal `seq`
15341535
15351536 sqrtVal = round $ sqrt (fromIntegral value :: Double)
15361537
1538+-------------------------------------------------------------------------------
1539+-- Applicative
1540+-------------------------------------------------------------------------------
1541+
1542+o_1_space_applicative :: Int -> [Benchmark]
1543+o_1_space_applicative value =
1544+ [ bgroup "applicative"
1545+ [ benchIO "outer product (sqrt n x sqrt n)" $ toNullAp value serially
1546+ ]
1547+ ]
1548+
1549+{-# INLINE ap_ #-}
1550+ap_ :: Int -> Int -> IO ()
1551+ap_ value n =
1552+ S.drain
1553+ $ S.foldrM
1554+ (\x xs -> pure x *> xs)
1555+ (return () :: SerialT IO ())
1556+ $ sourceUnfoldrMSerial value n
1557+
1558+{-# INLINE apRev_ #-}
1559+apRev_ :: Int -> Int -> IO ()
1560+apRev_ value n =
1561+ S.drain
1562+ $ S.foldrM
1563+ (\x xs -> xs <* pure x)
1564+ (return () :: SerialT IO ())
1565+ $ sourceUnfoldrMSerial value n
1566+
1567+{-# INLINE liftA2 #-}
1568+liftA2 :: Int -> Int -> IO ()
1569+liftA2 value n =
1570+ S.drain
1571+ $ S.foldrM
1572+ (\x xs -> AP.liftA2 (+) (pure x) xs)
1573+ (S.yield 0 :: SerialT IO Int)
1574+ $ sourceUnfoldrMSerial value n
1575+
1576+{-# INLINE ap #-}
1577+ap :: Int -> Int -> IO ()
1578+ap value n =
1579+ S.drain
1580+ $ S.foldrM
1581+ (\x xs -> (P.fmap (+) (pure x) <*> xs))
1582+ (S.yield 0 :: SerialT IO Int)
1583+ $ sourceUnfoldrMSerial value n
1584+
1585+o_n_space_applicative :: Int -> [Benchmark]
1586+o_n_space_applicative value =
1587+ [ bgroup "applicative"
1588+ [ benchIO "(*>)" (ap_ value)
1589+ , benchIO "(<*)" (apRev_ value)
1590+ , benchIO "(<*>)" (ap value)
1591+ , benchIO "liftA2" (liftA2 value)
1592+ ]
1593+ ]
1594+
15371595-------------------------------------------------------------------------------
15381596-- Monad
15391597-------------------------------------------------------------------------------
15401598
1541−o_1_space_outerProduct :: Int -> [Benchmark]
1542−o_1_space_outerProduct value =
1543− [ bgroup "monad-outer-product"
1544− [ benchIO "toNullAp" $ toNullAp value serially
1545− , benchIO "toNull" $ toNullM value serially
1546− , benchIO "toNull3" $ toNullM3 value serially
1547− , benchIO "filterAllOut" $ filterAllOutM value serially
1548− , benchIO "filterAllIn" $ filterAllInM value serially
1549− , benchIO "filterSome" $ filterSome value serially
1550− , benchIO "breakAfterSome" $ breakAfterSome value serially
1599+o_1_space_monad :: Int -> [Benchmark]
1600+o_1_space_monad value =
1601+ [ bgroup "monad"
1602+ [ benchIO "outer product (sqrt n x sqrt n)" $ toNullM value serially
1603+ , benchIO "outer product (sqrt n x sqrt n) (filterAllOut)" $
1604+ filterAllOutM value serially
1605+ , benchIO "outer product (sqrt n x sqrt n) (filterAllIn)" $
1606+ filterAllInM value serially
1607+ , benchIO "outer product (sqrt n x sqrt n) (filterSome)" $
1608+ filterSome value serially
1609+ , benchIO "outer product (sqrt n x sqrt n) (breakAfterSome)" $
1610+ breakAfterSome value serially
1611+ , benchIO "outer product (cubert n x cubert n x cubert n)" $
1612+ toNullM3 value serially
15511613 ]
15521614 ]
15531615
1554−o_n_space_outerProduct :: Int -> [Benchmark]
1555−o_n_space_outerProduct value =
1556− [ bgroup "monad-outer-product"
1557− [ benchIO "toList" $ toListM value serially
1558− , benchIO "toListSome" $ toListSome value serially
1616+{-# INLINE bind_ #-}
1617+bind_ :: Int -> Int -> IO ()
1618+bind_ value n =
1619+ S.drain
1620+ $ S.foldrM
1621+ (\x xs -> pure x >> xs)
1622+ (return () :: SerialT IO ())
1623+ $ sourceUnfoldrMSerial value n
1624+
1625+
1626+{-# INLINE bind #-}
1627+bind :: Int -> Int -> IO ()
1628+bind value n =
1629+ S.drain
1630+ $ S.foldrM
1631+ (\x xs -> xs >>= \y -> return (x + y))
1632+ (S.yield 0 :: SerialT IO Int)
1633+ $ sourceUnfoldrMSerial value n
1634+
1635+o_n_space_monad :: Int -> [Benchmark]
1636+o_n_space_monad value =
1637+ [ bgroup "monad"
1638+ [ benchIO "(>>)" (bind_ value)
1639+ , benchIO "(>>=)" (bind value)
1640+ , benchIO "outer product (sqrt n x sqrt n) (toList)" $
1641+ toListM value serially
1642+ , benchIO "outer product (sqrt n x sqrt n) (toListSome)" $
1643+ toListSome value serially
15591644 ]
15601645 ]
15611646
@@ -1635,7 +1720,9 @@ main = do
16351720 , o_1_space_joining size
16361721 , o_1_space_concatFoldable size
16371722 , o_1_space_concat size
1638− , o_1_space_outerProduct size
1723+
1724+ , o_1_space_applicative size
1725+ , o_1_space_monad size
16391726
16401727 -- Monad transformation
16411728 , o_1_space_hoisting size
@@ -1660,6 +1747,7 @@ main = do
16601747 , o_n_space_grouping size
16611748
16621749 -- multi-stream
1663− , o_n_space_outerProduct size
1750+ , o_n_space_applicative size
1751+ , o_n_space_monad size
16641752 ]
16651753 ]