Pharoで継続

Pharo 3.0リリースというので なんとなく ChangeLogを眺めていたら

Continuations are now part of Pharo by default.

なんて書いてあるので 久しくSmalltalk触ってなかったけど試してみた.
↓のコードをWorkspaceでdoItすると、

| x cont |
Transcript clear.
x := 1 + 2 * (Continuation currentDo: [ :cc | cont := cc. 3 ]).
Transcript cr; show: x.
(x < 10) ifTrue: [ cont value: 10 ].

こうなる↓.

コード上では "Transcript show: x" は1回しか出てこないのに Transcript には2つ表示されてるのが分かる.

あ、ちなみに Smalltalkなので 1 + 2 * x は (1 + 2) * x に解釈される.

System Browser に[戻る]・[進む]ボタンを付けてみた

Squeakでシステムブラウザでコード眺めてて、前見てたあのコードに戻りたい、だけどどこだったっけ? ということありませんか?
私はあります。
というわけで、システムブラウザに[戻る]・[進む]ボタンを付けてみました。

[<]ボタンで戻り、[>]ボタンで進みます。
戻ったり進んだりできるのは、メソッドを選択してコードまで表示したやつだけです。
チェンジセットを↓に置いておきますのでドラッグ&ドロップするなり、File Inするなりで。

http://dl.dropbox.com/u/162487/misc/misc/history-20110315.cs.zip

新しく追加したクラス名がかなり一般的なHistoryという名前だったり、クラスカテゴリがいまいちだったりなので、そのあたり気に入らなかったら適宜修正してください。

動作確認はSqueak4.2でやりました。無責任・無保証です。

私も Schemeコードバトンを Squeak Smalltalk で

(追記)本家リンク [id:higepon:20100111:1263202895]

