Skip to content

Commit c5a83e3

Browse files
safarelisafareli
committed
Use same representation as Eff
1 parent ad5675e commit c5a83e3

6 files changed

Lines changed: 64 additions & 79 deletions

File tree

‎bench/Bench/Main.purs‎

Lines changed: 1 addition & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -77,15 +77,9 @@ extended = do
7777
log header
7878
bench2 ">>=R" testBindRight testBindRight [20000, 50000, 100000, 1000000]
7979
bench2 ">>=L" testBindLeft testBindLeft [20000, 50000, 100000, 1000000]
80-
bench2 "map" testMap testMap [10000, 20000, 50000, 100000, 1000000]
81-
timed ["map", "Ef", "10000000"] $ testMap 10000000 -- Aff can't handle this number, I got `JavaScript heap out of memory`
80+
bench2 "map" testMap testMap [10000, 20000, 50000, 100000, 1000000, 350000, 700000]
8281
bench2 "apply" testApply testApply [10000, 20000, 50000, 100000, 1000000]
8382

84-
timed :: Array String -> Ef BenchEff Unit -> Eff BenchEff Unit
85-
timed msg ef = do
86-
let eff = liftEf ef
87-
logBench' msg $ benchWith' 5 \_ -> unsafePerformEff eff
88-
8983
header :: String
9084
header =
9185
"| bench | type | n | mean | stddev | min | max |\n" <>

