|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 Object subclass:#PEGFsaInterpret |
|
6 instanceVariableNames:'fsa debug retvals stream maxPriority' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'PetitCompiler-FSA' |
|
10 ! |
|
11 |
|
12 !PEGFsaInterpret methodsFor:'accessing'! |
|
13 |
|
14 debug |
|
15 ^ debug |
|
16 ! |
|
17 |
|
18 debug: anObject |
|
19 debug := anObject |
|
20 ! |
|
21 |
|
22 fsa |
|
23 ^ fsa |
|
24 ! ! |
|
25 |
|
26 !PEGFsaInterpret methodsFor:'debugging'! |
|
27 |
|
28 reportFsa: anFsa |
|
29 debug ifTrue: [ |
|
30 Transcript show: anFsa asString; cr. |
|
31 ] |
|
32 ! |
|
33 |
|
34 reportStart |
|
35 debug ifTrue: [ |
|
36 Transcript show: '============================'; cr. |
|
37 ] |
|
38 ! |
|
39 |
|
40 reportStates: states |
|
41 debug ifTrue: [ |
|
42 Transcript show: 'states: '; show: states asString; cr |
|
43 ] |
|
44 ! ! |
|
45 |
|
46 !PEGFsaInterpret methodsFor:'initialization'! |
|
47 |
|
48 initialize |
|
49 super initialize. |
|
50 debug := true |
|
51 ! ! |
|
52 |
|
53 !PEGFsaInterpret methodsFor:'running'! |
|
54 |
|
55 interpret |
|
56 | states newStates character run | |
|
57 maxPriority := SmallInteger minVal. |
|
58 newStates := IdentitySet with: fsa startState. |
|
59 retvals := IdentityDictionary new. |
|
60 |
|
61 self recordNewState: fsa startState position: 0. |
|
62 |
|
63 self reportStart. |
|
64 self reportFsa: fsa. |
|
65 |
|
66 run := stream atEnd not. |
|
67 |
|
68 [run] whileTrue: [ |
|
69 states := newStates. |
|
70 newStates := IdentitySet new. |
|
71 character := stream peek. |
|
72 |
|
73 self reportStates: states. |
|
74 |
|
75 states do: [ :state | |
|
76 self expand: state on: character into: newStates. |
|
77 ]. |
|
78 |
|
79 newStates isEmpty ifFalse: [ stream next ]. |
|
80 run := stream atEnd not and: [ newStates isEmpty not ]. |
|
81 ]. |
|
82 |
|
83 ^ self return: newStates |
|
84 ! |
|
85 |
|
86 interpret: anFsa on: aStream |
|
87 fsa := anFsa. |
|
88 stream := aStream. |
|
89 |
|
90 ^ self interpret |
|
91 ! ! |
|
92 |
|
93 !PEGFsaInterpret methodsFor:'running support'! |
|
94 |
|
95 allowsTransition: t from: state transitionsTaken: transitionsTaken |
|
96 " (state hasPriority) ifTrue: [ |
|
97 ^ state priority <= t priority |
|
98 ]. |
|
99 " |
|
100 "state hasPriority ifTrue: [ " |
|
101 " transitionsTaken isEmpty ifTrue: [ ^ true ]. |
|
102 ^ transitionsTaken anyOne priority <= t priority. |
|
103 " "]." |
|
104 ^ true |
|
105 ! |
|
106 |
|
107 expand: state on: character into: newStates "transitionsTaken: transitionsTaken" |
|
108 | transitions transitionsTaken | |
|
109 |
|
110 transitionsTaken := OrderedCollection new. |
|
111 transitions := self sortedTransitionsFor: state. |
|
112 transitions do: [ :t | |
|
113 (self allowsTransition: t from: state transitionsTaken: transitionsTaken) ifTrue: [ |
|
114 t isEpsilon ifTrue: [ |
|
115 (t destination isFinal) ifTrue: [ |
|
116 newStates add: t destination. |
|
117 self recordNewState: t destination position: stream position. |
|
118 ]. |
|
119 |
|
120 "Descent into the next state" |
|
121 self expand: t destination |
|
122 on: character |
|
123 into: newStates. |
|
124 |
|
125 newStates isEmpty ifFalse: [ |
|
126 transitionsTaken add: t. |
|
127 ]. |
|
128 |
|
129 ] ifFalse: [ |
|
130 (t accepts: character) ifTrue: [ |
|
131 transitionsTaken add: t. |
|
132 newStates add: t destination. |
|
133 self recordNewState: t destination. |
|
134 ] |
|
135 ] |
|
136 ] |
|
137 ] |
|
138 ! |
|
139 |
|
140 recordNewState: state |
|
141 ^ self recordNewState: state position: stream position + 1 |
|
142 ! |
|
143 |
|
144 recordNewState: state position: position |
|
145 (state isFinal) ifFalse: [ ^ self ]. |
|
146 (maxPriority > state priority) ifTrue: [ ^ true ]. |
|
147 |
|
148 self assert: state hasPriority description: 'final state must have priority'. |
|
149 (maxPriority < state priority) ifTrue: [ |
|
150 retvals := IdentityDictionary new. |
|
151 maxPriority := state priority. |
|
152 ]. |
|
153 |
|
154 |
|
155 state retvalAsCollection do: [ :r | |
|
156 retvals at: r put: position |
|
157 ]. |
|
158 ! |
|
159 |
|
160 return: states |
|
161 | priority priorities | |
|
162 priorities := (states select: #hasPriority thenCollect: #priority). |
|
163 priorities isEmpty ifTrue: [ |
|
164 ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ] |
|
165 ]. |
|
166 |
|
167 priority := priorities max. |
|
168 |
|
169 (maxPriority < priority) ifTrue: [ ^ IdentityDictionary new ]. |
|
170 ^ retvals keysAndValuesRemove: [ :key :value | key class == PEGFsaFailure ] |
|
171 ! |
|
172 |
|
173 sortedTransitionsFor: state |
|
174 ^ (fsa transitionsFor: state) asOrderedCollection |
|
175 "Dear future me, enjoy this:" |
|
176 " sort: [ :e1 :e2 | (e1 isEpsilon not and: [e2 isEpsilon]) not ])" |
|
177 sort: [ :e1 :e2 | e1 priority > e2 priority ] |
|
178 |
|
179 ! ! |
|
180 |