Make Eff faster and safer

Author: safareli

package.json

@@ -6,8 +6,8 @@
   },
   "devDependencies": {
     "eslint": "^3.17.1",
-    "pulp": "^10.0.4",
-    "purescript-psa": "^0.5.0-rc.1",
+    "pulp": "^11.0.0",
+    "purescript-psa": "^0.5.1",
     "rimraf": "^2.6.1"
   }
 }

src/Control/Monad/Eff.js

@@ -1,16 +1,89 @@
 "use strict";
 
-exports.pureE = function (a) {
-  return function () {
-    return a;
+// Eff a
+// = { () -> a }
+// | { () -> a, tag: "PURE",   _0 :: a,         _1 :: Void  }
+// | { () -> a, tag: "MAP",    _0 :: b -> a,    _1 :: Ef b }
+// | { () -> a, tag: "APPLY",  _0 :: Ef b,      _1 :: Ef (b -> a) }
+// | { () -> a, tag: "BIND",   _0 :: b -> Ef a, _1 :: Ef b }
+
+// Operation a b
+// = { tag: "MAP",        _0 :: a -> b }
+// | { tag: "APPLY",      _0 :: Ef a }
+// | { tag: "APPLY_FUNC", _0 :: a -> b }
+// | { tag: "BIND",       _0 :: a -> Ef b }
+
+var PURE = "PURE";
+var MAP = "MAP";
+var APPLY = "APPLY";
+var BIND = "BIND";
+var APPLY_FUNC = "APPLY_FUNC";
+
+var runEff = function (inputEff) {
+  var operations = [];
+  var eff = inputEff;
+  var res;
+  var op;
+  var tag;
+  effLoop: for (;;) {
+    tag = eff.tag;
+    if (tag !== undefined) {
+      if (tag === MAP || tag === BIND || tag === APPLY) {
+        operations.push(eff);
+        eff = eff._1;
+        continue;
+      }
+      // here `tag === PURE`
+      res = eff._0;
+    } else {
+      res = eff();
+    }
+
+    while ((op = operations.pop())) {
+      if (op.tag === MAP) {
+        res = op._0(res);
+      } else if (op.tag === APPLY_FUNC) {
+        res = op._0(res);
+      } else if (op.tag === APPLY) {
+        eff = op._0;
+        operations.push({ tag: APPLY_FUNC, _0: res });
+        continue effLoop;
+      } else { // op.tag === BIND
+        eff = op._0(res);
+        continue effLoop;
+      }
+    }
+    return res;
+  }
+};
+
+var mkEff = function (tag, _0, _1) {
+  var eff = function eff_() { return runEff(eff_); };
+  eff.tag = tag;
+  eff._0 = _0;
+  eff._1 = _1;
+  return eff;
+};
+
+exports.pureE = function (x) {
+  return mkEff(PURE, x);
+};
+
+exports.mapE = function (f) {
+  return function (eff) {
+    return mkEff(MAP, f, eff);
   };
 };
 
-exports.bindE = function (a) {
+exports.applyE = function (effF) {
+  return function (eff) {
+    return mkEff(APPLY, eff, effF);
+  };
+};
+
+exports.bindE = function (eff) {
   return function (f) {
-    return function () {
-      return f(a())();
-    };
+    return mkEff(BIND, f, eff);
   };
 };
 

src/Control/Monad/Eff.purs

@@ -6,10 +6,10 @@ module Control.Monad.Eff
   , untilE, whileE, forE, foreachE
   ) where
 
-import Control.Applicative (class Applicative, liftA1)
+import Control.Applicative (class Applicative)
 import Control.Apply (class Apply)
 import Control.Bind (class Bind)
-import Control.Monad (class Monad, ap)
+import Control.Monad (class Monad)
 
 import Data.Functor (class Functor)
 import Data.Unit (Unit)
@@ -36,10 +36,14 @@ foreign import kind Effect
 foreign import data Eff :: # Effect -> Type -> Type
 
 instance functorEff :: Functor (Eff e) where
-  map = liftA1
+  map = mapE
+
+foreign import mapE :: forall e a b. (a -> b) -> Eff e a -> Eff e b
 
 instance applyEff :: Apply (Eff e) where
-  apply = ap
+  apply = applyE
+
+foreign import applyE :: forall e a b. Eff e (a -> b) -> Eff e a-> Eff e b
 
 instance applicativeEff :: Applicative (Eff e) where
   pure = pureE