Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 394 lines (350 sloc) 10.08 kB
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
1
2
3 .namespace [ "PGE::P5Regex" ]
4
5 .sub "compile_p5regex"
6 .param pmc source
7 .param pmc adverbs :slurpy :named
8
9 $I0 = exists adverbs['name']
10 if $I0 goto adverbs_1
11 adverbs['name'] = '_p5regex'
12 adverbs_1:
13 $I0 = exists adverbs['grammar']
14 if $I0 goto adverbs_2
1c757c9 @pmichaud [PGE]:
pmichaud authored
15 adverbs['grammar'] = 'PGE::Grammar'
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
16 adverbs_2:
17
18 .local string target
19 target = adverbs['target']
e1f7b0c @pmichaud [PGE]:
pmichaud authored
20 target = downcase target
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
21
22 .local pmc match
e1f7b0c @pmichaud [PGE]:
pmichaud authored
23 $P0 = get_global "p5regex"
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
24 match = $P0(source)
25 if target != 'parse' goto check
26 .return (match)
27
28 check:
29 unless match goto check_1
30 $S0 = source
31 $S1 = match
32 if $S0 == $S1 goto analyze
33 check_1:
34 null $P0
35 .return ($P0)
36
37 analyze:
38 .local pmc exp, pad
39 exp = match['expr']
b3ef02f @pmichaud [pge]:
pmichaud authored
40 pad = new 'Hash'
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
41 pad['subpats'] = 0
42 exp = exp.'p5analyze'(pad)
e1f7b0c @pmichaud [PGE]:
pmichaud authored
43 .return exp.'compile'(adverbs :flat :named)
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
44 .end
45
46
47 .sub "p5regex"
48 .param pmc mob
49 .local pmc optable
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
50 optable = get_hll_global ["PGE::P5Regex"], "$optable"
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
51 $P0 = optable."parse"(mob)
52 .return ($P0)
53 .end
54
55
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
56 .include "cclass.pasm"
57
58 .const int PGE_INF = 2147483647
59
60 .sub "__onload" :load
61 .local pmc optable
62
63 $I0 = find_type "PGE::OPTable"
64 optable = new $I0
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
65 set_hll_global ["PGE::P5Regex"], "$optable", optable
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
66
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
67 $P0 = get_hll_global ["PGE::P5Regex"], "parse_lit"
0700c33 @particle [PGE]: convert deprecated 'addtok' calls to 'newtok'
particle authored
68 optable.newtok('term:', 'precedence'=>'=', 'nows'=>1, 'parsed'=>$P0)
69
c82c9aa @pmichaud [pge]:
pmichaud authored
70 optable.newtok('term:\b', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
71 optable.newtok('term:\B', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
0700c33 @particle [PGE]: convert deprecated 'addtok' calls to 'newtok'
particle authored
72 optable.newtok('term:^', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
73 optable.newtok('term:$', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
74
c82c9aa @pmichaud [pge]:
pmichaud authored
75 optable.newtok('term:\d', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
76 optable.newtok('term:\D', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
77 optable.newtok('term:\s', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
78 optable.newtok('term:\S', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
79 optable.newtok('term:\w', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
80 optable.newtok('term:\W', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
0700c33 @particle [PGE]: convert deprecated 'addtok' calls to 'newtok'
particle authored
81
82 optable.newtok('circumfix:( )', 'equiv'=>'term:', 'nows'=>1, 'nullterm'=>1, 'match'=>'PGE::Exp::CGroup')
83 optable.newtok('circumfix:(?: )', 'equiv'=>'term:', 'nows'=>1, 'nullterm'=>1, 'match'=>'PGE::Exp::Group')
84
85 $P0 = get_hll_global ['PGE::P5Regex'], 'parse_enumclass'
86 optable.newtok('term:[', 'precedence'=>'=', 'nows'=>1, 'parsed'=>$P0)
87 optable.newtok('term:.', 'precedence'=>'=', 'nows'=>1, 'parsed'=>$P0)
88
89 $P0 = get_hll_global ['PGE::P5Regex'], 'parse_quant'
404a2a7 [callin convs] attempt to fix t/op/calling_95
Leopold Toetsch authored
90 optable.newtok('postfix:*', 'looser'=>'term:', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
0700c33 @particle [PGE]: convert deprecated 'addtok' calls to 'newtok'
particle authored
91 optable.newtok('postfix:+', 'equiv'=>'postfix:*', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
92 optable.newtok('postfix:?', 'equiv'=>'postfix:*', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
93 optable.newtok('postfix:{', 'equiv'=>'postfix:*', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
94
95 optable.newtok('infix:', 'looser'=>'postfix:*', 'right'=>1, 'nows'=>1, 'match'=>'PGE::Exp::Concat')
96 optable.newtok('infix:|', 'looser'=>'infix:', 'left'=>1, 'nows'=>1, 'match'=>'PGE::Exp::Alt')
97
98 optable.newtok('close:}', 'looser'=>'infix:|', 'nows'=>1) # XXX: hack
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
99
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
100 $P0 = get_hll_global ["PGE::P5Regex"], "compile_p5regex"
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
101 compreg "PGE::P5Regex", $P0
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
102 .end
103
104
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
105 .sub 'parse_error'
106 .param pmc mob
107 .param int pos
108 .param string message
abb2d74 @particle [pge]: p5regex compiler now throws exception upon parse error
particle authored
109 $P0 = getattribute mob, '$.pos'
110 $P0 = pos
b3ef02f @pmichaud [pge]:
pmichaud authored
111 $P0 = new 'Exception'
abb2d74 @particle [pge]: p5regex compiler now throws exception upon parse error
particle authored
112 $S0 = 'p5regex parse error: '
113 $S0 .= message
114 $S0 .= ' at offset '
115 $S1 = pos
116 $S0 .= $S1
117 $S0 .= ", found '"
118 $P1 = getattribute mob, '$.target'
119 $S1 = $P1
120 $S1 = substr $S1, pos, 1
121 $S0 .= $S1
122 $S0 .= "'"
123 $P0['_message'] = $S0
124 throw $P0
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
125 .return ()
126 .end
127
128
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
129 .sub "parse_lit"
130 .param pmc mob
131 .local pmc newfrom
132 .local string target
133 .local int pos, lastpos
134 .local int litstart, litlen
135 .local string initchar
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
136 newfrom = get_hll_global ["PGE::Match"], "newfrom"
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
137 (mob, target, $P0, $P1) = newfrom(mob, 0, "PGE::Exp::Literal")
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
138 pos = $P0
139 lastpos = length target
140 initchar = substr target, pos, 1
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
141 unless initchar == '*' goto initchar_ok
142 parse_error(mob, pos, "Quantifier follows nothing")
143
144 initchar_ok:
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
145 if initchar == ')' goto end
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
146 inc pos
147 if initchar != "\\" goto term_literal
148 term_backslash:
149 initchar = substr target, pos, 1
150 inc pos
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
151 if pos <= lastpos goto term_backslash_ok
152 parse_error(mob, pos, "Search pattern not terminated")
153 term_backslash_ok:
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
154 $I0 = index "nrteab", initchar
155 if $I0 < 0 goto term_literal
156 initchar = substr "\n\r\t\e\a\b", $I0, 1
157 term_literal:
158 litstart = pos
159 litlen = 0
160 term_literal_loop:
161 if pos >= lastpos goto term_literal_end
162 $S0 = substr target, pos, 1
163 $I0 = index "[](){}*?+\\|^$.", $S0
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
164 # if not in circumfix:( ) throw error on end paren
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
165 if $I0 >= 0 goto term_literal_end
166 inc pos
167 inc litlen
168 goto term_literal_loop
169 term_literal_end:
170 if litlen < 1 goto term_literal_one
171 dec pos
172 term_literal_one:
173 $I0 = pos - litstart
174 $S0 = substr target, litstart, $I0
175 $S0 = concat initchar, $S0
19472de @pmichaud Change 'value' method to 'result_object' method, to address
pmichaud authored
176 mob.'result_object'($S0)
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
177 goto end
178 end:
56a089a @pmichaud Converted PGE's internal object attributes to use updated sigils and
pmichaud authored
179 $P0 = getattribute mob, "PGE::Match\x0$.pos"
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
180 $P0 = pos
181 .return (mob)
182 .end
183
184 .sub "parse_quant"
185 .param pmc mob
186 .local string target
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
187 .local int min, max, backtrack
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
188 .local int pos, lastpos
189 .local pmc mfrom, mpos
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
190 .local string key
191 key = mob['KEY']
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
192 $P0 = get_hll_global ["PGE::Match"], "newfrom"
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
193 (mob, target, mfrom, mpos) = $P0(mob, 0, "PGE::Exp::Quant")
194 pos = mfrom
195 lastpos = length target
196 min = 0
197 max = PGE_INF
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
198 backtrack = 0
199 if key == '{' goto quant_range
200 if key != '+' goto quant_max
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
201 min = 1
202 quant_max:
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
203 if key != "?" goto quant_lazy
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
204 max = 1
205 goto quant_lazy
206 quant_range:
207 $I1 = find_not_cclass .CCLASS_NUMERIC, target, pos, lastpos
208 if $I1 <= pos goto quant_range_max
209 $S0 = substr target, pos
210 min = $S0
211 max = $S0
212 pos = $I1
213 quant_range_max:
214 $S0 = substr target, pos, 1
215 if $S0 != "," goto quant_range_end
216 inc pos
217 max = PGE_INF
218 $I1 = find_not_cclass .CCLASS_NUMERIC, target, pos, lastpos
219 if $I1 <= pos goto quant_range_end
220 $S0 = substr target, pos
221 max = $S0
222 pos = $I1
223 quant_range_end:
224 $S0 = substr target, pos, 1
225 if $S0 != "}" goto err_range
226 inc pos
227 quant_lazy:
228 $S0 = substr target, pos, 1
229 if $S0 != "?" goto end
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
230 backtrack = PGE_BACKTRACK_EAGER
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
231 inc pos
232 end:
233 mob["min"] = min
234 mob["max"] = max
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
235 mob["backtrack"] = backtrack
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
236 mpos = pos
237 .return (mob)
238 err_range:
239 parse_error(mob, pos, "Error in quantified range")
240 .end
241
242
243 .sub parse_group
244 .param pmc mob
245 .local string target
246 .local pmc mfrom, mpos
247 .local int pos, lastpos
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
248 $P0 = get_hll_global ["PGE::Match"], "newfrom"
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
249 (mob, target, mfrom, mpos) = $P0(mob, 0, "PGE::Exp::CGroup")
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
250 pos = mfrom
251 inc pos
252 $S0 = substr target, pos, 2
253 if $S0 == "?:" goto nocapture
254 goto end
255 nocapture:
256 pos += 2
257 end:
258 mpos = pos
259 .return (mob)
260 .end
261
262 .sub "parse_enumclass"
263 .param pmc mob
264 .local string target
265 .local pmc mfrom, mpos
266 .local int pos, lastpos
267 .local int isrange
268 .local string charlist
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
269 .local string key
270 key = mob['KEY']
a96d265 @chipdude Always enclose namespace names in brackets for new pdd21 opcodes.
chipdude authored
271 $P0 = get_hll_global ["PGE::Match"], "newfrom"
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
272 (mob, target, mfrom, mpos) = $P0(mob, 0, "PGE::Exp::EnumCharList")
273 pos = mfrom
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
274 if key == '.' goto dot
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
275 lastpos = length target
276 charlist = ""
277 mob["isnegated"] = 0
278 isrange = 0
279 $S0 = substr target, pos, 1
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
280 if $S0 != "^" goto scan_first
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
281 mob["isnegated"] = 1
282 inc pos
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
283 scan_first:
284 if pos >= lastpos goto err_close
285 $S0 = substr target, pos, 1
286 inc pos
287 if $S0 == "\\" goto backslash
288 goto addchar
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
289 scan:
290 if pos >= lastpos goto err_close
291 $S0 = substr target, pos, 1
292 inc pos
293 if $S0 == "]" goto endclass
294 if $S0 == "-" goto hyphenrange
295 if $S0 != "\\" goto addchar
296 backslash:
297 $S0 = substr target, pos, 1
298 inc pos
299 $I0 = index "nrtfae0b", $S0
300 if $I0 == -1 goto addchar
301 $S0 = substr "\n\r\t\f\a\e\0\b", $I0, 1
302 addchar:
303 if isrange goto addrange
304 charlist .= $S0
305 goto scan
306 addrange:
307 isrange = 0
308 $I2 = ord charlist, -1
309 $I0 = ord $S0
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
310 if $I0 < $I2 goto err_range
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
311 addrange_1:
312 inc $I2
313 if $I2 > $I0 goto scan
314 $S1 = chr $I2
315 charlist .= $S1
316 goto addrange_1
317 hyphenrange:
318 if isrange goto addrange
319 isrange = 1
320 goto scan
321 endclass:
322 if isrange == 0 goto end
323 charlist .= "-"
324 goto end
325 dot:
326 charlist = "\n"
327 mob["isnegated"] = 1
328 end:
329 mpos = pos
19472de @pmichaud Change 'value' method to 'result_object' method, to address
pmichaud authored
330 mob.'result_object'(charlist)
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
331 .return (mob)
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
332
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
333 err_close:
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
334 parse_error(mob, pos, "Unmatched [")
335 err_range:
336 $S0 = 'Invalid [] range "'
337 $S1 = chr $I2
338 $S0 .= $S1
339 $S0 .= '-'
340 $S1 = chr $I0
341 $S0 .= $S1
342 $S0 .= '"'
343 parse_error(mob, pos, $S0)
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
344 .end
1af8ba3 @particle [PGE]: #40106: [PATCH] 15 more tests work for PGE::P5Regex
particle authored
345
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
346
347 .namespace [ "PGE::Exp" ]
348
349 .sub "p5analyze" :method
350 .param pmc pad
351 .local pmc exp
352 $I0 = 0
353 loop:
354 $I1 = defined self[$I0]
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
355 if $I1 == 0 goto end
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
356 $P0 = self[$I0]
357 $P0 = $P0."p5analyze"(pad)
358 self[$I0] = $P0
359 inc $I0
360 goto loop
361 end:
362 .return (self)
363 .end
364
9cbdcbc @pmichaud Merge pge-pm branch with updated PGE into trunk.
pmichaud authored
365 .namespace [ "PGE::Exp::CGroup" ]
c346e6b @pmichaud * Added initial version of compreg "PGE::P5Regexp"
pmichaud authored
366
367 .sub "p5analyze" :method
368 .param pmc pad
369 .local pmc exp
370
371 self["iscapture"] = 0
372 if self != "(" goto end
373 self["iscapture"] = 1
374 self["isscope"] = 0
375 self["isarray"] = 0
376 $I0 = pad["subpats"]
377 self["cname"] = $I0
378 inc $I0
379 pad["subpats"] = $I0
380 end:
381 exp = self[0]
382 exp = exp."p5analyze"(pad)
383 self[0] = exp
384 .return (self)
385 .end
386
387
99869c4 @paultcochrane [pge] Added pir coda as per coding standards (part 5)
paultcochrane authored
388
389 # Local Variables:
390 # mode: pir
391 # fill-column: 100
392 # End:
393 # vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.