|
1 "{ Package: 'stx:goodies/petitparser/islands' }" |
|
2 |
|
3 PPParser subclass:#PPIsland |
|
4 instanceVariableNames:'island afterWaterParser beforeWaterParser context |
|
5 afterWaterDelegate beforeWaterDelegate water' |
|
6 classVariableNames:'' |
|
7 poolDictionaries:'' |
|
8 category:'PetitIslands-Parsers' |
|
9 ! |
|
10 |
|
11 PPIsland comment:'A PPIsland allows for imprecise parsing. One can create it on a parser p by calling: ''p island'' E.g.: |
|
12 |
|
13 p := x, a island, y accepts following inputs: |
|
14 x.....a.....b |
|
15 xab |
|
16 |
|
17 yet fails on: |
|
18 x....a....c |
|
19 xb |
|
20 xac |
|
21 x..b....a....b |
|
22 |
|
23 The input represented by dots is called water and water can appear before and after the island. Use it, if you don''t want to define all the grammar rules and you want to skip something. |
|
24 |
|
25 I am still an experiment, but if you know how to improve me, please contact Jan Kurs at: kurs@iam.unibe.ch |
|
26 |
|
27 Instance Variables |
|
28 afterWaterParser: <Object> |
|
29 awp: <Object> |
|
30 beforeWaterParser: <Object> |
|
31 bwp: <Object> |
|
32 context: <Object> |
|
33 island: <Object> |
|
34 |
|
35 afterWaterParser |
|
36 - xxxxx |
|
37 |
|
38 awp |
|
39 - xxxxx |
|
40 |
|
41 beforeWaterParser |
|
42 - xxxxx |
|
43 |
|
44 bwp |
|
45 - xxxxx |
|
46 |
|
47 context |
|
48 - xxxxx |
|
49 |
|
50 island |
|
51 - xxxxx |
|
52 ' |
|
53 ! |
|
54 |
|
55 !PPIsland methodsFor:'accessing'! |
|
56 |
|
57 children |
|
58 |
|
59 ^ Array with: water with: island with: water |
|
60 ! |
|
61 |
|
62 followSet: aPPContext |
|
63 |
|
64 ^ aPPContext root followSets at: self. |
|
65 ! |
|
66 |
|
67 initialize |
|
68 super initialize. |
|
69 water := #any asParser name: 'water'; yourself. |
|
70 ! |
|
71 |
|
72 island |
|
73 |
|
74 ^ island |
|
75 ! |
|
76 |
|
77 island: anObject |
|
78 island := anObject. |
|
79 ! |
|
80 |
|
81 nextSet: aPPContext |
|
82 |
|
83 ^ aPPContext root nextSets at: self. |
|
84 ! |
|
85 |
|
86 replace: parser with: anotherParser |
|
87 super replace: parser with: anotherParser. |
|
88 |
|
89 (water == parser) ifTrue: [ water := anotherParser ]. |
|
90 (island == parser) ifTrue: [ island := anotherParser ]. |
|
91 ! |
|
92 |
|
93 water |
|
94 ^ water |
|
95 ! |
|
96 |
|
97 water: aPPParser |
|
98 water := aPPParser |
|
99 ! ! |
|
100 |
|
101 !PPIsland methodsFor:'memoization'! |
|
102 |
|
103 memoized |
|
104 ^ PPMemoizingIsland new |
|
105 island: self island; |
|
106 water: water; |
|
107 yourself |
|
108 ! |
|
109 |
|
110 reset: aPPContext |
|
111 context := aPPContext. |
|
112 beforeWaterParser := nil. |
|
113 afterWaterParser := nil. |
|
114 ! ! |
|
115 |
|
116 !PPIsland methodsFor:'parsing'! |
|
117 |
|
118 afterWaterParser: aPPContext |
|
119 context == aPPContext ifFalse: [ self reset: aPPContext ]. |
|
120 |
|
121 afterWaterParser ifNil: [ |
|
122 afterWaterParser := self createAfterWaterParser: aPPContext. |
|
123 ]. |
|
124 ^ afterWaterParser |
|
125 ! |
|
126 |
|
127 beforeWaterParser: aPPContext |
|
128 context == aPPContext ifFalse: [ self reset: aPPContext ]. |
|
129 |
|
130 beforeWaterParser ifNil: [ |
|
131 beforeWaterParser := self createBeforeWaterParser: aPPContext. |
|
132 ]. |
|
133 ^ beforeWaterParser |
|
134 ! |
|
135 |
|
136 createAfterWaterParser: aPPContext |
|
137 | nextSet p | |
|
138 |
|
139 nextSet := Set new. |
|
140 nextSet addAll: (self nextSet: aPPContext). |
|
141 nextSet add: PPInputEnds new. |
|
142 |
|
143 nextSet := nextSet collect: [ :e | PPNonEmptyParser on: e ]. |
|
144 |
|
145 p := (PPChoiceParser withAll: nextSet) not. |
|
146 ^ PPWater on: p waterToken: water |
|
147 ! |
|
148 |
|
149 createBeforeWaterParser: aPPContext |
|
150 | nextSet p | |
|
151 nextSet := Set new. |
|
152 nextSet addAll: (self nextSet: aPPContext). |
|
153 nextSet add: PPInputEnds new. |
|
154 |
|
155 nextSet := nextSet collect: [:e | PPNonEmptyParser on: e]. |
|
156 |
|
157 p := (PPChoiceParser withAll: nextSet) not, (PPNonEmptyParser on: island) not. |
|
158 ^ PPWater on: p waterToken: water. |
|
159 ! |
|
160 |
|
161 exampleOn: aStream |
|
162 aStream nextPutAll: '~~~~ '. |
|
163 island exampleOn: aStream . |
|
164 aStream nextPutAll: ' ~~~~'. |
|
165 ! |
|
166 |
|
167 parseAfterWater: aPPContext |
|
168 ^ (self afterWaterParser: aPPContext) parseOn: aPPContext . |
|
169 ! |
|
170 |
|
171 parseBeforeWater: aPPContext |
|
172 ^ (self beforeWaterParser: aPPContext) parseOn: aPPContext. |
|
173 ! |
|
174 |
|
175 parseOn: aPPContext |
|
176 | bwr awr result retval memento | |
|
177 |
|
178 memento := aPPContext remember. |
|
179 "Halt ifShiftPressed." |
|
180 |
|
181 bwr := self parseBeforeWater: aPPContext. |
|
182 bwr isPetitFailure ifTrue: |
|
183 [ |
|
184 self error: 'IMO should never happen'. |
|
185 ]. |
|
186 |
|
187 "JK: HACK ALERT, FIX!!" |
|
188 (aPPContext waterPosition == aPPContext position) ifTrue:[ |
|
189 result := (PPNonEmptyParser on: island) parseOn: aPPContext. |
|
190 ] ifFalse: [ |
|
191 result := island parseOn: aPPContext. |
|
192 ]. |
|
193 |
|
194 |
|
195 result isPetitFailure ifTrue: [ |
|
196 retval := PPFailure message: 'Island not found between ', memento position asString, ' and ', aPPContext position asString context: aPPContext. |
|
197 aPPContext restore: memento. |
|
198 ^ retval |
|
199 ]. |
|
200 |
|
201 |
|
202 awr := self parseAfterWater: aPPContext. |
|
203 awr isPetitFailure ifTrue: |
|
204 [ |
|
205 retval := PPFailure message: 'IMO should not happen :(' context: aPPContext. |
|
206 aPPContext restore: memento. |
|
207 ^ retval. |
|
208 ]. |
|
209 |
|
210 retval := OrderedCollection with: bwr with: result with: awr. |
|
211 ^ retval |
|
212 |
|
213 |
|
214 ! |
|
215 |
|
216 waterToken |
|
217 | waterObjects | |
|
218 self halt: 'deprecated?'. |
|
219 waterObjects := self globalAt: #waterObjects ifAbsent: [ OrderedCollection new ]. |
|
220 waterObjects add: #any asParser. |
|
221 ^ PPChoiceParser withAll: waterObjects. |
|
222 ! ! |
|
223 |
|
224 !PPIsland methodsFor:'queries'! |
|
225 |
|
226 acceptsEpsilon |
|
227 "JK: Hack alert?" |
|
228 "Let us suppose island is always nullable, it helps to sequences of islands" |
|
229 ^ true |
|
230 "^ island isNullableOpenSet: (IdentitySet with: self)" |
|
231 ! |
|
232 |
|
233 acceptsEpsilonOpenSet: set |
|
234 "JK: Hack alert?" |
|
235 ^ true |
|
236 " ^ island isNullableOpenSet: set" |
|
237 ! |
|
238 |
|
239 name |
|
240 ^ super name ifNil: [ 'an island ']. |
|
241 ! ! |
|
242 |