演算子に優先順位を持たせていない Smalltalk の場合、ただ式を作って評価しただけでは電卓モードの答えしか出せません。しかし、括弧を付ける細工をするのは個人的に苦手(^_^;)なので、パーサーをちょこっといじって（a ModifiedParser）通常の言語と同様に乗除を優先させるなんちゃってコンパイラ（a ModifiedCompiler）をこしらえてみました。これなら同じ式文字列に対してコンパイラを切り替えて評価することで両方の答えを確かめることができます。
まず、パーサー。いじるのは、スキャナから継承した #xBinary と #messagePart:repeat: の二つなので、ModifiedParser を Parser のサブクラスとして定義して、これら二つのメソッドを再定義します。後者は長いですが、Parser>>#messagePart:repeat: からコードをコピペして、赤字部分を追加しただけです。やっていることは簡単で、字句解析の際に #multiplicative という字句タイプを新設し、乗除にこれを当てはめます。あとは、#messagePart:repeat: で #word（単項メッセージ）の次の優先順位で #multiplicative をパースさせる…というカラクリです。
Parser subclass: #ModifiedParser
ModifiedParser >> xBinary
super xBinary.
(#(* /) includes: token) ifTrue: [tokenType := #multiplicative]
ModifiedParser >> messagePart: level repeat: repeat
| start receiver selector args precedence words keywordStart |
[receiver := parseNode.
(hereType == #keyword
and: [level >= 3])
ifTrue: [start := self startOfNextToken.
selector := WriteStream
on: (String new: 32).
args := OrderedCollection new.
words := OrderedCollection new.
[hereType == #keyword]
whileTrue: [keywordStart := self startOfNextToken + requestorOffset.
selector nextPutAll: self advance.
words
addLast: (keywordStart to: self endOfLastToken + requestorOffset).
self primaryExpression
ifFalse: [^ self expected: 'Argument'].
self messagePart: 2 repeat: true.
args addLast: parseNode].
(Symbol
hasInterned: selector contents
ifTrue: [:sym | selector := sym])
ifFalse: [selector := self
correctSelector: selector contents
wordIntervals: words
exprInterval: (start to: self endOfLastToken)
ifAbort: [^ self fail]].
precedence := 3]
ifFalse: [((hereType == #binary
or: [hereType == #verticalBar])
and: [level >= 2])
ifTrue: [start := self startOfNextToken.
selector := self advance asOctetString asSymbol.
self primaryExpression
ifFalse: [^ self expected: 'Argument'].
self messagePart: 1 repeat: true.
args := Array with: parseNode.
precedence := 2]
ifFalse: [(hereType == #multiplicative
and: [level >= 1])
ifTrue: [start := self startOfNextToken.
selector := self advance asOctetString asSymbol.
self primaryExpression
ifFalse: [^ self expected: 'Argument'].
self messagePart: 0 repeat: true.
args := Array with: parseNode.
precedence := 2]
ifFalse: [hereType == #word
ifTrue: [start := self startOfNextToken.
selector := self advance.
args := #().
words := OrderedCollection
with: (start + requestorOffset to: self endOfLastToken + requestorOffset).
(Symbol
hasInterned: selector
ifTrue: [:sym | selector := sym])
ifFalse: [selector := self
correctSelector: selector
wordIntervals: words
exprInterval: (start to: self endOfLastToken)
ifAbort: [^ self fail]].
precedence := 1]
ifFalse: [^ args notNil]]]].
parseNode := MessageNode new
receiver: receiver
selector: selector
arguments: args
precedence: precedence
from: encoder
sourceRange: (start to: self endOfLastToken).
repeat] whileTrue.
^ true
コンパイラは新しく作ったパーサーを使うように指示するだけなので簡単。
Compiler subclass: ModifiedCompiler
ModifiedCompiler class >> parserClass
^ModifiedParser
念のため動作をチェックしてみましょう。通常のコンパイラは電卓で逐次計算をしたときと同様の挙動をします。
Compiler evaluate: '1 + 2 * 3' "=> 9 "
新しく作ったコンパイラでは、乗除が優先して評価されます。
ModifiedCompiler evaluate: '1 + 2 * 3' "=> 7"
大丈夫みたいですね。
さて、コンパイラは出来たのでこれに評価させる組み合わせを作りましょう。演算子穴埋め用の重複を許す組み合わせの列挙には #asDigitsToPower:do: を用います。
| index | index := 0. #('+' '-' '*' '/' '') asDigitsToPower: 8 do: [:signs | index := index + 1]. ^index "=> 390625 "
ただ、手元の古いマシンでは、ちょっと時間がかかりそうなので、待ち時間の見当をつけられるように（少々長たらしくなりますが…）プログレスバーを表示させることにしました。
| index | 'searching...' displayProgressAt: Display center from: (index := 0) to: (5 raisedTo: 8) during: [:bar | #('+' '-' '*' '/' '') asDigitsToPower: 8 do: [:signs | bar value: (index := index + 1)]]. ^index "=> 390625 "
準備が整ったところで、実際の処理を記述。
| results1 results2 index | results1 := OrderedCollection new. results2 := OrderedCollection new. 'searching...' displayProgressAt: Display center from: (index := 0) to: (5 raisedTo: 8) during: [:bar | #('+' '-' '*' '/' '') asDigitsToPower: 8 do: [:signs | | expression | bar value: (index := index + 1). expression := '1{1}2{2}3{3}4{4}5{5}6{6}7{7}8{8}9' format: signs. (ModifiedCompiler evaluate: expression) = 100 ifTrue: [results1 add: expression]. (Compiler evaluate: expression) = 100 ifTrue: [results2 add: expression]]]. ^{results1 inspect; size. results2 inspect; size}
結果はこちら。
=> #(101 68)
以上のファイルイン用チェンジセット
