Squeak5.0で日本語表示をするシリーズ： FontImporterTool を使う
ご多分に漏れず１バイト文字圏に自由気ままに振る舞われているのと、将来的には EncodingTag/leadingChar とかの仕組みが変わるような話も耳にして、5.0 までになった Squeak ではもはや日本語表示は無理なのかなぁ…4.3J とか 4.4J を使い続けるかなぁ…と、はなからあきらめて試してすらいなかったのですが、id:phaendal さんが http://phaendal.hatenablog.com/entry/2015/11/08/024055 の方法であっさり日本語表示できたの目の当たりにして、改心してちょっと調べてみました。
いろいろと眺めてみたところ、破壊されているのは確かですが、想像していたような壊滅的状況というわけではなく、根気強く直していけばなんとかなりそうな印象でした。しかし、それにつけても TrueType の表示に関わる TTなんちゃらクラス群は似たような名前のクラスが入り交じっていて、TrueType フォント周りはまったく無知な私が自力でなんとかするにしても、状況を把握する段階でかなり時間がかかりそうなので、とりあえず日本語を表示して遊びたいという向けの暫定的情報として FontImporterTool というのを見つけたのでこれだけ書いておきます。
このツールは Appsメニュー → Font Importer 等、あるいは、FontImporterTool open を do it (alt/cmd + d) することで起動できます。その名の通り、TrueType フォントをシステムにリンク、もしくはグリフデータごと読み込んでイメージ（環境）への組込みが可能な機構を持っているようです。
ただ相変わらずの Squeak クオリティで、デフォではいろいろと壊れているのでちょこちょこ直さないとうまく動きません。たとえば現状では、左側で選択したフォントが右側のプレビューで表示されないというなんだかなぁ…なバグがあります。
TrueType フォントファイル（.ttf、.ttc）によっては日本語フォントを提供していても、今の Squeak5.0 では日本語の表示ができないものもあるのでこれは不便です。そこで、とりあえず、FontImportTool>>#currentSelection: をさくっと一カ所修正（#contents を #previewText に変えて accept (alt/cmd + s)。イニシャルを求められたら適当に入れてあげてください）すれば、期待された動作をするようになるはずです。
これで選択したフォントの表示例が（なんとか）出るようになるので、この欄に 'あ' などと入力すれば選択したフォントで日本語表示が可能かどうか手軽に判断できるようになります。
フォントが決まったらインポートなのですが、ここで注意しないといけないのは、日本語表示用のフォントを下のボタンで Import しても表示できないということです。とんでもないワナですね。^^; Import ボタンを押したくなるのをぐっとこらえて、左側の枠の表示できるようにしたいフォント名のところで黄ボタン（通常は右ボタン）クリックし、 Link Font を選ぶ必要があります。
これで、ワークスペースなどの別ウインドウでもフォント選択ツール（FontChooserTool。alt/cmd + k）でフォントを選択すれば表示が可能になります。
システムフォントに設定するなどすれば日本語文字列の表示が可能になるはずです。手元の Windows では日本語入力も IME 経由で可能そうですが、他の OS ではいろいろといじる必要があるかもしれません。他にも、日本語フォントは MultiTTCFont でインポートされなければならないのに TTCFont になっているとか（したがって cache を再構築したりすると死にます）、もろもろの不都合があるので仕組みを勉強しつつ、暇をみて直していければと思っています。
“サイコロの展開図”問題を正規表現がデフォで使える Pharo Smalltalk で（正規表現を使わずに Squeak でも）
Pharo では正規表現が使えるとのことなので、ちょうどそれ向きのお題ということもあり、久しぶりに Pharo で、Squeak 向けのコードの動作確認の範疇をこえて、書き下ろしていろいろ遊んでみました。
| patterns solveDiceDev | patterns := #( '12S/453' '1T6/D45' '146/53D' '15S/3D4' '215/T64' '2S5/41T' ) inject: OrderedCollection new into: [:sum :pat | | alt | alt := (pat last: 3), '/', (pat first: 3). sum addAll: {pat. pat reversed. alt. alt reversed}; yourself ]. solveDiceDev := [:probStr | | boxes regex found | boxes := probStr allRegexMatches: '(w|x|y|z)'. regex := (probStr copyWithRegex: '(w|x|y|z)' matchesReplacedWith: '(.)') asRegex. found := OrderedCollection new. patterns do: [:pat | (regex matches: pat) ifTrue: [ found add: (String streamContents: [:ss | (1 to: boxes size) do: [:idx | ss nextPutAll: (boxes at: idx), '=', (regex subexpression: idx+1) ] separatedBy: [ss nextPutAll: ','] ]) ] ]. found size caseOf: { [0] -> ['none']. [1] -> [found first]. } otherwise: ['many'] ]. #( '0' 'Tx4/5yz' 'x=1,y=S,z=2' '1' '14S/xyz' 'none' '2' '1w6/xyz' 'many' '3' '4w3/12S' 'w=5' '4' '4w3/S51' 'w=D' '5' '15S/wD4' 'w=3' '6' '54D/6Tw' 'w=1' '7' 'S21/35w' 'w=4' '8' 'w2x/354' 'w=S,x=1' '9' 'wx1/54D' 'w=6,x=T' '10' '45w/12x' 'w=3,x=S' '11' '5w2/x14' 'w=S,x=T' '12' 'Dw5/x41' 'w=3,x=6' '13' 'w4x/1y6' 'w=D,x=5,y=T' '14' '15w/xy4' 'w=S,x=3,y=D' '15' 'D35/wxy' 'w=6,x=4,y=1' '16' '4wx/51y' 'w=6,x=T,y=2' '17' 'wTx/D4y' 'w=1,x=6,y=5' '18' 'wxy/z3D' 'w=1,x=4,y=6,z=5' '19' 'wx5/1yz' 'w=D,x=4,y=T,z=6' '20' 'w53/xyz' 'w=4,x=1,y=2,z=S' '21' 'wx1/yzD' 'w=6,x=T,y=5,z=4' '22' 'wxS/3yz' 'w=1,x=5,y=D,z=4' '23' 'wx2/y1z' 'w=5,x=S,y=T,z=4' '24' '4wx/2yz' 'w=1,x=T,y=S,z=5' '25' 'T6w/xyz' 'w=4,x=2,y=1,z=5' '26' 'Swx/yDz' 'w=5,x=1,y=4,z=3' '27' 'wDx/yzS' 'w=3,x=4,y=1,z=5' '28' 'wxy/5Sz' 'w=T,x=1,y=4,z=2' '29' 'wSx/4yz' 'w=2,x=5,y=1,z=T' '30' 'wxS/y5z' 'w=1,x=2,y=4,z=3' '31' 'wxy/35z' 'w=S,x=2,y=1,z=4' '32' 'wxy/T6z' 'w=2,x=1,y=5,z=4' '33' 'wxD/yz1' 'w=5,x=4,y=6,z=T' '34' '1wx/yz5' 'w=T,x=6,y=D,z=4' '35' 'wx3/y5z' 'w=4,x=D,y=S,z=1' '36' '6wx/y3z' 'w=4,x=1,y=D,z=5' '37' '5wx/4yz' 'w=1,x=2,y=6,z=T' '38' 'wx4/Syz' 'w=3,x=5,y=2,z=1' '39' 'w3D/xyz' 'w=5,x=1,y=4,z=6' '40' 'w3x/6yz' 'w=D,x=5,y=4,z=1' '41' 'wxy/z12' 'w=4,x=6,y=T,z=5' '42' '1wS/xyz' 'many' '43' 'wxy/Dz5' 'many' '44' '3w4/xyz' 'many' '45' 'wxy/5zD' 'many' '46' 'wxy/Tz4' 'many' '47' '5wD/xyz' 'many' '48' 'wDx/y5z' 'many' '49' 'wxy/3z4' 'many' '50' 'wxy/5z2' 'many' '51' 'Dyz/S1x' 'none' '52' 'w1z/xyS' 'none' '53' '15x/T6y' 'none' '54' 'zy4/5x6' 'none' '55' '2xy/4Tz' 'none' '56' 'xzS/y1w' 'none' '57' 'Syx/4z5' 'none' '58' 'xwS/Tzy' 'none' '59' 'D5z/xwy' 'none' '60' 'yxD/z35' 'none' ) groupsOf: 3 atATimeDo: [:data | self assert: [(solveDiceDev value: data second) = data third]]
Pharo も 4 まで来てだいぶマシになったように思うのですが、4 になって改めて、ifTrue: ifFalse: のイッパツ挿入とか、advance argument（shift + alt + A）とか、これなくして Pharo 使いはいったいどうやってコードを書いているの？といったような、いにしえの Smalltalk-80 〜 Squeak 時代の（かろうじて Pharo 3 までは使えた）便利機能をぶっ壊したまま放置されているところが多々あり、相変わらずいろいろダメなやつですね。
もちろん、今回の正規表現とかコード補完とか、今日日の処理系や IDE にはあってあたりまえの機能があたりまえのようにデフォで用意されている点に関しては Squeak は完全に置いてきぼりにされた感があるので（だが、古き良き機能をぶっ壊すくらいならそれでいい…）、Squeak を知らない世代は Pharo でぜんぜんオッケー、あえて Squeak を使う意味がきっとわからないのでは？とも思いますが。^^;
そんなわけでやっぱりしばらくは Squeak 使いなので Squeak でも動く正規表現を使わない版も書きました。
| boxChars patterns solveDiceDev | boxChars := 'wxyz'. patterns := #( '12S/453' '1T6/D45' '146/53D' '15S/3D4' '215/T64' '2S5/41T' ) inject: OrderedCollection new into: [:sum :pat | | alt | alt := (pat last: 3), '/', (pat first: 3). sum addAll: {pat. pat reversed. alt. alt reversed}; yourself ]. solveDiceDev := [:probStr | | found | found := OrderedCollection new. patterns do: [:pat | [:exit | found add: (String streamContents: [:ss | pat with: probStr do: [:a :b | (a = b or: [(boxChars includes: b) and: [ss nextPutAll: {b. $=. a. $,}. true]]) ifFalse: [exit value] ]. ss skip: -1 ]) ] valueWithExit]. found ifEmpty: ['none'] ifNotEmpty: [found size = 1 ifTrue: [found first] ifFalse: ['many']] ]. #( '0' 'Tx4/5yz' 'x=1,y=S,z=2' '1' '14S/xyz' 'none' '2' '1w6/xyz' 'many' '3' '4w3/12S' 'w=5' '4' '4w3/S51' 'w=D' '5' '15S/wD4' 'w=3' '6' '54D/6Tw' 'w=1' '7' 'S21/35w' 'w=4' '8' 'w2x/354' 'w=S,x=1' '9' 'wx1/54D' 'w=6,x=T' '10' '45w/12x' 'w=3,x=S' '11' '5w2/x14' 'w=S,x=T' '12' 'Dw5/x41' 'w=3,x=6' '13' 'w4x/1y6' 'w=D,x=5,y=T' '14' '15w/xy4' 'w=S,x=3,y=D' '15' 'D35/wxy' 'w=6,x=4,y=1' '16' '4wx/51y' 'w=6,x=T,y=2' '17' 'wTx/D4y' 'w=1,x=6,y=5' '18' 'wxy/z3D' 'w=1,x=4,y=6,z=5' '19' 'wx5/1yz' 'w=D,x=4,y=T,z=6' '20' 'w53/xyz' 'w=4,x=1,y=2,z=S' '21' 'wx1/yzD' 'w=6,x=T,y=5,z=4' '22' 'wxS/3yz' 'w=1,x=5,y=D,z=4' '23' 'wx2/y1z' 'w=5,x=S,y=T,z=4' '24' '4wx/2yz' 'w=1,x=T,y=S,z=5' '25' 'T6w/xyz' 'w=4,x=2,y=1,z=5' '26' 'Swx/yDz' 'w=5,x=1,y=4,z=3' '27' 'wDx/yzS' 'w=3,x=4,y=1,z=5' '28' 'wxy/5Sz' 'w=T,x=1,y=4,z=2' '29' 'wSx/4yz' 'w=2,x=5,y=1,z=T' '30' 'wxS/y5z' 'w=1,x=2,y=4,z=3' '31' 'wxy/35z' 'w=S,x=2,y=1,z=4' '32' 'wxy/T6z' 'w=2,x=1,y=5,z=4' '33' 'wxD/yz1' 'w=5,x=4,y=6,z=T' '34' '1wx/yz5' 'w=T,x=6,y=D,z=4' '35' 'wx3/y5z' 'w=4,x=D,y=S,z=1' '36' '6wx/y3z' 'w=4,x=1,y=D,z=5' '37' '5wx/4yz' 'w=1,x=2,y=6,z=T' '38' 'wx4/Syz' 'w=3,x=5,y=2,z=1' '39' 'w3D/xyz' 'w=5,x=1,y=4,z=6' '40' 'w3x/6yz' 'w=D,x=5,y=4,z=1' '41' 'wxy/z12' 'w=4,x=6,y=T,z=5' '42' '1wS/xyz' 'many' '43' 'wxy/Dz5' 'many' '44' '3w4/xyz' 'many' '45' 'wxy/5zD' 'many' '46' 'wxy/Tz4' 'many' '47' '5wD/xyz' 'many' '48' 'wDx/y5z' 'many' '49' 'wxy/3z4' 'many' '50' 'wxy/5z2' 'many' '51' 'Dyz/S1x' 'none' '52' 'w1z/xyS' 'none' '53' '15x/T6y' 'none' '54' 'zy4/5x6' 'none' '55' '2xy/4Tz' 'none' '56' 'xzS/y1w' 'none' '57' 'Syx/4z5' 'none' '58' 'xwS/Tzy' 'none' '59' 'D5z/xwy' 'none' '60' 'yxD/z35' 'none' ) groupsOf: 3 atATimeDo: [:data | self assert: [(solveDiceDev value: data second) = data third]]
“とある世界のタクシー料金”問題を Squeak/Pharo Smalltalk で
| cityOfPlace distOfSection additFare initFare fareFor | cityOfPlace := Dictionary new. #(円來 'ABC' 炭州 'DEFG') pairsDo: [:ci :pls | pls do: [:pl | cityOfPlace at: pl put: ci]]. distOfSection := { 'AC'->180. 'AB'->1090. 'DA'->540. 'BC'->960. 'BG'->1270. 'DC'->400. 'CF'->200. 'DE'->720. 'DF'->510. 'EG'->1050. 'FG'->230 } as: Dictionary. initFare := {#円來->#(-995 400). #炭州->#(-845 350)} as: Dictionary. additFare := {#円來->#(-200 60). #炭州->#(-200 50)} as: Dictionary. fareFor := [:path | | path1 distAndFare | path1 := path. "for Pharo" distAndFare := (initFare at: (cityOfPlace at: path1 first)) copy. [path1 size < 2] whileFalse: [ | section nextDist city | section := path1 first: 2. nextDist := distOfSection at: section ifAbsent: [distOfSection at: (section := section reversed)]. distAndFare at: 1 incrementBy: nextDist. city := cityOfPlace at: section first. [distAndFare first positive] whileTrue: [distAndFare := distAndFare + (additFare at: city)]. path1 := path1 allButFirst. ]. distAndFare last ]. #( (0 ADFC 510) (1 CFDA 500) (2 AB 460) (3 BA 460) (4 CD 400) (5 DC 350) (6 BG 520) (7 GB 530) (8 FDA 450) (9 ADF 450) (10 FDACB 750) (11 BCADF 710) (12 EDACB 800) (13 BCADE 810) (14 EGFCADE 920) (15 EDACFGE 910) (16 ABCDA 960) (17 ADCBA 1000) (18 BADCFGB 1180) (19 BGFCDAB 1180) (20 CDFC 460) (21 CFDC 450) (22 ABGEDA 1420) (23 ADEGBA 1470) (24 CFGB 640) (25 BGFC 630) (26 ABGEDFC 1480) (27 CFDEGBA 1520) (28 CDFGEDABG 1770) (29 GBADEGFDC 1680) ) do: [:data | self assert: (fareFor value: data second) = data last]
以下、解説。
cityOfPlace は乗降場所（A〜G）がどちらの市にあるか、の辞書です。
distOfSection は各区間がどのくらいの距離かを調べるための辞書です。キーである区間は乗降場所二カ所を表わす二文字の組み合わせの文字列で、距離を引けるようになっています。両端の乗降場所がある市が異なる場合については、最初の文字の市がその区間が属する市と同一になるようにしました。
initFare、additFare は、それぞれの市（円來、炭州）での初乗り、もしくは、加算の距離と運賃のタプル（配列ですが）を引くための辞書です。
これくらいを用意しておけば、料金体系の違う市が追加されることがあっても対応可能と考えました（無いと思いますが^^;）。
fareFor が料金計算機です。お題にあるように乗降場所のルート（パス）を表わす文字列を与えることでかかった料金の計算をします。
冒頭に
path1 := path. "for Pharo"
とあるのは、Squeak と違い、Pharo ではブロック引数への代入が禁じられているため、書き換え専用の一時変数（path1）を用意したからです。
まず、path1 の一文字目（path1 first）で cityOfPlace 辞書を引いてどちらの市からの乗車かを判定し、さらにその市の初乗り距離と料金のタプルを distAndFare の初期値として得ます。あとで処理を単純な加算ですませられるように、初乗り距離は負にしてあります。
distAndFare := (initFare at: (cityOfPlace at: path1 first)) copy.
あとで破壊的な操作をしているので、得られた値はここでコピーしておかないとひどい目に遭います。^^;
path1 が二文字より少なくなければ、最初の二文字から区間 section を得ます
section := path1 first: 2.
得られた区間をキーにして distOfSection 辞書から距離 nextDist を得ますが、見つからなければ section を逆順にして辞書を引き直します。
nextDist := distOfSection at: section ifAbsent: [distOfSection at: (section := section reversed)].
区間を Set のインスタンスとして管理しておけば逆順にして〜のくだりの処理は必要ないので、どうするかすこし迷ったところですが、区間が属する市、ひいては加算距離と料金を得るのに簡単で、distOfSection 辞書を複雑にしない方向にしました。
ここで得られた nextDist をもって、distAndFare の第一要素である初乗り距離（負数）に破壊的に加算します。
distAndFare at: 1 incrementBy: nextDist.
こういうむき出しの処理が入ると、distAndFare は料金メーターかなにかに抽象化したオブジェクトであったほうがコードの可読性が増すのでよいかなとも一瞬思いましたが、たとえば GUI をつけるとか、ゲームやシミュレーションにするとかの方向にこのお題が拡張されることはないと判断し、そういう仕組みを作り込むことはしませんでした。
続いて、必要なら加算距離・料金の計算をするために、区間が属する市を得ます。すでに section は第一文字目が示す乗降場所がその区間が属する市と一致するように変更されているので、キーは section first で事足ります。
city := cityOfPlace at: section first.
負数の初乗り距離に対して、正の区間距離を足していますので、それがゼロ以上になるのを待って（distAndFare first positive）、その間、距離を減算しつつ料金を加算します。
distAndFare := distAndFare + (additFare at: city)）
距離と料金のタプル（配列）同士の加算（加算距離の方は負数なので減算）になっているのがミソとなっています。
最後に、path1 から最初の文字を省いて次の区間の計算を同様に繰り返し、
path1 := path1 allButFirst.
パスを消費しつくしたら、タプルの料金の方だけを返し終了する、
distAndFare last
とそんな感じです。
「進捗・どう・です・か」を Squeak Smalltalk で
タイトルにもあるように「進捗・どう・です・か」をランダムな順序で表示し、「進捗どうですか」が完成したところで適当にクエスチョンマークをつけて去っていくプログラムです。
特に意味もなく文字カウントします。おおよそ数十文字から1000文字程度で目的を成し遂げて去っていきます。
「進捗・どう・です・か」をランダムに表示し「進捗どうですか」が完成したら煽ってくるプログラム | ぞうさんの何でもノート
| elems count tail | elems := #(進捗 どう です か). count := 0. World findATranscript: nil. Transcript cr. tail := OrderedCollection new: elems size withAll: ''. [ Transcript show: (tail removeFirst; add: elems atRandom). count := count + tail last size. tail asArray = elems ] whileFalse. Transcript show: '???\' withCRs, count, '文字で煽られました。'
共立出版刊「Common Lisp オブジェクトシステム」の共通例題 Grapher の Smalltalk-80 版を Squeak 1.3 で
Ruby の「特異メソッド」命名の元ネタとも言われる、共立出版刊「Common Lisp オブジェクトシステム」にあった各種 OOPL での共通例題の Smalltalk-80 版を Squeak Smalltalk のごく初期のバージョン（1.31）で動かしてみました。
だいぶ改変しないといけないのかな…とおそるおそる試しててみたところ、GrapherView >> #display を #displayView に変更するなどちょこっと変えるだけで案外あっさり動きました。あと、GrapherController >> #isControlActive は必要ないようだったので削ったり、通常のクリックでもメニューが出るように GrapherController >> #redButtonActivity を追加したりしてあります。
Squeak1.3 は ftp.squeak.org のアーカイブから入手してものを使用しました（Windows 版）。展開して、Squeak1.31.image を Squeak.exe にドロップインすると起動できます。手元の環境では、あらかじめ Squeak.exe のプロパティ→ 互換性で XP 互換にして動かすと安定するように見えました。
CLOS-Grapher.st を Squeak1.31 フォルダに移動してから Squeak 環境内で デスクトップクリック → open... → open file list でファイラを起動し、CLOS-Grapher.st を右クリック → fileIn で環境に読み込めます。Grapher 自体の起動は、下のペイン（選択ファイルの内容）をスクロールするなどして GrapherView open を見つけて選択し（あるいはどこかにタイプして入力してから改めて選択し）、右クリック → do it (d) で起動します。
ウインドウ内をクリックするとメニューが現われるので、add node もしくは複数のノードがある状態で add arc し、十字のマウスポインタで設置したいウインドウ内の位置をクリックする（前者）とノードを、つなぎたい２つのノードを順次クリックして選択する（後者）とアークを追加できます。
ちなみに、ここで用いた Squeak1.31 を使うと、第30回Smalltalk勉強会「もういちどMVC」 で使われた副読本 青木淳さんの「使わないと損をするModel-View-Controller」 のコードを移植した Mickey1（コントローラーが頑張る MVC ）、Mickey2（依存性を利用する MVC ）、Mickey3（プラガブルを利用する MVC ）を動かしてみることも可能です。ぜひ、おためしあれかし。
- 作者: 井田昌之,元吉文男,大久保清貴,川辺治之
- 出版社/メーカー: 共立出版
- 発売日: 2010/08/28
- メディア: 単行本
- 購入: 1人 クリック: 13回
- この商品を含むブログ (8件) を見る
“SEND + MORE = MONEY”ソルバーを Squeak Smalltalk で その４
久しぶりに SEND + MORE = MONEY 。以前書いたもの（ブルートフォース版）の焼き直しなのですが、少しだけ趣を変えてみました。デュードニーの覆面算というのですね。
| int solveAlphametics | int := [:array | array reversed polynomialEval: 10]. solveAlphametics := [:spec | | check ans | check := spec value: (ans := OrderedCollection new). (0 to: 9) combinations: check numArgs atATimeDo: [:digits | digits permutationsDo: [:param | check valueWithArguments: param]]. ans asArray]. solveAlphametics value: [:ans | [:S :E :N :D :M :O :R :Y | | a b c | (({S. M} noneSatisfy: #isZero) and: [ (a := int value: {S.E.N.D}) + (b := int value: {M.O.R.E}) = (c := int value: {M.O.N.E.Y})]) ifTrue: [ans add: {a. b. c}]]]. "=> #(#(9567 1085 10652)) " solveAlphametics value: [:ans | [:W :D :O :T :G :L :E :C :M | | a b c | (({W. G. D} noneSatisfy: #isZero) and: [ (a := int value: {W.W.W.D.O.T}) - (b := int value: {G.O.O.G.L.E}) = (c := int value: {D.O.T.C.O.M})]) ifTrue: [ans add: {a. b. c}]]]. "=> #(#(777589 188106 589483) #(777589 188103 589486)) "
Consセルがメッセージを受け取って動くLispもどきをPharo3.0 Smalltalk で
引数を評価する(carをevalしていく)ときにatomとして使っているSmalltalkのデータ全てがevalメッセージを理解
http://phaendal.hatenablog.com/entry/2015/04/17/164825
名詞とか動詞とか宣言的とかは難しくてよく分からないのですが（をゐ）、このアイデアに触発されて、タイトルにあるようにとにかく Consセルとそれに EVAL や APPLY というメッセージを送ることで評価できる Lisp っぽく動くものを手軽にでっち上げることを目指しました。
ふだんなら Squeak で書くところなのですが、これまで Pharo は新しいことをいろいろ覚えるのがめんどくさくて触ったことがなかったので、Squeak から派生して先ごろついに 4.0 が出るまでに進化したこやつの成長ぶりを確認する敵情視察も兼ねて Pharo4.0 で書いてみよう！
と…思い立ったまではよかったのですが、この出たばかりの Pharo4.0 は、なんかいろんなところが壊れていることが判明したので、これよりはいくぶんかこなれているであろう一つ前の Pharo3.0 を使うことにしました。^^;
現行バージョンではないためアーカイブされている Pharo3.0 は http://files.pharo.org/platform/ から各ホストOS（mac、linux、win）用のものが入手可能です。三つの OS で共通して使える Pharo3.0-portable.zip もあります。zip を展開すると、たとえば winであれば Pharo.exe をダブルクリックすると自動的に Pharo3.0.image（後述の永続化されたオブジェクトを収めたバイナリーファイル）を読み込んで Smalltalk 環境が立ち上がります。
Smalltalk ではシステムブラウザ（場合によってはクラスブラウザとも言う）を使ってクラス定義やそこにメソッドを書きます。Pharo3.0 のシステムブラウザ（デスクトップクリック→System Browser で起動）はこんな画面です。
おおまかには上段に左から「パッケージ名一覧」「クラス名一覧」「プロトコル名一覧」「メソッド名一覧」の枠があり、上段で選択したクラスやメソッドの定義やコードを記述するのに下段の大きな枠を使う仕組みになっています。
この中で３番目の「プロトコル」というちょっと見慣れない概念は、メソッドカテゴリーやメッセージカテゴリーとも呼ばれ、クラスに定義されたメソッドを分類するための属性です。メソッドを定義するときにあらかじめ指定しておく必要があるものですが、特に指定しなければ as yet classified になりますし、あとから変更することも可能なので比較的ゆるいです。
後の Objective-C では同名のプロトコルという言語機能が、その後継の Java のインターフェイスに相当する機構の前身に進化したりしていますが、Smalltalk の時点ではまだメソッドに定められている属性のひとつ…程度の能力しかありません（なお、実装上はクラスが有する属性です。為念）。
下段のコードを記述する枠には、当該メソッドをコールするときに送信するメッセージ記述を模したメッセージパターン（メソッド名と仮引数名の宣言を兼ねる）に続いてメソッド本体を記述する決まりになっています。
Smalltalk には（GNU Smalltalk など変わり種の処理系を除き）他の言語にあるメソッド定義のための構文のようなものは存在しませんので、システムブラウザというマルチペインのグラフィカルな UI が、そうした構文や特殊形式の肩代わりをしていると考えることもできます。
Smalltalk では、クラスはもちろん、メソッドもそれを生成するのに使った（つまり我々が書いた）ソースコードもオブジェクトとして扱われ、たとえばメソッドのソースはそのメソッドの属性のような扱いになります（メソッドに getSource というメッセージを送るとそのソースが得られるといったふうに）。環境全体が簡易なオブジェクトストア（OODB）のようなものだと考えると、他の普通の処理系向けの IDE との違いを理解しやすいと思います。
では実際に、次のような感じで動作する ConsCell を作ってみたいと思います。
ConsCell car: 1 cdr: 2 "=> (1 . 2) " #(a (1 2 3) c d) as: ConsCell "=> (a (1 2 3) c d) " (#(+ 1 2 3 4) as: ConsCell) EVAL "=> 10 " (#(MAP factorial (LIST 1 2 3)) as: ConsCell) EVAL "=> (1 2 6) " (#(reduce: (asArray 1 2 3) +) as: ConsCell) EVAL "=> 6 "
主に配列を Consセルを使ったリストに変換し、さらにそれにメッセージを送ることで評価できるように。あと、+ や factorial、reduce: といった Smalltalk に組み込みのメソッドもそのまま使えるようにします。
ファイルアウトしたコード（すなわち、ファイルイン可能なコード）は MessageReceivableCons-Lisp.st ですが、これだとチャンクの区切りやメタ情報が入ったり、順不同だったりして読みにくいので、以下では改めて
クラス名（クラスメソッドの場合は クラス名 class） > カテゴリー名 > メッセージパターン
メソッド本体
という独自記法で抜粋して解説します。
▼ConsCell の定義とアクセッサー（accessingプロトコル）生成
ConsCell には car と cdr というインスタンス変数を用意します。システムブラウザのクラス名一覧枠を右クリック→ Add class... でシステムにクラスを追加できます。
Object subclass: #ConsCell instanceVariableNames: 'car cdr' classVariableNames: '' category: 'MessageReceivableCons-Lisp'
アクセッサーはインスタンス変数と同名のものを用意します。ただ Smalltalk ではコロンもメソッド名（セレクターとも言う）に含まれるため、この「同名」と言う表現には語弊があり（というか明かな間違いで）、コロンの有り（セッター）無し（ゲッター）で別の独立したメソッドとして用意する必要があります。
いちいち手で書いてもよいのですが、数が多いと大変なので、クラス名一覧枠で ConsCell を選択して右クリック→ Analyze... → Create inst var acccessors した方が楽でしょう（Pharo4.0 ではなぜかこの機能が消滅しています。これが分かった時点で今回の Pharo4.0 の使用は諦めました。^^;）。
ConsCell > accessing > car
^ car
ConsCell > accessing > car: aCellOrObject
car := aCellOrObject
ConsCell > accessing > cdr
^ cdr
ConsCell > accessing > cdr: aCellOrObject
cdr := aCellOrObject
これで
ConsCell new car: 1; cdr: 2; yourself
という式をどこか（文字が入力できれば原則どこでもＯＫですが普通は デスクトップ右クリック→ Workspace ）に入力し Print it（alt + p）すると、任意の ConsCell のインスタンスが生成できるのが確認できます。
▼文字列化（printingプロトコル）と判定メソッド（testingプロトコル）
ただ、今の状態ですと ConsCell インスタンスを生成しても 「a ConsCell」としか表示されず、いちいちインスペクト（Inspect it）するなどないと中身が分からず面倒です。そこで内容を反映した文字列化を適宜おこなってくれるよう printingプロトコルにある printOn: メソッドをオーバーライドします。なお、プロトコルは、上段第三枠の右クリック→ Add protocol... で追加できます。
ConsCell > printing > printOn: aStream | nextCellOrObject | aStream nextPut: $(. aStream nextPutAll: car asString. nextCellOrObject := cdr. [ nextCellOrObject isConsCell ] whileTrue: [ aStream space; nextPutAll: nextCellOrObject car asString. nextCellOrObject := nextCellOrObject cdr ]. nextCellOrObject notNil ifTrue: [ aStream nextPutAll: ' . ' , nextCellOrObject asString ]. aStream nextPut: $)
コンパイル（alt + s）時、ConsCell のインスタンスか否かを判定するメソッド（testingプロトコル）である isConsCell が未定義であることを（あるいはスペルミスではないかと）とがめられますが、その場は isConsCell で間違いないことだけを伝えてコンパイルは完了してください。
もちろん、あとで忘れずに定義しておく必要はあります。
Object > *MessageReceivableCons-Lisp > isConsCell
^ false
ConsCell > testing > isConsCell
^ true
本来であれば Object>>#isConsCell も ConsCell>>#isConsCell 同様に testingプロトコルに属させたいところですが、そうしてしまうと MessageReceivableCons-Lisp パッケージに同梱できないので、やむを得ず、パッケージ名に * 付した *MessageReceivableCons-Lisp という特殊なプロトコルに属させています。ここらへんは、Montecello などで新たに導入された今どきのパッケージ管理の限界で、個人的にも気にくわないところです。
余談ですが、Smalltalk 処理系に比較的最近組み込まれるようになった分散管理が可能な VCS である Monticelloではなく、Smalltalk に古くからあるチェンジセットという古典的なソースコード管理機構を使う場合は、文字通り「（システムに加えられた）変更の集合」として黙っていても（追加、変更の別を問わず）すべて蓄積されるため、このへんの気遣いは無用です。
これで、ConsCellオブジェクトの car、cdr の中身を反映した文字列化がされるようになったはずです。Print it して試してみましょう。
ConsCell new car: 1; cdr: 2; yourself "=> (1 . 2) "
▼コンストラクター（instance creationプロトコル）、配列化メソッド（convertingプロトコル）
いちいち ConsCell を new して car と cdr をセットするのは面倒なので、ConsCell class（メタクラス）に car:cdr: メソッドを定義します。システムブラウザでメタクラスにメソッドを定義する（つまり、クラスメソッドを定義する）には、中央左寄りにある □ Class side と書かれたスイッチをクリックして ■ にしてから作業（プロトコル追加→メソッドソース記述、コンパイル）します。
ConsCell class > instance creation > car: carCellOrObject cdr: cdrCellOrObject ^self new car: carCellOrObject; cdr: cdrCellOrObject; yourself
これだけでもだいぶすっきりするのですが、
ConsCell car: 1 cdr: 2 "=> (1 . 2) "
リストを定義しようとするとやっかいなことになります。
ConsCell car: 1 cdr: (ConsCell car: 2 cdr: (ConsCell car: 3 cdr: nil)) "=> (1 2 3) "
そこで、newFrom: メソッドをオーバーライドして
ConsCell newFrom: #(1 2 3)
もしくは
#(1 2 3) as: ConsCell
という記述で配列などの順序付きコレクションを ConsCell のリストに変換できるようにしましょう。
ConsCell class > instance creation > newFrom: aCollection | instance elem next | aCollection isEmpty ifTrue: [ ^ nil ]. elem := aCollection first. (elem isCollection and: [ elem isString not ]) ifTrue: [ elem := elem as: self ]. instance := next := self new car: elem; yourself. aCollection allButFirstDo: [ :each | elem := each. (elem isCollection and: [ elem isString not ]) ifTrue: [ elem := each as: self ]. next cdr: (next := self new car: elem; yourself) ]. ^ instance
これで次の記述が可能になります。
#(a (1 2 3) b c) as: ConsCell "=> (a (1 2 3) b c) "
▼ちょっとした細工と便利メソッド
なぜか Phato では Squeak などでは可能な、通常のブロック（一つ目の例）の代わりにシンボルを渡してメソッドを呼び出す二つ目の例のようなこと
#(1 2 3) reduce: [:sum :x | sum + x] "=> 6 "
#(1 2 3) reduce: #+ "=> error "
がエラーになってできないため不便きわまるので、これをちょいちょいといじってできるようにしておきます。なお、ここからふたたびインスタンスメソッドの定義なので、直前にクラスメソッドの #newFrom: を定義するために切り替えたシステムブラウザの ■ Class side チェックをクリックして元の □ に戻しておくのを忘れずに！（これを読みながら逐次定義している場合）
Symbol > *MessageReceivableCons-Lisp > argumentCount
^ self numArgs + 1
Symbol > *MessageReceivableCons-Lisp > valueWithArguments: args
^ args first perform: self withArguments: args allButFirst
という二つのメソッドを Symbol に追加しておくと、期待通りの動作をしてくれるようになります。
#(1 2 3) reduce: #+ "=> 6 "
用意しておくとあとあと便利なので、Consセルで表現されたリストの要素を配列化する ConsCell>>#asArray を convertingプロトコルに、#collect: を enumeratingプロトコルに定義しておきます。
ConsCell > converting > asArray
^ (Array with: car), (cdr ifNil: [ #() ]) asArray
ConsCell > enumerating > collect: aBlock
^ self class
car: (aBlock value: car)
cdr: (cdr isConsCell
ifTrue: [ cdr collect: aBlock ]
ifFalse: [ cdr ])
試してみます。
(#(1 2 3) as: ConsCell) asArray "=> #(1 2 3) " (#(1 2 3) as: ConsCell) collect: #negated "=> (-1 -2 -3) "
念のため、この asArray はリストの各要素に再帰的に適用されないので、要素が Consセルでもあそれは配列には変換されません。
▼EVAL、APPLY、MAP の定義
では本題の Lisp（っぽい）コードを記述した ConsCell に EVAL メッセージを送って評価できるように ConsCell>>#EVAL メソッドを定義しましょう。同時に Object>>#EVAL の定義も忘れずに。あと、 APPLY するときに流用する Smalltalk の二項セレクターの判定が簡潔に記述できるよう Symbol>>#isBinarySelector もあらかじめ定義しておきます。
Symbol > *MessageReceivableCons-Lisp > isBinarySelector
^ self allSatisfy: #isSpecial
Object > *MessageReceivableCons-Lisp > EVAL
^ self
ConsCell > LISP-FUNCTIONS > APPLY
cdr isNil ifTrue: [ ^ self class perform: car ].
car isBinarySelector ifTrue: [ ^ cdr asArray reduce: car ].
car numArgs = 0 ifTrue: [ ^ car value: cdr ].
^ car valueWithArguments: cdr asArray
ConsCell > LISP-FUNCTIONS > EVAL
| funSymbol args |
funSymbol := car EVAL.
args := cdr collect: #EVAL.
^ (self class car: funSymbol cdr: args) APPLY
評価してみます。
(#(+ 1 2 3 4) as: ConsCell) EVAL "=> 10 " (#(* (+ 1 2) 3 4) as: ConsCell) EVAL "=> 36 "
よさそうですね。
最後にこのエントリーの冒頭のと、元エントリーのサンプルコードなども評価できるように、いくつか LISP-FUNCTIONSプロトコルにメソッドを追加しましょう。
ConsCell > LISP-FUNCTIONS > CONS
^ self class car: car cdr: cdr car
ConsCell > LISP-FUNCTIONS > CAR
^ car car
ConsCell > LISP-FUNCTIONS > CDR
^ car cdr
ConsCell > LISP-FUNCTIONS > LIST
^ self
ConsCell > LISP-FUNCTIONS > MAP
^ cdr car collect: car
以下、久しぶりに Pharo を触った感想をざっくばらんに。
テキスト編集時に again（alt + j）や again many（alt + shift + j）、exchange（alt + e）、duplicate（alt + e）を古くから愛用している Squeakスキーとしては、これらの画期的テキスト編集向け機構を Pharo に残さなかった（残せなかった、あるいは正常に動作させられない、させる気のない）開発陣には殺意すら禁じ得ませんがｗ、今どきの Find/Replace はまあ普通に作ってあるしこれでいいと思います。
今回調べていてちょっと驚いたのは、意外にも古典的なチェンジセットがまだかろうじて使えることと、その一方で、古典的なプロジェクト機構（Smalltalk に古来からある仮想デスクトップ機構で、チェンジセットと紐付けしてそれを視覚的に切り替えるのにも使用できる）が完全に取り払われていて、チェンジセットがほぼ使いものにならない状態だったことです。プロジェクトは Pharo のかなり早い時期に取り除かれていたようで、なんだかすごく残念でした。
クラス名やメソッド名の補完は今風だしすごく便利だと思うのですが、query symbol（alt + q 連打）で満足している身としては、望まない動作をすることもあるのでプラマイゼロ…といったところでしょうか。
月並みですが、作っている人も使っている人も、古典的な Smalltalk環境に思い入れのない向きの Smalltalk環境としてどんどん進化している感じですね。
