M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

コルーチン

一般に、ジェネレータ (generator) は呼び出されるたびに新しい値を生成して返す関数のことをいいます。このような処理をさらに一般化して、複数のプログラム間で実行の中断や再開を相互に行わせることができます。このようなプログラムのことを「コルーチン (co-routine)」といいます。

サブルーチン (sub-routine) は call してから return するまで途中で処理を中断することはできませんが、コルーチンは途中で処理を中断し、そこから実行を再開することができます。また、コルーチンを使うと複数のプログラムを (擬似的に) 並行に動作させることができます。この動作は「スレッド (thread)」とよく似ています。

通常、スレッドは一定時間毎に実行するスレッドを強制的に切り替えます。このとき、スレッドのスケジューリングは処理系が行います。これを「プリエンプティブ (preemptive)」といいます。コルーチンの場合、プログラムの実行は一定時間ごとに切り替わるものではなく、プログラム自身が実行を中断しないといけません。これを「ノンプリエンプティブ (nonpreemptive)」といいます。

コルーチンで複数のプログラムを並行に動作させるには、あるプログラムだけを優先的に実行するのではなく、他のプログラムが実行できるよう自主的に処理を中断する、といった協調的な動作を行わせる必要があります。そのかわり、スレッドと違って排他制御といった面倒な処理を考える必要がなく、スレッドのような切り替え時のオーバーヘッドも少ないことから、スレッドよりも動作が軽くて扱いやすいといわれています。

コルーチンをサポートしているプログラミング言語はいくつかありますが、M.Hiroi が知っている言語では LuaRuby (Fiber : ファイバー) があります。今回は Lua や Ruby を参考に、SML/NJ の継続を使ってコルーチンを作成してみましょう。

●コルーチンの動作

今回作成するコルーチンには親子関係をもたせることにします。コルーチン A からコルーチン B を呼び出した場合、A が親で B が子になります。このように主従関係を持つコルーチンを「セミコルーチン (semi-coroutine)」といいます。コルーチンの親子関係は木構造と考えることができます。子のコルーチンは親または祖先のコルーチンを呼び出すことはできません。

新しいコルーチンは coroutine_create で生成します。coroutine_create は引数なしの関数を引数として受け取ります。このような関数を thunk といいます。coroutine_create はコルーチンを表すデータを返します。このデータを coroutine と呼ぶことにしましょう。

コルーチンを実行 (または再開) するには関数 coroutine_resume を使います。coroutine_resume には coroutine_create が返した coroutine を渡します。coroutine_resume を呼び出したほうが親、呼び出されたほうが子になります。

子コルーチンの中で関数 coroutine_yield を評価すると、そこでプログラムの実行を中断して親コルーチンに戻ります。このとき、coroutine_yield の引数が親コルーチンで呼び出した coroutine_reusme の返り値になります。

ただし、最初はプログラムを簡単にするため、coroutine_yield の引数は unit とし、coroutine_resume は unit を返すことにします。つまり、コルーチンを切り替えるだけの処理を作成します。そのあとで coroutine_yield に引数を渡すことができるようプログラムを改造しましょう。

●コルーチンの作成

それでは継続を使ってコルーチンを作りましょう。次のリストを見てください。

リスト : コルーチン

(* とりあえずコルーチンを切り替えるだけ *)

open SMLofNJ.Cont

(* コルーチンをあらわすデータ型 *)
datatype coroutine = Co of (unit cont option ref) * (unit cont option cont option ref) * (unit -> unit) option ref

(* 脱出先の継続をセット *)
val ret : unit cont option cont option ref = ref NONE

(* コルーチンの生成 *)
fun coroutine_create proc = Co(ref NONE, ref NONE, ref (SOME proc))

(* 実行の中断 *)
fun coroutine_yield () =
    callcc(fn k => throw (valOf(!ret)) (SOME k))

(* 実行の再開 *)
exception Coroutine_err
exception Dead_coroutine

