[Squeak-ja: 3583] Re: [SML 7312] ブロック生成のメタプログラミング

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

[Squeak-ja: 3583] Re: [SML 7312] ブロック生成のメタプログラミング

NISHIHARA Satoshi
Squeak-ja にも Cc: します.全文引用ですみません.

え〜,Symbol>>asBlock と Symbol>>asBlockFor: をフォーマットしただけで
す. SequenceableCollection>>with:collect: は Squeak オリジナルのを使い
ます.他は Collection>>fold: を定義しました.人の褌で何とやらです (笑).

on 07.9.6 10:12 AM, AOKI Atsushi wrote:

> SRA先端技術研究所の青木です。
>
> じゅんメーリングリストの話題をSMLにも流すことにしました。
>
> ブロック生成の例として、シンボルが asBlock / asBlockFor: の
> メッセージを理解できるようにするプログラムを添付します。。
>
> 似たようなプログラムがちらほらと存在するのですが、どれもベタ
> なプログラムでエレガントさに欠けますので、ユニバーサル・メッ
> セージ(万能関数)を用いたメタプログラミング(高階関数)手法
> で実装しておきました。
>
> #VisualWorks のプログラムですが、Squeak でも動作することを
> #西原さんが確かめてくれています。
>
> 伝言選択子(メッセージ・セレクタ)シンボルに対して用いるのが
> 適切です。使い方は以下のようになります。
>
> #size asBlock
>
> #@ asBlock
>
> #x:y: asBlock
>
> #x:y: asBlockFor: Point
>
> どんなブロックが生成されているのかは、逆コンパイルをしてみれ
> ば判明します。
>
> #size asBlock method decompiledSource
> ==> '
> [:t1 |
> | t2 |
> t2 := Array new: 0.
> t1 perform: #size withArguments: t2]'
>
> #@ asBlock method decompiledSource
> ==> '
> [:t1 :t2 |
> | t3 |
> (t3 := Array new: 1) at: 1 put: t2.
> t1 perform: #@ withArguments: t3]'
>
> #x:y: asBlock method decompiledSource
> ==> '
> [:t1 :t2 :t3 |
> | t4 |
> (t4 := Array new: 2) at: 1 put: t2.
> t4 at: 2 put: t3.
> t1 perform: #x:y: withArguments: t4]'
>
> (#x:y: asBlockFor: Point) method decompiledSource
> ==> '
> [:t1 :t2 |
> | t3 |
> (t3 := Array new: 2) at: 1 put: t1.
> t3 at: 2 put: t2.
> self perform: #x:y: withArguments: t3]'
>
> 伝言選択子としてのシンボルがブロックになる効用は、次のような
> 典型的な場合が考えられます。
>
> (0 to: 9) select: #even asBlock
> ==> #(0 2 4 6 8)
>
> (0 to: 9) reject: #even asBlock
> ==> #(1 3 5 7 9)
>
> (0 to: 9) collect: #even asBlock
> ==> #(true false true false true false true false true false)
>
> #('asaoka' 'aoki') collect: #size asBlock
> ==> #(6 4)
>
> #(0 2 4 6 8) with: #(1 3 5 7 9) collect: #@ asBlock
> ==> #(0@1 2@3 4@5 6@7 8@9)
>
> #(0 2 4 6 8) with: #(1 3 5 7 9) collect: (#x:y: asBlockFor: Point)
> ==> #(0@1 2@3 4@5 6@7 8@9)
>
> #(0 2 4 6 8) fold: #+ asBlock
> ==> 20
>
> #(1 3 5 7 9) fold: #* asBlock
> ==> 945
>
> #(12 21 -19) inject: 9999 into: #min: asBlock
> ==> -19
>
> #(12 21 -19) inject: -9999 into: #max: asBlock
> ==> 21
>
> 今、ある人たちと協力して、この機構を VisualWorks の新バージョ
> ンに導入しよう、というロビー活動をしてます。ぜひ Squeak でも。
>
> asBlock / asBlockFor: のメッセージに応えられる他のオブジェク
> トの候補としては Message / MessageSend / BlockClosure などの
> オブジェクトたちがあげられると思います。
>
> Smalltalk はメタプログラミングが気軽に(あまりにあっけなく)
> できるので、プログラマに備わっているファンタジー創世の能力が
> 刺激され、増幅されることがしばしばでしょう。
>
> また、メタプログラミングはスーパープログラマへの道です。自己
> 相似の中に入ってフラクタルな次元に遊ぶ、という感じになります。
>
> このように言及しても、成長段階にあるプログラマには通じないで
> しょうから、C プログラミングの状況で、誤解を恐れずに翻訳する
> と、おおよそ以下のようになると思います。
>
> 今、ここに「test.c」というプログラムがあったとします。この実
> 行可能プログラム「test」が走行している真っ只中でやっているこ
> とは、走行状況に応じて「subs.c」というソースコードを創り出し、
> それをコンパイル&リンクするための「Makefile」も創り出してお
> いて「make」を起動(fork:dup&exec&wait)させ、「subs」という
> 実行可能プログラムを獲得します。そして最後に「subs」を起動し、
> その実行結果をもらって、「test」が走行し続けるというものです。
> もちろん「subs.c」や「Makefile」そして「subs」などは跡形も無
> く(unlink)しておくのは当然のこと。
>
> ------------------------------------------------------------
> R2D2 (AOKI Atsushi)        http://www.sra.co.jp/people/aoki/
>

--
--------------------------------------------
西原聡士 (NISHIHARA Satoshi)
URL:    http://www.zephyr.dti.ne.jp/~nishis/
--------------------------------------------

'From Squeak3.10beta of 22 July 2007 [latest update: #7143] on 6 September 2007 at 12:25:50 pm'! TestCase subclass: #BlockGenerationTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'BlockGeneration-Tests'! !BlockGenerationTestCase methodsFor: 'testing' stamp: 'nsh 9/6/2007 12:23'! testAsBlock self assert: ((0 to: 9) select: #even asBlock) = #(0 2 4 6 8 ). self assert: ((0 to: 9) reject: #even asBlock) = #(1 3 5 7 9 ). self assert: ((0 to: 9) collect: #even asBlock) = #(true false true false true false true false true false ). self assert: (#('asaoka' 'aoki' ) collect: #size asBlock) = #(6 4 ). self assert: (#(0 2 4 6 8 ) with: #(1 3 5 7 9 ) collect: #@ asBlock) = {0 @ 1. 2 @ 3. 4 @ 5. 6 @ 7. 8 @ 9}. self assert: (#(0 2 4 6 8 ) with: #(1 3 5 7 9 ) collect: (#x:y: asBlockFor: Point)) = {0 @ 1. 2 @ 3. 4 @ 5. 6 @ 7. 8 @ 9}. self assert: (#(0 2 4 6 8 ) fold: #+ asBlock) == 20. self assert: (#(1 3 5 7 9 ) fold: #* asBlock) == 945. self assert: ((1 to: 6) fold: #* asBlock) == 720. self assert: (#('Hello ' 'world' '!!') fold: #, asBlock) = 'Hello world!!'. self assert: (#(12 21 -19 ) inject: 9999 into: #min: asBlock) == -19. self assert: (#(12 21 -19 ) inject: -9999 into: #max: asBlock) == 21! ! !BlockGenerationTestCase methodsFor: 'testing' stamp: 'nsh 9/6/2007 12:01'! testAsBlockFor self assert: (#(0 2 4 6 8 ) with: #(1 3 5 7 9 ) collect: (#x:y: asBlockFor: Point)) = {0 @ 1. 2 @ 3. 4 @ 5. 6 @ 7. 8 @ 9}! !
'From Squeak3.10beta of 22 July 2007 [latest update: #7143] on 6 September 2007 at 12:25:46 pm'! !Collection methodsFor: 'enumerating' stamp: 'nsh 9/6/2007 01:54'! fold: binaryBlock | thisValue nextValue | thisValue := nextValue := Object new. self do: [:each | nextValue := thisValue == nextValue ifTrue: [each] ifFalse: [binaryBlock value: nextValue value: each]]. ^ nextValue == thisValue ifTrue: [self error: 'this collection is empty'] ifFalse: [nextValue]! ! !Symbol methodsFor: 'converting' stamp: 'nsh 9/5/2007 20:58'! asBlock | aStream numberOfArguments aCode | [aStream := String new writeStream. aStream nextPutAll: '['. numberOfArguments := self numArgs. (1 to: numberOfArguments + 1) do: [:n | aStream nextPutAll: ':a'; nextPutAll: n printString; space]. aStream nextPutAll: '|'; cr. aStream nextPutAll: '| arguments |'; cr. aStream nextPutAll: 'arguments := Array new: '; nextPutAll: numberOfArguments printString; nextPutAll: '.'; cr. (2 to: numberOfArguments + 1) do: [:n | aStream nextPutAll: 'arguments at: '; nextPutAll: (n - 1) printString; nextPutAll: ' put: a'; nextPutAll: n printString; nextPutAll: '.'; cr]. aStream nextPutAll: 'a1 perform: '; nextPutAll: self printString; nextPutAll: ' withArguments: arguments'. aStream nextPutAll: ']'. aCode := aStream contents] ensure: [aStream close]. ^ Compiler evaluate: aCode for: nil logged: false! ! !Symbol methodsFor: 'converting' stamp: 'nsh 9/5/2007 20:58'! asBlockFor: aReceiver | aStream numberOfArguments aCode | [aStream := String new writeStream. aStream nextPutAll: '['. numberOfArguments := self numArgs. (1 to: numberOfArguments) do: [:n | aStream nextPutAll: ':a'; nextPutAll: n printString; space]. aStream nextPutAll: '|'; cr. aStream nextPutAll: '| arguments |'; cr. aStream nextPutAll: 'arguments := Array new: '; nextPutAll: numberOfArguments printString; nextPutAll: '.'; cr. (1 to: numberOfArguments) do: [:n | aStream nextPutAll: 'arguments at: '; nextPutAll: n printString; nextPutAll: ' put: a'; nextPutAll: n printString; nextPutAll: '.'; cr]. aStream nextPutAll: 'self perform: '; nextPutAll: self printString; nextPutAll: ' withArguments: arguments'. aStream nextPutAll: ']'. aCode := aStream contents] ensure: [aStream close]. ^ Compiler evaluate: aCode for: aReceiver logged: false! !