TaskTをTrampolineのモナドインスタンスと組み合わせてスタックレス非同期計算を取得するにはどうすればよいですか?
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
変圧器はありません。何が足りないのですか?
回答
このコードスニペットにはいくつかの問題があります。
問題#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 r
。k => 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
戻り値の型が間違っていることです。
問題は
foo
、TaskT
ラップされたものを返すことであるように思われ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つあります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] HaskellにIOトランスがないのはなぜですか?