fun coroutine_resume(Co(_, _, ref NONE)) = raise Dead_coroutine
|   coroutine_resume(Co(resume, save as (ref NONE), proc)) = (
    resume := callcc(fn k => (
      save := !ret;
      ret := SOME k;
      case !resume of
           NONE => ((valOf(!proc))(); proc := NONE; throw (valOf(!ret)) NONE)
         | (SOME x) => throw x () ));
    ret := !save;
    save := NONE;
    ()  )
|   coroutine_resume(_) = raise Coroutine_err
val coroutine_create = fn : (unit -> unit) -> coroutine
val coroutine_yield = fn : unit -> unit
val coroutine_resume = fn : coroutine -> unit

datatype でコルーチンをあらわす型 coroutine を定義します。coroutine には 3 つ要素があり、先頭がコルーチンの処理を再開するための継続です。2 番目も継続で、親コルーチンの脱出先継続を保存します。3 番目がコルーチン本体を表す thunk です。どの要素も値を書き換えるので、option ref 変数で定義しています。データ型はあとで説明します。

大域変数 ret は coroutine_yield で親コルーチンに戻るための継続をセットします。ret の使い方は前回作成したジェネレータとほとんど同じです。coroutine_resume でコルーチンを実行 (または再開) するとき、ret の値を coroutine の 2 番目の要素に保存してから、ret の値を書き換えます。コルーチンの処理を中断 (または終了) するとき、ret の値を元に戻します。これでコルーチンを切り替えることができます。

コルーチンの生成は coroutine_create で行います。coroutine の 1, 2 番目の要素を ref NONE で初期化し、引数の proc を 3 番目の要素に格納します。コルーチンの中断は coroutine_yield で行います。このとき、処理を再開するための継続を取り出して、それを ret の継続に渡して実行します。コルーチンの再開と終了を区別するため option を使っていることに注意してください。

コルーチンを再開するとき、継続に値を渡す必要はないので、継続のデータ型は unit cont になります。したがって、coroutine の第 1 要素の型は unit cont option ref になります。2 番目の要素と ret の型は、unit cont option を継続に渡して実行することになるので、(unit cont option) cont option ref となります。コルーチン本体を表す thunk のデータ型は unit -> unit なので、第 3 要素の型は (unit -> unit) option ref となります。

coroutine_resume はちょっとだけ複雑です。最初にコルーチンが終了しているかチェックします。コルーチンが終了したとき、それを表すため第 3 要素を NONE に書き換えます。第 3 要素が NONE の場合はエラー Dead_coroutine を送出します。

次に、第 2 要素 save が NONE の場合、コルーチンは処理を中断しているので実行を再開します。まず callcc で継続 k を取り出し、ret を save に保存してから、ret に k をセットします。第 1 要素 resume が NONE の場合はコルーチンの本体 proc を実行します。終了した場合、proc を NONE に書き換えてから、継続 ret に NONE を渡して実行します。resume が NONE でなければ、継続 x を取り出して実行します。

coroutine_yield でコルーチンの実行を中断すると、coroutine_resume の callcc まで戻ってきます。callcc の返り値は option に格納されいる継続、またはコルーチンが終了したことを表す NONE になります。その返り値を resume にセットします。そのあと、ret の値を元に戻して、save を NONE に書き換えます。そして 最後に unit を返します。

最後の節はエラー Coroutine_err を送出します。たとえば、コルーチンの中で自分自身を呼び出すことを避けるため、第 2 要素 save が NONE でないとき coroutine_resume を呼び出すと最後の節が実行されます。

それでは実際に試してみましょう。

