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

Question

Trampoline 是一个 monad 并且将堆栈安全添加到 monad 转换器堆栈。它通过依赖一个特殊的解释器 (monadRec) 来实现这一点，该解释器由 monadic 计算的结果提供（实际上它是免费 monad 模式的专用版本）。因此，Trampoline monad 必须是最外层的 monad，即 transformer 堆栈的基础 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) return 是一个与类型 m r 不匹配的超时 ID。请注意 k => setTimeout(comp(k) (f), ms, x) 的类型应为 (b -> m r) -> m r.

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

尽管如此，我们可以将 Task 定义为 Cont 的特殊版本。

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

因此，只要 Task 出现在 monad 转换器堆栈中，它就会始终位于底部，就像 IO.

如果你想让 Task monad 堆栈安全，请阅读。

问题 #2：`foo` 函数有错误的 return 类型

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

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。请注意，无法使用 setTimeout 正确定义 foo。因此，我将 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?

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

How to combine TaskT with the monad instance of Trampoline to get stackless async computations?

javascript

monads

functional-programming

trampolines

monad-transformers

问题 #1：`IO`（即 `Task`）没有 monad 转换器

问题 #2：`foo` 函数有错误的 return 类型

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

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

How to combine TaskT with the monad instance of Trampoline to get stackless async computations?

javascript

monads

functional-programming

trampolines

monad-transformers

问题 #1：IO（即 Task）没有 monad 转换器

问题 #2：foo 函数有错误的 return 类型

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

问题 #1：`IO`（即 `Task`）没有 monad 转换器

问题 #2：`foo` 函数有错误的 return 类型

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