1import Gauge 2import Gauge.Main 3import Control.Concurrent (threadDelay) 4import UnliftIO 5import qualified Control.Concurrent.Async as A 6import Data.List (foldl') 7import Control.Applicative (liftA2, (<|>), empty) 8 9sizes :: (Int -> [Benchmark]) -> [Benchmark] 10sizes f = map 11 (\size -> bgroup (show size) (f size)) 12 [1, 2, 10, 100, 1000, 10000, 100000] 13 14sum' :: [Int] -> Int 15sum' = foldl' (+) 0 16{-# INLINE sum' #-} 17 18replicateA_ :: Applicative f => Int -> f () -> f () 19replicateA_ cnt0 f = 20 let go 1 = f 21 go i = f *> go (i - 1) 22 in go cnt0 23{-# INLINE replicateA_ #-} 24 25main :: IO () 26main = defaultMain 27 [ bgroup "concurrently, minimal work" $ sizes $ \size -> 28 [ bench "A.replicateConcurrently_" $ whnfIO $ do 29 ref <- newIORef (0 :: Int) 30 A.replicateConcurrently_ size $ atomicModifyIORef' ref $ \i -> (i + 1, ()) 31 , bench "replicateConcurrently_" $ whnfIO $ do 32 ref <- newIORef (0 :: Int) 33 replicateConcurrently_ size $ atomicModifyIORef' ref $ \i -> (i + 1, ()) 34 , bench "Conc" $ whnfIO $ do 35 ref <- newIORef (0 :: Int) 36 runConc $ replicateA_ size $ conc $ atomicModifyIORef' ref $ \i -> (i + 1, ()) 37 ] 38 , bgroup "concurrently, no results" $ sizes $ \size -> 39 [ bench "A.replicateConcurrently_" $ whnfIO $ A.replicateConcurrently_ size (pure ()) 40 , bench "replicateConcurrently_" $ whnfIO $ replicateConcurrently_ size (pure ()) 41 , bench "Conc" $ whnfIO $ runConc $ replicateA_ size $ conc $ pure () 42 , bench "Conc, cheating" $ whnfIO $ runConc $ replicateA_ size $ pure () 43 ] 44 , bgroup "concurrently, with results" $ sizes $ \size -> 45 [ bench "A.mapConcurrently" $ whnfIO $ fmap sum' $ A.mapConcurrently pure [1..size] 46 , bench "mapConcurrently" $ whnfIO $ fmap sum' $ mapConcurrently pure [1..size] 47 , bench "Conc" $ whnfIO $ runConc $ 48 let go i 49 | i == size = conc (pure i) 50 | otherwise = liftA2 (+) (conc (pure i)) (go (i + 1)) 51 in go 1 52 -- This is cheating, since it's using our Pure data constructor 53 , bench "Conc, cheating" $ whnfIO $ runConc $ 54 let go i 55 | i == size = pure i 56 | otherwise = liftA2 (+) (pure i) (go (i + 1)) 57 in go 1 58 ] 59 , bgroup "race" $ sizes $ \size -> 60 [ bench "A.Concurrently" $ whnfIO $ 61 A.runConcurrently $ 62 foldr (<|>) empty (replicate size (pure ())) 63 , bench "Concurrently" $ whnfIO $ 64 runConcurrently $ 65 foldr (<|>) empty (replicate size (pure ())) 66 , bench "Conc" $ whnfIO $ 67 runConc $ 68 foldr (<|>) empty (replicate size (conc (pure ()))) 69 -- This is cheating, since it's using our Pure data constructor 70 , bench "Conc, cheating" $ whnfIO $ 71 runConc $ 72 foldr (<|>) empty (replicate size (pure ())) 73 ] 74 , bgroup "race (with result)" $ 75 sizes $ \size -> 76 [ bench "Concurrently" $ 77 whnfIO $ 78 runConcurrently $ 79 let go i 80 | i == size = Concurrently (pure i) 81 | otherwise = liftA2 (+) (Concurrently (pure i)) (go (i + 1)) 82 in (Concurrently $ threadDelay maxBound >> return 0) <|> (go 1) <|> 83 (Concurrently $ threadDelay maxBound >> return 0) 84 , bench "Conc" $ 85 whnfIO $ 86 runConc $ 87 let go i 88 | i == size = conc (pure i) 89 | otherwise = liftA2 (+) (conc (pure i)) (go (i + 1)) 90 in (conc $ threadDelay maxBound >> return 0) <|> (go 1) <|> 91 (conc $ threadDelay maxBound >> return 0) 92 , bench "Conc, cheating" $ 93 whnfIO $ 94 runConc $ 95 let go i 96 | i == size = conc (pure i) 97 | otherwise = liftA2 (+) (pure i) (go (i + 1)) 98 in (conc $ threadDelay maxBound >> return 0) <|> (go 1) <|> 99 (conc $ threadDelay maxBound >> return 0) 100 ] 101 , let size = 10 102 in bgroup 103 "race (nested)" 104 [ bench "Concurrently" $ 105 whnfIO $ 106 runConcurrently $ 107 let go i 108 | i == size = Concurrently (pure i) 109 | i `mod` 2 == 0 = 110 (liftA2 (+) (Concurrently (pure i)) (go (i + 1))) <|> 111 (liftA2 (+) (Concurrently (pure i)) (go (i + 2))) 112 | otherwise = 113 liftA2 (+) (Concurrently (pure i)) (go (i + 1)) 114 in go 1 115 , bench "Conc" $ 116 whnfIO $ 117 runConc $ 118 let go i 119 | i == size = conc (pure i) 120 | i `mod` 2 == 0 = 121 (liftA2 (+) (conc (pure i)) (go (i + 1))) <|> 122 (liftA2 (+) (conc (pure i)) (go (i + 2))) 123 | otherwise = liftA2 (+) (conc (pure i)) (go (i + 1)) 124 in go 1 125 , bench "Conc, cheating" $ 126 whnfIO $ 127 runConc $ 128 let go i 129 | i == size = conc (pure i) 130 | i `mod` 2 == 0 = 131 (liftA2 (+) (pure i) (go (i + 1))) <|> 132 (liftA2 (+) (pure i) (go (i + 2))) 133 | otherwise = liftA2 (+) (pure i) (go (i + 1)) 134 in go 1 135 ] 136 ] 137