- val c = coroutine_create(fn () => let fun iter(n) = 
= (print(Int.toString(n) ^ "\n"); coroutine_yield(); iter(n + 1)) in iter(0) end);
val c = Co (ref NONE,ref NONE,ref (SOME fn)) : coroutine
- coroutine_resume(c);
0
val it = () : unit
- coroutine_resume(c);
1
val it = () : unit
- coroutine_resume(c);
2
val it = () : unit
- coroutine_resume(c);
3
val it = () : unit
- coroutine_resume(c);
4
val it = () : unit
- coroutine_resume(c);
5
val it = () : unit

局所関数 iter で無限ループを作り、その中で n の値を表示して coroutine_yield を呼び出します。最初に coroutine_resume を呼び出すと、コルーチンが評価されて最初の値 0 が表示されます。次に coroutine_resume を呼び出すと、n の値が +1 されて 1 が表示され、coroutine_yield を実行して処理が中断されます。coroutine_resume を呼び出すたびに、この処理が繰り返し行われます。

●簡単なテスト

それでは複数のコルーチンを使った簡単なテストを行ってみましょう。次のリストを見てください。

リスト : 簡単なテスト1

fun make_coroutine(mes) =
    coroutine_create(fn () => 
                       let
                         fun iter() = (
                               print mes;
                               coroutine_yield ();
                               iter ()
                              )
                       in
                         iter()
                       end)

fun test1(n) =
    let
      val xs = [make_coroutine("h"),
                make_coroutine("e"),
                make_coroutine("y"),
                make_coroutine("!"),
                make_coroutine(" ")]
      fun iter(0) = ()
      |   iter(n) = (app (fn x => coroutine_resume(x)) xs; iter(n - 1))
    in
      iter(n)
    end

関数 make_coroutine は引数 code を表示するコルーチンを生成します。h, e, y, !, 空白を表示するコルーチンを生成し、関数 test1 で順番に呼び出すと、指定した回数だけ "hey! " を表示することができます。

実行例を示します。

- test1(5);
hey! hey! hey! hey! hey! val it = () : unit
- test1(10);
hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! val it = () : unit
- test1(20);
hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey!
hey! hey! hey! hey! val it = () : unit

コルーチンの中から他のコルーチンを呼び出すこともできます。次のリストを見てください。

リスト : 簡単なテスト2

fun make_coroutine_b(mes, next) =
    coroutine_create(fn () =>
      let
        fun iter() = (
          print mes;
          case next of
               NONE => ()
             | (SOME x) => coroutine_resume(x);
          coroutine_yield();
          iter() )
      in
        iter()
      end )

fun test_b(n) =
    let
      val b0 = make_coroutine_b(" ", NONE)
      val b1 = make_coroutine_b("!", SOME b0)
      val b2 = make_coroutine_b("y", SOME b1)
      val b3 = make_coroutine_b("e", SOME b2)
      val b4 = make_coroutine_b("h", SOME b3)
      fun iter(0) = ()
      |   iter(n) = (coroutine_resume(b4); iter(n - 1))
    in
      iter(n)
    end

関数 make_coroutine_b は code のほかに次に実行するコルーチン next を受け取ります。コルーチンの中では、code を表示したあと next が NONE でなければ、coroutine_resume で next の実行を再開します。そのあと、coroutine_yield で親コルーチンに戻ります。あとはコルーチンを 5 つ生成して、関数 test_b で最後に生成したコルーチン b4 を呼び出します。実行結果はテスト1と同じになります。

●coroutine_resume で値を返す場合

親コルーチンに値を返す場合、coroutine_yield と coroutine_resume を多相型関数として定義できると便利です。脱出先継続を大域変数 ret に格納する方法では、ret のデータ型を指定する必要があるので、このままでは多相型関数を実現することができません。

そこで、coroutine の第 2 要素に脱出先継続をセットし、コルーチンの本体を呼び出すとき、その引数として coroutine を渡すことにします。corutine_yield を呼び出すときは、その coroutine と値を引数として渡します。

