1"======================================================================
2|
3|   Run-time parsable expression support (for plural forms)
4|
5|
6 ======================================================================"
7
8"======================================================================
9|
10| Copyright 2001, 2002 Free Software Foundation, Inc.
11| Written by Paolo Bonzini.
12|
13| This file is part of the GNU Smalltalk class library.
14|
15| The GNU Smalltalk class library is free software; you can redistribute it
16| and/or modify it under the terms of the GNU Lesser General Public License
17| as published by the Free Software Foundation; either version 2.1, or (at
18| your option) any later version.
19|
20| The GNU Smalltalk class library is distributed in the hope that it will be
21| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the GNU Lesser
23| General Public License for more details.
24|
25| You should have received a copy of the GNU Lesser General Public License
26| along with the GNU Smalltalk class library; see the file COPYING.LESSER.
27| If not, write to the Free Software Foundation, 59 Temple Place - Suite
28| 330, Boston, MA 02110-1301, USA.
29|
30 ======================================================================"
31
32
33
34Object subclass: RunTimeExpression [
35
36    <category: 'i18n-Messages'>
37    <comment: nil>
38
39    Precedence := nil.
40    Selectors := nil.
41
42    RunTimeExpression class >> initialize [
43	"Private - Initialize internal tables for the parser"
44
45	<category: 'initializing'>
46	Precedence := (Dictionary new)
47		    at: #'||' put: 1;
48		    at: #&& put: 2;
49		    at: #== put: 3;
50		    at: #'!=' put: 3;
51		    at: #< put: 4;
52		    at: #> put: 4;
53		    at: #<= put: 4;
54		    at: #>= put: 4;
55		    at: #+ put: 5;
56		    at: #- put: 5;
57		    at: #* put: 6;
58		    at: #/ put: 6;
59		    at: #% put: 6;
60		    yourself.
61	Selectors := (Dictionary new)
62		    at: #'||' put: #bitOr:;
63		    at: #&& put: #bitAnd:;
64		    at: #== put: #=;
65		    at: #'!=' put: #~=;
66		    at: #/ put: #//;
67		    at: #% put: #\\;
68		    yourself
69    ]
70
71    RunTimeExpression class >> on: aString [
72	"Compile aString and answer a RunTimeExpression"
73
74	<category: 'instance creation'>
75	| expr stream |
76	stream := ReadStream on: aString.
77	expr := self parseExpression: stream.
78	stream skipSeparators.
79	stream atEnd ifFalse: [self error: 'expected operator'].
80	^expr
81    ]
82
83    RunTimeExpression class >> parseExpression: stream [
84	"Private - Compile the expression in the stream"
85
86	<category: 'compiling'>
87	| lhs op rhs prec topPrec stack |
88	lhs := self parseOperand: stream.
89	lhs isNil ifTrue: [self error: 'expected operand'].
90	stack := OrderedCollection new.
91	topPrec := 9999999.
92	[(op := self parseOperator: stream) isNil or: [op == #?]] whileFalse:
93		[rhs := self parseOperand: stream.
94		rhs isNil ifTrue: [self error: 'expected operand'].
95		prec := Precedence at: op.
96		[stack notEmpty and: [prec < topPrec]] whileTrue:
97			["We ended a subexpression with higher precedence, which
98			 is to become the RHS of the lower-precedence subexpression
99			 (for example, 3+4*5+6 after reading the +6)"
100
101			topPrec := stack removeLast.
102			lhs := RTEBinaryNode
103				    lhs: stack removeLast
104				    op: stack removeLast
105				    rhs: lhs].
106		prec > topPrec
107		    ifTrue:
108			["Wait, the old RHS is actually the LHS of a subexpression
109			 with higher precedence.  Save the state on the stack and
110			 reset the parser (for example 3+4*5+6 after reading *5:
111			 lhs is 3+4, but 3+ is saved and 4 is the new LHS)."
112
113			stack
114			    add: lhs op;
115			    add: lhs lhs;
116			    add: topPrec.
117			lhs := lhs rhs].
118		lhs := RTEBinaryNode
119			    lhs: lhs
120			    op: op
121			    rhs: rhs.
122		topPrec := prec].
123
124	"Combine the LHS's that were saved on the stack."
125	[stack isEmpty] whileFalse:
126		[stack removeLast.	"precedence"
127		lhs := RTEBinaryNode
128			    lhs: stack removeLast
129			    op: stack removeLast
130			    rhs: lhs].
131
132	"Parse a ternary expression"
133	op == #?
134	    ifTrue:
135		[lhs := RTEAlternativeNode
136			    condition: lhs
137			    ifTrue: (self parseExpression: stream)
138			    ifFalse: ((stream peekFor: $:)
139				    ifTrue: [self parseExpression: stream]
140				    ifFalse: [self error: 'expected :'])].
141	^lhs
142    ]
143
144    RunTimeExpression class >> parseOperator: stream [
145	"Answer a Symbol for an operator read from stream, or nil if something
146	 else is found."
147
148	<category: 'compiling'>
149	| c1 c2 |
150	stream skipSeparators.
151	c1 := stream peek.
152	c1 isNil ifTrue: [^nil].
153	c1 == $n ifTrue: [^nil].
154	c1 == $( ifTrue: [^nil].
155	c1 isDigit ifTrue: [^nil].
156	c1 == $) ifTrue: [^nil].
157	c1 == $: ifTrue: [^nil].
158	c2 := stream
159		    next;
160		    peek.
161	c2 isNil ifTrue: [^c1 asSymbol].
162	c2 isSeparator ifTrue: [^c1 asSymbol].
163	c2 == $n ifTrue: [^c1 asSymbol].
164	c2 == $! ifTrue: [^c1 asSymbol].
165	c2 == $( ifTrue: [^c1 asSymbol].
166	c2 isDigit ifTrue: [^c1 asSymbol].
167	c2 == $) ifTrue: [^self error: 'expected operand'].
168	c2 == $: ifTrue: [^self error: 'expected operand'].
169	stream next.
170	^(String with: c1 with: c2) asSymbol
171    ]
172
173    RunTimeExpression class >> parseOperand: stream [
174	"Parse an operand from the stream (i.e. an unary negation,
175	 a parenthesized subexpression, `n' or a number) and answer
176	 the corresponding parse node."
177
178	<category: 'compiling'>
179	| expr |
180	stream skipSeparators.
181	(stream peekFor: $!)
182	    ifTrue: [^RTENegationNode child: (self parseOperand: stream)].
183	(stream peekFor: $()
184	    ifTrue:
185		[expr := self parseExpression: stream.
186		(stream peekFor: $)) ifFalse: [self error: 'expected )'].
187		^expr].
188	(stream peekFor: $n) ifTrue: [^RTEParameterNode new].
189	(stream peek notNil and: [stream peek isDigit])
190	    ifTrue: [^RTELiteralNode parseFrom: stream].
191	^nil
192    ]
193
194    value: parameter [
195	"Evaluate the receiver, and answer its value as an integer"
196
197	<category: 'computing'>
198	| result |
199	result := self send: parameter.
200	result isInteger ifFalse: [result := result ifTrue: [1] ifFalse: [0]].
201	^result
202    ]
203
204    send: parameter [
205	<category: 'computing'>
206	self subclassResponsibility
207    ]
208]
209
210
211
212RunTimeExpression subclass: RTEAlternativeNode [
213    | condition ifTrue ifFalse |
214
215    <category: 'i18n-Messages'>
216    <comment: nil>
217
218    RTEAlternativeNode class >> condition: cond ifTrue: trueNode ifFalse: falseNode [
219	"Private - Create a node in the parse tree for the run-time expression,
220	 mapping s to a Smalltalk arithmetic selector"
221
222	<category: 'compiling'>
223	^self new
224	    condition: cond
225	    ifTrue: trueNode
226	    ifFalse: falseNode
227    ]
228
229    send: parameter [
230	"Evaluate the receiver by conditionally choosing one of its children
231	 and evaluating it"
232
233	<category: 'computing'>
234	^(condition value: parameter) = 0
235	    ifFalse: [ifTrue value: parameter]
236	    ifTrue: [ifFalse value: parameter]
237    ]
238
239    printOn: aStream [
240	"Print a representation of the receiver on aStream"
241
242	<category: 'computing'>
243	aStream
244	    print: condition;
245	    nextPut: $?;
246	    print: ifTrue;
247	    nextPut: $:;
248	    print: ifFalse
249    ]
250
251    condition: condNode ifTrue: trueNode ifFalse: falseNode [
252	"Initialize the children of the receiver and the conditional expression
253	 to choose between them"
254
255	<category: 'computing'>
256	condition := condNode.
257	ifTrue := trueNode.
258	ifFalse := falseNode
259    ]
260]
261
262
263
264RunTimeExpression subclass: RTEBinaryNode [
265    | lhs op rhs |
266
267    <category: 'i18n-Messages'>
268    <comment: nil>
269
270    RTEBinaryNode class >> lhs: lhs op: op rhs: rhs [
271	"Private - Create a node in the parse tree for the run-time expression,
272	 mapping s to a Smalltalk arithmetic selector"
273
274	<category: 'compiling'>
275	^self new
276	    lhs: lhs
277	    op: op
278	    rhs: rhs
279    ]
280
281    lhs [
282	<category: 'compiling'>
283	^lhs
284    ]
285
286    op [
287	<category: 'compiling'>
288	^op
289    ]
290
291    rhs [
292	<category: 'compiling'>
293	^rhs
294    ]
295
296    send: parameter [
297	"Private - Evaluate the receiver by evaluating both children
298	 and performing an arithmetic operation between them."
299
300	<category: 'computing'>
301	^(lhs value: parameter) perform: op with: (rhs value: parameter)
302    ]
303
304    printOn: aStream [
305	"Print a representation of the receiver on aStream"
306
307	<category: 'computing'>
308	aStream
309	    nextPut: $(;
310	    print: lhs;
311	    nextPutAll: op;
312	    print: rhs;
313	    nextPut: $)
314    ]
315
316    lhs: lhsNode op: aSymbol rhs: rhsNode [
317	"Initialize the children of the receiver and the operation
318	 to be done between them"
319
320	<category: 'computing'>
321	lhs := lhsNode.
322	op := Selectors at: aSymbol ifAbsent: [aSymbol].
323	rhs := rhsNode
324    ]
325]
326
327
328
329RunTimeExpression subclass: RTELiteralNode [
330    | n |
331
332    <category: 'i18n-Messages'>
333    <comment: nil>
334
335    RTELiteralNode class >> parseFrom: aStream [
336	"Parse a literal number from aStream and return a new node"
337
338	<category: 'initializing'>
339	| ch n |
340	n := 0.
341	[(ch := aStream peek) notNil and: [ch isDigit]] whileTrue:
342		[n := n * 10 + ch digitValue.
343		aStream next].
344	^self new n: n
345    ]
346
347    send: parameter [
348	"Answer a fixed value, the literal encoded in the node"
349
350	<category: 'computing'>
351	^n
352    ]
353
354    n: value [
355	"Set the value of the literal that the node represents"
356
357	<category: 'computing'>
358	n := value
359    ]
360
361    printOn: aStream [
362	"Print a representation of the receiver on aStream"
363
364	<category: 'computing'>
365	aStream print: n
366    ]
367]
368
369
370
371RunTimeExpression subclass: RTEParameterNode [
372
373    <category: 'i18n-Messages'>
374    <comment: nil>
375
376    send: parameter [
377	"Evaluate the receiver by answering the parameter"
378
379	<category: 'computing'>
380	^parameter
381    ]
382
383    printOn: aStream [
384	"Print a representation of the receiver on aStream"
385
386	<category: 'computing'>
387	aStream nextPut: $n
388    ]
389]
390
391
392
393RunTimeExpression subclass: RTENegationNode [
394    | child |
395
396    <category: 'i18n-Messages'>
397    <comment: nil>
398
399    RTENegationNode class >> child: aNode [
400	"Answer a new node representing the logical negation of aNode"
401
402	<category: 'initializing'>
403	^self new child: aNode
404    ]
405
406    send: parameter [
407	"Evaluate the receiver by computing the child's logical negation"
408
409	<category: 'computing'>
410	^(child value: parameter) = 0 ifTrue: [1] ifFalse: [0]
411    ]
412
413    printOn: aStream [
414	"Print a representation of the receiver on aStream"
415
416	<category: 'computing'>
417	aStream
418	    nextPut: $!;
419	    print: child
420    ]
421
422    child: value [
423	"Set the child of which the receiver will compute the negation"
424
425	<category: 'computing'>
426	child := value
427    ]
428]
429
430
431
432Eval [
433    RunTimeExpression initialize
434]
435
436