Phratchにブロックを拡張する方法のメモ

概要
---
[Scratch](http://scratch.mit.edu/) の [Pharo](http://pharo.org/) ポートである[Phratch](http://www.phratch.com/) に Smalltalk で機能拡張してブロックを定義する手順メモです。本家の based on Scratch の実装と比べ、リファクタリングされ、拡張がしやすくなっています。

拡張の概要
---

Phratch に「Design」というカタログを追加し、アサーション（pre-condition, post-condition, assert）のためのブロックを4つ（pre ブロック、post ブロック、pre-post ブロック、assert ブロック）作成し登録します。

![スクリーンショット 2014-12-23 6.18.35.png](https://qiita-image-store.s3.amazonaws.com/0/59918/a6a0b1c1-bc83-2261-fb5c-1b28abcdb2bf.png)


Phratch を入手する
---
Phratch は [smalltalkhub上のプロジェクト](http://smalltalkhub.com/#!/~JLaval/Phratch) としても公開されていますが、 [プリパッケージされたアプリケーション](http://www.phratch.com/phratch/phratchinstall) ごとダウンロードするのが楽です。

起動するとこんな感じで、最初から Phratch が使える状態になっています。

![スクリーンショット 2014-12-23 5.49.47.png](https://qiita-image-store.s3.amazonaws.com/0/59918/873eb2f4-72a7-c5df-6bb8-b6bdb9a06613.png)

MacOSX 上の場合、shift-option-click でモーフの Halo を出せるので、とりあえず Phratch全体のモーフ を delete すれば、普通の Pharo の開発環境として使えます。

PhratchProcess にメソッドを追加する。
---

アサーションの機能は Pharo ではまだ提供されていないので、まずは処理系にその機能を追加します。Phratch の実行エンジンは PhratchProcess クラスで定義されています。

PhratchProcess クラスの private-special forms メッセージカテゴリに doIf 等の参考になるメソッドがあります。まずは assert 機能を定義します。

```smalltalk:PhratchProcess
doAssert
	"Evaluate the current expression (which must be an assertion)."

	| block arguments argExp |
	block := stackFrame expression.
	arguments := stackFrame arguments.
	"Evaluate the arg if we haven't already."
	arguments size = 0
		ifTrue: [ 
			argExp := block argumentAt: 1.
			^ self pushStackFrame: (PhratchStackFrame new expression: argExp) ].
	"We can pop this expression off the stack either way."
	self popStackFrame.	"If the predicate was false, just return."
	arguments first = true
		ifFalse: [ ^ self assertionError: block ]
```

Phratch の実行エンジンはスタックマシンになっていて、 ```expression``` に現在実行中のブロック（Morph）が格納されています。さらに、ブロックの引数もスタックに積まれています。まずは、実引数が揃える必要があります。実引数を得るためには、引数ブロックをスタックに乗せて、実行エンジンの処理を継続させます。（```arguments size = 0 ifTrue: [...]```のあたり）

すると実行エンジンは次のステップでスタックに積まれた引数ブロックを取り出して処理します。いつか、assert ブロックがスタックのtopになったらまたこの doAssert が実行されて、今度はスタック上に引数が乗ってくるので、```arguments size = 0 ifTrue: [...]```を通過して、いよいよ assert の処理本体を実行します。

```self popStackFrame```で自分自身をスタックから取り払って、もし実引数が```true```であれば検査合格です。何もする必要ありません。もし```true```でなければ、アサーションエラーとして処理します。

アサーションエラーの処理用に以下のメソッドも定義しておきます。

```smalltalk:PhratchProcess
assertionError: aPhratchBlock
	aPhratchBlock hasError: true.
	aPhratchBlock showError.
	aPhratchBlock changed
```

同様の方法で、doPre, doPost, doPrePostも定義します。

ブロックの実装クラスを定義する
---

次に、処理系に doAssert を実行させるブロックを定義します。
Phratchでは BlockMorph のどこか適切なサブクラスから継承すると楽に定義することができます。 assert の場合には、単体の命令ブロックなので CommandBlockMorph が適切な選択になります。

```smalltalk:class-definition
CommandBlockMorph subclass: #AssertBlockMorph
	instanceVariableNames: 'hasError'
	classVariableNames: ''
	category: 'Assertch-Core'
```

アサーションが失敗した場合の管理のためにインスタンス変数 ```hasError``` を定義しています。

まずは ```PhratchProcess``` の ```assertionError:``` で使った ```hasError:```を定義します。

```smalltalk:AssertBlockMorph
hasError: aBoolean
	hasError := aBoolean = true
```

ついでにエラー状態を問い合わせるメッセージやエラー状態をリセットするメッセージも用意しておきましょう。

```smalltalk:AssertBlockMorph
hasError
	^ hasError = true
```

```smalltalk:AssertBlockMorph
resetError
	self hasError: false.
	self color: PhratchCategoryAssertions color.
	self changed.
```

さらに、エラーを起こしたブロックを右クリックでエラー状態をリセットするための機能も追加します。まずはメニューに reset error を追加します。

```smalltalk:AssertBlockMorph
rightButtonMenu
	| menu choice |
	menu := MenuMorph new defaultTarget: self.
	menu add: 'help' value: #presentHelpScreen.
	owner isPhratchBlockPaletteMorph
		ifFalse: [ 
			menu addLine.
			self hasError
				ifTrue: [ 
					menu add: 'reset error' value: #resetError.
					menu addLine ].
			menu add: 'duplicate' value: #duplicate.
			self owner isBlockMorph
				ifFalse: [ 
					"we can't yet delete a blocks inside a script"
					menu add: 'delete' value: #delete ].
			menu add: 'show algorithm' value: #showCodeString ].
	menu
		localize;
		invokeModal.
	choice := menu selectedValue ifNil: [ ^ self ].
	self perform: choice
```

実際に追加するのは ```self hasError ifTrue: [...]``` の部分だけです。

さて、最後にこのブロックの「処理」は ```PhratchProcess```に拡張した```doAssert```を実行するようにしましょう。

```smalltalk:AssertBlockMorph-class
blockTypeOn: aScriptablePhratchMorph spec: spec color: blockColor
	
	|block|
	block :=  self new isSpecialForm: true.
	^block
```

```isSpecialForm: true```をすることで、このブロックは```PhratchProcess```の専用命令```doAssert```で処理されるようになります。

```AssertchPreBlockMorph```, ```AssertchPostBlockMorph```, ```AssertchPrePostBlockMorph```も同様に実装します。

カタログを作成する
---

さて、ではユーザーにブロックを提供するためにカタログに載せましょう。
カタログ用のクラスを定義するには、```PhratchCategory``` クラスから定義するのが簡単です。

```smalltalk:class-definition
PhratchCategory subclass: #PhratchCategoryAssertions
	instanceVariableNames: ''
	classVariableNames: ''
	category: 'Assertch-Core'
```

カタログの色、名前、順位を定義するだけです。

```smalltalk:PhratchCategoryAssertions-class
color
	^(Color r: 0.02 g: 0.02 b: 0.02)
```

```smalltalk:PhratchCategoryAssertions-class
label
	^'design'
```

```smalltalk:PhratchCategoryAssertions-class
order
	^2.26
```

カタログにブロックを登録するためには、 ```ScriptablePhratchMorph``` にpragmaメソッドを追加します。

```smalltalk:ScriptablePhratchMorph
doAssert
	<phratchItem: 'here should hold $Boolean$' kind: #AssertBlockMorph category: 'design' defaultValues: #() subCategory: #inv special: #()>
```

```phratchItem``` にブロック上のラベルを記述します。今回は引数はbooleanなので、仮引数として ```$Boolean$``` と書いておくと、真偽値が入る穴を作ってくれます。あとはだいたい見ての通りです。

他のブロックも同様に登録します。

使ってみる
---

pre-post ブロックを使った例を紹介します。
まずは以下のプログラムをみてください。

![スクリーンショット 2014-12-23 6.48.21.png](https://qiita-image-store.s3.amazonaws.com/0/59918/05201a87-67a3-86b1-d92d-4ce9877e2810.png)

テキストで書くと、

```
set x to 10
because x >= 0, make x < 0 by
    set x to neg x
```

となります。
because ...の部分がアサーションです。このアサーションには

 * set x to neg x というブロックを使う意図として、「 x >= 0 が成り立っているから、set x to neg x することで、 x < 0 を実現している」という説明
 * プログラムを実行する時に、set x to neg x を実行する前に x >= 0 かどうかをテストし、さらに、set x to neg x を実行した後には x < 0 をテストする

という2つの役割があります。

お気付きかもしれませんが、このアサーションにはバグがあります。x >= 0を理由としている以上は、x >= 0 を満たす全ての x について、set x to neg xすると x < 0 とならなければなりません。しかし、x = 0 の時には、成り立ちません。確かめてみましょう。

![スクリーンショット 2014-12-23 6.55.40.png](https://qiita-image-store.s3.amazonaws.com/0/59918/bc5b3b34-18f2-f9b4-a731-fd5f0ebb54e4.png)

アサーションに失敗し、ブロックが赤くなりました。これがエラーを表しています。
```AssertchProcess``` の ```assertionError:``` メッセージにより、アサーションブロックがエラー状態になりました。

右クリックメニューで reset error を選ぶと、

![スクリーンショット 2014-12-23 6.58.04.png](https://qiita-image-store.s3.amazonaws.com/0/59918/fe4dbfc0-e655-b9f4-5fba-ec5ad9d930a7.png)

黒に戻ります。

![スクリーンショット 2014-12-23 6.58.27.png](https://qiita-image-store.s3.amazonaws.com/0/59918/286ddcd9-4a40-d71a-8aea-92f1f2f3b564.png)

公開する
---

monticelloでパッケージとして公開することができます。この記事の内容は [Assertch](http://smalltalkhub.com/#!/~tomooda/Assertch) で公開されています。

まとめ
---

不埒なPhratchにアサッテなAssertchを拡張しました。
本家の based on Scratch の実装と比べ、入念にリファクタリングされているために、拡張がしやすくなっています。based on Scratchにブロックを拡張するためには、色々な箇所のコードを変更する必要がありました。Phratchでは、変更箇所がとても良く整理されています。新規カタログをクラスとして定義できたり、さらにブロックをpragmaによる簡単な宣言でカタログに登録できるなど、気軽に独自カタログ、独自ブロックを拡張できます。この拡張性はとても大きな魅力です。Scratch的なブロックプログラミング環境を構築する時のプラットフォームとして有力な候補になると思います。