如何将TaskT与Trampoline的monad实例相结合以获得无堆栈异步计算

Question

Trampoline是一个monad，它为monad变压器堆栈添加了堆栈安全性。它通过依赖一个特殊的解释器(monadRec(来实现这一点，该解释器提供了一个单元计算的结果(实际上它是免费单元模式的专用版本(。因此，Trampolinemonad必须是最外层的monad，也就是变压器堆栈的基础monad。

在以下设置中，TaskT(本质上是具有共享的Cont(是monad转换器，Trampoline是基本monad:

// TASK
const TaskT = taskt => record(
TaskT,
thisify(o => {
o.taskt = k =>
taskt(x => {
o.taskt = k_ => k_(x);
return k(x);
});
return o;
}));
// Monad
const taskChainT = mmx => fmm =>
TaskT(k =>
mmx.taskt(x =>
fmm(x).taskt(k)));
const taskOfT = x =>
TaskT(k => k(x));
// Transformer
const taskLiftT = chain => mmx =>
TaskT(k => chain(mmx) (k));
// auxiliary functions
const taskAndT = mmx => mmy =>
taskChainT(mmx) (x =>
taskChainT(mmy) (y =>
taskOfT([x, y])));
const delayTaskT = f => ms => x =>
TaskT(k => setTimeout(comp(k) (f), ms, x));
const record = (type, o) => (
o[Symbol.toStringTag] = type.name || type, o);
const thisify = f => f({});
const log = (...ss) =>
(console.log(...ss), ss[ss.length - 1]);
// TRAMPOLINE
const monadRec = o => {
while (o.tag === "Chain")
o = o.fm(o.chain);
return o.tag === "Of"
? o.of
: _throw(new TypeError("unknown trampoline tag"));
};
// tags
const Chain = chain => fm =>
({tag: "Chain", fm, chain});

const Of = of =>
({tag: "Of", of});
// Monad
const recOf = Of;
const recChain = mx => fm =>
mx.tag === "Chain" ? Chain(mx.chain) (x => recChain(mx.fm(x)) (fm))
: mx.tag === "Of" ? fm(mx.of)
: _throw(new TypeError("unknown trampoline tag"));
// MAIN
const foo = x =>
Chain(delayTaskT(x => x) (0) (x)) (Of);
const bar = taskAndT(
taskLiftT(recChain) (foo(1)))
(taskLiftT(recChain) (foo(2))); // yields TaskT
const main = bar.taskt(x => Of(log(x))); // yields Chain({fm, chain: TaskT})
monadRec(main); // yields [TaskT, TaskT] but [1, 2] desired

这不是我想要的，因为Trampoline在事件循环接收异步任务的结果之前强制求值。我需要的是另一种方式，但正如我已经提到的，没有TrampolineT变压器。我错过了什么？

Answer 1

此代码段中存在几个问题。

问题1：IO(即Task(没有monad变压器

众所周知，IO没有monad转换器^[1]您的TaskT类型是以ContT为模型的，而ContT实际上是一个monad转换器。但是，您使用TaskT来执行异步计算，例如setTimeout，这就是问题所在。

考虑一下TaskT的定义，它与ContT类似。

newtype TaskT r m a = TaskT { taskt :: (a -> m r) -> m r }

因此，delayTaskT应该具有类型(a -> b) -> Number -> a -> TaskT r m b。

const delayTaskT = f => ms => x =>
TaskT(k => setTimeout(comp(k) (f), ms, x));

然而，setTimeout(comp(k) (f), ms, x)返回与类型m r不匹配的超时id。请注意，k => setTimeout(comp(k) (f), ms, x)的类型应为(b -> m r) -> m r。

事实上，当异步调用延续k时，不可能变出m r类型的值。ContTmonad转换器仅适用于同步计算。

然而，我们可以将Task定义为Cont的专门版本。

newtype Task a = Task { task :: (a -> ()) -> () } -- Task = Cont ()

因此，无论何时Task出现在monad转换器堆栈中，它都将始终位于底部，就像IO一样。

如果您想使Taskmonad堆栈安全，请阅读以下答案。

问题2：foo函数的返回类型错误

让我们假设delayTaskT具有正确的类型。正如您已经注意到的，下一个问题是foo具有错误的返回类型。

问题似乎是foo，它返回一个包裹在Chain中的TaskT，而这个包裹的TaskT与TaskT链完全解耦，因此永远不会被求值/激发。

我假设foo的预期类型是a -> TaskT r Trampoline a。然而，foo的实际类型是a -> Trampoline (TaskT r m a)。幸运的是，修复很容易。

const foo = delayTaskT(x => x) (0);

foo的类型与taskOfT相同，即a -> TaskT r m a。我们可以专营m = Trampoline。

问题3：您没有正确使用taskLiftT

CCD_ 50函数将底层的一元计算提升到CCD_ 51层中。

taskLiftT :: (forall a b. m a -> (a -> m b) -> m b) -> m a -> TaskT r m a
taskLiftT(recChain) :: Trampoline a -> TaskT r Trampoline a

现在，您正在将taskLiftT(recChain)应用于foo(1)和foo(2)。

foo :: a -> Trampoline (TaskT r m a) -- incorrect definition of foo
foo(1) :: Trampoline (TaskT r m Number)
foo(2) :: Trampoline (TaskT r m Number)
taskLiftT(recChain) (foo(1)) :: TaskT r Trampoline (TaskT r m Number)
taskLiftT(recChain) (foo(2)) :: TaskT r Trampoline (TaskT r m Number)

然而，如果我们使用foo的正确定义，那么这些类型甚至不会匹配。

foo :: a -> TaskT r Trampoline a -- correct definition of foo
foo(1) :: TaskT r Trampoline Number
foo(2) :: TaskT r Trampoline Number
-- Can't apply taskLiftT(recChain) to foo(1) or foo(2)

如果我们使用foo的正确定义，那么有两种方法可以定义bar。请注意，使用setTimeout无法正确定义foo。因此，我将foo重新定义为taskOfT。

1. 使用foo，不要使用taskLiftT。

   const bar = taskAndT(foo(1))(foo(2)); // yields TaskT
   

   // TASK
   const TaskT = taskt => record(
   TaskT,
   thisify(o => {
   o.taskt = k =>
   taskt(x => {
   o.taskt = k_ => k_(x);
   return k(x);
   });
   return o;
   }));
   // Monad
   const taskChainT = mmx => fmm =>
   TaskT(k =>
   mmx.taskt(x =>
   fmm(x).taskt(k)));
   const taskOfT = x =>
   TaskT(k => k(x));
   // Transformer
   const taskLiftT = chain => mmx =>
   TaskT(k => chain(mmx) (k));
   // auxiliary functions
   const taskAndT = mmx => mmy =>
   taskChainT(mmx) (x =>
   taskChainT(mmy) (y =>
   taskOfT([x, y])));
   const delayTaskT = f => ms => x =>
   TaskT(k => setTimeout(comp(k) (f), ms, x));
   const record = (type, o) => (
   o[Symbol.toStringTag] = type.name || type, o);
   const thisify = f => f({});
   const log = (...ss) =>
   (console.log(...ss), ss[ss.length - 1]);
   // TRAMPOLINE
   const monadRec = o => {
   while (o.tag === "Chain")
   o = o.fm(o.chain);
   return o.tag === "Of"
   ? o.of
   : _throw(new TypeError("unknown trampoline tag"));
   };
   // tags
   const Chain = chain => fm =>
   ({tag: "Chain", fm, chain});
   
   const Of = of =>
   ({tag: "Of", of});
   // Monad
   const recOf = Of;
   const recChain = mx => fm =>
   mx.tag === "Chain" ? Chain(mx.chain) (x => recChain(mx.fm(x)) (fm))
   : mx.tag === "Of" ? fm(mx.of)
   : _throw(new TypeError("unknown trampoline tag"));
   // MAIN
   const foo = taskOfT;
   const bar = taskAndT(foo(1))(foo(2)); // yields TaskT
   const main = bar.taskt(x => Of(log(x))); // yields Chain({fm, chain: TaskT})
   monadRec(main); // yields [TaskT, TaskT] but [1, 2] desired

2. 不要使用foo，而是使用taskLiftT。

   const bar = taskAndT(
   taskLiftT(recChain) (Of(1)))
   (taskLiftT(recChain) (Of(2))); // yields TaskT
   

   // TASK
   const TaskT = taskt => record(
   TaskT,
   thisify(o => {
   o.taskt = k =>
   taskt(x => {
   o.taskt = k_ => k_(x);
   return k(x);
   });
   return o;
   }));
   // Monad
   const taskChainT = mmx => fmm =>
   TaskT(k =>
   mmx.taskt(x =>
   fmm(x).taskt(k)));
   const taskOfT = x =>
   TaskT(k => k(x));
   // Transformer
   const taskLiftT = chain => mmx =>
   TaskT(k => chain(mmx) (k));
   // auxiliary functions
   const taskAndT = mmx => mmy =>
   taskChainT(mmx) (x =>
   taskChainT(mmy) (y =>
   taskOfT([x, y])));
   const delayTaskT = f => ms => x =>
   TaskT(k => setTimeout(comp(k) (f), ms, x));
   const record = (type, o) => (
   o[Symbol.toStringTag] = type.name || type, o);
   const thisify = f => f({});
   const log = (...ss) =>
   (console.log(...ss), ss[ss.length - 1]);
   // TRAMPOLINE
   const monadRec = o => {
   while (o.tag === "Chain")
   o = o.fm(o.chain);
   return o.tag === "Of"
   ? o.of
   : _throw(new TypeError("unknown trampoline tag"));
   };
   // tags
   const Chain = chain => fm =>
   ({tag: "Chain", fm, chain});
   
   const Of = of =>
   ({tag: "Of", of});
   // Monad
   const recOf = Of;
   const recChain = mx => fm =>
   mx.tag === "Chain" ? Chain(mx.chain) (x => recChain(mx.fm(x)) (fm))
   : mx.tag === "Of" ? fm(mx.of)
   : _throw(new TypeError("unknown trampoline tag"));
   // MAIN
   const foo = taskOfT;
   const bar = taskAndT(
   taskLiftT(recChain) (Of(1)))
   (taskLiftT(recChain) (Of(2))); // yields TaskT
   const main = bar.taskt(x => Of(log(x))); // yields Chain({fm, chain: TaskT})
   monadRec(main); // yields [TaskT, TaskT] but [1, 2] desired

---

^[1]为什么Haskell中没有IO转换器？