Go Language Programming

電卓プログラムの改良 (コルーチン編その２)

今回はコルーチンのテストを兼ねて簡単なサンプルプログラムを作ってみましょう。

●コルーチンの簡単なテスト

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

リスト : 簡単なテスト１

def makeCoroutine(code)
  create(fn()
    while 1 do
      print(code),
      yield(0)
    end
  end)
end

def testA(n)
  let
    a = makeCoroutine("h"),
    b = makeCoroutine("e"),
    c = makeCoroutine("y"),
    d = makeCoroutine("!"),
    e = makeCoroutine(" ")
  in
    while n > 0 do
      resume(a, 0),
      resume(b, 0),
      resume(c, 0),
      resume(d, 0),
      resume(e, 0),
      n = n - 1
    end
  end
end

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

実行例を示します。

Calc> testA(5);
hey! hey! hey! hey! hey! 0
Calc> testA(10);
hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! 0
Calc> testA(20);
hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey! hey!
hey! hey! hey! hey! 0
Calc>

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

リスト : 簡単なテスト２

def makeCoroutineB(code, next)
  create(fn()
    while 1 do
      print(code),
      if next then resume(next, 0) end,
      yield(0)
    end
  end)
end

def testB(n)
  let
    a = makeCoroutineB(" ", 0),
    b = makeCoroutineB("!", a),
    c = makeCoroutineB("y", b),
    d = makeCoroutineB("e", c),
    e = makeCoroutineB("h", d)
  in
    while n > 0 do
      resume(e, 0),
      n = n - 1
    end
  end
end

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

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

コルーチンを使うと高階関数をジェネレータに変換することも簡単にできます。たとえば、ベクタやリストを木とみなして、それを巡回する高階関数 foreachTree を考えてみましょう。foreachTree は電卓プログラムのライブラリ関数 foreach (lib.cal) を使うと簡単に定義できます。

リスト : 木の巡回

def foreachTree(f, xs)
  foreach(fn(x) if isVec(x) or pair(x) then
                  foreachTree(f, x)
                else
                  f(x)
                end
          end,
          xs)
end

プログラムは特に難しいところはないでしょう。簡単な実行例を示します。

Calc> foreachTree(println, [1,[2,[3],4],5]);
1
2
3
4
5
5
Calc> foreachTree(println, list(list(1,2,3), list(4,5,6)));
1
2
3
4
5
6
6

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

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

def makeGen(f, xs)
  create(fn() f(fn(x) yield(x) end, xs), nil end)
end

makeGen の引数 f は高階関数、引数 xs は関数 f に渡す引数です。電卓プログラムは可変長引数をサポートしていないので、f に渡す引数は関数とその引数に限定します。コルーチンを生成する create には匿名関数を渡します。その中で関数 f を呼び出します。このとき、第 1 引数に匿名関数を渡して、その中で yield を実行します。これで f が実行されて、第 1 引数で渡した匿名関数が呼び出されると、yield により引数 x を resume に返して実行が中断されます。f の実行が終了したら nil を返します。

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

Calc> a = makeGen(foreachTree, [1,[2,[3],4],5]);
<Coroutine>
Calc> resume(a, 0);
1
Calc> resume(a, 0);
2
Calc> resume(a, 0);
3
Calc> resume(a, 0);
4
Calc> resume(a, 0);
5
Calc> resume(a, 0);
()
Calc> resume(a, 0);
resume: Dead Coroutine
Calc> a = makeGen(foreachTree,list(list(1,2), list(3,4)));
<Coroutine>
Calc> resume(a, 0);
1
Calc> resume(a, 0);
2
Calc> resume(a, 0);
3
Calc> resume(a, 0);
4
Calc> resume(a, 0);
()
Calc> resume(a, 0);
resume: Dead Coroutine

●順列の生成

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

リスト : 順列の生成

def permGen(n, xs)
  create(fn()
    if n == 0 then
      yield(nil)
    else
      let gen = permGen(n - 1, xs),
          x = 0,
          r = 1
      in
        while r do
          x = resume(gen, 0),
          if pair(x) or null(x) then
            foreach(fn(y)
                      if !member(y, x) then
                        yield(append(x, list(y)))
                      end
                    end,
                    xs)
          else
            r = 0
          end
        end
      end
    end
  end)
