extensible-effects-4.0.0.0: test/Control/Eff/NdetEff/Bench.hs
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
-- A benchmark of shift/reset: Filinski's representing non-determinism monads
--
-- The benchmark is taken from Sec 6.1 of
-- Martin Gasbichler, Michael Sperber: Final Shift for Call/cc: Direct
-- Implementation of Shift and Reset, ICFP'02, pp. 271-282.
-- http://www-pu.informatik.uni-tuebingen.de/users/sperber/papers/shift-reset-direct.pdf
-- This code is a straightforward translation of bench_nondet.ml
--
-- This is a micro-benchmark: it is very non-determinism-intensive. It is
-- *not* representative: the benchmark does nothing else but
-- concatenates lists. The List monad does this directly; whereas
-- continuation monads do the concatenation with more overhead (e.g.,
-- building the closures representing continuations). Therefore,
-- the List monad here outperforms all other implementations of
-- non-determinism.
-- It should be stressed that the delimited control is optimized
-- for the case where control operations are infrequent, so we pay
-- as we go. The use of the delimited control operators is more
-- expensive, but the code that does not use delimited control does not
-- have to pay anything for delimited control.
-- Again, in the present micro-benchmark, there is hardly any code that
-- does not use non-determinism, so the overhead of delimited control
-- is very noticeable. That is why this benchmark is good at estimating
-- the overhead of different implementations of delimited control.
-- To compile this code
-- ghc -O2 -rtsopts -main-is Bench_nondet.main_list5 Bench_nondet.hs
-- To run this code
-- GHCRTS="-tstderr" /usr/bin/time ./Bench_nondet
module Control.Eff.NdetEff.Bench where
import Control.Eff
import qualified Control.Eff.NdetEff as E
import Data.List (sort)
-- import Control.Monad.Identity
-- import Control.Monad (liftM2)
import Control.Monad (MonadPlus(..), msum)
import Control.Applicative
-- import System.CPUTime
-- Small language with non-determinism: just like the one in our DSL-WC paper
int :: MonadPlus repr => Int -> repr Int
int x = return x
add :: MonadPlus repr => repr Int -> repr Int -> repr Int
-- add xs ys = liftM2 (+) xs ys
add xs ys = do {x <- xs; y <- ys; return $! x+y }
lam :: MonadPlus repr => (repr a -> repr b) -> repr (a -> repr b)
lam f = return $ f . return
app :: MonadPlus repr => repr (a -> repr b) -> (repr a -> repr b)
app xs ys = do {x <- xs; y <- ys; x y}
amb :: MonadPlus repr => [repr Int] -> repr Int
amb = msum
-- Benchmark cases
test_ww :: MonadPlus repr => repr Int
test_ww =
let f = lam (\x ->
add (add x (amb [int 6, int 4, int 2, int 8]))
(amb [int 2, int 4, int 5, int 4, int 1]))
in f `app` amb [int 0, int 2, int 3, int 4, int 5, int 32]
ww_answer =
sort [8, 10, 11, 10, 7, 6, 8, 9, 8, 5, 4, 6, 7, 6, 3, 10, 12, 13,
12, 9, 10, 12, 13, 12, 9, 8, 10, 11, 10, 7, 6, 8, 9, 8, 5, 12, 14, 15,
14, 11, 11, 13, 14, 13, 10, 9, 11, 12, 11, 8, 7, 9, 10, 9, 6, 13, 15,
16, 15, 12, 12, 14, 15, 14, 11, 10, 12, 13, 12, 9, 8, 10, 11, 10, 7,
14, 16, 17, 16, 13, 13, 15, 16, 15, 12, 11, 13, 14, 13, 10, 9, 11, 12,
11, 8, 15, 17, 18, 17, 14, 40, 42, 43, 42, 39, 38, 40, 41, 40, 37, 36,
38, 39, 38, 35, 42, 44, 45, 44, 41]
-- Real benchmark cases
test_www :: MonadPlus repr => repr Int
test_www =
let f = lam (\x ->
add (add x (amb [int 6, int 4, int 2, int 8]))
(amb [int 2, int 4, int 5, int 4, int 1]))
in f `app` (f `app` amb [int 0, int 2, int 3, int 4, int 5, int 32])
test_wwww :: MonadPlus repr => repr Int
test_wwww =
let f = lam (\x ->
add (add x (amb [int 6, int 4, int 2, int 8]))
(amb [int 2, int 4, int 5, int 4, int 1]))
in f `app` (f `app` (f `app` amb [int 0, int 2, int 3, int 4, int 5, int 32]))
test_w5 :: MonadPlus repr => repr Int
test_w5 =
let f = lam (\x ->
add (add x (amb [int 6, int 4, int 2, int 8]))
(amb [int 2, int 4, int 5, int 4, int 1]))
in f `app` (f `app`
(f `app` (f `app` amb [int 0, int 2, int 3, int 4, int 5, int 32])))
-- Different implementations of our language (MonadPlus)
-- The List monad: Non-determinism monad as a list of successes
run_list :: [Int] -> [Int]
run_list = id
testl1 = (==) [101, 201, 102, 202] . run_list $
add (amb [int 1, int 2]) (amb [int 100, int 200])
testl2 = ww_answer == sort (run_list test_ww)
-- CPS-monad, implemented by hand; it must be quite efficient therefore
-- It is a monad, not a transformer. It cannot do any other effects beside
-- the non-determinism.
newtype CPS a = CPS{unCPS:: (a -> [Int]) -> [Int]}
instance Functor CPS where
fmap f fa = CPS $ \k -> unCPS fa (k . f)
instance Applicative CPS where
pure x = CPS $ \k -> k x
mf <*> fa = CPS $ \k -> unCPS mf (\f -> unCPS fa (k . f))
instance Monad CPS where
return x = CPS $ \k -> k x
m >>= f = CPS $ \k -> unCPS m (\a -> unCPS (f a) k)
instance Alternative CPS where
empty = mzero
(<|>) = mplus
instance MonadPlus CPS where
mzero = CPS $ \_ -> []
mplus m1 m2 = CPS $ \k -> unCPS m1 k ++ unCPS m2 k
run_cps :: CPS Int -> [Int]
run_cps m = unCPS m (\x -> [x])
testc1 = (==) [101, 201, 102, 202] . run_cps $
add (amb [int 1, int 2]) (amb [int 100, int 200])
testc2 = ww_answer == sort (run_cps test_ww)
-- ExtEff implementation
-- Eff is already an instance of MonadPlus. Thus we only need to
-- define the run instance
-- run_eff :: Eff '[E.Choose] Int -> [Int]
-- run_eff = run . E.makeChoice
-- More direct interpreter
-- makeChoiceA :: Eff (E.NdetEff ': r) a -> Eff r [a]
-- makeChoiceA = handle_relay (\x -> x `seq` return [x] ) $ \m k -> case m of
-- E.MZero -> return []
-- E.MPlus -> liftM2 (++) (k True) (k False)
run_eff :: Eff '[E.NdetEff] Int -> [Int]
run_eff = run . E.makeChoiceA
teste2 = ww_answer == sort (run_eff test_ww)
data Count a = Count (Maybe a) !Int
instance Functor Count where
fmap f (Count (Just x) n) = Count (Just (f x)) n
fmap _ _ = Count Nothing 0
instance Applicative Count where
pure x = Count (Just x) 1
Count (Just f) nf <*> Count (Just x) nx = Count (Just (f x)) (nf + nx)
_ <*> _ = Count Nothing 0
instance Alternative Count where
empty = Count Nothing 0
Count m1@Just{} n1 <|> Count _ n2 = Count m1 (n1+n2)
_ <|> m2 = m2
run_effc :: Eff '[E.NdetEff] Int -> Int
run_effc m = let Count _ n = run . E.makeChoiceA $ m in n
teste12 = length ww_answer == run_effc test_ww
{-
-- CCEx monad
-- Not a very optimal implementation of mplus (a tree would be better)
-- But is suffices as a benchmark of different implementations of CC
instance Monad m => MonadPlus (CC (PS [Int]) m) where
mzero = abortP ps (return [])
mplus m1 m2 = takeSubCont ps (\k ->
liftM2 (++)
(pushPrompt ps (pushSubCont k m1))
(pushPrompt ps (pushSubCont k m2)))
run_dir :: CC (PS [Int]) Identity Int -> [Int]
run_dir m = runIdentity . runCC $
pushPrompt ps (m >>= return . (:[]))
testd1 = (==) [101, 201, 102, 202] . run_dir $
add (amb [int 1, int 2]) (amb [int 100, int 200])
testd2 = ww_answer == sort (run_dir test_ww)
-}
-- Benchmarks themselves
main_list3 = print $ 2400 == (length . run_list $ test_www)
main_list4 = print $ 48000 == (length . run_list $ test_wwww)
main_list5 = print $ 960000 == (length . run_list $ test_w5)
main_cps3 = print $ 2400 == (length . run_cps $ test_www)
main_cps4 = print $ 48000 == (length . run_cps $ test_wwww)
main_cps5 = print $ 960000 == (length . run_cps $ test_w5)
-- We expect the direct implementation to be slower since CC is the transformer,
-- whereas CPS is not. The latter is hand-written for a specific answer-type.
main_eff3 = print $ 2400 == (length . run_eff $ test_www)
main_eff4 = print $ 48000 == (length . run_eff $ test_wwww)
main_eff5 = print $ 960000 == (length . run_eff $ test_w5)
main_eff5c = print $ 960000 == (run_effc $ test_w5)
-- To clarify the effect of building a list
main_eff5m = print $ ((run . E.makeChoiceA $ test_w5) :: Maybe Int)
{-
-- Instantiate CC to the IO as the base monad, attempting to quantify the
-- effect of the Identity transformer
main_dir5io = do
l <- runCC $ pushPrompt ps (test_w5 >>= return . (:[]))
print $ length l == 960000
-}
-- ------------------------------------------------------------------------
-- Old results, from 2010
{- Median of 5 runs
main_list5
<<ghc: 186526764 bytes, 356 GCs, 619182/1156760 avg/max bytes residency (3 samples), 4M in use, 0.00 INIT (0.00 elapsed), 0.25 MUT (0.25 elapsed), 0.06 GC (0.06 elapsed) :ghc>>
0.30 real 0.30 user 0.00 sys
main_cps5
<<ghc: 231580040 bytes, 442 GCs, 4017/4104 avg/max bytes residency (24 samples), 2M in use, 0.00 INIT (0.00 elapsed), 0.28 MUT (0.28 elapsed), 0.31 GC (0.33 elapsed) :ghc>>
0.60 real 0.58 user 0.01 sys
main_dir5 (CCExc implementation)
<<ghc: 780415108 bytes, 1489 GCs, 10459973/39033060 avg/max bytes residency (14 samples), 110M in use, 0.00 INIT (0.00 elapsed), 1.30 MUT (1.32 elapsed), 2.92 GC (3.14 elapsed) :ghc>>
4.48 real 4.22 user 0.24 sys
main_dir5io (CCExc implementation)
<<ghc: 1148031880 bytes, 2190 GCs, 10339954/38941944 avg/max bytes residency (14 samples), 108M in use, 0.00 INIT (0.00 elapsed), 2.15 MUT (2.20 elapsed), 3.04 GC (3.24 elapsed) :ghc>>
5.45 real 5.18 user 0.21 sys
main_dir5 (CCCxe implementation)
./Bench_nondet +RTS -tstderr
True
<<ghc: 991065016 bytes, 1891 GCs, 10473968/38790660 avg/max bytes residency (14 samples), 110M in use, 0.00 INIT (0.00 elapsed), 1.45 MUT (1.49 elapsed), 2.99 GC (3.20 elapsed) :ghc>>
4.70 real 4.44 user 0.23 sys
main_dir5io (CCCxe implementation)
./Bench_nondet +RTS -tstderr
True
<<ghc: 991065412 bytes, 1891 GCs, 10364029/37920012 avg/max bytes residency (14 samples), 109M in use, 0.00 INIT (0.00 elapsed), 1.46 MUT (1.50 elapsed), 2.99 GC (3.20 elapsed) :ghc>>
4.72 real 4.44 user 0.23 sys
main_ref5io (without pushDelimSubCont)
./Bench_nondet +RTS -tstderr
True
<<ghc: 19050261764 bytes, 36337 GCs, 10620542/49328200 avg/max bytes residency (16 samples), 123M in use, 0.00 INIT (0.00 elapsed), 61.45 MUT (62.70 elapsed), 6.06 GC (6.21 elapsed) :ghc>>
68.94 real 67.51 user 1.03 sys
main_ref5io (with pushDelimSubCont)
./Bench_nondet +RTS -tstderr
True
<<ghc: 5666546308 bytes, 10809 GCs, 10538302/46414760 avg/max bytes residency (14 samples), 114M in use, 0.00 INIT (0.00 elapsed), 16.27 MUT (16.68 elapsed), 3.65 GC (3.80 elapsed) :ghc>>
20.50 real 19.92 user 0.46 sys
-}
-- ------------------------------------------------------------------------
-- Newer Benchmarks, July 2015
{-
main_list5
True
<<ghc: 374751856 bytes, 720 GCs, 939265/2386984 avg/max bytes residency (6 samples), 7M in use, 0.00 INIT (0.00 elapsed), 0.11 MUT (0.11 elapsed), 0.02 GC (0.02 elapsed) :ghc>>
main_cps5
True
<<ghc: 463450920 bytes, 889 GCs, 36708/44312 avg/max bytes residency (2 samples), 1M in use, 0.00 INIT (0.00 elapsed), 0.14 MUT (0.15 elapsed), 0.00 GC (0.01 elapsed) :ghc>>
-- using makeChoiceA (setting f as an Alternative)
main_eff5
True
<<ghc: 1013337072 bytes, 1944 GCs, 18671465/83300976 avg/max bytes residency (17 samples), 231M in use, 0.00 INIT (0.00 elapsed), 0.36 MUT (0.39 elapsed), 1.08 GC (1.13 elapsed) :ghc>>
With strict add:
True
<<ghc: 993935088 bytes, 1906 GCs, 15000238/77154800 avg/max bytes residency (19 samples), 199M in use, 0.00 INIT (0.00 elapsed), 0.37 MUT (0.39 elapsed), 0.95 GC (1.02 elapsed) :ghc>>
1.32user 0.08system 0:01.40elapsed 99%CPU (0avgtext+0avgdata 819408maxresident)k
0inputs+0outputs (0major+51485minor)pagefaults 0swaps
It looks like a huge memory leak. Perhaps the list is fully realized?
Using the counting Alternative Count
True
<<ghc: 591341472 bytes, 1133 GCs, 16603280/76447176 avg/max bytes residency (10 samples), 162M in use, 0.00 INIT (0.00 elapsed), 0.28 MUT (0.28 elapsed), 0.61 GC (0.66 elapsed) :ghc>>
Using Maybe
Just 32
<<ghc: 523838824 bytes, 1003 GCs, 16969712/76447176 avg/max bytes residency (9 samples), 150M in use, 0.00 INIT (0.00 elapsed), 0.21 MUT (0.19 elapsed), 0.46 GC (0.52 elapsed) :ghc>>
0.67user 0.05system 0:00.72elapsed 100%CPU (0avgtext+0avgdata 620752maxresident)k
0inputs+0outputs (0major+38937minor)pagefaults 0swaps
-- using Maybe, but with the better makeChoice
Just 32
<<ghc: 517460016 bytes, 883 GCs, 20215861/91552144 avg/max bytes residency (9 samples), 138M in use, 0.00 INIT (0.00 elapsed), 0.22 MUT (0.24 elapsed), 0.41 GC (0.43 elapsed) :ghc>>
0.63user 0.04system 0:00.68elapsed 100%CPU (0avgtext+0avgdata 570720maxresident)k
0inputs+0outputs (0major+35760minor)pagefaults 0swaps
Better makeChoiceA, full list
True
<<ghc: 454475112 bytes, 839 GCs, 8700298/33304904 avg/max bytes residency (8 samples), 58M in use, 0.00 INIT (0.00 elapsed), 0.23 MUT (0.23 elapsed), 0.19 GC (0.20 elapsed) :ghc>>
0.42user 0.02system 0:00.44elapsed 100%CPU (0avgtext+0avgdata 244064maxresident)k
0inputs+0outputs (0major+15391minor)pagefaults 0swaps
-}