とても簡単な方法ですが、残念ながら欠点もあります。引数として渡された coroutine を使って corutine_yield を呼び出す場合、親子コルーチンの関係 (木構造の関係) を崩すことはありませんが、それ以外の coroutine を渡して coroutine_yield を呼び出すと、木構造の関係が崩れてコルーチンが正常に動作しないこともありえます。ご注意くださいませ。

プログラムは次のようになります。

リスト : コルーチン (2)

open SMLofNJ.Cont

datatype 'a coroutine = Co of (unit cont option ref)
                            * ((unit cont option * 'a option) cont option ref)
                            * ('a coroutine -> unit) option ref

(* コルーチンの生成 *)
fun coroutine_create proc = Co(ref NONE, ref NONE, ref (SOME proc))

(* 実行の中断 *)
fun coroutine_yield (Co(_, ref (SOME ret), _), x) =
    callcc(fn k => throw ret (SOME k, SOME x))

(* 実行の再開 *)
exception Coroutine_err
exception Dead_coroutine

fun coroutine_resume(Co(_, _, ref NONE)) = raise Dead_coroutine
|   coroutine_resume(co as Co(resume, ret as (ref NONE), proc)) =
    let
      val (c, v) = callcc(fn k => (
        ret := SOME k;
        case !resume of
             NONE => ((valOf(!proc))(co);
                      proc := NONE;
                      throw (valOf(!ret)) (NONE, NONE) )
           | (SOME x) => throw x () ))
    in
      resume := c;
      ret := NONE;
      v
    end
|   coroutine_resume(_) = raise Coroutine_err
val coroutine_create = fn : ('a coroutine -> unit) -> 'a coroutine
val coroutine_yield = fn : 'a coroutine * 'a -> unit
val coroutine_resume = fn : 'a coroutine -> 'a option

コルーチンをあらわすデータ型を 'a coroutine とします。'a は coroutine_yield の引数のデータ型、coroutine_resume の返り値のデータ型になります。コルーチンの処理を再開するための継続は unit cont のままです。

脱出用の継続は unit cont だけではなくデータも返す必要があるので、その 2 つをタプルにまとめて脱出用継続に渡すことにします。したがって、脱出用継続のデータ型は (unit cont option * 'a option) cont となります。コルーチン本体 (thunk) のデータ型は coroutine を引数として渡すので、'a coroutine -> unit とします。

coroutine_yield は簡単です。引数の coroutine から脱出用継続 ret を取り出し、throw で ret を実行します。このとき、処理を再開するための継続 k と引数 x をタプルにまとめて渡します。

coroutine_resume は、脱出用の継続 k を coroutine の第 2 要素 ret にセットします。最初の実行では、coroutine を表す引数 co を proc に渡して呼び出します。処理を再開する場合は、resume から再開用の継続 x を取り出して throw で実行します。脱出用の継続が返す値は変数 c, v で受け取ります。そして、resume の値を再開用の継続 c で書き換え、ret を NONE で書き換えます。最後に v を返します。

それでは実際に試してみましょう。

- val a = coroutine_create(fn co => let fun iter(n) = (coroutine_yield(co, n);
= iter(n + 1)) in iter(0) end);
val a = Co (ref NONE,ref NONE,ref (SOME fn)) : int coroutine
- coroutine_resume(a);
val it = SOME 0 : int option
- coroutine_resume(a);
val it = SOME 1 : int option
- coroutine_resume(a);
val it = SOME 2 : int option
- coroutine_resume(a);
val it = SOME 3 : int option
- coroutine_resume(a);
val it = SOME 4 : int option
- coroutine_resume(a);
val it = SOME 5 : int option

局所関数 iter で無限ループを作り、その中で coroutine_yield を呼び出します。最初に coroutine_resume を呼び出すと、コルーチンが評価されて最初の値 0 が返ってきます。次に coroutine_resume を呼び出すと、n の値が +1 されて coroutine_yield を実行して処理が中断されます。coroutine_resume を呼び出すたびに、この処理が繰り返し行われます。

●高階関数をジェネレータに変換

コルーチンを使うと高階関数をジェネレータに変換することも簡単にできます。たとえば、前回作成した二分木を巡回する高階関数 for_each_tree を考えてみましょう。プログラムを再掲します。

リスト : 木の高階関数

(* 二分木 *)
datatype 'a tree = Leaf of 'a | Node of 'a tree * 'a tree

(* 巡回 *)
fun for_each_tree f (Leaf x) = f(x)
|   for_each_tree f (Node(left, right)) = (
      for_each_tree f left;
      for_each_tree f right
    )
val for_each_tree = fn : ('a -> 'b) -> 'a tree -> 'b

このような高階関数をジェネレータに変換する場合もコルーチンを使うと簡単にできます。次のリストを見てください。

リスト : 高階関数からジェネレータを生成

fun make_gen proc args =
    coroutine_create(fn (co) => proc (fn x => coroutine_yield(co, x)) args)

引数 proc は高階関数、そのあとの args が proc に渡す引数です。なお、関数 proc は第 1 引数に関数を受け取るものとします。coroutine_create に渡す匿名関数の中で関数 proc を呼び出します。このとき、第 1 引数に匿名関数を渡して、その中で coroutine_yield を実行します。これで proc が評価されて、第 1 引数で渡した匿名関数が呼び出されると、coroutine_yield により引数 x を coroutine_resume に返して実行が中断されます。

それでは実行してみましょう。

- val b = make_gen for_each_tree (Node(Node(Leaf 1, Leaf 2), Leaf 3));
val b = Co (ref NONE,ref NONE,ref (SOME fn)) : int coroutine
- coroutine_resume(b);
val it = SOME 1 : int option
- coroutine_resume(b);
val it = SOME 2 : int option
- coroutine_resume(b);
val it = SOME 3 : int option
- coroutine_resume(b);
val it = NONE : int option
- coroutine_resume(b);

uncaught exception Dead_coroutine

coroutine_resume を呼び出すたびに、木の要素を順番に取り出して返します。要素がなくなると NONE を返します。そのあと、coroutine_resume を呼び出すとエラーが送出されます。

もちろん、リストのジェネレータも簡単に実現できます。

- val c = make_gen app [1,2,3,4];
val c = Co (ref NONE,ref NONE,ref (SOME fn)) : int coroutine
- coroutine_resume(c);
val it = SOME 1 : int option
- coroutine_resume(c);
val it = SOME 2 : int option
- coroutine_resume(c);
val it = SOME 3 : int option
- coroutine_resume(c);
val it = SOME 4 : int option
- coroutine_resume(c);
val it = NONE : int option
- coroutine_resume(c);

uncaught exception Dead_coroutine

●順列の生成

順列を生成するジェネレータは make_gen を使わなくても、コルーチンで直接プログラムすることができます。次のリストを見てください。

リスト : 順列の生成

(* x と等しい要素があるか *)
fun mem(_, []) = false
|   mem(x, y::ys) = if x = y then true else mem(x, ys)

(* 順列の生成 *)
fun gen_perm(ls, m) =
    coroutine_create(fn co =>
      if m = 0 then coroutine_yield(co, [])
      else
        let
          val gen = gen_perm(ls, m - 1)
          fun iter(NONE) = ()
          |   iter(SOME x) = (
              app (fn y => if not(mem(y, x)) then coroutine_yield(co, x @ [y]) else ()) ls;
              iter(coroutine_resume(gen)) )
        in
          iter(coroutine_resume(gen))
        end )

関数 gen_perm は順列を生成するコルーチンを返します。引数 ls が選択する要素を格納したリスト、m が選ぶ個数です。m が 0 の場合、要素の選択が終わったので coroutine_yield で空リストを返します。そうでなければ、gen_perm を呼び出して新しいコルーチン gen を生成します。そして、局所関数 iter でその要素 (順列を格納したリスト) を取り出して x にセットし、それに含まれていない要素 y を選びます。あとは coroutine_yield で y を追加したリストを返します。これで順列を生成することができます。

簡単な実行例を示します。

val gen_perm = fn : ''a list * int -> ''a list coroutine
- val a = gen_perm([1,2,3], 3);
val a = Co (ref NONE,ref NONE,ref (SOME fn)) : int list coroutine
- coroutine_resume(a);
val it = SOME [1,2,3] : int list option
- coroutine_resume(a);
val it = SOME [1,3,2] : int list option
- coroutine_resume(a);
val it = SOME [2,1,3] : int list option
- coroutine_resume(a);
val it = SOME [2,3,1] : int list option
- coroutine_resume(a);
val it = SOME [3,1,2] : int list option
- coroutine_resume(a);
val it = SOME [3,2,1] : int list option
- coroutine_resume(a);
val it = NONE : int list option
- coroutine_resume(a);

uncaught exception Dead_coroutine

●エラトステネスの篩

最後にコルーチンを使って素数を求めるプログラムを作ってみましょう。考え方は簡単です。最初に、2 から始まる整数列を生成するコルーチンを用意します。この場合、コルーチンを「遅延ストリーム」として使います。2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。ここでもコルーチンを使って、入力ストリームから 2 で割り切れる整数を取り除いたストリームを返すフィルターを作ります。

2 で割り切れる整数が取り除かれたので、次の要素は 3 になります。今度は 3 で割り切れる整数を取り除けばいいのです。これもフィルターを使えば簡単です。このとき、入力用のストリームは 2 で割り切れる整数が取り除かれています。したがって、このストリームに対して 3 で割り切れる整数を取り除くようにフィルターを設定すればいいわけです。

このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩」といいます。ようするに、2 から始まる整数ストリームに対して、見つけた素数 2, 3, 5, 7, 11, ... を順番にフィルターで設定して素数でない整数をふるい落としていくわけです。

プログラムは次のようになります。

リスト : エラトステネスの篩

(* n から始まる数列 *)
fun integers(x) =
    coroutine_create(fn (co) =>
                       let
                         fun iter(n) = (coroutine_yield(co, n); iter(n + 1))
                       in
                         iter(x)
                       end)

(* フィルター *)
fun stream_filter pred co =
    coroutine_create(fn (co1) =>
      let
        fun iter() =
            let
              val (SOME x) = coroutine_resume(co)
            in
              if pred(x) then coroutine_yield(co1, x) else ();
              iter()
            end
      in
        iter()
      end )

(* n 個の素数を求める *)
fun sieve(n) =
    let
      val nums = ref (integers(2))
      fun iter(0) = ()
      |   iter(m) = 
          let
            val (SOME x) = coroutine_resume(!nums)
          in
            print(Int.toString(x) ^ " ");
            nums := stream_filter (fn y => y mod x <> 0) (!nums);
            iter(m - 1)
          end
    in
      iter(n)
    end
val integers = fn : int -> int coroutine
val stream_filter = fn : ('a -> bool) -> 'a coroutine -> 'a coroutine
val sieve = fn : int -> unit

関数 integers は n から始まる整数列を生成するストリームです。このような遅延ストリームはコルーチンを使って簡単に作ることができます。関数 stream_filter は述語 pred が偽を返す要素をコルーチン co から取り除きます。co から要素を取り出して x にセットします。pred(x) が真であれば coroutine_yield に co1 を渡して呼び出し、親コルーチンに x を返します。これで述語が偽を返す要素を取り除くことができます。

素数を求める関数 sieve も簡単です。引数 n は求める素数の個数です。最初に、2 から始まる整数列を integers で生成して変数 nums に セットします。このストリーム nums の先頭要素が素数になります。cotoutine_resume でストリームから素数を取り出して x にセットします。次に x を表示して、x で割り切れる整数を取り除くフィルターを生成して nums にセットします。つまり、n 個の素数を求めるために、n 個のフィルターをストリームに重ねていくわけです。

それでは実際に sieve(100) を実行してみましょう。

- sieve(100);
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 
107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211
223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331
337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449
457 461 463 467 479 487 491 499 503 509 521 523 541 val it = () : unit

正常に動作していますね。


●プログラムリスト

(*
 * coroutine.sml : 継続によるコルーチンの実装
 *
 *                Copyright (C) 2012-2021 Makoto Hiroi
 *
 *)

open SMLofNJ.Cont

(* コルーチンの定義 *)
datatype 'a coroutine = Co of (unit cont option ref)
                            * ((unit cont option * 'a option) cont option ref)
                            * ('a coroutine -> unit) option ref

(* 例外 *)
exception Coroutine_err
exception Dead_coroutine

(* コルーチンの生成 *)
fun coroutine_create proc = Co(ref NONE, ref NONE, ref (SOME proc))

(* 実行の中断 *)
fun coroutine_yield (Co(_, ref (SOME ret), _), x) =
    callcc(fn k => throw ret (SOME k, SOME x))

(* 実行の再開 *)
fun coroutine_resume(Co(_, _, ref NONE)) = raise Dead_coroutine
|   coroutine_resume(co as Co(resume, ret as (ref NONE), proc)) =
    let
      val (c, v) = callcc(fn k => (
        ret := SOME k;
        case !resume of
             NONE => ((valOf(!proc))(co);
                      proc := NONE;
                      throw (valOf(!ret)) (NONE, NONE) )
           | (SOME x) => throw x () ))
    in
      resume := c;
      ret := NONE;
      v
    end
|   coroutine_resume(_) = raise Coroutine_err


(* 簡単なテスト *)

(* 二分木 *)
datatype 'a tree = Leaf of 'a | Node of 'a tree * 'a tree

(* 巡回 *)
fun for_each_tree f (Leaf x) = f(x)
|   for_each_tree f (Node(left, right)) = (
      for_each_tree f left;
      for_each_tree f right
    )

(* ジェネレータの生成 *)
fun make_gen proc args =
    coroutine_create(fn (co) => proc (fn x => coroutine_yield(co, x)) args)

(* x と等しい要素があるか *)
fun mem(_, []) = false
|   mem(x, y::ys) = if x = y then true else mem(x, ys)

(* 順列の生成 *)
fun gen_perm(ls, m) =
    coroutine_create(fn co =>
      if m = 0 then coroutine_yield(co, [])
      else
        let
          val gen = gen_perm(ls, m - 1)
          fun iter(NONE) = ()
          |   iter(SOME x) = (
              app (fn y => if not(mem(y, x)) then coroutine_yield(co, x @ [y]) else ()) ls;
              iter(coroutine_resume(gen)) )
        in
          iter(coroutine_resume(gen))
        end )

(* n から始まる数列 *)
fun integers(x) =
    coroutine_create(fn (co) =>
                       let
                         fun iter(n) = (coroutine_yield(co, n); iter(n + 1))
                       in
                         iter(x)
                       end)

(* フィルター *)
fun stream_filter pred co =
    coroutine_create(fn (co1) =>
      let
        fun iter() =
            let
              val (SOME x) = coroutine_resume(co)
            in
              if pred(x) then coroutine_yield(co1, x) else ();
              iter()
            end
      in
        iter()
      end )

(* n 個の素数を求める *)
fun sieve(n) =
    let
      val nums = ref (integers(2))
      fun iter(0) = ()
      |   iter(m) = 
          let
            val (SOME x) = coroutine_resume(!nums)
          in
            print(Int.toString(x) ^ " ");
            nums := stream_filter (fn y => y mod x <> 0) (!nums);
            iter(m - 1)
          end
    in
      iter(n)
    end

初版 2012 年 7 月 14 日
改訂 2021 年 5 月 29 日

Copyright (C) 2012-2021 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]