1#============================================================= -*-Perl-*- 2# 3# Parser.yp 4# 5# DESCRIPTION 6# Definition of the parser grammar for the Template Toolkit language. 7# 8# AUTHOR 9# Andy Wardley <abw@wardley.org> 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. 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. 22# 23# COPYRIGHT 24# Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved. 25# Copyright (C) 1998-2004 Canon Research Centre Europe Ltd. 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 49%left CAT 50%left DOT 51%left CMPOP 52%left BINOP 53%left '+' 54%left '/' 55%left DIV 56%left MOD 57%left TO 58%% 59 60#-------------------------------------------------------------------------- 61# START AND TOP-LEVEL RULES 62#-------------------------------------------------------------------------- 63 64template: block { $factory->template($_[1]) } 65; 66 67block: chunks { $factory->block($_[1]) } 68 | /* NULL */ { $factory->block() } 69; 70 71chunks: chunks chunk { push(@{$_[1]}, $_[2]) 72 if defined $_[2]; $_[1] } 73 | chunk { defined $_[1] ? [ $_[1] ] : [ ] } 74; 75 76chunk: TEXT { $factory->textblock($_[1]) } 77 | statement ';' { return '' unless $_[1]; 78 $_[0]->location() . $_[1]; 79 } 80; 81 82statement: directive 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 */ 93; 94 95directive: setlist { $factory->set($_[1]) } 96 | atomdir 97 | condition 98 | switch 99 | loop 100 | try 101 | perl 102; 103 104 105#-------------------------------------------------------------------------- 106# DIRECTIVE RULES 107#-------------------------------------------------------------------------- 108 109atomexpr: expr { $factory->get($_[1]) } 110 | atomdir 111; 112 113atomdir: 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 = '';"; } 124 | LAST { $_[0]->block_label('last ', ';') } 125 | NEXT { $_[0]->in_block('FOR') 126 ? $factory->next($_[0]->block_label) 127 : $_[0]->block_label('next ', ';') } 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 } 136 | wrapper 137 | filter 138; 139 140condition: IF expr ';' 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]) } 146; 147 148else: ELSIF expr ';' 149 block else { unshift(@{$_[5]}, [ @_[2, 4] ]); 150 $_[5]; } 151 | ELSE ';' block { [ $_[3] ] } 152 | /* NULL */ { [ undef ] } 153; 154 155switch: SWITCH expr ';' 156 block case END { $factory->switch(@_[2, 5]) } 157; 158 159case: CASE term ';' block 160 case { unshift(@{$_[5]}, [ @_[2, 4] ]); 161 $_[5]; } 162 | CASE DEFAULT ';' block { [ $_[4] ] } 163 | CASE ';' block { [ $_[3] ] } 164 | /* NULL */ { [ undef ] } 165; 166 167loop: FOR loopvar ';' { $_[0]->enter_block('FOR') } 168 block END { $factory->foreach(@{$_[2]}, $_[5], $_[0]->leave_block) } 169 | atomexpr FOR loopvar { $factory->foreach(@{$_[3]}, $_[1]) } 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]) } 173; 174 175loopvar: IDENT ASSIGN term args { [ @_[1, 3, 4] ] } 176 | IDENT IN term args { [ @_[1, 3, 4] ] } 177 | term args { [ 0, @_[1, 2] ] } 178; 179 180wrapper: WRAPPER nameargs ';' 181 block END { $factory->wrapper(@_[2, 4]) } 182 | atomexpr 183 WRAPPER nameargs { $factory->wrapper(@_[3, 1]) } 184; 185 186try: TRY ';' 187 block final END { $factory->try(@_[3, 4]) } 188; 189 190final: 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 201; 202 203use: USE lnameargs { $factory->use($_[2]) } 204; 205 206view: VIEW nameargs ';' { $_[0]->push_defblock(); } 207 block END { $factory->view(@_[2,5], 208 $_[0]->pop_defblock) } 209; 210 211perl: PERL ';' { ${$_[0]->{ INPERL }}++; } 212 block END { ${$_[0]->{ INPERL }}--; 213 $_[0]->{ EVAL_PERL } 214 ? $factory->perl($_[4]) 215 : $factory->no_perl(); } 216; 217 218rawperl: RAWPERL { ${$_[0]->{ INPERL }}++; 219 $rawstart = ${$_[0]->{'LINE'}}; } 220 ';' TEXT END { ${$_[0]->{ INPERL }}--; 221 $_[0]->{ EVAL_PERL } 222 ? $factory->rawperl($_[4], $rawstart) 223 : $factory->no_perl(); } 224; 225 226filter: FILTER lnameargs ';' 227 block END { $factory->filter(@_[2,4]) } 228 | atomexpr FILTER 229 lnameargs { $factory->filter(@_[3,1]) } 230; 231 232defblock: defblockname 233 blockargs ';' 234 template END { my $name = join('/', @{ $_[0]->{ DEFBLOCKS } }); 235 pop(@{ $_[0]->{ DEFBLOCKS } }); 236 $_[0]->define_block($name, $_[4]); 237 undef 238 } 239; 240 241defblockname: BLOCK blockname { push(@{ $_[0]->{ DEFBLOCKS } }, $_[2]); 242 $_[2]; 243 } 244; 245 246blockname: filename 247 | LITERAL { $_[1] =~ s/^'(.*)'$/$1/; $_[1] } 248; 249 250blockargs: metadata 251 | /* NULL */ 252; 253 254anonblock: BLOCK blockargs ';' block END 255 { local $" = ', '; 256 print STDERR "experimental block args: [@{ $_[2] }]\n" 257 if $_[2]; 258 $factory->anon_block($_[4]) } 259; 260 261capture: ident ASSIGN mdir { $factory->capture(@_[1, 3]) } 262; 263 264macro: MACRO IDENT '(' margs ')' 265 mdir { $factory->macro(@_[2, 6, 4]) } 266 | MACRO IDENT mdir { $factory->macro(@_[2, 3]) } 267; 268 269mdir: directive 270 | BLOCK ';' block END { $_[3] } 271; 272 273margs: margs IDENT { push(@{$_[1]}, $_[2]); $_[1] } 274 | margs COMMA { $_[1] } 275 | IDENT { [ $_[1] ] } 276; 277 278metadata: metadata meta { push(@{$_[1]}, @{$_[2]}); $_[1] } 279 | metadata COMMA 280 | meta 281; 282 283meta: 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] ] } 288; 289 290 291#-------------------------------------------------------------------------- 292# FUNDAMENTAL ELEMENT RULES 293#-------------------------------------------------------------------------- 294 295term: lterm 296 | sterm 297; 298 299lterm: '[' list ']' { "[ $_[2] ]" } 300 | '[' range ']' { "[ $_[2] ]" } 301 | '[' ']' { "[ ]" } 302 | '{' hash '}' { "{ $_[2] }" } 303; 304 305sterm: ident { $factory->ident($_[1]) } 306 | REF ident { $factory->identref($_[2]) } 307 | '"' quoted '"' { $factory->quoted($_[2]) } 308 | LITERAL 309 | NUMBER 310; 311 312list: list term { "$_[1], $_[2]" } 313 | list COMMA 314 | term 315; 316 317range: sterm TO sterm { $_[1] . '..' . $_[3] } 318; 319 320 321hash: params 322 | /* NULL */ { "" } 323; 324 325params: params param { "$_[1], $_[2]" } 326 | params COMMA 327 | param 328; 329 330param: LITERAL ASSIGN expr { "$_[1] => $_[3]" } 331 | item ASSIGN expr { "$_[1] => $_[3]" } 332; 333 334ident: ident DOT node { push(@{$_[1]}, @{$_[3]}); $_[1] } 335 | ident DOT NUMBER { push(@{$_[1]}, 336 map {($_, 0)} split(/\./, $_[3])); 337 $_[1]; } 338 | node 339; 340 341node: item { [ $_[1], 0 ] } 342 | item '(' args ')' { [ $_[1], $factory->args($_[3]) ] } 343; 344 345item: IDENT { "'$_[1]'" } 346 | '${' sterm '}' { $_[2] } 347 | '$' IDENT { $_[0]->{ V1DOLLAR } 348 ? "'$_[2]'" 349 : $factory->ident(["'$_[2]'", 0]) } 350; 351 352expr: 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 366; 367 368setlist: setlist assign { push(@{$_[1]}, @{$_[2]}); $_[1] } 369 | setlist COMMA 370 | assign 371; 372 373 374assign: ident ASSIGN expr { [ $_[1], $_[3] ] } 375 | LITERAL ASSIGN expr { [ @_[1,3] ] } 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 382args: 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 */ { [ [ ] ] } 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 397lnameargs: lvalue ASSIGN nameargs { push(@{$_[3]}, $_[1]); $_[3] } 398 | nameargs 399; 400 401lvalue: item 402 | '"' quoted '"' { $factory->quoted($_[2]) } 403 | LITERAL 404; 405 406nameargs: '$' ident args { [ [$factory->ident($_[2])], $_[3] ] } 407 | names args { [ @_[1,2] ] } 408 | names '(' args ')' { [ @_[1,3] ] } 409; 410 411names: names '+' name { push(@{$_[1]}, $_[3]); $_[1] } 412 | name { [ $_[1] ] } 413; 414 415name: '"' quoted '"' { $factory->quoted($_[2]) } 416 | filename { "'$_[1]'" } 417 | LITERAL 418; 419 420filename: filename DOT filepart { "$_[1].$_[3]" } 421 | filepart 422; 423 424filepart: FILENAME | IDENT | NUMBER 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 434quoted: quoted quotable { push(@{$_[1]}, $_[2]) 435 if defined $_[2]; $_[1] } 436 | /* NULL */ { [ ] } 437; 438 439quotable: ident { $factory->ident($_[1]) } 440 | TEXT { $factory->text($_[1]) } 441 | ';' { undef } 442; 443 444 445%% 446 447 448 449