end

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

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

Calc> a = permGen(3, list(1,2,3));
<Coroutine>
Calc> resume(a, 0);
(1 2 3)
Calc> resume(a, 0);
(1 3 2)
Calc> resume(a, 0);
(2 1 3)
Calc> resume(a, 0);
(2 3 1)
Calc> resume(a, 0);
(3 1 2)
Calc> resume(a, 0);
(3 2 1)
Calc> resume(a, 0);
0
Calc> resume(a, 0);
resume: Dead Coroutine

●エラトステネスの篩

次は素数を求める「エラトステネスの篩」をコルーチンで作ってみましょう。この場合、コルーチンを「遅延ストリーム」として使います。プログラムは次のようになります。

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

// n から始まる整数列
def integers(n)
  create(fn() while 1 do yield(n), n = n + 1 end end)
end

// フィルター
def streamFilter(f, co)
  create(fn()
    while 1 do
      let x = resume(co, 0) in
        if f(x) then yield(x) end
      end
    end
  end)
end

// n 個の素数を求める
def sieveCo(n)
  let
    nums = integers(2)
  in
    while n > 0 do
      let x = resume(nums, 0) in
        print(x), print(" "),
        nums = streamFilter(fn(y) y % x != 0 end, nums)
      end,
      n = n - 1
    end
  end
end

関数 integers は n から始まる整数列を生成するストリームです。関数 streamFilter は引数 f で渡された述語が偽を返す要素をストリーム co から取り除きます。resume で co から要素を取り出して x にセットします。f(x) が真であれば yield(x) で親コルーチンに x を返します。これで述語が偽を返す要素を取り除くことができます。

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

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

