『クロージャによる超軽量並行プロセス』を Squeak Smalltalk で　２

See More

id:sumim:20070618:p1 からの続き。

フリップフロップ機構はなんのために必要なのかな…と疑問だったので、状態遷移など調べていて謎が解けました。元記事の OCaml の例では、Senders と Receivers が同時に必要となる状況がないのを利用して、空となったそれぞれを使い捨てしているのですね（もっとも細かいことを言えば、使い捨てといえば要素の増減時にすでに使い捨ててるわけですが、まあ、そこはあくまで私のメンタルモデルとして）。それで、... Senders [v, v, v]、Senders [v, v]、Senders [v] と Receivers [f] 、Receivers [f, f]、Receivers [f, f, f] ...の間を行き来するのにフリップフロップが必要だった、ということが分かったところで、より忠実にその動きを再現して遊んでみることにしました。

内輪ネタ的にはクック言うところの「型による抽象化」手法がとられているので、Senders や Receivers は単なる順序付きコレクションではだめで、しかるべく型情報を持たせておく必要があります。また、チャンネルも（型情報こそ必要ありませんが）参照としての振る舞いをさせるために、なんらかの工夫が必要です。普通ならここでクラスの出番となるわけですが、あえてそれをしないとすれば、関連付けオブジェクト（an Association）を使ってみてはどうかと思いつきました。

関連付けオブジェクトは「キー」と「値」を key -> value と記述（リテラル式っぽいですが、れっきとしたメッセージ式です…）することで生成できるオブジェクトで、二つの値を関連付けして扱うのに便利なものです。Smalltalk では辞書（a Dictionary。他の言語では一般的にハッシュ）の要素として利用されています。

通信用のキューおよび参照を実現するために、この関連付けオブジェクトの「キー」にシンボルで模した型情報を、「値」にキュー代わりの順序付きコレクションを割り振ってみてはどうかと思ってそのように書いてみました。

| newc send recv c repeat servc serv r fibc fib nn |

newc := [#Senders -> OrderedCollection new].

send := [:ch :vals |
    ch key caseOf: {
        [#Senders] -> [ch value add: vals].
        [#Receivers] -> [ch value
            ifEmpty: [ch key: #Senders value:  (OrderedCollection with: vals)]
            ifNotEmpty: [ch value removeFirst valueWithArguments: vals]]}].

recv := [:ch :proc |
    ch key caseOf: {
        [#Receivers] -> [ch value add: proc].
        [#Senders] -> [ch value
            ifEmpty: [ch key: #Receivers value: (OrderedCollection with: proc)]
            ifNotEmpty: [proc valueWithArguments: ch value removeFirst]]}].

World findATranscript: nil.  Transcript clear.

"整数を受信して画面に表示"
c := newc value.
send value: c value: {3}.
recv value: c value: [:x | Transcript cr; show: x].

"何回でも c から整数を受信して画面に表示"
repeat := [recv value: c value: [:x | Transcript cr; show: x. repeat value]].
repeat value.
(1 to: 3) do: [:i | send value: c value: {i}].

"関数サーバー"
servc := newc value..
serv := [
    recv value: servc value: [:i :recp |
        send copy value: recp value: {i * i}.
        serv value]].
serv value.
r := newc value.
send copy value: servc value: {123. r}.
recv value: r value: [:j |  Transcript cr; show: j].
send copy value: servc value: {45. r}.
recv value: r value: [:j |  Transcript cr; show: j].

"フィボナッチ数列"
fibc := newc value.
fib := [
    recv value: fibc value: [:n :repc |
        fib fixTemps value.
        n <= 1
            ifTrue: [
                send value: repc value: {n}]
            ifFalse: [
                | repc1 repc2 |
                repc1 := newc value.
                repc2 := newc value.
                send copy value: fibc value: {n - 1. repc1}.
                send copy value: fibc value: {n - 2. repc2}.
                recv copy value: repc1 value: [:rep1 |
                    recv copy value: repc2 value: [:rep2 |
                        send copy value: repc value: {rep1 + rep2}]]]]].
fib fixTemps value.
nn := 10.
r := newc value.
send copy value: fibc value: {nn. r}.
recv copy value: r value: [:m | Transcript cr; show: ('fib({1}) = {2}' format: {nn. m})].
"=> fib(10) = 55 "

もくろみ通り。機能してくれるようです。

例のごとく Ruby でも。Ruby には Smalltalk の an Association に当たるオブジェクトはありませんが、なんちゃって版を Association として定義。#-> はメソッド名として使えないので Symbol#>= を定義してこれを代わりに用います。

class Association; attr_accessor :key, :val; def initialize(k,v); @key=k; @val=v end end
class Symbol; def >=(other); Association.new(self,other) end end

newc = proc{ :Senders >= Array.new }

send = proc do |ch,*vals|
  case ch.key
  when :Senders
    ch.val << vals
  when :Receivers
    if ch.val.empty?
      ch.key = :Senders; ch.val = [vals]
    else
      ch.val.shift.call(*vals)
    end
  end
end

recv = proc do |ch,proc|
  case ch.key
  when :Receivers
    ch.val << proc
  when :Senders
    if ch.val.empty?
      ch.key = :Receivers; ch.val = [proc]
    else
      proc.call(*ch.val.shift)
    end
  end
end

#整数を受信して画面に表示"
c = newc.call
send.call(c, 3)
recv.call(c, proc{ |x| p x })

#何回でも c から整数を受信して画面に表示"
rep = proc{ recv.call(c, proc{ |x| p x; rep.call }) }
rep.call
(1..3).each{ |i| send.call(c, i) }

#関数サーバー
servc = newc.call
serv = proc do
  recv.call(servc, proc{ |i,recp| send.call(recp, i * i); serv.call })
end
serv.call
r = newc.call
send.call(servc, 123, r)
recv.call(r, proc{ |j| p j })
send.call(servc, 45, r)
recv.call(r, proc{ |j| p j })

#フィボナッチ数列
fibc = newc.call
fib = proc do
  recv.call(fibc, proc do |n,repc|
    fib.call
    if n <= 1
      send.call(repc, n)
    else
      repc1 = newc.call
      repc2 = newc.call
      send.call(fibc, n - 1, repc1)
      send.call(fibc, n - 2, repc2)
      recv.call(repc1, proc do |rep1|
        recv.call(repc2, proc do |rep2|
          send.call(repc, rep1 + rep2)
        end)
      end)
    end
  end)
end
fib.call
nn = 10
r = newc.call
send.call(fibc, nn, r)
recv.call(r, proc{ |m| p "fib(#{nn}) = #{m}" })

id:sumim:20070619:p1 に続く。