Skip to content

Commit cfd2003

Browse files
safarelisafareli
committed
WIP
1 parent 6caa8e1 commit cfd2003

File tree

12 files changed

+503
-11
lines changed

12 files changed

+503
-11
lines changed

‎.eslintrc.json

+1-1
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
"no-param-reassign": 2,
2020
"no-return-assign": 2,
2121
"no-unused-expressions": 2,
22-
"no-use-before-define": 2,
22+
"no-use-before-define": [2, { "functions": false }],
2323
"radix": [2, "always"],
2424
"indent": [2, 2, { "SwitchCase": 1 }],
2525
"quotes": [2, "double"],

‎.travis.yml

+9-1
Original file line numberDiff line numberDiff line change
@@ -11,9 +11,17 @@ install:
1111
- chmod a+x $HOME/purescript
1212
- npm install -g bower
1313
- npm install
14-
- bower install
14+
- bower install --production
15+
- cd bench
16+
- npm install
17+
- bower install --production
18+
- cd ..
1519
script:
1620
- npm run -s build
21+
- bower install
22+
- npm run -s test
23+
- cd bench
24+
- npm run -s build
1725
after_success:
1826
- >-
1927
test $TRAVIS_TAG &&

‎bench/.gitignore

+6
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
/.*
2+
!/.gitignore
3+
!/.travis.yml
4+
/bower_components/
5+
/node_modules/
6+
/output/

‎bench/bower.json

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
{
2+
"name": "purescript-eff-aff-bench",
3+
"dependencies": {
4+
"purescript-minibench": "^2.0.0",
5+
"purescript-effect": "safareli/purescript-effect#fast",
6+
"purescript-aff": "^5.0.0"
7+
},
8+
"resolutions": {
9+
"purescript-effect": "fast"
10+
}
11+
}

‎bench/package.json

+19
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
{
2+
"private": true,
3+
"scripts": {
4+
"clean": "rimraf output && rimraf .pulp-cache",
5+
"start": "npm run build && npm run run",
6+
"run": "node --expose-gc -e 'require(\"./output/Bench.Main/index.js\").main()'",
7+
"build": "eslint src && pulp build -- --censor-lib --strict"
8+
},
9+
"devDependencies": {
10+
"eslint": "^4.19.1",
11+
"pulp": "^12.2.0",
12+
"purescript-psa": "^0.6.0",
13+
"rimraf": "^2.6.2"
14+
},
15+
"dependencies": {
16+
"bower": "^1.8.8",
17+
"purescript": "^0.12.5"
18+
}
19+
}

‎bench/src/Bench/Main.js

+21
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
"use strict";
2+
3+
exports.mkArr = function(){
4+
return { count: 0 };
5+
};
6+
7+
exports.pushToArr = function(xs) {
8+
return function() {
9+
return function() {
10+
xs.count += 1;
11+
return xs;
12+
};
13+
};
14+
};
15+
16+
exports.log = function(x) {
17+
return function(){
18+
// eslint-disable-next-line
19+
console.log(x);
20+
};
21+
};

‎bench/src/Bench/Main.purs

