TaskTをTrampolineのモナドインスタンスと組み合わせてスタックレス非同期計算を取得するにはどうすればよいですか?

Dec 13 2020

Trampolineはモナドであり、モナド変換子スタックにスタックの安全性を追加します。これmonadRecは、モナド計算の結果が提供される特別なインタープリター()に依存することで実現されます(実際には、無料のモナドパターンの特殊バージョンです)。このため、Trampolineモナドは最も外側のモナド、つまりトランススタックのベースモナドである必要があります。

次の設定TaskT(基本的Contに共有あり)には、モナド変換子とTrampolineベースモナドがあります。

// 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変圧器はありません。何が足りないのですか?

回答

2 AaditMShah Dec 14 2020 at 12:10

このコードスニペットにはいくつかの問題があります。

問題#1 :(IOすなわちTask)のモナド変換子がない

のモナド変換子がないことはよく知られていIOます。[1]あなたのTaskTタイプは、をモデルにしてContTおり、ContT実際にはモナド変換子です。ただし、問題が発生する場所である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)タイプと一致しないタイムアウトIDを返しますm rk => setTimeout(comp(k) (f), ms, x)タイプは(b -> m r) -> m r。である必要があることに注意してください。

実際、m r継続kが非同期的に呼び出される場合、型の値を呼び出すことは不可能です。ContTモナド変換は、同期の計算のために動作します。

それでも、のTask特殊バージョンとして定義できますCont

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

したがって、Taskモナド変換子スタックに存在する場合は常に、のように常にベースになりますIO

Taskモナドスタックを安全にしたい場合は、次の回答を読んでください。

問題#2:foo関数の戻り値の型が間違っている

少しの間delayTaskT、正しいタイプであると仮定しましょう。すでにお気づきのように、次の問題はfoo戻り値の型が間違っていることです。

問題はfooTaskTラップされたものを返すことであるように思われChain、このラップ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正しく使用していない

この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を定義する方法は2つありますbarfooを使用して正しく定義する方法はないことに注意してくださいsetTimeout。したがって、私は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トランスがないのはなぜですか?