|
1 "{ Package: 'stx:goodies/petitparser/parsers/smalltalk' }" |
|
2 |
|
3 PPSmalltalkGrammar subclass:#PPSmalltalkParser |
|
4 instanceVariableNames:'' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitSmalltalk-Core' |
|
8 ! |
|
9 |
|
10 PPSmalltalkParser comment:'Enhances the Smalltalk grammar with production actions to build parse-tree nodes of the refactoring browser.' |
|
11 ! |
|
12 |
|
13 !PPSmalltalkParser methodsFor:'accessing'! |
|
14 |
|
15 startExpression |
|
16 "Make the sequence node has a method node as its parent and that the source is set." |
|
17 |
|
18 ^ ([ :stream | stream collection ] asParser and , super startExpression) map: [ :source :node | |
|
19 (RBMethodNode selector: #doIt body: node) |
|
20 source: source. |
|
21 (node statements size = 1 and: [ node temporaries isEmpty ]) |
|
22 ifTrue: [ node statements first ] |
|
23 ifFalse: [ node ] ] |
|
24 ! |
|
25 |
|
26 startMethod |
|
27 "Make sure the method node has the source code properly set." |
|
28 |
|
29 ^ ([ :stream | stream collection ] asParser and , super startMethod) |
|
30 map: [ :source :node | node source: source ] |
|
31 ! ! |
|
32 |
|
33 !PPSmalltalkParser methodsFor:'grammar'! |
|
34 |
|
35 array |
|
36 ^ super array map: [ :openNode :statementNodes :closeNode | |
|
37 (self buildArray: statementNodes) |
|
38 left: openNode start; |
|
39 right: closeNode start; |
|
40 yourself ] |
|
41 ! |
|
42 |
|
43 expression |
|
44 ^ super expression map: [ :variableNodes :expressionNodes | self build: expressionNodes assignment: variableNodes ] |
|
45 ! |
|
46 |
|
47 method |
|
48 ^ super method map: [ :methodNode :bodyNode | |
|
49 methodNode pragmas: bodyNode first. |
|
50 methodNode body: bodyNode second. |
|
51 self buildMethod: methodNode ] |
|
52 ! |
|
53 |
|
54 methodDeclaration |
|
55 ^ super methodDeclaration ==> [ :nodes | |
|
56 RBMethodNode |
|
57 selectorParts: nodes first |
|
58 arguments: nodes second ] |
|
59 ! |
|
60 |
|
61 methodSequence |
|
62 ^ super methodSequence map: [ :periodNodes1 :pragmaNodes1 :periodNodes2 :tempNodes :periodNodes3 :pragmaNodes2 :periodNodes4 :statementNodes | |
|
63 Array |
|
64 with: pragmaNodes1 , pragmaNodes2 |
|
65 with: (self build: tempNodes sequence: periodNodes1 , periodNodes2 , periodNodes3 , periodNodes4 , statementNodes) ] |
|
66 ! |
|
67 |
|
68 parens |
|
69 ^ super parens map: [ :openToken :expressionNode :closeToken | expressionNode addParenthesis: (openToken start to: closeToken start) ] |
|
70 ! |
|
71 |
|
72 pragma |
|
73 ^ super pragma ==> [ :nodes | |
|
74 (RBPragmaNode selectorParts: nodes second first arguments: nodes second second) |
|
75 addComments: nodes first comments; |
|
76 addComments: nodes last comments; |
|
77 left: nodes first start; |
|
78 right: nodes last start; |
|
79 yourself ] |
|
80 ! |
|
81 |
|
82 return |
|
83 ^ super return map: [ :token :expressionNode | RBReturnNode return: token start value: expressionNode ] |
|
84 ! |
|
85 |
|
86 sequence |
|
87 ^ super sequence map: [ :tempNodes :periodNodes :statementNodes | self build: tempNodes sequence: periodNodes , statementNodes ] |
|
88 ! |
|
89 |
|
90 variable |
|
91 ^ super variable ==> [ :token | RBVariableNode identifierToken: token ] |
|
92 ! ! |
|
93 |
|
94 !PPSmalltalkParser methodsFor:'grammar-blocks'! |
|
95 |
|
96 block |
|
97 ^ super block map: [ :leftToken :blockNode :rightToken | blockNode left: leftToken start; right: rightToken start ] |
|
98 ! |
|
99 |
|
100 blockArgument |
|
101 ^ super blockArgument ==> #second |
|
102 ! |
|
103 |
|
104 blockBody |
|
105 ^ super blockBody |
|
106 ==> [ :nodes | |
|
107 | result | |
|
108 result := RBBlockNode arguments: nodes first first body: nodes last. |
|
109 nodes first last ifNotNil: [ result bar: nodes first last start ]. |
|
110 result ] |
|
111 ! ! |
|
112 |
|
113 !PPSmalltalkParser methodsFor:'grammar-literals'! |
|
114 |
|
115 arrayLiteral |
|
116 ^ super arrayLiteral ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: false ] |
|
117 ! |
|
118 |
|
119 arrayLiteralArray |
|
120 ^ super arrayLiteralArray ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: false ] |
|
121 ! |
|
122 |
|
123 byteLiteral |
|
124 ^ super byteLiteral ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: true ] |
|
125 ! |
|
126 |
|
127 byteLiteralArray |
|
128 ^ super byteLiteralArray ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: true ] |
|
129 ! |
|
130 |
|
131 charLiteral |
|
132 ^ super charLiteral ==> [ :token | RBLiteralValueNode literalToken: ((RBLiteralToken value: token inputValue second start: token start stop: token stop) comments: token comments; yourself) ] |
|
133 ! |
|
134 |
|
135 falseLiteral |
|
136 ^ super falseLiteral ==> [ :token | RBLiteralValueNode literalToken: ((RBLiteralToken value: false start: token start stop: token stop) comments: token comments; yourself) ] |
|
137 ! |
|
138 |
|
139 nilLiteral |
|
140 ^ super nilLiteral ==> [ :token | RBLiteralValueNode literalToken: ((RBLiteralToken value: nil start: token start stop: token stop) comments: token comments; yourself) ] |
|
141 ! |
|
142 |
|
143 numberLiteral |
|
144 ^ super numberLiteral ==> [ :token | RBLiteralValueNode literalToken: ((RBNumberLiteralToken value: (Number readFrom: token inputValue) start: token start stop: token stop source: token inputValue) comments: token comments; yourself) ] |
|
145 ! |
|
146 |
|
147 stringLiteral |
|
148 ^ super stringLiteral ==> [ :token | RBLiteralValueNode literalToken: ((RBLiteralToken value: (self buildString: token inputValue) start: token start stop: token stop) comments: token comments; yourself) ] |
|
149 ! |
|
150 |
|
151 symbolLiteral |
|
152 ^ super symbolLiteral ==> [ :tokens | RBLiteralValueNode literalToken: ((RBLiteralToken value: (self buildString: tokens last inputValue) asSymbol start: tokens first start stop: tokens last stop) comments: tokens last comments; yourself) ] |
|
153 ! |
|
154 |
|
155 symbolLiteralArray |
|
156 ^ super symbolLiteralArray ==> [ :token | RBLiteralValueNode literalToken: ((RBLiteralToken value: (self buildString: token inputValue) asSymbol start: token start stop: token stop) comments: token comments; yourself) ] |
|
157 ! |
|
158 |
|
159 trueLiteral |
|
160 ^ super trueLiteral ==> [ :token | RBLiteralValueNode literalToken: ((RBLiteralToken value: true start: token start stop: token stop) comments: token comments; yourself) ] |
|
161 ! ! |
|
162 |
|
163 !PPSmalltalkParser methodsFor:'grammar-messages'! |
|
164 |
|
165 binaryExpression |
|
166 ^ super binaryExpression map: [ :receiverNode :messageNodes | self build: receiverNode messages: messageNodes ] |
|
167 ! |
|
168 |
|
169 cascadeExpression |
|
170 ^ super cascadeExpression map: [ :receiverNode :messageNodes | self build: receiverNode cascade: messageNodes ] |
|
171 ! |
|
172 |
|
173 keywordExpression |
|
174 ^ super keywordExpression map: [ :receiveNode :messageNode | self build: receiveNode messages: (Array with: messageNode) ] |
|
175 ! |
|
176 |
|
177 unaryExpression |
|
178 ^ super unaryExpression map: [ :receiverNode :messageNodes | self build: receiverNode messages: messageNodes ] |
|
179 ! ! |
|
180 |
|
181 !PPSmalltalkParser methodsFor:'private'! |
|
182 |
|
183 addStatements: aCollection into: aNode |
|
184 aCollection isNil |
|
185 ifTrue: [ ^ aNode ]. |
|
186 aCollection do: [ :each | |
|
187 each class == PPSmalltalkToken |
|
188 ifFalse: [ aNode addNode: each ] |
|
189 ifTrue: [ |
|
190 aNode statements isEmpty |
|
191 ifTrue: [ aNode addComments: each comments ] |
|
192 ifFalse: [ aNode statements last addComments: each comments ]. |
|
193 aNode periods: (aNode periods asOrderedCollection |
|
194 addLast: each start; |
|
195 yourself) ] ]. |
|
196 ^ aNode |
|
197 ! |
|
198 |
|
199 build: aNode assignment: anArray |
|
200 ^ anArray isEmpty |
|
201 ifTrue: [ aNode ] |
|
202 ifFalse: [ |
|
203 anArray reverse |
|
204 inject: aNode |
|
205 into: [ :result :each | |
|
206 RBAssignmentNode |
|
207 variable: each first |
|
208 value: result |
|
209 position: each second start ] ] |
|
210 ! |
|
211 |
|
212 build: aNode cascade: anArray |
|
213 | messages semicolons | |
|
214 ^ (anArray isNil or: [ anArray isEmpty ]) |
|
215 ifTrue: [ aNode ] |
|
216 ifFalse: [ |
|
217 messages := OrderedCollection new: anArray size + 1. |
|
218 messages addLast: aNode. |
|
219 semicolons := OrderedCollection new. |
|
220 anArray do: [ :each | |
|
221 messages addLast: (self |
|
222 build: aNode receiver |
|
223 messages: (Array with: each second)). |
|
224 semicolons addLast: each first start ]. |
|
225 RBCascadeNode messages: messages semicolons: semicolons ] |
|
226 ! |
|
227 |
|
228 build: aNode messages: anArray |
|
229 ^ (anArray isNil or: [ anArray isEmpty ]) |
|
230 ifTrue: [ aNode ] |
|
231 ifFalse: [ |
|
232 anArray |
|
233 inject: aNode |
|
234 into: [ :rec :msg | |
|
235 msg isNil |
|
236 ifTrue: [ rec ] |
|
237 ifFalse: [ |
|
238 RBMessageNode |
|
239 receiver: rec |
|
240 selectorParts: msg first |
|
241 arguments: msg second ] ] ] |
|
242 ! |
|
243 |
|
244 build: aTempCollection sequence: aStatementCollection |
|
245 | result | |
|
246 result := self |
|
247 addStatements: aStatementCollection |
|
248 into: RBSequenceNode new. |
|
249 aTempCollection isEmpty ifFalse: [ |
|
250 result |
|
251 leftBar: aTempCollection first start |
|
252 temporaries: aTempCollection second |
|
253 rightBar: aTempCollection last start ]. |
|
254 ^ result |
|
255 ! |
|
256 |
|
257 buildArray: aStatementCollection |
|
258 ^ self addStatements: aStatementCollection into: RBArrayNode new |
|
259 ! |
|
260 |
|
261 buildMethod: aMethodNode |
|
262 aMethodNode selectorParts |
|
263 do: [ :each | aMethodNode addComments: each comments ]. |
|
264 aMethodNode arguments |
|
265 do: [ :each | aMethodNode addComments: each token comments ]. |
|
266 aMethodNode pragmas do: [ :pragma | |
|
267 aMethodNode addComments: pragma comments. |
|
268 pragma selectorParts |
|
269 do: [ :each | aMethodNode addComments: each comments ]. |
|
270 pragma arguments do: [ :each | |
|
271 each isLiteralArray |
|
272 ifFalse: [ aMethodNode addComments: each token comments ] ]. |
|
273 pragma comments: nil ]. |
|
274 ^ aMethodNode |
|
275 ! |
|
276 |
|
277 buildString: aString |
|
278 (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ]) |
|
279 ifTrue: [ ^ aString ]. |
|
280 ^ (aString |
|
281 copyFrom: 2 |
|
282 to: aString size - 1) |
|
283 copyReplaceAll: '''''' |
|
284 with: '''' |
|
285 ! ! |
|
286 |
|
287 !PPSmalltalkParser methodsFor:'token'! |
|
288 |
|
289 binaryToken |
|
290 ^ super binaryToken ==> [ :token | (RBBinarySelectorToken value: token inputValue start: token start) comments: token comments; yourself ] |
|
291 ! |
|
292 |
|
293 identifierToken |
|
294 ^ super identifierToken ==> [ :token | (RBIdentifierToken value: token inputValue start: token start) comments: token comments; yourself ] |
|
295 ! |
|
296 |
|
297 keywordToken |
|
298 ^ super keywordToken ==> [ :token | (RBKeywordToken value: token inputValue start: token start) comments: token comments; yourself ] |
|
299 ! |
|
300 |
|
301 unaryToken |
|
302 ^ super unaryToken ==> [ :token | (RBIdentifierToken value: token inputValue start: token start) comments: token comments; yourself ] |
|
303 ! ! |
|
304 |