javascript - 如何将 TaskT 与 Trampoline 的 monad 实例结合起来进行无堆栈异步计算？

Question

Trampoline是一个单子(monad)，并为单子(monad)变压器堆栈增加了堆栈安全性。它通过依赖一个特殊的解释器( monadRec )来实现这一点，该解释器被输入单子(monad)计算的结果(实际上它是自由单子(monad)模式的特殊版本)。出于这个原因，Trampoline monad 必须是最外层的 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 没有单子(monad)转换器(即 Task )
众所周知，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 .
事实上，不可能变出 m r 类型的值。当继续k被异步调用。 ContT monad 转换器仅适用于同步计算。
尽管如此，我们可以定义Task作为 Cont 的专用版本.

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

因此，每当 Task存在于单子(monad)变压器堆栈中，它将始终位于底部，就像 IO .
如果你想制作 Task monad 堆栈安全然后阅读 following answer .
问题 #2:foo函数的返回类型错误
让我们暂时假设 delayTaskT有正确的类型。正如您已经注意到的，下一个问题是 foo有错误的返回类型。

The problem seems to be foo which return a TaskT wrapped in a Chain and this wrapped TaskT is completely decoupled from the TaskT chain and is thus never evaluated/fired.

我假设 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正确地taskLiftT函数将底层的一元计算提升到 TaskT层。

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 .请注意，无法正确定义 foo使用 setTimeout .因此，我重新定义了 foo如taskOfT .

使用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

不要使用 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] Why is there no IO transformer in Haskell?