sumimさんの [id:sumim:20100129#p1] より、勝手にバトンを受け取ったことにして書いてみました。
変更点はたいしたことなくて、

  • クラスをつくった
  • words.txt がなかったらデフォルトの辞書を使うようにした

です。


クラスにしたので、以下チャンク形式でコードをのせます(一応 http://dl.dropbox.com/u/162487/code-baton/Code-Baton.st にも置いておきます)。

Object subclass: #SmalltalkBaton
	instanceVariableNames: 'wordSpecs'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Code-Baton'!

!SmalltalkBaton methodsFor: 'as yet unclassified' stamp: 's10d 1/29/2010 23:01'!
initializeWordSpecs
	| path file scanner |
	path := self class wordSpecPath.
	file := FileStream fileNamed: path.
	file size isZero
		ifTrue: [wordSpecs := #(#('heap' '積み重ねた物' 0 0) #('exploration' '探査、探検' 0 0) #('errand' '使いっ走り' 0 0) #('defect' '欠点' 0 0) #('allowance' '割当量' 0 0) )]
		ifFalse: [scanner := Scanner new.
			wordSpecs := OrderedCollection new.
			[[file atEnd]
				whileFalse: [wordSpecs
						add: (scanner scanTokens: file nextLine)]]
				ensure: [file
						ifNotNil: [file close]]].
	file close.
	wordSpecs := wordSpecs asArray shuffled
				select: [:each | each size = 4].
	wordSpecs
		sort: [:a :b | a fourth - a third > (b fourth - b third)]!]lang[(168 6 24 5 19 5 19 2 22 3 389)0,5,0,5,0,5,0,5,0,5,0! !

!SmalltalkBaton methodsFor: 'as yet unclassified' stamp: 's10d 1/29/2010 23:05'!
run
	| message |
	self initializeWordSpecs.
	message := '(正解->{1} / 不正解->{2} / 終了->{3})?'
				format: (#('Yes' 'No' 'Cancel' )
						collect: [:each | each translated]).
	[:exit | wordSpecs
		do: [:wordSpec | 
			PopUpMenu inform: wordSpec first.
			(PopUpMenu
				confirm: wordSpec second , String cr , message
				orCancel: [exit value]) caseOf: {
				[true] -> [wordSpec at: 3 incrementBy: 1].
				[false] -> [wordSpec at: 4 incrementBy: 1]}]] valueWithExit.
	self saveWordSpecs!]lang[(58 2 8 3 8 2 400)0,5,0,5,0,5,0! !

!SmalltalkBaton methodsFor: 'as yet unclassified' stamp: 's10d 1/29/2010 23:05'!
saveWordSpecs
	| file path |
	path := self class wordSpecPath.
	file := FileStream fileNamed: path.
	[wordSpecs
		do: [:wordSpec | 
			wordSpec
				do: [:each | file nextPutAll: each storeString]
				separatedBy: [file space].
			file cr]]
		ensure: [file
				ifNotNil: [file close]]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SmalltalkBaton class
	instanceVariableNames: ''!

!SmalltalkBaton class methodsFor: 'as yet unclassified' stamp: 's10d 1/29/2010 22:46'!
run
	self new run! !

!SmalltalkBaton class methodsFor: 'as yet unclassified' stamp: 's10d 1/29/2010 23:00'!
wordSpecPath
	^ 'words.txt'! !

実行はワークス―ペースで "SmalltalkBaton run" を do it です。


だれか次にバトンを受け取ってくれる人いないかな。

[Smalltalk][VisualWorks]VisualWorksのクラス階層をグラフ化 その2
id:sumimさんに昨日のコメントで教えていただいたのをやってみた。

できた画像のサイズがでかすぎて、縮小するにもツールが処理しきれなかったのでリンクだけ貼ります。
http://dl.dropbox.com/u/162487/misc/vwClasses2.png (13.4MB)

Objectクラスに収斂されているのが美しいといえば美しい。


sumimさんのコードを再掲(一部変更してあります)。

| abstractClasses nodes nameSpaces classes file |

abstractClasses := OrderedCollection new.
nodes := OrderedCollection new.
nameSpaces := Root allNameSpaces select: [:each |
  #(UI Kernel Graphics Core) includes: each name].
classes := OrderedCollection new.
nameSpaces do: [:nameSpace | classes addAll: nameSpace allClasses].

classes do: [:class |
  | hasSubResp comment hasAbstComment hasAbstName |
  hasSubResp := class selectors anySatisfy: [:sel |
    (class compiledMethodAt: sel) messages includes: #subclassResponsibility].
  comment := class comment asLowercase.
  hasAbstComment := (classes select: [:classx | 'i am * abstract class*' match: comment]) size > 0.
  hasAbstName := class name match: 'Abstract*'.
  (hasSubResp or: [hasAbstComment or: [hasAbstName]])
    ifTrue: [abstractClasses add: class].

  nodes add: class -> class superclass].

file := 'vwClasses2.dot' asFilename writeStream.
[ file nextPutAll: 'digraph G{'; cr.
  file nextPutAll: 'graph[rankdir=RL];'; cr.
  file nextPutAll: 'edge[arrowsize=0.5];'; cr.
  file nextPutAll: 'node[fontsize=12, shape=box, width=0.05, height=0.05];'; cr.
  abstractClasses do: [:abst |
    file nextPutAll: abst name, ' [style=filled, fillcolor="#FF8888"];'; cr].
  nodes do: [:assoc | file nextPutAll: assoc printString, ';' ; cr].
  file nextPutAll: '}'
] ensure: [file ifNotNil: [file close]]

VisualWorksのクラス階層をグラフ化

sumimさんのところ[id:sumim:20091116:p1]から。
VisualWorksでやってみたくなったのでやってみた。
Traitのところをけずっただけなので、いろいろダメなところあると思われ。


| abstractClasses nodes file packages |

abstractClasses := OrderedCollection new.
nodes := OrderedCollection new.
packages := #('Kernel' 'Collections' 'Exceptions' 'Files' 'Graphics' 'Morphic'
   'Multilingual' 'Network' 'ST80' 'SUnit' 'Sound' 'Compiler' 'Tools' 'Traits').

Smalltalk allClasses do: [:class |
   (packages includes: (class category copyUpTo: $-)) ifTrue: [
      | hasSubResp hasAbstComment hasAbstName |
      hasSubResp := class selectors anySatisfy: [:sel |
         (class compiledMethodAt: sel) messages includes: #subclassResponsibility].
      class comment asString asLowercase.
      hasAbstComment := false.
      hasAbstName := 'Abstract*' match: class name.
      (hasSubResp or: [hasAbstComment or: [hasAbstName]])
         ifTrue: [abstractClasses add: class].
      nodes add: class -> class superclass]].

file := 'vwClasses.dot' asFilename writeStream.
[  file nextPutAll: 'digraph G{'; cr.
   file nextPutAll: 'graph[rankdir=RL];'; cr.
   file nextPutAll: 'edge[arrowsize=0.5];'; cr.
   file nextPutAll: 'node[fontsize=12, shape=box, width=0.05, height=0.05];'; cr.
   abstractClasses do: [:abst |
      file nextPutAll: abst name, ' [style=filled, fillcolor="#FF8888"];'; cr].
   nodes do: [:assoc | file nextPutAll: assoc printString, ';' ; cr].
   file nextPutAll: '}'
] ensure: [file ifNotNil: [file close]]

packagesのところが無修整だから、初手からダメな気がしてきた。

ワークスペースからクラスを作る方法のメモ

VisualWorksワークスペースからクラス作成して削除するまでの一連の流れ。

"ネームスペースを作る"
Smalltalk defineNameSpace: #FooNameSpace
	private: false
	imports: '
			private Smalltalk.*
			'
	category: 'Foo-Bar'.

"クラスを作る"
Smalltalk.FooNameSpace defineClass: #Foo
	superclass: #{Core.Object}
	indexedType: #none
	private: false
	instanceVariableNames: 'a'
	classInstanceVariableNames: ''
	imports: ''
	category: 'Foo-Bar'.


"インスタンスメソッドを追加"
(Smalltalk.FooNameSpace at: #Foo) compile: '
m1: anObject
	^anObject'
	classified: 'bar'.

"クラスメソッドを追加"
(Smalltalk.FooNameSpace at: #Foo) class compile: '
m2: anObject
	^anObject'
	classified: 'buz'.

"クラスを削除"
(Smalltalk.FooNameSpace at: #Foo) removeFromSystem.

"ネームスペースを削除"
Smalltalk.FooNameSpace removeFromSystem.

"カテゴリを削除(必要?)"
Smalltalk organization removeCategory: 'Foo-Bar'.

ただし、パッケージが『(none) *』になってしまうのだった。