Lua のコルーチンをシミュレート - Smalltalkのtは小文字です

TMUG（東京マッキントッシュユーザーズグループ）のメーリングリストで Apple の Aperture への言及にからめて引き合いに出された Adobe の Lightroom について、そこで引用されていた Sooey の「Adobe Lightroom には Lua が使われている」によれば、

Adobe の写真編集ソフト Lightroom はコードの約40%が組み込み向けスクリプト言語 Lua で書かれている

のだそうです。で、さらに読み進めて、やはり私も気になったのは「 Lua の最大の長所はコルーチンとクロージャだ（Key Lua Strengths の Coroutines and closures are more valuable than objects）」という部分。

コルーチンと聞いて、以前、www.textfile.org で結城さんが、「 yield文って、コルーチンみたい。というかコルーチンなのか。」と書いておられるのを見かけて、コルーチンって何？と分からないままいつもの悪い癖でスルーして（さらにその後も等閑にして）しまっていたことをふと思い出しました。

せっかく(?)なので、この機会にそのコルーチンなるものの挙動をおおざっぱに把握するために、Squeak の Smalltalk のスレッド（ここではプロセス。a Process）を使って、Lua リファレンスマニュアルのコルーチンの項で挙げられているサンプルスクリプトと似たような動きをするスクリプトを書いてみることに。これはそのメモ。

coroutine.yield はアクティブプロセスのサスペンド（Process >> #suspend）で、coroutine.resume は co に束縛したプロセスのレジューム（Process >> #resume）とプロセスの強制的な切り換え（ProcessorScheduler >> #yield）で、返値の受け渡しはキューに見立てた an OrderedCollection を介したやりとりで、それぞれを代用しています。いつもどおり、つっこみどころ満載ですが、ご容赦あれ、かし。

| foo1 co aa bb cc queue results print |

queue := OrderedCollection new.
results := String new writeStream.
print := [:ary |
   ary do: [:ea | results nextPutAll: ea asString] separatedBy: [results tab].
   results cr].


foo1 := [:a1 |
   print value: {'foo'. a1}.
   queue add: true; add: 2 * a1. Processor activeProcess suspend].


co := [
   | a2 b2 rr ss |

   a2 := queue removeFirst. b2 := queue removeFirst.
   print value: {'co-body'. a2. b2}.

   foo1 value: a2 + 1.

   rr := queue removeFirst.
   print value: {'co-body'. rr}.

   queue add: true; add: a2 + b2; add: a2 - b2. Processor activeProcess suspend.
   rr := queue removeFirst. ss := queue removeFirst.
   print value: {'co-body'. rr. ss}.

   queue add: true; add: b2; add: 'end'. Processor activeProcess suspend.
   rr := queue removeFirst. ss := queue removeFirst.

   queue add: false; add: 'cannot resume dead coroutine'] newProcess.


queue add: 1; add: 10. co resume. Processor yield. 
aa := queue removeFirst. bb := queue removeFirst.
print value: {'main'. aa. bb}.

queue add: 'r'. co resume. Processor yield. 
aa := queue removeFirst. bb := queue removeFirst. cc := queue removeFirst.
print value: {'main'. aa. bb. cc}.

queue add: 'x'; add: 'y'. co resume. Processor yield. 
aa := queue removeFirst. bb := queue removeFirst. cc := queue removeFirst.
print value: {'main'. aa. bb. cc}.

queue add: 'x'; add: 'y'. co resume. Processor yield. 
aa := queue removeFirst. bb := queue removeFirst.
print value: {'main'. aa. bb}.

^ results contents

=>  'co-body    1       10
     foo        2
     main       true    4
     co-body    r
     main       true    11      -9
     co-body    x       y
     main       true    10      end
     main       false   cannot resume dead coroutine'

SharedQueue 版

キューと書いて、そういえば a SharedQueue なんてのがあったなぁ…とその存在を思い出したので（遅っ！）、そのセマフォによる排他的制御を用いて同様の動きをシミュレート。かなりすっきり。

| foo1 co aa bb cc coqueue results print mqueue |

mqueue := SharedQueue new.
coqueue := SharedQueue new.
results := String new writeStream.
print := [:ary |
   ary do: [:ea | results nextPutAll: ea asString] separatedBy: [results tab].
   results cr].


foo1 := [:a1 |
   print value: {'foo'. a1}.
   mqueue nextPut: true; nextPut: 2 * a1].


co := [
   | a2 b2 rr ss |

   a2 := coqueue next. b2 := coqueue next.
   print value: {'co-body'. a2. b2}.

   foo1 value: a2 + 1.

   rr := coqueue next.
   print value: {'co-body'. rr}.

   mqueue nextPut: true; nextPut: a2 + b2; nextPut: a2 - b2.
   rr := coqueue next. ss := coqueue next.
   print value: {'co-body'. rr. ss}.

   mqueue nextPut: true; nextPut: b2; nextPut: 'end'.
   rr := coqueue next. ss := coqueue next.

   mqueue nextPut: false; nextPut: 'cannot resume dead coroutine'] newProcess.

co resume.


coqueue nextPut: 1; nextPut: 10.
aa := mqueue next. bb := mqueue next.
print value: {'main'. aa. bb}.

coqueue nextPut: 'r'.
aa := mqueue next. bb := mqueue next. cc := mqueue next.
print value: {'main'. aa. bb. cc}.

coqueue nextPut: 'x'; nextPut: 'y'.
aa := mqueue next. bb := mqueue next. cc := mqueue next.
print value: {'main'. aa. bb. cc}.

coqueue nextPut: 'x'; nextPut: 'y'.
aa := mqueue next. bb := mqueue next.
print value: {'main'. aa. bb}.

^ results contents

call/cc 版（Continuation のインストールが必要です）

| co foo1 aa bb cc print resume yield temps continuation |

World findATranscript: nil. Transcript clear.
print := [:vals | 
   Transcript cr.
   vals do: [:each | Transcript show: each asString] separatedBy: [Transcript tab]].

resume := [:vals | [:cont | continuation := cont. vals first value: vals allButFirst] callCC].
yield := [:vals | [:cont | co := cont. continuation value: vals] callCC].


foo1 := [:a1 |
   print value: {'foo'. a1}.
   yield value: {true. 2 * a1}].


co := [:vals | [:a2 :b2 |
   | tmps rr ss |
   print value: {'co-body'. a2. b2}.

   tmps := foo1 value: a2 + 1.
   rr := tmps first.
   print value: {'co-body'. rr}.

   tmps := yield value: {true. a2 + b2. a2 - b2}.
   rr := tmps first. ss := tmps second.
   print value: {'co-body'. rr. ss}.

   tmps := yield value: {true. b2}.
 
   yield value: {false. 'cannot resume dead coroutine'}] valueWithArguments: vals].


temps := resume value: {co. 1. 10}.
aa := temps first. bb := temps second.
print value: {'main'. aa. bb}.

temps := resume value: {co. 'r'}.
aa := temps first. bb := temps second. cc := temps third.
print value: {'main'. aa. bb. cc}.

temps := resume value: {co. 'x'. 'y'}.
aa := temps first. bb := temps second.
print value: {'main'. aa. bb}.

temps := resume value: {co. 'x'. 'y'}.
aa := temps first. bb := temps second.
print value: {'main'. aa. bb}