|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 PPStream subclass:#PPCContext |
|
4 instanceVariableNames:'root properties globals furthestFailure compiledParser rc ws' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'PetitCompiler-Context' |
|
8 ! |
|
9 |
|
10 PPCContext comment:'' |
|
11 ! |
|
12 |
|
13 !PPCContext class methodsFor:'as yet unclassified'! |
|
14 |
|
15 new |
|
16 ^ self basicNew initialize |
|
17 ! |
|
18 |
|
19 on: aPPParser stream: aStream |
|
20 ^ self basicNew |
|
21 initialize; |
|
22 root: aPPParser; |
|
23 stream: aStream asPetitStream; |
|
24 yourself |
|
25 ! ! |
|
26 |
|
27 !PPCContext methodsFor:'accessing-globals'! |
|
28 |
|
29 globalAt: aKey |
|
30 "Answer the global property value associated with aKey." |
|
31 |
|
32 ^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ] |
|
33 ! |
|
34 |
|
35 globalAt: aKey ifAbsent: aBlock |
|
36 "Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." |
|
37 |
|
38 ^ globals isNil |
|
39 ifTrue: [ aBlock value ] |
|
40 ifFalse: [ globals at: aKey ifAbsent: aBlock ] |
|
41 ! |
|
42 |
|
43 globalAt: aKey ifAbsentPut: aBlock |
|
44 "Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." |
|
45 |
|
46 ^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ] |
|
47 ! |
|
48 |
|
49 globalAt: aKey put: anObject |
|
50 "Set the global property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." |
|
51 |
|
52 ^ (globals ifNil: [ globals := Dictionary new: 1 ]) |
|
53 at: aKey put: anObject |
|
54 ! |
|
55 |
|
56 hasGlobal: aKey |
|
57 "Test if the global property aKey is present." |
|
58 |
|
59 ^ globals notNil and: [ globals includesKey: aKey ] |
|
60 ! |
|
61 |
|
62 invoke: parser |
|
63 ^ parser parseOn: self |
|
64 ! |
|
65 |
|
66 peek2 |
|
67 position = readLimit ifTrue: [ ^ nil ]. |
|
68 ^ collection at: (position + 1) |
|
69 ! |
|
70 |
|
71 removeGlobal: aKey |
|
72 "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." |
|
73 |
|
74 ^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ] |
|
75 ! |
|
76 |
|
77 removeGlobal: aKey ifAbsent: aBlock |
|
78 "Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." |
|
79 |
|
80 | answer | |
|
81 globals isNil ifTrue: [ ^ aBlock value ]. |
|
82 answer := globals removeKey: aKey ifAbsent: aBlock. |
|
83 globals isEmpty ifTrue: [ globals := nil ]. |
|
84 ^ answer |
|
85 ! ! |
|
86 |
|
87 !PPCContext methodsFor:'accessing-properties'! |
|
88 |
|
89 hasProperty: aKey |
|
90 "Test if the property aKey is present." |
|
91 |
|
92 ^ properties notNil and: [ properties includesKey: aKey ] |
|
93 ! |
|
94 |
|
95 propertyAt: aKey |
|
96 "Answer the property value associated with aKey." |
|
97 |
|
98 ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ] |
|
99 ! |
|
100 |
|
101 propertyAt: aKey ifAbsent: aBlock |
|
102 "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." |
|
103 |
|
104 ^ properties isNil |
|
105 ifTrue: [ aBlock value ] |
|
106 ifFalse: [ properties at: aKey ifAbsent: aBlock ] |
|
107 ! |
|
108 |
|
109 propertyAt: aKey ifAbsentPut: aBlock |
|
110 "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." |
|
111 |
|
112 ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] |
|
113 ! |
|
114 |
|
115 propertyAt: aKey put: anObject |
|
116 "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." |
|
117 |
|
118 ^ (properties ifNil: [ properties := Dictionary new: 1 ]) |
|
119 at: aKey put: anObject |
|
120 ! |
|
121 |
|
122 removeProperty: aKey |
|
123 "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." |
|
124 |
|
125 ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ] |
|
126 ! |
|
127 |
|
128 removeProperty: aKey ifAbsent: aBlock |
|
129 "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." |
|
130 |
|
131 | answer | |
|
132 properties isNil ifTrue: [ ^ aBlock value ]. |
|
133 answer := properties removeKey: aKey ifAbsent: aBlock. |
|
134 properties isEmpty ifTrue: [ properties := nil ]. |
|
135 ^ answer |
|
136 ! ! |
|
137 |
|
138 !PPCContext methodsFor:'acessing'! |
|
139 |
|
140 hash |
|
141 ^ collection hash |
|
142 ! |
|
143 |
|
144 initializeFor: parser |
|
145 parser == root ifTrue: [ ^ self ]. |
|
146 |
|
147 root := parser. |
|
148 root allParsersDo: [ :p | |
|
149 p updateContext: self |
|
150 ] |
|
151 ! |
|
152 |
|
153 root |
|
154 ^ root |
|
155 ! |
|
156 |
|
157 stream |
|
158 ^ self |
|
159 ! |
|
160 |
|
161 stream: aStream |
|
162 collection := aStream collection. |
|
163 position := aStream position. |
|
164 readLimit := collection size. |
|
165 ! ! |
|
166 |
|
167 !PPCContext methodsFor:'as yet unclassified'! |
|
168 |
|
169 atWs |
|
170 ^ position = ws |
|
171 ! |
|
172 |
|
173 goUpTo: char |
|
174 [ position < readLimit ] whileTrue: [ |
|
175 (collection at: position + 1) = char ifTrue: [ position := position + 1. ^ char ] . |
|
176 position := position + 1. |
|
177 ] |
|
178 |
|
179 ! |
|
180 |
|
181 setWs |
|
182 ^ ws := position |
|
183 ! |
|
184 |
|
185 ws |
|
186 ^ ws |
|
187 ! |
|
188 |
|
189 ws: anInteger |
|
190 ws := anInteger |
|
191 ! ! |
|
192 |
|
193 !PPCContext methodsFor:'converting'! |
|
194 |
|
195 asCompiledParserContext |
|
196 ^ self |
|
197 ! ! |
|
198 |
|
199 !PPCContext methodsFor:'failures'! |
|
200 |
|
201 furthestFailure |
|
202 ^ furthestFailure |
|
203 ! |
|
204 |
|
205 noteFailure: aPPFailure |
|
206 (aPPFailure position > furthestFailure position) |
|
207 ifTrue: [ furthestFailure := aPPFailure ]. |
|
208 ! ! |
|
209 |
|
210 !PPCContext methodsFor:'initialization'! |
|
211 |
|
212 compiledParser |
|
213 ^ compiledParser |
|
214 ! |
|
215 |
|
216 compiledParser: anObject |
|
217 compiledParser := anObject |
|
218 ! |
|
219 |
|
220 initialize |
|
221 |
|
222 rc := 0. |
|
223 "Note a failure at -1" |
|
224 furthestFailure := PPFailure new position: -1; yourself. |
|
225 ! ! |
|
226 |
|
227 !PPCContext methodsFor:'memoization'! |
|
228 |
|
229 lwRemember |
|
230 |
|
231 ^ position |
|
232 ! |
|
233 |
|
234 lwRestore: aPPContextMemento |
|
235 |
|
236 position := aPPContextMemento. |
|
237 ! |
|
238 |
|
239 remember |
|
240 | memento | |
|
241 " |
|
242 ^ position |
|
243 " |
|
244 memento := PPCContextMemento new |
|
245 position: position; |
|
246 yourself. |
|
247 |
|
248 self rememberProperties: memento. |
|
249 "JK: Just while developing" |
|
250 rc := rc + 1. |
|
251 (rc > ((self size + 1)* 1000*1000)) ifTrue: [ self error: 'Hey, this is not normal, is it?' ]. |
|
252 ^ memento |
|
253 ! |
|
254 |
|
255 rememberProperties: aPPContextMemento |
|
256 properties ifNil: [ ^ self ]. |
|
257 |
|
258 properties keysAndValuesDo: [ :key :value | |
|
259 aPPContextMemento propertyAt: key put: value |
|
260 ]. |
|
261 ! |
|
262 |
|
263 restore: aPPContextMemento |
|
264 " |
|
265 position := aPPContextMemento. |
|
266 " |
|
267 position := aPPContextMemento position. |
|
268 |
|
269 self restoreProperties: aPPContextMemento. |
|
270 |
|
271 ! |
|
272 |
|
273 restoreProperties: aPPContextMemento |
|
274 aPPContextMemento keysAndValuesDo: [ :key :value | |
|
275 self propertyAt: key put: value |
|
276 ]. |
|
277 ! ! |
|
278 |