+109
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
module Bench.Main where
2+
3+
import Prelude
4+
5+
import Effect (Effect)
6+
import Effect.Aff (Aff, launchAff_)
7+
import Effect.Class (class MonadEffect, liftEffect)
8+
import Effect.Unsafe (unsafePerformEffect)
9+
import Data.Traversable (for_, intercalate)
10+
import Performance.Minibench (BenchResult, benchWith', withUnits)
11+
12+
13+
testApply :: forall m. MonadEffect m => Int -> m Unit
14+
testApply n' = do
15+
arr <- liftEffect mkArr
16+
applyLoop (void <<< liftEffect <<< pushToArr arr) n'
17+
where
18+
applyLoop :: Monad m => (Int -> m Unit) -> Int -> m Unit
19+
applyLoop eff max = go (pure unit) 0
20+
where
21+
go acc n | n == max = acc
22+
go acc n = go (acc <* eff n) (n + 1)
23+
24+
25+
testBindRight :: forall m. MonadEffect m => Int -> m Unit
26+
testBindRight n' = do
27+
arr <- liftEffect mkArr
28+
bindRightLoop (void <<< liftEffect <<< pushToArr arr) n'
29+
where
30+
bindRightLoop :: Monad m => (Int -> m Unit) -> Int -> m Unit
31+
bindRightLoop eff max = go (pure unit) 0
32+
where
33+
go acc n | n == max = acc
34+
go acc n = go (eff (max - n - 1) >>= const acc) (n + 1)
35+
36+
37+
testBindLeft :: forall m. MonadEffect m => Int -> m Unit
38+
testBindLeft n' = do
39+
arr <- liftEffect mkArr
40+
bindLeftLoop (void <<< liftEffect <<< pushToArr arr) n'
41+
where
42+
bindLeftLoop :: Monad m => (Int -> m Unit) -> Int -> m Unit
43+
bindLeftLoop eff max = go (pure unit) 0
44+
where
45+
go acc n | n == max = acc
46+
go acc n = go (acc >>= const (eff n)) (n + 1)
47+
48+
49+
testMap :: forall m. MonadEffect m => Int -> m Unit
50+
testMap n = do
51+
arr <- liftEffect mkArr
52+
res <- mapLoop n (liftEffect $ pushToArr arr 0)
53+
pure unit
54+
where
55+
mapLoop :: Monad m => Int -> m Int -> m Int
56+
mapLoop max i =
57+
if max == 0
58+
then i
59+
else mapLoop (max - 1) (map (_ + 1) i)
60+
61+
62+
main :: Effect Unit
63+
main = do
64+
log "<details><summary>benchmark</summary>"
65+
log "| bench | type | n | mean | stddev | min | max |"
66+
log "| ----- | ---- | - | ---- | ------ | --- | --- |"
67+
bench 10 ">>=R" testBindRight testBindRight [100, 1000, 5000]
68+
bench 10 ">>=L" testBindLeft testBindLeft [100, 1000, 5000]
69+
bench 10 "map" testMap testMap [100, 1000, 5000]
70+
bench 10 "apply" testApply testApply [100, 1000, 5000]
71+
log "| - | - | - | - | - | - | - |"
72+
bench 2 ">>=R" testBindRight testBindRight [10000, 50000, 100000, 1000000]
73+
bench 2 ">>=L" testBindLeft testBindLeft [10000, 50000, 100000, 1000000]
74+
bench 2 "map" testMap testMap [10000, 50000, 100000, 1000000, 350000, 700000]
75+
bench 2 "apply" testApply testApply [10000, 50000, 100000, 1000000]
76+
log "</details>"
77+
78+
bench
79+
:: Int
80+
-> String
81+
-> (Int -> Effect Unit)
82+
-> (Int -> Aff Unit)
83+
-> Array Int
84+
-> Effect Unit
85+
bench n name buildEffect buildAff vals = for_ vals \val -> do
86+
logBench [name <> " build", "Eff", show val] $ benchWith' n \_ -> buildEffect val
87+
logBench' identity [name <> " build", "Aff", show val] $ benchWith' n \_ -> buildAff val
88+
let eff = liftEffect $ buildEffect val
89+
logBench [name <> " run", "Eff", show val] $ benchWith' n \_ -> unsafePerformEffect eff
90+
let aff = launchAff_ $ buildAff val
91+
logBench' identity [name <> " run", "Aff", show val] $ benchWith' n \_ -> unsafePerformEffect aff
92+
93+
logBench' :: (String -> String) -> Array String -> Effect BenchResult -> Effect Unit
94+
logBench' f msg benchEffect = do
95+
res <- benchEffect
96+
let
97+
logStr = intercalate " | "
98+
$ append msg
99+
$ map (f <<< withUnits) [res.mean, res.stdDev, res.min, res.max]
100+
log $ "| " <> logStr <> " |"
101+
102+
logBench :: Array String -> Effect BenchResult -> Effect Unit
103+
logBench = logBench' \s -> "**" <> s <> "**"
104+
105+
foreign import data Arr :: Type -> Type
106+
foreign import mkArr :: forall a. Effect (Arr a)
107+
foreign import pushToArr :: forall a. Arr a -> a -> Effect a
108+
foreign import log :: forall a. a -> Effect Unit
109+

‎package.json

+5
Original file line numberDiff line numberDiff line change
@@ -2,12 +2,17 @@
22
"private": true,
33
"scripts": {
44
"clean": "rimraf output && rimraf .pulp-cache",
5+
"test": "pulp test",
56
"build": "eslint src && pulp build -- --censor-lib --strict"
67
},
78
"devDependencies": {
89
"eslint": "^4.19.1",
910
"pulp": "^12.2.0",
1011
"purescript-psa": "^0.6.0",
1112
"rimraf": "^2.6.2"
13+
},
14+
"dependencies": {
15+
"bower": "^1.8.8",
16+
"purescript": "^0.12.5"
1217
}
1318
}

0 commit comments

Comments
 (0)