Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 449 lines (373 sloc) 17.405 kb
3ebfa07 @abw Initial revision
authored
1 #============================================================= -*-Perl-*-
2 #
3 # Parser.yp
4 #
5 # DESCRIPTION
6 # Definition of the parser grammar for the Template Toolkit language.
7 #
8 # AUTHOR
512be2b @abw updated email/copyright
authored
9 # Andy Wardley <abw@wardley.org>
3ebfa07 @abw Initial revision
authored
10 #
11 # HISTORY
12 # Totally re-written for version 2, based on Doug Steinwand's
13 # implementation which compiles templates to Perl code. The generated
14 # code is _considerably_ faster, more portable and easier to process.
15 #
16 # WARNINGS
17 # Expect 1 reduce/reduce conflict. This can safely be ignored.
f4df3b6 @abw approach v2.03
authored
18 # Now also expect 1 shift/reduce conflict, created by adding a rule
19 # to 'args' to allow assignments of the form 'foo.bar = baz'. It
20 # should be possible to fix the problem by rewriting some rules, but
21 # I'm loathed to hack it up too much right now. Maybe later.
3ebfa07 @abw Initial revision
authored
22 #
23 # COPYRIGHT
512be2b @abw updated email/copyright
authored
24 # Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
25 # Copyright (C) 1998-2004 Canon Research Centre Europe Ltd.
3ebfa07 @abw Initial revision
authored
26 #
27 # This module is free software; you can redistribute it and/or
28 # modify it under the same terms as Perl itself.
29 #
30 #------------------------------------------------------------------------
31 #
32 # NOTE: this module is constructed from the parser/Grammar.pm.skel
33 # file by running the parser/yc script. You only need to do this if
34 # you have modified the grammar in the parser/Parser.yp file and need
35 # to-recompile it. See the README in the 'parser' directory for more
36 # information (sub-directory of the Template distribution).
37 #
38 #------------------------------------------------------------------------
39 #
40 # $Id$
41 #
42 #========================================================================
43
44 %right ASSIGN
45 %right '?' ':'
46 %left COMMA
47 %left AND OR
48 %left NOT
a2ca2c1 @abw commit for 2.06b
authored
49 %left CAT
3ebfa07 @abw Initial revision
authored
50 %left DOT
51 %left CMPOP
52 %left BINOP
36ff03e @abw *** empty log message ***
authored
53 %left '+'
3ebfa07 @abw Initial revision
authored
54 %left '/'
d52480d @abw *** empty log message ***
authored
55 %left DIV
56 %left MOD
3ebfa07 @abw Initial revision
authored
57 %left TO
58 %%
59
60 #--------------------------------------------------------------------------
61 # START AND TOP-LEVEL RULES
62 #--------------------------------------------------------------------------
63
6966839 @abw fixed whitespace damage
authored
64 template: block { $factory->template($_[1]) }
3ebfa07 @abw Initial revision
authored
65 ;
66
6966839 @abw fixed whitespace damage
authored
67 block: chunks { $factory->block($_[1]) }
68 | /* NULL */ { $factory->block() }
3ebfa07 @abw Initial revision
authored
69 ;
70
6966839 @abw fixed whitespace damage
authored
71 chunks: chunks chunk { push(@{$_[1]}, $_[2])
72 if defined $_[2]; $_[1] }
73 | chunk { defined $_[1] ? [ $_[1] ] : [ ] }
3ebfa07 @abw Initial revision
authored
74 ;
75
6966839 @abw fixed whitespace damage
authored
76 chunk: TEXT { $factory->textblock($_[1]) }
77 | statement ';' { return '' unless $_[1];
78 $_[0]->location() . $_[1];
79 }
3ebfa07 @abw Initial revision
authored
80 ;
81
02b01d7 @abw * added file/line reporting
authored
82 statement: directive
6966839 @abw fixed whitespace damage
authored
83 | defblock
84 | anonblock
85 | capture
86 | macro
87 | use
88 | view
89 | rawperl
90 | expr { $factory->get($_[1]) }
91 | META metadata { $_[0]->add_metadata($_[2]); }
92 | /* empty statement */
3ebfa07 @abw Initial revision
authored
93 ;
94
6966839 @abw fixed whitespace damage
authored
95 directive: setlist { $factory->set($_[1]) }
96 | atomdir
97 | condition
98 | switch
99 | loop
100 | try
101 | perl
3ebfa07 @abw Initial revision
authored
102 ;
103
104
105 #--------------------------------------------------------------------------
106 # DIRECTIVE RULES
107 #--------------------------------------------------------------------------
108
6966839 @abw fixed whitespace damage
authored
109 atomexpr: expr { $factory->get($_[1]) }
110 | atomdir
111 ;
112
113 atomdir: GET expr { $factory->get($_[2]) }
114 | CALL expr { $factory->call($_[2]) }
115 | SET setlist { $factory->set($_[2]) }
116 | DEFAULT setlist { $factory->default($_[2]) }
117 | INSERT nameargs { $factory->insert($_[2]) }
118 | INCLUDE nameargs { $factory->include($_[2]) }
119 | PROCESS nameargs { $factory->process($_[2]) }
120 | THROW nameargs { $factory->throw($_[2]) }
121 | RETURN { $factory->return() }
122 | STOP { $factory->stop() }
123 | CLEAR { "\$output = '';"; }
5a89101 @abw Fixed a bug in the parser/grammar to make NEXT/LAST work correctly in…
authored
124 | LAST { $_[0]->block_label('last ', ';') }
125 | NEXT { $_[0]->in_block('FOR')
126 ? $factory->next($_[0]->block_label)
127 : $_[0]->block_label('next ', ';') }
6966839 @abw fixed whitespace damage
authored
128 | DEBUG nameargs { if ($_[2]->[0]->[0] =~ /^'(on|off)'$/) {
129 $_[0]->{ DEBUG_DIRS } = ($1 eq 'on');
130 $factory->debug($_[2]);
131 }
132 else {
133 $_[0]->{ DEBUG_DIRS } ? $factory->debug($_[2]) : '';
134 }
135 }
052df3e @abw *** empty log message ***
authored
136 | wrapper
6966839 @abw fixed whitespace damage
authored
137 | filter
3ebfa07 @abw Initial revision
authored
138 ;
139
140 condition: IF expr ';'
6966839 @abw fixed whitespace damage
authored
141 block else END { $factory->if(@_[2, 4, 5]) }
142 | atomexpr IF expr { $factory->if(@_[3, 1]) }
143 | UNLESS expr ';'
144 block else END { $factory->if("!($_[2])", @_[4, 5]) }
145 | atomexpr UNLESS expr { $factory->if("!($_[3])", $_[1]) }
3ebfa07 @abw Initial revision
authored
146 ;
147
6966839 @abw fixed whitespace damage
authored
148 else: ELSIF expr ';'
149 block else { unshift(@{$_[5]}, [ @_[2, 4] ]);
150 $_[5]; }
151 | ELSE ';' block { [ $_[3] ] }
152 | /* NULL */ { [ undef ] }
3ebfa07 @abw Initial revision
authored
153 ;
154
6966839 @abw fixed whitespace damage
authored
155 switch: SWITCH expr ';'
156 block case END { $factory->switch(@_[2, 5]) }
3ebfa07 @abw Initial revision
authored
157 ;
158
6966839 @abw fixed whitespace damage
authored
159 case: CASE term ';' block
160 case { unshift(@{$_[5]}, [ @_[2, 4] ]);
161 $_[5]; }
162 | CASE DEFAULT ';' block { [ $_[4] ] }
163 | CASE ';' block { [ $_[3] ] }
164 | /* NULL */ { [ undef ] }
3ebfa07 @abw Initial revision
authored
165 ;
166
5a89101 @abw Fixed a bug in the parser/grammar to make NEXT/LAST work correctly in…
authored
167 loop: FOR loopvar ';' { $_[0]->enter_block('FOR') }
168 block END { $factory->foreach(@{$_[2]}, $_[5], $_[0]->leave_block) }
6966839 @abw fixed whitespace damage
authored
169 | atomexpr FOR loopvar { $factory->foreach(@{$_[3]}, $_[1]) }
5a89101 @abw Fixed a bug in the parser/grammar to make NEXT/LAST work correctly in…
authored
170 | WHILE expr ';' { $_[0]->enter_block('WHILE') }
171 block END { $factory->while(@_[2, 5], $_[0]->leave_block) }
172 | atomexpr WHILE expr { $factory->while(@_[3, 1]) }
3ebfa07 @abw Initial revision
authored
173 ;
174
175 loopvar: IDENT ASSIGN term args { [ @_[1, 3, 4] ] }
99a1461 @abw * added 'IN' as an alternate for '=' in FOREACH directive, e.g.
authored
176 | IDENT IN term args { [ @_[1, 3, 4] ] }
6966839 @abw fixed whitespace damage
authored
177 | term args { [ 0, @_[1, 2] ] }
3ebfa07 @abw Initial revision
authored
178 ;
179
3e45060 @abw *** empty log message ***
authored
180 wrapper: WRAPPER nameargs ';'
6966839 @abw fixed whitespace damage
authored
181 block END { $factory->wrapper(@_[2, 4]) }
182 | atomexpr
183 WRAPPER nameargs { $factory->wrapper(@_[3, 1]) }
3e45060 @abw *** empty log message ***
authored
184 ;
185
6966839 @abw fixed whitespace damage
authored
186 try: TRY ';'
187 block final END { $factory->try(@_[3, 4]) }
3ebfa07 @abw Initial revision
authored
188 ;
189
6966839 @abw fixed whitespace damage
authored
190 final: CATCH filename ';'
191 block final { unshift(@{$_[5]}, [ @_[2,4] ]);
192 $_[5]; }
193 | CATCH DEFAULT ';'
194 block final { unshift(@{$_[5]}, [ undef, $_[4] ]);
195 $_[5]; }
196 | CATCH ';'
197 block final { unshift(@{$_[4]}, [ undef, $_[3] ]);
198 $_[4]; }
199 | FINAL ';' block { [ $_[3] ] }
200 | /* NULL */ { [ 0 ] } # no final
3ebfa07 @abw Initial revision
authored
201 ;
202
6966839 @abw fixed whitespace damage
authored
203 use: USE lnameargs { $factory->use($_[2]) }
3ebfa07 @abw Initial revision
authored
204 ;
205
6966839 @abw fixed whitespace damage
authored
206 view: VIEW nameargs ';' { $_[0]->push_defblock(); }
207 block END { $factory->view(@_[2,5],
208 $_[0]->pop_defblock) }
36ff03e @abw *** empty log message ***
authored
209 ;
210
6966839 @abw fixed whitespace damage
authored
211 perl: PERL ';' { ${$_[0]->{ INPERL }}++; }
212 block END { ${$_[0]->{ INPERL }}--;
213 $_[0]->{ EVAL_PERL }
214 ? $factory->perl($_[4])
215 : $factory->no_perl(); }
3ebfa07 @abw Initial revision
authored
216 ;
217
6cbf6f6 @abw *** empty log message ***
authored
218 rawperl: RAWPERL { ${$_[0]->{ INPERL }}++;
6966839 @abw fixed whitespace damage
authored
219 $rawstart = ${$_[0]->{'LINE'}}; }
220 ';' TEXT END { ${$_[0]->{ INPERL }}--;
221 $_[0]->{ EVAL_PERL }
222 ? $factory->rawperl($_[4], $rawstart)
223 : $factory->no_perl(); }
3ebfa07 @abw Initial revision
authored
224 ;
225
6966839 @abw fixed whitespace damage
authored
226 filter: FILTER lnameargs ';'
227 block END { $factory->filter(@_[2,4]) }
228 | atomexpr FILTER
229 lnameargs { $factory->filter(@_[3,1]) }
3ebfa07 @abw Initial revision
authored
230 ;
231
6966839 @abw fixed whitespace damage
authored
232 defblock: defblockname
233 blockargs ';'
234 template END { my $name = join('/', @{ $_[0]->{ DEFBLOCKS } });
235 pop(@{ $_[0]->{ DEFBLOCKS } });
236 $_[0]->define_block($name, $_[4]);
237 undef
238 }
3ebfa07 @abw Initial revision
authored
239 ;
240
d0b3f68 @abw * modified defblock to correctly construct names of nested BLOCK defs
authored
241 defblockname: BLOCK blockname { push(@{ $_[0]->{ DEFBLOCKS } }, $_[2]);
6966839 @abw fixed whitespace damage
authored
242 $_[2];
243 }
d0b3f68 @abw * modified defblock to correctly construct names of nested BLOCK defs
authored
244 ;
245
82cbea8 @abw version 2.00
authored
246 blockname: filename
6966839 @abw fixed whitespace damage
authored
247 | LITERAL { $_[1] =~ s/^'(.*)'$/$1/; $_[1] }
82cbea8 @abw version 2.00
authored
248 ;
89bdc37 @abw *** empty log message ***
authored
249
36ff03e @abw *** empty log message ***
authored
250 blockargs: metadata
6966839 @abw fixed whitespace damage
authored
251 | /* NULL */
36ff03e @abw *** empty log message ***
authored
252 ;
253
6966839 @abw fixed whitespace damage
authored
254 anonblock: BLOCK blockargs ';' block END
255 { local $" = ', ';
256 print STDERR "experimental block args: [@{ $_[2] }]\n"
257 if $_[2];
258 $factory->anon_block($_[4]) }
3ebfa07 @abw Initial revision
authored
259 ;
260
6966839 @abw fixed whitespace damage
authored
261 capture: ident ASSIGN mdir { $factory->capture(@_[1, 3]) }
3ebfa07 @abw Initial revision
authored
262 ;
263
264 macro: MACRO IDENT '(' margs ')'
6966839 @abw fixed whitespace damage
authored
265 mdir { $factory->macro(@_[2, 6, 4]) }
266 | MACRO IDENT mdir { $factory->macro(@_[2, 3]) }
3ebfa07 @abw Initial revision
authored
267 ;
268
6966839 @abw fixed whitespace damage
authored
269 mdir: directive
270 | BLOCK ';' block END { $_[3] }
3ebfa07 @abw Initial revision
authored
271 ;
272
6966839 @abw fixed whitespace damage
authored
273 margs: margs IDENT { push(@{$_[1]}, $_[2]); $_[1] }
274 | margs COMMA { $_[1] }
275 | IDENT { [ $_[1] ] }
3ebfa07 @abw Initial revision
authored
276 ;
277
6966839 @abw fixed whitespace damage
authored
278 metadata: metadata meta { push(@{$_[1]}, @{$_[2]}); $_[1] }
279 | metadata COMMA
280 | meta
3ebfa07 @abw Initial revision
authored
281 ;
282
6966839 @abw fixed whitespace damage
authored
283 meta: IDENT ASSIGN LITERAL { for ($_[3]) { s/^'//; s/'$//;
284 s/\\'/'/g };
285 [ @_[1,3] ] }
286 | IDENT ASSIGN '"' TEXT '"' { [ @_[1,4] ] }
287 | IDENT ASSIGN NUMBER { [ @_[1,3] ] }
3ebfa07 @abw Initial revision
authored
288 ;
289
290
291 #--------------------------------------------------------------------------
292 # FUNDAMENTAL ELEMENT RULES
293 #--------------------------------------------------------------------------
294
6966839 @abw fixed whitespace damage
authored
295 term: lterm
296 | sterm
3ebfa07 @abw Initial revision
authored
297 ;
298
6966839 @abw fixed whitespace damage
authored
299 lterm: '[' list ']' { "[ $_[2] ]" }
300 | '[' range ']' { "[ $_[2] ]" }
301 | '[' ']' { "[ ]" }
302 | '{' hash '}' { "{ $_[2] }" }
3ebfa07 @abw Initial revision
authored
303 ;
304
6966839 @abw fixed whitespace damage
authored
305 sterm: ident { $factory->ident($_[1]) }
306 | REF ident { $factory->identref($_[2]) }
307 | '"' quoted '"' { $factory->quoted($_[2]) }
308 | LITERAL
309 | NUMBER
3ebfa07 @abw Initial revision
authored
310 ;
311
6966839 @abw fixed whitespace damage
authored
312 list: list term { "$_[1], $_[2]" }
313 | list COMMA
314 | term
3ebfa07 @abw Initial revision
authored
315 ;
316
6966839 @abw fixed whitespace damage
authored
317 range: sterm TO sterm { $_[1] . '..' . $_[3] }
3ebfa07 @abw Initial revision
authored
318 ;
319
320
6966839 @abw fixed whitespace damage
authored
321 hash: params
322 | /* NULL */ { "" }
3ebfa07 @abw Initial revision
authored
323 ;
324
6966839 @abw fixed whitespace damage
authored
325 params: params param { "$_[1], $_[2]" }
326 | params COMMA
327 | param
3ebfa07 @abw Initial revision
authored
328 ;
329
6baef56 @abw * Applied patch from Craig to allow $foo and ${foo} to be used as
authored
330 param: LITERAL ASSIGN expr { "$_[1] => $_[3]" }
331 | item ASSIGN expr { "$_[1] => $_[3]" }
3ebfa07 @abw Initial revision
authored
332 ;
333
6966839 @abw fixed whitespace damage
authored
334 ident: ident DOT node { push(@{$_[1]}, @{$_[3]}); $_[1] }
335 | ident DOT NUMBER { push(@{$_[1]},
336 map {($_, 0)} split(/\./, $_[3]));
337 $_[1]; }
338 | node
3ebfa07 @abw Initial revision
authored
339 ;
340
6966839 @abw fixed whitespace damage
authored
341 node: item { [ $_[1], 0 ] }
342 | item '(' args ')' { [ $_[1], $factory->args($_[3]) ] }
3ebfa07 @abw Initial revision
authored
343 ;
344
6966839 @abw fixed whitespace damage
authored
345 item: IDENT { "'$_[1]'" }
346 | '${' sterm '}' { $_[2] }
347 | '$' IDENT { $_[0]->{ V1DOLLAR }
348 ? "'$_[2]'"
349 : $factory->ident(["'$_[2]'", 0]) }
3ebfa07 @abw Initial revision
authored
350 ;
351
6966839 @abw fixed whitespace damage
authored
352 expr: expr BINOP expr { "$_[1] $_[2] $_[3]" }
353 | expr '/' expr { "$_[1] $_[2] $_[3]" }
354 | expr '+' expr { "$_[1] $_[2] $_[3]" }
355 | expr DIV expr { "int($_[1] / $_[3])" }
356 | expr MOD expr { "$_[1] % $_[3]" }
357 | expr CMPOP expr { "$_[1] $CMPOP{ $_[2] } $_[3]" }
358 | expr CAT expr { "$_[1] . $_[3]" }
359 | expr AND expr { "$_[1] && $_[3]" }
360 | expr OR expr { "$_[1] || $_[3]" }
361 | NOT expr { "! $_[2]" }
362 | expr '?' expr ':' expr { "$_[1] ? $_[3] : $_[5]" }
363 | '(' assign ')' { $factory->assign(@{$_[2]}) }
364 | '(' expr ')' { "($_[2])" }
365 | term
3ebfa07 @abw Initial revision
authored
366 ;
367
6966839 @abw fixed whitespace damage
authored
368 setlist: setlist assign { push(@{$_[1]}, @{$_[2]}); $_[1] }
369 | setlist COMMA
370 | assign
3ebfa07 @abw Initial revision
authored
371 ;
372
373
6966839 @abw fixed whitespace damage
authored
374 assign: ident ASSIGN expr { [ $_[1], $_[3] ] }
375 | LITERAL ASSIGN expr { [ @_[1,3] ] }
3ebfa07 @abw Initial revision
authored
376 ;
377
378 # The 'args' production constructs a list of named and positional
379 # parameters. Named parameters are stored in a list in element 0
380 # of the args list. Remaining elements contain positional parameters
381
6966839 @abw fixed whitespace damage
authored
382 args: args expr { push(@{$_[1]}, $_[2]); $_[1] }
383 | args param { push(@{$_[1]->[0]}, $_[2]); $_[1] }
384 | args ident ASSIGN expr { push(@{$_[1]->[0]}, "'', " .
385 $factory->assign(@_[2,4])); $_[1] }
386 | args COMMA { $_[1] }
387 | /* init */ { [ [ ] ] }
3ebfa07 @abw Initial revision
authored
388 ;
389
390
391 # These are special case parameters used by INCLUDE, PROCESS, etc., which
392 # interpret barewords as quoted strings rather than variable identifiers;
393 # a leading '$' is used to explicitly specify a variable. It permits '/',
394 # '.' and '::' characters, allowing it to be used to specify filenames, etc.
395 # without requiring quoting.
396
397 lnameargs: lvalue ASSIGN nameargs { push(@{$_[3]}, $_[1]); $_[3] }
6966839 @abw fixed whitespace damage
authored
398 | nameargs
3ebfa07 @abw Initial revision
authored
399 ;
400
6966839 @abw fixed whitespace damage
authored
401 lvalue: item
402 | '"' quoted '"' { $factory->quoted($_[2]) }
403 | LITERAL
3ebfa07 @abw Initial revision
authored
404 ;
36ff03e @abw *** empty log message ***
authored
405
6966839 @abw fixed whitespace damage
authored
406 nameargs: '$' ident args { [ [$factory->ident($_[2])], $_[3] ] }
407 | names args { [ @_[1,2] ] }
408 | names '(' args ')' { [ @_[1,3] ] }
3ebfa07 @abw Initial revision
authored
409 ;
410
6966839 @abw fixed whitespace damage
authored
411 names: names '+' name { push(@{$_[1]}, $_[3]); $_[1] }
412 | name { [ $_[1] ] }
36ff03e @abw *** empty log message ***
authored
413 ;
414
6966839 @abw fixed whitespace damage
authored
415 name: '"' quoted '"' { $factory->quoted($_[2]) }
416 | filename { "'$_[1]'" }
417 | LITERAL
36ff03e @abw *** empty log message ***
authored
418 ;
419
420 filename: filename DOT filepart { "$_[1].$_[3]" }
6966839 @abw fixed whitespace damage
authored
421 | filepart
3ebfa07 @abw Initial revision
authored
422 ;
423
89bdc37 @abw *** empty log message ***
authored
424 filepart: FILENAME | IDENT | NUMBER
3ebfa07 @abw Initial revision
authored
425 ;
426
427
428 # The 'quoted' production builds a list of 'quotable' items that might
429 # appear in a quoted string, namely text and identifiers. The lexer
430 # adds an explicit ';' after each directive it finds to help the
431 # parser identify directive/text boundaries; we're not interested in
432 # them here so we can simply accept and ignore by returning undef
433
6966839 @abw fixed whitespace damage
authored
434 quoted: quoted quotable { push(@{$_[1]}, $_[2])
435 if defined $_[2]; $_[1] }
436 | /* NULL */ { [ ] }
3ebfa07 @abw Initial revision
authored
437 ;
438
6966839 @abw fixed whitespace damage
authored
439 quotable: ident { $factory->ident($_[1]) }
440 | TEXT { $factory->text($_[1]) }
441 | ';' { undef }
3ebfa07 @abw Initial revision
authored
442 ;
443
444
445 %%
446
447
448
Something went wrong with that request. Please try again.