‎bower.json‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,8 @@
1818
],
1919
"dependencies": {
2020
"purescript-prelude": "^3.0.0",
21-
"purescript-eff": "^3.1.0"
21+
"purescript-eff": "^3.1.0",
22+
"purescript-unsafe-coerce": "^3.0.0"
2223
},
2324
"devDependencies": {
2425
"purescript-foldable-traversable": "^3.6.1",

‎src/Control/Monad/Ff.js‎

Lines changed: 51 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
"use strict";
22

33

4-
// Ef a
4+
// Ef a
55
// = () -> a
6-
// | { tag: "PURE", _0 :: a, _1 :: Void }
7-
// | { tag: "MAP", _0 :: b -> a, _1 :: Ef b }
8-
// | { tag: "APPLY", _0 :: Ef b, _1 :: Ef (b -> a) }
9-
// | { tag: "BIND", _0 :: b -> Ef a, _1 :: Ef b }
6+
// | { Ef a, tag: "PURE", _0 :: a, _1 :: Void }
7+
// | { Ef a, tag: "MAP", _0 :: b -> a, _1 :: Ef b }
8+
// | { Ef a, tag: "APPLY", _0 :: Ef b, _1 :: Ef (b -> a) }
9+
// | { Ef a, tag: "BIND", _0 :: b -> Ef a, _1 :: Ef b }
1010

1111
// Operation a b
1212
// = { tag: "MAP", _0 :: a -> b }
@@ -15,84 +15,78 @@
1515
// | { tag: "BIND", _0 :: a -> Ef b }
1616

1717

18-
function Ef(tag, _0, _1) {
19-
this.tag = tag;
20-
this._0 = _0;
21-
this._1 = _1;
22-
}
23-
2418
var PURE = "PURE";
2519
var MAP = "MAP";
2620
var APPLY = "APPLY";
2721
var BIND = "BIND";
2822
var APPLY_FUNC = "APPLY_FUNC";
2923

30-
exports.liftEffE = function (eff) {
31-
return eff;
32-
};
33-
3424
exports.pureE = function (x) {
35-
return new Ef(PURE, x);
25+
return mkEf(PURE, x);
3626
};
3727

3828
exports.mapE = function (f) {
3929
return function (eff) {
40-
return new Ef(MAP, f, eff);
30+
return mkEf(MAP, f, eff);
4131
};
4232
};
4333

4434
exports.applyE = function (effF) {
4535
return function (eff) {
46-
return new Ef(APPLY, eff, effF);
36+
return mkEf(APPLY, eff, effF);
4737
};
4838
};
4939

5040
exports.bindE = function (eff) {
5141
return function (f) {
52-
return new Ef(BIND, f, eff);
42+
return mkEf(BIND, f, eff);
5343
};
5444
};
5545

56-
exports.toEff = function (inputEff) {
57-
if (typeof inputEff === "function") {
58-
return inputEff;
59-
}
60-
return function() {
61-
var operations = [];
62-
var eff = inputEff;
63-
var res;
64-
var op;
65-
var tag;
66-
effLoop: for (;;) {
67-
tag = eff.tag;
68-
if (tag !== undefined) {
69-
if (tag === MAP || tag === BIND || tag === APPLY) {
70-
operations.push(eff);
71-
eff = eff._1;
72-
continue;
73-
}
74-
// here `tag === PURE`
75-
res = eff._0;
76-
} else {
77-
// here `typeof eff == "function"`
78-
res = eff();
46+
47+
var mkEf = function (tag, _0, _1) {
48+
var eff = function eff_() { return toEff(eff_) }
49+
eff.tag = tag
50+
eff._0 = _0
51+
eff._1 = _1
52+
return eff
53+
}
54+
55+
var toEff = function (inputEff) {
56+
var operations = [];
57+
var eff = inputEff;
58+
var res;
59+
var op;
60+
var tag;
61+
effLoop: for (;;) {
62+
tag = eff.tag;
63+
if (tag !== undefined) {
64+
if (tag === MAP || tag === BIND || tag === APPLY) {
65+
operations.push(eff);
66+
eff = eff._1;
67+
continue;
7968
}
69+
// here `tag === PURE`
70+
res = eff._0;
71+
} else {
72+
// here `typeof eff == "function"`
73+
res = eff();
74+
}
8075

81-
while ((op = operations.pop())) {
82-
if (op.tag === MAP) {
83-
res = op._0(res);
84-
} else if (op.tag === APPLY_FUNC) {
85-
res = op._0(res);
86-
} else if (op.tag === APPLY) {
87-
eff = op._0;
88-
operations.push(new Ef(APPLY_FUNC, res));
89-
continue effLoop;
90-
} else { // op.tag === BIND
91-
eff = op._0(res);
92-
continue effLoop;
93-
}
76+
while ((op = operations.pop())) {
77+
if (op.tag === MAP) {
78+
res = op._0(res);
79+
} else if (op.tag === APPLY_FUNC) {
80+
res = op._0(res);
81+
} else if (op.tag === APPLY) {
82+
eff = op._0;
83+
operations.push(new Ef(APPLY_FUNC, res));
84+
continue effLoop;
85+
} else { // op.tag === BIND
86+
eff = op._0(res);
87+
continue effLoop;
9488
}
95-
return res;
9689
}
97-
};
90+
return res;
91+
}
9892
};

‎src/Control/Monad/Ff.purs‎

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,4 @@
1-
module Control.Monad.Ef
2-
( Ef
3-
, toEff
4-
) where
1+
module Control.Monad.Ef (Ef) where
52

63
import Control.Applicative (class Applicative)
74
-- import Control.Applicative (class Applicative, liftA1)
@@ -12,6 +9,7 @@ import Control.Monad (class Monad)
129
import Control.Monad.Eff (Eff, kind Effect)
1310
import Data.Functor (class Functor)
1411
import Control.Monad.Eff.Class (class MonadEff)
12+
import Unsafe.Coerce (unsafeCoerce)
1513

1614

1715
foreign import data Ef :: # Effect -> Type -> Type
@@ -33,11 +31,8 @@ instance bindEf :: Bind (Ef e) where
3331
instance monadEf :: Monad (Ef e)
3432

3533
instance monadEEFff :: MonadEff eff (Ef eff) where
36-
liftEff = liftEffE
34+
liftEff = unsafeCoerce
3735

38-
foreign import toEff :: forall e a. Ef e a -> Eff e a
39-
40-
foreign import liftEffE :: forall e a. Eff e a -> Ef e a
4136
foreign import mapE :: forall e a b. (a -> b) -> Ef e a -> Ef e b
4237
foreign import applyE :: forall e a b. Ef e (a -> b) -> Ef e a-> Ef e b
4338
foreign import pureE :: forall e a. a -> Ef e a

‎src/Control/Monad/Ff/Class.purs‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,13 @@
1-
module Control.Monad.Ef.Class where
1+
module Control.Monad.Ef.Class
2+
( class MonadEf
3+
, liftEf
4+
) where
25

36
import Control.Category (id)
47
import Control.Monad (class Monad)
5-
import Control.Monad.Ef (Ef, toEff)
8+
import Control.Monad.Ef (Ef)
69
import Control.Monad.Eff (Eff)
10+
import Unsafe.Coerce (unsafeCoerce)
711

812
class Monad m <= MonadEf eff m | m -> eff where
913
liftEf :: forall a. Ef eff a -> m a
@@ -12,4 +16,4 @@ instance monadEfEf :: MonadEf eff (Ef eff) where
1216
liftEf = id
1317

1418
instance monadEfEff :: MonadEf eff (Eff eff) where
15-
liftEf = toEff
19+
liftEf = unsafeCoerce

‎test/Test/Main.purs‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,6 @@ import Control.Apply (lift2)
77
import Control.Monad.Eff.Class (class MonadEff, liftEff)
88
import Control.Monad.Ef (Ef)
99
import Control.Monad.Ef.Class (liftEf)
10-
import Data.Traversable (for_)
11-
import Performance.Minibench (benchWith)
12-
import Control.Monad.Eff.Unsafe (unsafePerformEff)
1310
import Control.Monad.Eff.Console (CONSOLE)
1411

1512

0 commit comments

Comments
 (0)