git.iko.soy/effects-benchmarks
on master help sign in
Start porting to use Backpack.
commite6e981ae76c31673c1249340211b6ce7443bed51 authorPatrick Thomson <patrickt@github.com> dateTue 30 Apr 2019, 11:42 (7 years ago) parent938af84
15 files changed+257−104
compare with master
unifiedsplit
.gitignore+2 effects-benchmarks.cabal+49−18 instances/FSStateful.hs+18 instances/Freer/StatefulExcept.hs+21 instances/Fused/Stateful.hs+17 instances/Fused/StatefulExcept.hs+21 instances/MTL/StatefulExcept.hs+20 instances/MTLStateful.hs+16 instances/PStateful.hs+17 src/Bench/Countdown.hs+14 src/Bench/Countdown/StateExcept.hs+2 src/Bench/Signature/Stateful.hsig+17 src/Bench/Signature/StatefulExcept.hsig+17 src/Main.hs+26−10 stack.yaml−76
.gitignore+2
@@ -1,2 +1,4 @@
11.stack-work
22.DS_Store
3+core-html/
4+dist-newstyle/
effects-benchmarks.cabal+49−18
@@ -1,30 +1,61 @@
1+cabal-version: 2.2
12name: effects-benchmarks
23version: 0.1.0.0
3−-- synopsis:
4−-- description:
5−homepage: https://github.com/githubuser/effects-benchmarks#readme
6−license: BSD3
4+homepage: https://github.com/patrickt/effects-benchmarks#readme
5+license: BSD-3-Clause
76license-file: LICENSE
87author: Author name here
98maintainer: example@example.com
109copyright: 2018 Author name here
1110category: Web
1211build-type: Simple
13−cabal-version: >=1.10
1412extra-source-files: README.md
1513
16−executable effects-benchmarks
17− hs-source-dirs: src
18− main-is: Main.hs
19− other-modules: HigherOrder
20− , JVEffects
21− , MTL
22− , FreerSimple
14+common shared
2315 default-language: Haskell2010
16+ ghc-options: -Wall -Werror -O1
2417 build-depends: base >= 4.7 && < 5
25− , higher-order-effects
26− , effects
27− , gauge
28− , mtl
29− , freer-simple
30− ghc-options: -Wall -Werror -O2
18+
19+library benchmark-signatures
20+ import: shared
21+ hs-source-dirs: src
22+ signatures: Bench.Signature.Stateful
23+ , Bench.Signature.StatefulExcept
24+ exposed-modules: Bench.Countdown
25+
26+library instances-for-mtl
27+ import: shared
28+ hs-source-dirs: instances
29+ exposed-modules: MTLStateful
30+ , MTL.StatefulExcept
31+ build-depends: mtl ^>= 2.2.2
32+
33+library instances-for-fused-effects
34+ import: shared
35+ hs-source-dirs: instances
36+ exposed-modules: Fused.Stateful
37+ , Fused.StatefulExcept
38+ build-depends: fused-effects >= 0.3.1.0
39+
40+library instances-for-freer-simple
41+ import: shared
42+ hs-source-dirs: instances
43+ exposed-modules: FSStateful
44+ , Freer.StatefulExcept
45+ build-depends: freer-simple ^>= 1.2.1
46+
47+benchmark effects-benchmarks
48+ import: shared
49+ type: exitcode-stdio-1.0
50+ hs-source-dirs: src
51+ build-depends: benchmark-signatures
52+ , instances-for-mtl
53+ , instances-for-fused-effects
54+ , instances-for-freer-simple
55+ , dump-core
56+ , gauge
57+ , polysemy
58+ main-is: Main.hs
59+ mixins: benchmark-signatures (Bench.Countdown as MTL.Countdown) requires (Bench.Signature.Stateful as MTLStateful, Bench.Signature.StatefulExcept as MTL.StatefulExcept)
60+ , benchmark-signatures (Bench.Countdown as Fused.Countdown) requires (Bench.Signature.Stateful as Fused.Stateful, Bench.Signature.StatefulExcept as Fused.StatefulExcept)
61+ , benchmark-signatures (Bench.Countdown as Simple.Countdown) requires (Bench.Signature.Stateful as FSStateful, Bench.Signature.StatefulExcept as Freer.StatefulExcept)
instances/FSStateful.hsnew file+18
@@ -0,0 +1,18 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
2+
3+module FSStateful where
4+
5+import Control.Monad.Freer
6+import Control.Monad.Freer.State as State
7+import Data.Tuple
8+
9+type StateM = Eff '[State Int]
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+runStateful :: Int -> StateM a -> (Int, a)
18+runStateful n x = swap . run $ State.runState n x
instances/Freer/StatefulExcept.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
2+module Freer.StatefulExcept where
3+
4+import Control.Monad.Freer
5+import Control.Monad.Freer.State as State
6+import Control.Monad.Freer.Error
7+import Data.Tuple
8+
9+type StateM = Eff '[State Int, Error String]
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+throw :: String -> StateM a
18+throw = throwError
19+
20+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21+runStatefulExcept n x = fmap swap . run . runError $ State.runState n x
instances/Fused/Stateful.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE TypeApplications #-}
2+
3+module Fused.Stateful where
4+
5+import Control.Effect (run, PureC)
6+import Control.Effect.State.Lazy as State
7+
8+type StateM = StateC Int PureC
9+
10+get :: StateM Int
11+get = State.get @Int
12+
13+put :: Int -> StateM ()
14+put = State.put @Int
15+
16+runStateful :: Int -> StateM a -> (Int, a)
17+runStateful n x = run $ State.runState n x
instances/Fused/StatefulExcept.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE TypeApplications #-}
2+
3+module Fused.StatefulExcept where
4+
5+import Control.Effect (run, PureC)
6+import Control.Effect.State.Strict as State
7+import Control.Effect.Error
8+
9+type StateM = StateC Int (ErrorC String PureC)
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+throw :: String -> StateM a
18+throw = throwError
19+
20+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21+runStatefulExcept n x = run . runError $ State.runState n x
instances/MTL/StatefulExcept.hsnew file+20
@@ -0,0 +1,20 @@
1+module MTL.StatefulExcept where
2+
3+import qualified Control.Monad.State.Strict as MTL
4+import qualified Control.Monad.Except as MTL
5+import Data.Tuple
6+import Data.Functor.Identity
7+
8+type StateM = MTL.StateT Int (MTL.ExceptT String Identity)
9+
10+get :: StateM Int
11+get = MTL.get
12+
13+put :: Int -> StateM ()
14+put = MTL.put
15+
16+throw :: String -> StateM a
17+throw = MTL.throwError
18+
19+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
20+runStatefulExcept n x = fmap swap . MTL.runExcept $ MTL.runStateT x n
instances/MTLStateful.hsnew file+16
@@ -0,0 +1,16 @@
1+module MTLStateful where
2+
3+import qualified Control.Monad.State.Strict as MTL
4+import Data.Tuple
5+import Data.Functor.Identity
6+
7+type StateM = MTL.StateT Int Identity
8+
9+get :: StateM Int
10+get = MTL.get
11+
12+put :: Int -> StateM ()
13+put = MTL.put
14+
15+runStateful :: Int -> StateM a -> (Int, a)
16+runStateful n x = swap (MTL.runState x n)
instances/PStateful.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
2+
3+module PStateful where
4+
5+import Polysemy
6+import Polysemy.State as State
7+
8+type StateM = Sem '[State Int]
9+
10+get :: StateM Int
11+get = State.get
12+
13+put :: Int -> StateM ()
14+put = State.put
15+
16+runStateful :: Int -> StateM a -> (Int, a)
17+runStateful n x = run $ State.runState n x
src/Bench/Countdown.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+
3+module Bench.Countdown where
4+
5+import qualified Bench.Signature.Stateful as S
6+import qualified Bench.Signature.StatefulExcept as SE
7+
8+countDownPut :: Int -> (Int, Int)
9+countDownPut start = S.runStateful start go where
10+ go = S.get >>= (\n -> if n < 0 then pure n else S.put (n - 1) *> go)
11+
12+countDownExc :: Int -> Either String (Int, Int)
13+countDownExc start = SE.runStatefulExcept start go where
14+ go = SE.get >>= (\n -> if n <= 0 then SE.throw "what" else SE.put (n - 1) *> go)
src/Bench/Countdown/StateExcept.hsnew file+2
@@ -0,0 +1,2 @@
1+module Bench.Countdown.StateExcept where
2+
src/Bench/Signature/Stateful.hsignew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE KindSignatures #-}
2+signature Bench.Signature.Stateful
3+ ( StateM
4+ , get
5+ , put
6+ , runStateful
7+ ) where
8+
9+data StateM a
10+
11+instance Applicative StateM
12+instance Monad StateM
13+
14+get :: StateM Int
15+put :: Int -> StateM ()
16+runStateful :: Int -> StateM a -> (Int, a)
17+
src/Bench/Signature/StatefulExcept.hsignew file+17
@@ -0,0 +1,17 @@
1+signature Bench.Signature.StatefulExcept
2+ ( StateM
3+ , get
4+ , put
5+ , throw
6+ , runStatefulExcept
7+ ) where
8+
9+data StateM a
10+
11+instance Applicative StateM
12+instance Monad StateM
13+
14+get :: StateM Int
15+put :: Int -> StateM ()
16+throw :: String -> StateM a
17+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
src/Main.hs+26−10
@@ -1,14 +1,30 @@
1+{-# LANGUAGE FlexibleContexts, GADTs, CPP #-}
2+
13module Main where
24
3−import qualified HigherOrder as HigherOrder
4−import qualified JVEffects as JVEffects
5−import qualified FreerSimple as FreerSimple
6−import qualified MTL as MTL
7−import Gauge.Main
5+import Gauge (bench, bgroup, nf)
6+import Gauge.Main (defaultMain)
7+
8+import qualified Fused.Countdown as Fused
9+import qualified Simple.Countdown as Simple
10+import qualified MTL.Countdown as MTL
11+
12+#define SUITE(nam,bare) [ bench "fused-effects" (nf MTL.nam 10000) \
13+ , bench "mtl" (nf Fused.nam 10000) \
14+ , bench "freer-simple" (nf Simple.nam 10000) \
15+ , bench "manual" (nf bare 10000) ]
816
917main :: IO ()
10−main = defaultMain [ HigherOrder.marks
11− , JVEffects.marks
12− , FreerSimple.marks
13− , MTL.marks
14− ]
18+main = defaultMain
19+ [
20+ bgroup "Countdown"
21+ [ bgroup "Put" SUITE(countDownPut, bareDown)
22+ , bgroup "Put+Exc" SUITE(countDownExc, bareDownExc)
23+ ]
24+ ]
25+
26+bareDown :: Int -> (Int, Int)
27+bareDown st = if st <= 0 then (st, st) else bareDown (st - 1)
28+
29+bareDownExc :: Int -> Either String (Int, Int)
30+bareDownExc st = if st <= 0 then Left "what" else bareDownExc (st - 1)
stack.yamldeleted−76
@@ -1,76 +0,0 @@
1−# This file was automatically generated by 'stack init'
2−#
3−# Some commonly used options have been documented as comments in this file.
4−# For advanced use and comprehensive documentation of the format, please see:
5−# https://docs.haskellstack.org/en/stable/yaml_configuration/
6−
7−# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8−# A snapshot resolver dictates the compiler version and the set of packages
9−# to be used for project dependencies. For example:
10−#
11−# resolver: lts-3.5
12−# resolver: nightly-2015-09-21
13−# resolver: ghc-7.10.2
14−# resolver: ghcjs-0.1.0_ghc-7.10.2
15−#
16−# The location of a snapshot can be provided as a file or url. Stack assumes
17−# a snapshot provided as a file might change, whereas a url resource does not.
18−#
19−# resolver: ./custom-snapshot.yaml
20−# resolver: https://example.com/snapshots/2018-01-01.yaml
21−resolver: lts-12.12
22−
23−# User packages to be built.
24−# Various formats can be used as shown in the example below.
25−#
26−# packages:
27−# - some-directory
28−# - https://example.com/foo/bar/baz-0.0.2.tar.gz
29−# - location:
30−# git: https://github.com/commercialhaskell/stack.git
31−# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
32−# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
33−# subdirs:
34−# - auto-update
35−# - wai
36−packages:
37−- .
38−- location:
39− git: https://github.com/robrix/higher-order-effects
40− commit: 9426ca363e8bccfc7477de13d90fcdb07b11c012
41− extra-dep: true
42−- location:
43− git: https://github.com/joshvera/effects
44− commit: fc7fc0e2896239a1fef3dbc40a76c131c42e0396
45− extra-dep: true
46−
47−extra-deps:
48− - type-aligned-0.9.6
49−# Dependency packages to be pulled from upstream that are not in the resolver
50−# using the same syntax as the packages field.
51−# (e.g., acme-missiles-0.3)
52−# extra-deps: []
53−
54−# Override default flag values for local packages and extra-deps
55−# flags: {}
56−
57−# Extra package databases containing global packages
58−# extra-package-dbs: []
59−
60−# Control whether we use the GHC we find on the path
61−# system-ghc: true
62−#
63−# Require a specific version of stack, using version ranges
64−# require-stack-version: -any # Default
65−# require-stack-version: ">=1.7"
66−#
67−# Override the architecture used by stack, especially useful on Windows
68−# arch: i386
69−# arch: x86_64
70−#
71−# Extra directories used by stack for building
72−# extra-include-dirs: [/path/to/dir]
73−# extra-lib-dirs: [/path/to/dir]
74−#
75−# Allow a newer minor version of GHC than the snapshot specifies
76−# compiler-check: newer-minor