「よりClojureらしい素数列」をSqueak Smalltalkで―のつもりがあらぬ方向へ

OOPL


まず、Squeak Smalltalk には遅延評価はおろか、無限配列もないのでどうしようかと思ったのですが（って、この時点であきらめろという^^;）、とりあえず Interval のインスタンスで終端値に無限を表わす Float infinity をしれっと指定することで (1 to: Float infinity) といったようなナンチャッテ無限数列が作れるので、これを軸に頑張ってみることにしました。


その前にまず、元の Clojure のコードの prime? 〜 Smalltalk 風に命名すると isPrime 〜 をそのまま書くとこんなふうになります。

| isPrime |
isPrime := [:x |
   ((2 to: x // 2) collect: [:each | x \\ each])
      noneSatisfy: #isZero].
(2 to: 10) select: [:each | isPrime value: each]   "=> #(2 3 5 7) "

ここまでは問題なし。


で、難関は prime-numbers です。(drop 2 (range)) は (2 to: Float infinity) と日和るにしても、filter を翻訳した次の式は残念ながら動きません。

| isPrime primeNumbers |
isPrime := [:x |
   ((2 to: x // 2) collect: [:each | x \\ each])
      noneSatisfy: #isZero].
primeNumbers := (2 to: Float infinity) select: isPrime


きっと #select: が無限の配列を作ろうとしてコケてるんだろうな…と思いきや、さにあらず。どうも想定とは違うエラーが出ています。この (n to: Float infinity) にはまず size がとれないという問題があるようです。

(1 to: Float infinity) size   "=> Error: Cannot truncate this number"


スタックトレースを見ると、Float infinity // step をする際に、結果を整数化するためにコールする Float>>#truncated で（プリミティブに失敗したあと）わざわざエラーを出しているのが分かります。

Float(Object)>>error:
Float>>truncated
Float(Number)>>floor
Float(Number)>>//
Interval>>size
Interval >> size
   "Answer how many elements the receiver contains."

   step < 0
      ifTrue: [start < stop
            ifTrue: [^ 0]
            ifFalse: [^ stop - start // step + 1]]
      ifFalse: [stop < start
            ifTrue: [^ 0]
            ifFalse: [^ stop - start // step + 1]]

Number >> // aNumber 
   "Integer quotient defined by division with truncation toward negative 
   infinity. 9//4 = 2, -9//4 = -3. -0.9//0.4 = -3. \\ answers the remainder 
   from this division."

   ^(self / aNumber) floor

Number >> floor
   "Answer the integer nearest the receiver toward negative infinity."

   | truncation |
   truncation := self truncated.
   self >= 0 ifTrue: [^truncation].
   self = truncation
      ifTrue: [^truncation]
      ifFalse: [^truncation - 1]

Float >> truncated
   "Answer with a SmallInteger equal to the value of the receiver without
   its fractional part. The primitive fails if the truncated value cannot be
   represented as a SmallInteger. In that case, the code below will compute
   a LargeInteger truncated value.
   Essential. See Object documentation whatIsAPrimitive. "

   <primitive: 51>
   self isFinite ifFalse: [self error: 'Cannot truncate this number'].

   self abs < 2.0e16
   "以下略"


なので、この例外を挙げずにそのまま self を返すように変更してしまいましょう。

Float >> truncated
   "Answer with a SmallInteger equal to the value of the receiver without
   its fractional part. The primitive fails if the truncated value cannot be
   represented as a SmallInteger. In that case, the code below will compute
   a LargeInteger truncated value.
   Essential. See Object documentation whatIsAPrimitive. "

   <primitive: 51>
   self isFinite ifFalse: [^self].

   self abs < 2.0e16
   "以下略"


さあ、これで (1 to: Float infinity) は size を返せるようになったはずです。

(Float infinity) size   "=> Infinity "


どーでもいいですが、副作用でいろいろと動かせるようになります。

(1 to: Float infinity) first: 10   "=> #(1 2 3 4 5 6 7 8 9 10) "

World findATranscript: nil.
(1 to: Float infinity) do: [:each |
   Transcript space; show: each.
   each = 10 ifTrue: [^self]]

1 2 3 4 5 6 7 8 9 10


ここであらためて前述のコードを走らせると、こんどはちゃんと #select: が無限サイズの配列を作ろうとし（self species new: self size）そこでコケます。おめでとう。

| isPrime primeNumbers |
isPrime := [:x |
   ((2 to: x // 2) collect: [:each | x \\ each])
      noneSatisfy: #isZero].
primeNumbers := (2 to: Float infinity) select: isPrime   "=>Error: basicNew: failed "

Array class(Object)>>error:
Array class(Object)>>primitiveFailed:
Array class(Object)>>primitiveFailed
Array class(Behavior)>>basicNew:
Array class>>new:
Interval(SequenceableCollection)>>select:
SequenceableCollection>>select: aBlock
   "Refer to the comment in Collection|select:."
   | aStream |
   aStream := WriteStream on: (self species new: self size).
   1 to: self size do:
      [:index |
      (aBlock value: (self at: index))
         ifTrue: [aStream nextPut: (self at: index)]].
   ^ aStream contents

そもそも無限とかメモリ不足とかそんなこと以前に、配列の生成時に Float infinity なんてわけのわからない数値を渡されることを想定していませんからコケて当たり前です。


さて。ここでギブして撤退するのもなんだかくやしいので、Interval>>#select: をフックして、ナンチャッテ遅延処理にチャレンジしてみることにします。

Interval >> select: aBlock
   self size isFinite ifTrue: [^super select: aBlock].
   ^(self as: LazyInterval) select: aBlock; yourself

Interval subclass: #LazyInterval
   instanceVariableNames: 'filterBlocks'

LazyInterval >> at: index
   | count |
   count := 0.
   self do: [:each |
      (filterBlocks allSatisfy: [:filter | filter value: each])
         ifTrue: [(count := count + 1) = index ifTrue: [^each]]]

LazyInterval >> initialize
   filterBlocks := OrderedCollection new

LazyInterval >> select: aBlock
   filterBlocks add: aBlock.
   ^self

LazyInterval class >> newFrom: interval
   ^self new copySameFrom: interval; initialize; yourself

手抜きをするにもほどがありますが、まあここはこれでよしとしましょう。


で、

| isPrime primeNumbers |
isPrime := [:x |
   ((2 to: x // 2) collect: [:each | x \\ each])
      noneSatisfy: #isZero].
primeNumbers := (2 to: Float infinity) select: isPrime.
primeNumbers first: 10   "=> #(2 3 5 7 11 13 17 19 23 29) "

めでたし、めでたし。


あと、オリジナルを模した noneSatisfy: #isZero のままでもかっこいいのですが、ここでほんのちょっとだけ Squeak Smalltalk っぽさを醸し出すのなら、isPrime の処理をこんなふうに書くのもよいでしょう。

isPrime := [:x | (2 to: x // 2) noneSatisfy: [:each | x isDivisibleBy: each]]


そして―、そもそも最初からすなおにジェネレーターを使え、という話はあります。もちろん。はい。

| isPrime primeNumberSeq |
isPrime := [:x | (2 to: x // 2) noneSatisfy: [:each | x isDivisibleBy: each]].
primeNumberSeq := Generator on: [:g |
   2 to: Float infinity do: [:n | (isPrime value: n) ifTrue: [g value: n]]].
primeNumberSeq next: 10   "=> an OrderedCollection(2 3 5 7 11 13 17 19 23 29) "

余談１

Squeak Smalltalk 独自の APL っぽい機能（配列と配列、配列と数値、数値と配列―の演算も出来る）を活用すれば、isPrime はこんなふうによりシンプルに書くこともできます。

isPrime := [:x | x \\ (2 to: x // 2) noneSatisfy: #isZero]


―という紹介もしようとしたのですが、実はこれ、動きません。^^;


いくつか方法がありそうですが、とりあえず 数値 \\ 配列（数値を配列の各要素で割った余りの配列を返す処理）の中でコールされる Integer>>#// に少し細工をすると期待通り動作するみたいです。

Integer >> // aNumber 
   | q |
   aNumber isNumber ifFalse: [^super // aNumber].
   #Numeric.
   "以下略"

余談２

LazyInterval class>>#newFrom: は、Object class>>#newFrom: を呼べれば事は足ります。

Object class >> newFrom: aSimilarObject
   "Create an object that has similar contents to aSimilarObject.
   If the classes have any instance varaibles with the same names, copy them across.
   If this is bad for a class, override this method."

   ^ (self isVariable
      ifTrue: [self basicNew: aSimilarObject basicSize]
      ifFalse: [self basicNew]
     ) copySameFrom: aSimilarObject


ところが LazyInterval からですと、スーパークラスの Interval class>>#newFrom: に横取り(?)されてしまい、Object class>>#newFrom: に到達できないという罠が。継承を飛び越えて Object class>>#newFrom: を静的に直接コールする手もあるのですが、それもなんか違うよなーと。

LazyInterval class >> newFrom: interval
   ^((Object class >> #newFrom:)
      valueWithReceiver: self
      arguments: {interval}) initialize; yourself


結局、普通に new してデフォルトの動作である #copySameFrom: をコールするところに落ち着きました。参考まで、#copySameFrom: の定義はこんなふうになっています。

Object >> copySameFrom: otherObject
   "Copy to myself all instance variables named the same in otherObject.
   This ignores otherObject's control over its own inst vars."

   | myInstVars otherInstVars |
   myInstVars := self class allInstVarNames.
   otherInstVars := otherObject class allInstVarNames.
   myInstVars doWithIndex: [:each :index |
      | match |
      (match := otherInstVars indexOf: each) > 0 ifTrue:
         [self instVarAt: index put: (otherObject instVarAt: match)]].
   1 to: (self basicSize min: otherObject basicSize) do: [:i |
      self basicAt: i put: (otherObject basicAt: i)].


前後しますが、#newFrom: は interval as: LazyInterval でコールされる #as: の実質処理担当のメソッドで、これを変換先クラスのクラスメソッドとして再定義することで、類似内容のインスタンスを適切な手続き（例えば、要素やインスタンス変数をどうマッピングし直すかなど）で得ることが出来るようになっています。

Object >> as: aSimilarClass
   "Create an object of class aSimilarClass that has similar contents to the receiver."

   ^ aSimilarClass newFrom: self

余談３

ということで、リクエストにどこまでおこたえ出来るか分かりませんがジェネレーターについて。ｗ

必要とあれば call/cc だってユーザーランドで実装できてしまう Smalltalk のことですから、ジェネレーターなんてのもお茶の子さいさいです。

利用の仕方としては、Generator に on: block を送信することで生成します。ブロックは１引数をとるものを用い、#next での次値の呼び出し時にはこのブロック変数に生成されたジェネレーター自身が渡された状態でブロック内の処理が実行されます。その処理内で、ブロック変数を介して自身に value: 返値（#yield: や #nextPut: でもＯＫ）というメッセージを送ることで 1)処理をいったん停止し、2)引数として与えた次値を返し、3)元のコンテキストに戻って処理を続行する―いわゆるコルーチンの動作を実現しています。

| gen |
gen := Generator on: [:g | 1 to: 10 do: [:each | g value: each]].
gen next.      "=> 1 "
gen next.      "=> 2 "
gen next: 3.   "=> an OrderedCollection(3 4 5) "
gen peek.      "=> 6 "
gen atEnd.     "=> false "
gen upToEnd.   "=> an OrderedCollection(6 7 8 9 10) "
gen atEnd.     "=> true "


キモとなるコンテキストの切り替え処理（ある種の GOTO ）の実装は、#next コール時に現在実行中のコンテキスト（thisContext）の呼び出し元であり戻り場所（センダー）を保存しておいたジェネレーター自身（コルーチン）のコンテキストに入れ替えつつ、将来のコルーチンの戻り先を現在の本来の戻り先に置き換えておくという実にシンプルなものです。現在のコンテキスト（スタックフレーム）がファーストクラスオブジェクトで、かつそれを直接 thisContext という擬変数で取得できる Smalltalk ならではの“黒魔術”ですね。

Generator >> next
   "Generate and answer the next object in the receiver."

   ^ self atEnd ifFalse: [
      home swapSender: thisContext sender.
      continue := thisContext swapSender: continue
   ]

ContextPart >> swapSender: coroutine 
   "Replace the receiver's sender with coroutine and answer the receiver's 
   previous sender. For use in coroutining."

   | oldSender |
   oldSender := sender.
   sender := coroutine.
   ^oldSender

Generator >> value: anObject 
   "Allows passing generators as arguments to methods expecting blocks.
   A synonym for #yield: / #nextPut:."
   ^ self nextPut: anObject

Generator >> nextPut: anObject
   "Add anObject into the generator. A synonym to #yield: and value:."

   | previous |
   previous := next.
   next := anObject.
   continue := thisContext swapSender: continue.
   ^ previous