Calc> sieveCo(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 0

●簡単なマルチプロセスの作成

次はコルーチンの応用例として、簡単な「並行プログラミング」に挑戦してみましょう。並行プログラミングといっても、複数のプログラム (関数) を擬似的に並行に動かすだけなので、大げさに考えないでくださいね。ノンプリエンプティブなマルチプロセス (マルチタスク) の基本的な動作は、コルーチンを使って簡単に実装することができます。

プロセスは引数なしの関数で表します。一般に、プロセスには優先順位 (プライオリティ) がありますが、今回はプログラムを簡単にするため、すべてのプロセスは同じ優先順位とします。この場合、コルーチンをそのままプロセスとして扱うと簡単です。

最初に、メインプロセスをひとつ用意し、そこでコルーチンを生成して呼び出します。中断したコルーチンはキューに格納しておけばいいでしょう。つまり、キューからコルーチンを取り出して実行を再開し、中断したら再びキューに追加すればいいわけです。コルーチンの実行が終了した場合、そのコルーチンはキューに追加しません。これで生成したプロセスを擬似的にですが並行に実行することができます。

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

リスト : 簡単なマルチプロセス

// プロセスを格納するキュー
// キューはライブラリ (lib.cal) に定義済み
PQ = 0;

// プロセスの生成
def fork(f)
  enqueue(PQ, create(f))
end

// メインプロセス
def mainProcess(xs)
  PQ = makeQueue(),
  // プロセスの登録
  foreach(fn(f) fork(f) end, xs),
  // 実行
  while !isEmptyQueue(PQ) do
    let p = dequeue(PQ) in
      if resume(p, 0) then enqueue(PQ, p) end
    end
  end
end

// 中断
def break() yield(1) end

// 待機
def wait(pred)
  let r = 1 in
    while r do
      break(),
      if pred() then r = 0 end
    end
  end
end

大域変数 PQ には中断したプロセスを格納するキューをセットします。プロセスの生成は関数 fork で行います。引数 f は引数なしの関数とします。プロセスの終了は 0 で表すことにします。あとは create でコルーチンを生成し、それを enqueue でキューに追加します。

メインプロセスの実行は関数 mainProcess で行います。引数はプロセスの実体を表す関数です。最初に引数 xs から関数をひとつずつ取り出し、それを fork に渡してプロセスを生成します。あとはキューからプロセスを順番に取り出して変数 p にセットし、resumue(p, 0) でプロセス p の実行を再開します。返り値が真の場合、プロセス p はまだ終了していないので、p をキューに追加します。返り値が偽の場合はキューに追加しません。

関数 wait は述語 pred が真を返すまでプロセスを待機させます。まず最初に break を実行して mainProcess に戻ります。break は yield でメインプロセスに真 (1) を返すだけです。これで他のプロセスに実行権を渡すことができます。あとは while 文を使って、述語 pred が真を返すまで処理を繰り返します。

●簡単な実行例

それでは簡単な例を示しましょう。次のリストを見てください。

リスト : 簡単なテスト

def testC(name, n)
  while n > 0 do
    print(n), print(" "), println(name),
    break(),
    n = n - 1
  end
end

testC は name を n 回表示します。name と n を表示したあと、break で実行権を放棄します。これで他のプロセスが実行されるので、複数のプロセスを並行に動作させることができます。実行例を示します。

Calc> mainProcess([fn() testC("foo", 7) end, fn() testC("bar", 5) end]);
7 foo
5 bar
6 foo
4 bar
5 foo
3 bar
4 foo
2 bar
3 foo
1 bar
2 foo
1 foo
0

このように、他のプロセスと通信を行わない場合、プログラムはとても簡単になります。

●キューによる同期処理

次はプロセス間で通信を行う場合を考えてみましょう。この場合、いろいろな方法が考えられますが、今回は簡単な例としてキューを使ってみましょう。キューは配列 (スライス) を使って実装します。キューの詳しい説明は拙作のページ Appendix : 配列によるキューの実装 をお読みください。

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

リスト : キューによる同期処理

// キュー (RingBuffer) の生成
def makeRingBuffer(size)
  [0, 0, 0, vector(size, 0)]
end

// アクセス関数
def getFront(q)  q[0] end
def getRear(q)   q[1] end
def getCount(q)  q[2] end
def getBuffer(q) q[3] end

def setFront(q, x) q[0] = x end
def setRear(q, x)  q[1] = x end
def incCount(q) q[2] = q[2] + 1 end
def decCount(q) q[2] = q[2] - 1 end

// キューは満杯か
def ringBufferFull(q)
  getCount(q) == len(getBuffer(q))
end

// キューは空か
def ringBufferEmpty(q)
  getCount(q) == 0
end

// データの挿入
def enq(q, x)
  wait(fn() !ringBufferFull(q) end),
  let rear = getRear(q),
      buff = getBuffer(q)
  in
    buff[rear] = x,
    rear = rear + 1,
    if rear >= len(buff) then rear = 0 end,
    setRear(q, rear),
    incCount(q),
    x
  end
end

// データを取り出す
def deq(q)
  wait(fn() !ringBufferEmpty(q) end),
  let fr = getFront(q),
      buff = getBuffer(q),
      x = buff[fr]
  in
    fr = fr + 1,
    if fr >= len(buff) then fr = 0 end,
    setFront(q, fr),
    decCount(q),
    x
  end
end

ポイントはキューにデータを追加する関数 enq とデータを取り出す関数 deq で待ち合わせを行うところです。enq では、キューが満杯のときに wait で待ち合わせを行います。逆に deq の場合、キューが空のときに wait で待ち合わせを行います。キューの大きさが少ない場合でも、データを書き込むプロセスと読み出すプロセスが並行に動作することで、キューの大きさ以上のデータを受け渡すことができます。

それでは簡単な実行例を示します。次のリストを見てください。

リスト : キューの実行例

// キュー
que = 0;

// データを送る
def sendColor(color, n)
  let i = 0 in
    while i < n do
      enq(que, color),
      i = i + 1
    end
  end
end

// データを受け取る
def receiveColor(n)
  let i = 0 in
    while i < n do
      println(deq(que)),
      i = i + 1
    end
  end
end

// テスト
def testColor()
  que = makeRingBuffer(10),
  mainProcess([fn() sendColor("red", 8) end,
               fn() sendColor("blue", 8) end,
               fn() sendColor("yellow", 8) end,
               fn() receiveColor(24) end])
end

makeQueue でキューを生成して大域変数 que に格納します。キューの大きさは 10 とします。sendColor はデータ (color) を n 個キューに書き込みます。receiveColor は n 個のデータをキューから取り出して表示します。testColor では、キューに書き込むプロセスを 3 つ生成し、取り出すプロセスを 1 つ生成します。データを書き込む総数は 8 * 3 = 24 個なので、取り出すデータ数も 24 個とします。

それでは実行結果を示します。

Calc> testColor();
red
blue
yellow
red
blue
yellow
red
blue
yellow
red
blue
yellow
red
blue
red
red
red
blue
blue
blue
yellow
yellow
yellow
yellow
0

24 個のデータすべて表示されています。キューが満杯になると、receiveColor でデータを取り出さない限り、データを書き込むことはできません。このため、receiveColor のあとに評価されるプロセスが優先されることになり、red が続けて書き込まれ、そのあとに blue が、最後に yellow がキューに書き込まれることになります。

●哲学者の食事

最後に、「哲学者の食事」という並行プログラミングでは有名な問題を解いてみましょう。

詳しい説明は 食事する哲学者の問題 -- Wikipedia をお読みください。

それではプログラムを作りましょう。最初にフォークを操作する関数を定義します。

リスト : フォークを操作する関数

// フォークの有無を表すベクタ
Forks = vector(5, 1);

// フォークを取る
def getFork(n)
  wait(fn() Forks[n] end),
  Forks[n] = 0,
  n
end

// フォークを置く
def putFork(n)
  Forks[n] = 1,
  break()
end

フォークの有無は真偽値で表して、それをベクタに格納します。ベクタは大域変数 Forks にセットします。getFork はフォークを取る関数です。wait で n 番目の フォーク (Forks[n]) が使えるようになるまで待ちます。そのあとで、Forks[n] の値を 0 に書き換えます。putFork はフォークを元に戻す関数で、Forks[n] の値を 1 に書き換えて、break を実行して他のプロセスに実行権を渡します。

今回はノンプリエンプティブなコルーチンを使用しているので、Forks をアクセスするときに競合は発生しません。プリエンプティブなマルチスレッドを使用する場合、共有メモリにアクセスするときは競合について考慮する必要があります。ご注意ください。

次は哲学者の動作をプログラムします。次のリストを見てください。

リスト : 哲学者の動作

def person0(n, left, right)
  let m = 2 in
    while m > 0 do
      print("Philosopher"), print(n), println(" is thinking"),
      getFork(right),
      getFork(left),
      print("Philosopher"), print(n), println(" is eating"),
      break(),
      putFork(right),
      putFork(left),
      m = m - 1
    end,
    print("Philosopher"), print(n), println(" is sleeping"),
    0
  end
end

関数 person0 の引数 n は哲学者の名前を表します。引数 left が左側のフォークの番号、right が右側のフォークの番号です。変数 m は食事をする回数です。2 回食事をしたら処理を終了します。食事をする場合、最初に getFork で右側のフォークを取り、次に左側のフォークを取ります。食事を終えたら putFork で右側のフォークを置き、次に左側のフォークを置きます。

このように、マルチプロセスを使うと簡単にプログラムできますが、実は並行プログラミング特有の大きな問題点があるのです。これはプログラムを実行してみるとわかります。

●実行結果 (1)

プログラムの実行は関数 testD で行います。

リスト : 実行

def testD(person)
  mainProcess([fn() person("A", 0, 1) end,
               fn() person("B", 1, 2) end,
               fn() person("C", 2, 3) end,
               fn() person("D", 3, 4) end,
               fn() person("E", 4, 0) end])
end

mainProcess に 5 人の哲学者を表すプロセスを渡して実行します。フォークは整数 0, 1, 2, 3, 4 で表しています。哲学者は円形に並んでいるので、5 人目の左側のフォークが 1 人目の右側のフォークになります。

実行結果は次のようになります。

Calc> testD(person0);
PhilosopherA is thinking
PhilosopherB is thinking
PhilosopherC is thinking
PhilosopherD is thinking
PhilosopherE is thinking
                          < CTRL-C を入力

このように、すべてのプロセスが待ち状態となり進むことができなくなります。これを「デッドロック (deadlock)」といいます。この場合、0 番目の哲学者の右側のフォークは、4 番目の哲学者の左側のフォークになります。各哲学者が右側のフォークを取り、左側のフォークが置かれるのを待つときにデッドロックとなるわけです。

●デッドロックの防止

デッドロックを防止する簡単な方法は、右側のフォークを取っても左側のフォークを取れないときは、右側のフォークを元に戻すことです。プログラムは次のようになります。

リスト : デッドロックの防止 (1)

def person1(n, left, right)
  let m = 2 in
    while m > 0 do
      print("Philosopher"), print(n), println(" is thinking"),
      getFork(right),
      if Forks[left] then
        begin
          getFork(left),
          print("Philosopher"), print(n), println(" is eating"),
          break(),
          putFork(right),
          putFork(left),
          m = m - 1
        end
      else
        putFork(right)
      end
    end,
    print("Philosopher"), print(n), println(" is sleeping"),
    0
  end
end

右側のフォークを取ったあと、左側のフォークがあるか Forks[left] をチェックします。フォークがある場合は、getFork でフォークを取って食事をすることができます。左側のフォークがない場合は putFork で右側のフォークを元に戻します。

●実行結果 (2)

実行結果は次のようになります。

Calc> testD(person1);
PhilosopherA is thinking
PhilosopherB is thinking
PhilosopherC is thinking
PhilosopherD is thinking
PhilosopherE is thinking
PhilosopherB is thinking
PhilosopherC is eating
PhilosopherD is thinking
PhilosopherE is eating
PhilosopherA is eating
PhilosopherC is thinking
PhilosopherE is thinking
PhilosopherB is eating
PhilosopherD is eating
PhilosopherA is thinking
PhilosopherC is thinking
PhilosopherE is thinking
PhilosopherB is thinking
PhilosopherD is thinking
PhilosopherE is eating
PhilosopherA is thinking
PhilosopherA is eating
PhilosopherE is sleeping
PhilosopherB is eating
PhilosopherD is thinking
PhilosopherC is eating
PhilosopherA is sleeping
PhilosopherD is thinking
PhilosopherB is sleeping
PhilosopherC is sleeping
PhilosopherD is eating
PhilosopherD is sleeping
0

このように、デッドロックしないで実行することができます。拙作のページ 並行プログラミング (2) で説明しましたが、プリエンプティブな goroutine では、この方法でも不具合が生じる場合があります。

●デッドロックの防止 (2)

もうひとつ簡単な方法を紹介しましょう。奇数番目の哲学者は、まず左側のフォークを取り上げてから右側のフォークを取り、偶数番目の哲学者は、今までのように右側のフォークを取り上げてから左側のフォークを取ります。こんな簡単な方法で動作するのは不思議なように思います。たとえば、哲学者が 2 人の場合を考えてみてください。

哲学者 0 の右側のフォークを A、左側のフォークを B とします。哲学者 1 からみると、B が右側のフォークで、A が左側のフォークになります。デッドロックは、哲学者 0 が A を取り、哲学者 1 が B を取ったときに発生します。ここで、哲学者 1 が左側のフォーク A から取るようにします。先に哲学者 0 が A を取った場合、哲学者 1 は A があくまで待つことになるので、哲学者 0 はフォーク B を取って食事をすることができます。哲学者 1 が先にフォーク A を取った場合も同じです。これでデッドロックを防止することができます。

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

リスト : デッドロックの防止 (2)

def person2(n, left, right)
  let m = 2 in
    while m > 0 do
      print("Philosopher"), print(n), println(" is thinking"),
      if n == "B" or n == "D" then
        begin getFork(right), getFork(left) end
      else
        begin getFork(left), getFork(right) end
      end,
      print("Philosopher"), print(n), println(" is eating"),
      break(),
      putFork(right),
      putFork(left),
      m = m - 1
    end,
    print("Philosopher"), print(n), println(" is sleeping"),
    0
  end
end

if 文で n が B または D の場合は右側から、他の場合は左側のフォークから取るように処理を分けるだけです。

●実行結果 (3)

実行結果は次のようになります。

Calc> testD(person2);
PhilosopherA is thinking
PhilosopherB is thinking
PhilosopherC is thinking
PhilosopherD is thinking
PhilosopherE is thinking
PhilosopherA is eating
PhilosopherD is eating
PhilosopherB is eating
PhilosopherE is eating
PhilosopherA is thinking
PhilosopherC is eating
PhilosopherD is thinking
PhilosopherB is thinking
PhilosopherA is eating
PhilosopherE is thinking
PhilosopherC is thinking
PhilosopherD is eating
PhilosopherB is eating
PhilosopherA is sleeping
PhilosopherE is eating
PhilosopherC is eating
PhilosopherD is sleeping
PhilosopherB is sleeping
PhilosopherE is sleeping
PhilosopherC is sleeping
0

正常に動作していますね。この方法はプリエンプティブな goroutine でも正常に動作します。興味のある方はいろいろ試してみてください。

●参考文献, URL

1. Paul Graham (著)，野田 開 (訳), 『On Lisp』, Web 版
2. Timothy Buddy (著), 吉田雄二 (監修), 長谷川明生・大田義勝 (訳), 『Little Smalltake 入門』, アスキー出版, 1989
3. Ravi Sethi (著), 神林靖 (訳), 『プログラミング言語の概念と構造』, アジソンウェスレイ, 1995

●プログラムリスト１

//
// coroutine.cal : コルーチンのテスト
//
//                 Copyright (C) 2014-2021 Makoto Hiroi
//

def makeCoroutine(code)
  create(fn()
    while 1 do
      print(code),
      yield(0)
    end
  end)
end

def testA(n)
  let
    a = makeCoroutine("h"),
    b = makeCoroutine("e"),
    c = makeCoroutine("y"),
    d = makeCoroutine("!"),
    e = makeCoroutine(" ")
  in
    while n > 0 do
      resume(a, 0),
      resume(b, 0),
      resume(c, 0),
      resume(d, 0),
      resume(e, 0),
      n = n - 1
    end
  end
end

def makeCoroutineB(code, next)
  create(fn()
    while 1 do
      print(code),
      if next then resume(next, 0) end,
      yield(0)
    end
  end)
end

def testB(n)
  let
    a = makeCoroutineB(" ", 0),
    b = makeCoroutineB("!", a),
    c = makeCoroutineB("y", b),
    d = makeCoroutineB("e", c),
    e = makeCoroutineB("h", d)
  in
    while n > 0 do
      resume(e, 0),
      n = n - 1
    end
  end
end


// 巡回
def foreachGen(xs)
  create(fn() foreach(fn(x) yield(x) end, xs), nil end)
end

// 木の巡回
def foreachTree(f, xs)
  foreach(fn(x) if isVec(x) or pair(x) then foreachTree(f, x) else f(x) end end, xs)
end

// 1 引数限定
def makeGen(f, xs)
  create(fn() f(fn(x) yield(x) end, xs), nil end)
end

// 順列の生成
def permGen(n, xs)
  create(fn()
    if n == 0 then
      yield(nil)
    else
      let gen = permGen(n - 1, xs),
          x = 0,
          r = 1
      in
        while r do
          x = resume(gen, 0),
          if pair(x) or null(x) then
            foreach(fn(y)
                      if !member(y, x) then
                        yield(append(x, list(y)))
                      end
                    end,
                    xs)
          else
            r = 0
          end
        end
      end
    end
  end)
end


// エラトステネスの篩

// n から始まる整数列
def integers(n)
  create(fn() while 1 do yield(n), n = n + 1 end end)
end

// フィルター
def streamFilter(f, co)
  create(fn()
    while 1 do
      let x = resume(co, 0) in
        if f(x) then yield(x) end
      end
    end
  end)
end

// n 個の素数を求める
def sieveCo(n)
  let
    nums = integers(2)
  in
    while n > 0 do
      let x = resume(nums, 0) in
        print(x), print(" "),
        nums = streamFilter(fn(y) y % x != 0 end, nums)
      end,
      n = n - 1
    end
  end
end

//
// 簡単なマルチプロセス
//

// プロセスを格納するキュー
PQ = 0;

// プロセスの生成
def fork(f)
  enqueue(PQ, create(f))
end

// メインプロセス
def mainProcess(xs)
  PQ = makeQueue(),
  // プロセスの登録
  foreach(fn(f) fork(f) end, xs),
  // 実行
  while !isEmptyQueue(PQ) do
    let p = dequeue(PQ) in
      if resume(p, 0) then enqueue(PQ, p) end
    end
  end
end

// 中断
def break() yield(1) end

// 待機
def wait(pred)
  let r = 1 in
    while r do
      break(),
      if pred() then r = 0 end
    end
  end
end

def testC(name, n)
  while n > 0 do
    print(n), print(" "), println(name),
    break(),
    n = n - 1
  end
end

//
// RingBuffer
//

def makeRingBuffer(size)
  [0, 0, 0, vector(size, 0)]
end

// アクセス関数
def getFront(q)  q[0] end
def getRear(q)   q[1] end
def getCount(q)  q[2] end
def getBuffer(q) q[3] end

def setFront(q, x) q[0] = x end
def setRear(q, x)  q[1] = x end
def incCount(q) q[2] = q[2] + 1 end
def decCount(q) q[2] = q[2] - 1 end

def ringBufferFull(q)
  getCount(q) == len(getBuffer(q))
end

def ringBufferEmpty(q)
  getCount(q) == 0
end

def enq(q, x)
  wait(fn() !ringBufferFull(q) end),
  let rear = getRear(q),
      buff = getBuffer(q)
  in
    buff[rear] = x,
    rear = rear + 1,
    if rear >= len(buff) then rear = 0 end,
    setRear(q, rear),
    incCount(q),
    x
  end
end

def deq(q)
  wait(fn() !ringBufferEmpty(q) end),
  let fr = getFront(q),
      buff = getBuffer(q),
      x = buff[fr]
  in
    fr = fr + 1,
    if fr >= len(buff) then fr = 0 end,
    setFront(q, fr),
    decCount(q),
    x
  end
end

//
// 簡単なテスト
//

// キュー
que = 0;

// データを送る
def sendColor(color, n)
  let i = 0 in
    while i < n do
      enq(que, color),
      i = i + 1
    end
  end
end

// データを受け取る
def receiveColor(n)
  let i = 0 in
    while i < n do
      println(deq(que)),
      i = i + 1
    end
  end
end

// テスト
def testColor()
  que = makeRingBuffer(10),
  mainProcess([fn() sendColor("red", 8) end,
               fn() sendColor("blue", 8) end,
               fn() sendColor("yellow", 8) end,
               fn() receiveColor(24) end])
end

//
// 哲学者の食事
//

// フォークの有無を表すベクタ
Forks = vector(5, 1);

// フォークを取る
def getFork(n)
  wait(fn() Forks[n] end),
  Forks[n] = 0,
  n
end

// フォークを置く
def putFork(n)
  Forks[n] = 1,
  break()
end

def person0(n, left, right)
  let m = 2 in
    while m > 0 do
      print("Philosopher"), print(n), println(" is thinking"),
      getFork(right),
      getFork(left),
      print("Philosopher"), print(n), println(" is eating"),
      break(),
      putFork(right),
      putFork(left),
      m = m - 1
    end,
    print("Philosopher"), print(n), println(" is sleeping"),
    0
  end
end

def person1(n, left, right)
  let m = 2 in
    while m > 0 do
      print("Philosopher"), print(n), println(" is thinking"),
      getFork(right),
      if Forks[left] then
        begin
          getFork(left),
          print("Philosopher"), print(n), println(" is eating"),
          break(),
          putFork(right),
          putFork(left),
          m = m - 1
        end
      else
        putFork(right)
      end
    end,
    print("Philosopher"), print(n), println(" is sleeping"),
    0
  end
end

def person2(n, left, right)
  let m = 2 in
    while m > 0 do
      print("Philosopher"), print(n), println(" is thinking"),
      if n == "B" or n == "D" then
        begin getFork(right), getFork(left) end
      else
        begin getFork(left), getFork(right) end
      end,
      print("Philosopher"), print(n), println(" is eating"),
      break(),
      putFork(right),
      putFork(left),
      m = m - 1
    end,
    print("Philosopher"), print(n), println(" is sleeping"),
    0
  end
end

def testD(person)
  mainProcess([fn() person("A", 0, 1) end,
               fn() person("B", 1, 2) end,
               fn() person("C", 2, 3) end,
               fn() person("D", 3, 4) end,
               fn() person("E", 4, 0) end])
end