|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 Object subclass:#PEGFsaState |
|
6 instanceVariableNames:'name retval priority transitions final multivalue' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'PetitCompiler-FSA' |
|
10 ! |
|
11 |
|
12 !PEGFsaState methodsFor:'accessing'! |
|
13 |
|
14 destination |
|
15 self assert: transitions size = 1. |
|
16 ^ transitions anyOne destination |
|
17 ! |
|
18 |
|
19 destinations |
|
20 ^ (transitions collect: #destination) asIdentitySet |
|
21 ! |
|
22 |
|
23 final |
|
24 ^ final |
|
25 ! |
|
26 |
|
27 final: anObject |
|
28 final := anObject |
|
29 ! |
|
30 |
|
31 multivalue |
|
32 ^ multivalue |
|
33 ! |
|
34 |
|
35 multivalue: anObject |
|
36 multivalue := anObject |
|
37 ! |
|
38 |
|
39 name |
|
40 ^ name |
|
41 ! |
|
42 |
|
43 name: anObject |
|
44 name := anObject asString |
|
45 ! |
|
46 |
|
47 prefix |
|
48 ^ 'state' |
|
49 ! |
|
50 |
|
51 priority |
|
52 ^ priority |
|
53 ! |
|
54 |
|
55 priority: anObject |
|
56 priority := anObject |
|
57 ! |
|
58 |
|
59 priorityIfNone: value |
|
60 ^ self hasPriority ifTrue: [ self priority ] ifFalse: [ value ] |
|
61 ! |
|
62 |
|
63 retval |
|
64 ^ retval |
|
65 ! |
|
66 |
|
67 retval: anObject |
|
68 retval := anObject |
|
69 ! |
|
70 |
|
71 retvalAsCollection |
|
72 ^ self isMultivalue ifTrue: [ |
|
73 self retval |
|
74 ] ifFalse: [ |
|
75 Array with: self retval |
|
76 ] |
|
77 ! |
|
78 |
|
79 suffix |
|
80 ^ '' |
|
81 ! |
|
82 |
|
83 transitions |
|
84 ^ transitions |
|
85 ! ! |
|
86 |
|
87 !PEGFsaState methodsFor:'analysis'! |
|
88 |
|
89 reachableStates |
|
90 | openSet | |
|
91 openSet := IdentitySet new. |
|
92 self reachableStatesOpenSet: openSet. |
|
93 ^ openSet |
|
94 ! |
|
95 |
|
96 reachableStatesOpenSet: openSet |
|
97 (openSet includes: self) ifTrue: [ |
|
98 ^ self |
|
99 ]. |
|
100 |
|
101 openSet add: self. |
|
102 |
|
103 (self transitions) do: [ :t | |
|
104 t destination reachableStatesOpenSet: openSet |
|
105 ]. |
|
106 |
|
107 ! |
|
108 |
|
109 transitionPairs |
|
110 | size pairs collection | |
|
111 size := transitions size. |
|
112 pairs := OrderedCollection new: (size - 1) * size / 2. |
|
113 |
|
114 collection := transitions asOrderedCollection. |
|
115 |
|
116 1 to: (size - 1) do: [ :index1 | |
|
117 (index1 + 1 to: size) do: [ :index2 | |
|
118 pairs add: (PEGFsaPair new |
|
119 first: (collection at: index1); |
|
120 second: (collection at: index2); |
|
121 yourself). |
|
122 ] |
|
123 ]. |
|
124 ^ pairs |
|
125 ! ! |
|
126 |
|
127 !PEGFsaState methodsFor:'comparing'! |
|
128 |
|
129 = anotherState |
|
130 (self == anotherState) ifTrue: [ ^ true ]. |
|
131 (self class == anotherState class) ifFalse: [ ^ true ]. |
|
132 |
|
133 (name == anotherState name) ifFalse: [ ^ false ]. |
|
134 (priority == anotherState priority) ifFalse: [ ^ false ]. |
|
135 (multivalue == anotherState multivalue) ifFalse: [ ^ false ]. |
|
136 (retval = anotherState retval) ifFalse: [ ^ false ]. |
|
137 (final = anotherState final) ifFalse: [ ^ false ]. |
|
138 |
|
139 (transitions size = anotherState transitions size) ifFalse: [ ^ false ]. |
|
140 transitions do: [:t | |
|
141 (anotherState transitions contains: [:at | at = t]) ifFalse: [ ^ false ]. |
|
142 ]. |
|
143 |
|
144 ^ true |
|
145 ! |
|
146 |
|
147 canBeIsomorphicTo: anotherState |
|
148 (name == anotherState name) ifFalse: [ ^ false ]. |
|
149 (priority == anotherState priority) ifFalse: [ ^ false ]. |
|
150 (multivalue == anotherState multivalue) ifFalse: [ ^ false ]. |
|
151 (final == anotherState final) ifFalse: [ ^ false ]. |
|
152 (transitions size == anotherState transitions size) ifFalse: [ ^ false ]. |
|
153 (retval = anotherState retval) ifFalse: [ ^ false ]. |
|
154 |
|
155 ^ true |
|
156 ! |
|
157 |
|
158 equals: anotherState |
|
159 (self == anotherState) ifTrue: [ ^ true ]. |
|
160 (anotherState class == PEGFsaState) ifFalse: [ ^ false ]. |
|
161 |
|
162 (retval = anotherState retval) ifFalse: [ ^ false ]. |
|
163 (multivalue = anotherState multivalue) ifFalse: [ ^ false ]. |
|
164 (self isFinal = anotherState isFinal) ifFalse: [ ^ false ]. |
|
165 |
|
166 (self hasPriority and: [anotherState hasPriority]) ifTrue: [ |
|
167 (priority == anotherState priority) ifFalse: [ ^ false ]. |
|
168 ]. |
|
169 |
|
170 (transitions size == anotherState transitions size) ifFalse: [ ^ false ]. |
|
171 anotherState transitions do: [ :t | |
|
172 (transitions contains: [ :e | e equals: t]) ifFalse: [ ^ false ] |
|
173 ]. |
|
174 |
|
175 ^ true |
|
176 ! |
|
177 |
|
178 hash |
|
179 ^ retval hash bitXor: ( |
|
180 priority hash bitXor: ( |
|
181 multivalue hash bitXor: |
|
182 "JK: Size is not the best option here, but it one gets infinite loops otherwise" |
|
183 transitions size hash)). |
|
184 ! |
|
185 |
|
186 isIsomorphicTo: anotherState resolvedSet: set |
|
187 (self == anotherState) ifTrue: [ ^ true ]. |
|
188 |
|
189 (name == anotherState name) ifFalse: [ ^ false ]. |
|
190 (priority == anotherState priority) ifFalse: [ ^ false ]. |
|
191 (multivalue == anotherState multivalue) ifFalse: [ ^ false ]. |
|
192 (retval = anotherState retval) ifFalse: [ ^ false ]. |
|
193 (final = anotherState final) ifFalse: [ ^ false ]. |
|
194 |
|
195 (transitions size = anotherState transitions size) ifFalse: [ ^ false ]. |
|
196 transitions do: [:t | |
|
197 (anotherState transitions contains: [:at | t isIsomorphicto: at]) ifFalse: [ ^ false ]. |
|
198 ]. |
|
199 |
|
200 ^ true |
|
201 ! ! |
|
202 |
|
203 !PEGFsaState methodsFor:'copying'! |
|
204 |
|
205 postCopy |
|
206 super postCopy. |
|
207 transitions := (transitions collect: [ :t | t copy ]). |
|
208 retval := retval copy. |
|
209 ! ! |
|
210 |
|
211 !PEGFsaState methodsFor:'gt'! |
|
212 |
|
213 gtName |
|
214 | gtName | |
|
215 gtName := name. |
|
216 |
|
217 self hasPriority ifTrue: [ |
|
218 gtName := gtName asString, ',', self priority asString. |
|
219 ]. |
|
220 |
|
221 ^ gtName |
|
222 ! ! |
|
223 |
|
224 !PEGFsaState methodsFor:'initialization'! |
|
225 |
|
226 initialize |
|
227 super initialize. |
|
228 |
|
229 transitions := OrderedCollection new. |
|
230 multivalue := false. |
|
231 ! ! |
|
232 |
|
233 !PEGFsaState methodsFor:'modifications'! |
|
234 |
|
235 addTransition: t |
|
236 self assert: (transitions identityIncludes: t) not. |
|
237 transitions add: t |
|
238 ! |
|
239 |
|
240 decreasePriority |
|
241 (self isFinal and: [ self hasPriority not ]) ifTrue: [ |
|
242 priority := 0. |
|
243 ]. |
|
244 priority isNil ifFalse: [ |
|
245 priority := priority - 1 |
|
246 ] |
|
247 ! |
|
248 |
|
249 removeTransition: t |
|
250 self assert: (transitions includes: t). |
|
251 transitions remove: t |
|
252 ! ! |
|
253 |
|
254 !PEGFsaState methodsFor:'printing'! |
|
255 |
|
256 printNameOn: aStream |
|
257 self name isNil |
|
258 ifTrue: [ aStream print: self hash ] |
|
259 ifFalse: [ aStream nextPutAll: self name ] |
|
260 ! |
|
261 |
|
262 printOn: aStream |
|
263 super printOn: aStream. |
|
264 aStream nextPut: $(. |
|
265 self printNameOn: aStream. |
|
266 aStream nextPut: Character space. |
|
267 aStream nextPutAll: self identityHash asString. |
|
268 self isFinal ifTrue: [ |
|
269 aStream nextPutAll: ' FINAL'. |
|
270 ]. |
|
271 aStream nextPut: (Character codePoint: 32). |
|
272 aStream nextPutAll: priority asString. |
|
273 aStream nextPut: $) |
|
274 ! ! |
|
275 |
|
276 !PEGFsaState methodsFor:'testing'! |
|
277 |
|
278 canHavePPCId |
|
279 ^ true |
|
280 ! |
|
281 |
|
282 hasEqualPriorityTo: state |
|
283 "nil - nil" |
|
284 (self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ]. |
|
285 |
|
286 "nil - priority" |
|
287 (self hasPriority) ifFalse: [ ^ false ]. |
|
288 |
|
289 "priority - nil" |
|
290 state hasPriority ifFalse: [ ^ false ]. |
|
291 |
|
292 "priority - priority" |
|
293 ^ self priority = state priority |
|
294 ! |
|
295 |
|
296 hasHigherPriorityThan: state |
|
297 "nil - nil" |
|
298 (self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ]. |
|
299 |
|
300 "nil - priority" |
|
301 (self hasPriority) ifFalse: [ ^ false ]. |
|
302 |
|
303 "priority - nil" |
|
304 state hasPriority ifFalse: [ ^ true ]. |
|
305 |
|
306 "priority - priority" |
|
307 ^ self priority > state priority |
|
308 ! |
|
309 |
|
310 hasPriority |
|
311 ^ priority isNil not |
|
312 ! |
|
313 |
|
314 isFailure |
|
315 ^ self isFinal and: [ retval class == PEGFsaFailure ] |
|
316 ! |
|
317 |
|
318 isFinal |
|
319 final isNil ifTrue: [ ^ false ]. |
|
320 |
|
321 final ifTrue: [ |
|
322 " self assert: self hasPriority. " |
|
323 ^ true |
|
324 ]. |
|
325 |
|
326 ^ false |
|
327 ! |
|
328 |
|
329 isMultivalue |
|
330 ^ multivalue |
|
331 ! ! |
|
332 |
|
333 !PEGFsaState methodsFor:'transformation'! |
|
334 |
|
335 determinize |
|
336 ^ self determinize: Dictionary new. |
|
337 ! |
|
338 |
|
339 determinize: dictionary |
|
340 self transitionPairs do: [ :pair | |
|
341 self assert: (pair first destination = pair second destination) not. |
|
342 (pair first overlapsWith: pair second) ifTrue: [ |
|
343 self determinizeOverlap: pair first second: pair second joinDictionary: dictionary |
|
344 ] |
|
345 ]. |
|
346 ! |
|
347 |
|
348 determinizeOverlap: t1 second: t2 joinDictionary: dictionary |
|
349 | pair t1Prime t2Prime tIntersection | |
|
350 pair := PEGFsaPair with: t1 with: t2. |
|
351 |
|
352 (dictionary includes: pair) ifTrue: [ self error: 'should not happen'.]. |
|
353 dictionary at: pair put: nil. |
|
354 |
|
355 tIntersection := t1 join: t2 joinDictionary: dictionary. |
|
356 t1Prime := PEGFsaTransition new |
|
357 destination: t1 destination; |
|
358 characterSet: (t1 complement: t2); |
|
359 yourself. |
|
360 t2Prime := PEGFsaTransition new |
|
361 destination: t2 destination; |
|
362 characterSet: (t2 complement: t1); |
|
363 yourself. |
|
364 |
|
365 |
|
366 self removeTransition: t1. |
|
367 self removeTransition: t2. |
|
368 |
|
369 tIntersection isEpsilon ifFalse: [ self addTransition: tIntersection ]. |
|
370 t1Prime isEpsilon ifFalse: [ self addTransition: t1Prime ]. |
|
371 t2Prime isEpsilon ifFalse: [ self addTransition: t2Prime ]. |
|
372 |
|
373 dictionary at: pair put: (Array |
|
374 with: tIntersection |
|
375 with: t1Prime |
|
376 with: t2Prime |
|
377 ) |
|
378 ! |
|
379 |
|
380 join: state |
|
381 ^ self join: state joinDictionary: Dictionary new |
|
382 ! |
|
383 |
|
384 join: state joinDictionary: dictionary |
|
385 | pair newState | |
|
386 pair := PEGFsaPair with: self with: state. |
|
387 (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ]. |
|
388 |
|
389 newState := PEGFsaState new. |
|
390 |
|
391 dictionary at: pair put: newState. |
|
392 |
|
393 self joinFinal: state newState: newState. |
|
394 self joinPriority: state newState: newState. |
|
395 self joinRetval: state newState: newState. |
|
396 self joinName: state newState: newState. |
|
397 |
|
398 newState transitions addAll: (self transitions collect: #copy). |
|
399 newState transitions addAll: (state transitions collect: #copy). |
|
400 newState determinize: dictionary. |
|
401 |
|
402 ^ dictionary at: pair put: newState |
|
403 ! |
|
404 |
|
405 joinFinal: state newState: newState |
|
406 (self hasEqualPriorityTo: state) ifTrue: [ |
|
407 ^ newState final: (self isFinal or: [ state isFinal ]). |
|
408 ]. |
|
409 |
|
410 (self hasHigherPriorityThan: state) ifTrue: [ |
|
411 ^ newState final: self isFinal. |
|
412 ]. |
|
413 |
|
414 newState final: state isFinal. |
|
415 |
|
416 ! |
|
417 |
|
418 joinName: state newState: newState |
|
419 newState name: self name asString, '-', state name asString. |
|
420 ! |
|
421 |
|
422 joinPriority: state newState: newState |
|
423 (self hasHigherPriorityThan: state) ifTrue: [ |
|
424 newState priority: self priority. |
|
425 ^ self |
|
426 ]. |
|
427 |
|
428 newState priority: state priority. |
|
429 ! |
|
430 |
|
431 joinRetval: state newState: newState |
|
432 self isFinal ifFalse: [ ^ newState retval: state retval ]. |
|
433 state isFinal ifFalse: [ ^ newState retval: self retval ]. |
|
434 |
|
435 (self priority = state priority) ifTrue: [ |
|
436 newState multivalue: true. |
|
437 ^ newState retval: { self retval . state retval }. |
|
438 ]. |
|
439 |
|
440 "Both are final" |
|
441 self priority isNil ifTrue: [ |
|
442 ^ newState retval: state retval. |
|
443 ]. |
|
444 |
|
445 state priority isNil ifTrue: [ |
|
446 ^ newState retval: self retval. |
|
447 ]. |
|
448 |
|
449 (self priority > state priority) ifTrue: [ |
|
450 ^ newState retval: self retval. |
|
451 ]. |
|
452 |
|
453 ^ newState retval: state retval. |
|
454 ! ! |
|
455 |