#============================================================= -*-Perl-*- # # Parser.yp # # DESCRIPTION # Definition of the parser grammar for the Template Toolkit language. # # AUTHOR # Andy Wardley # # HISTORY # Totally re-written for version 2, based on Doug Steinwand's # implementation which compiles templates to Perl code. The generated # code is _considerably_ faster, more portable and easier to process. # # WARNINGS # Expect 1 reduce/reduce conflict. This can safely be ignored. # Now also expect 1 shift/reduce conflict, created by adding a rule # to 'args' to allow assignments of the form 'foo.bar = baz'. It # should be possible to fix the problem by rewriting some rules, but # I'm loathed to hack it up too much right now. Maybe later. # # COPYRIGHT # Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved. # Copyright (C) 1998-2004 Canon Research Centre Europe Ltd. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # #------------------------------------------------------------------------ # # NOTE: this module is constructed from the parser/Grammar.pm.skel # file by running the parser/yc script. You only need to do this if # you have modified the grammar in the parser/Parser.yp file and need # to-recompile it. See the README in the 'parser' directory for more # information (sub-directory of the Template distribution). # #------------------------------------------------------------------------ # # $Id$ # #======================================================================== %right ASSIGN %right '?' ':' %left COMMA %left AND OR %left NOT %left CAT %left DOT %left CMPOP %left BINOP %left '+' %left '/' %left DIV %left MOD %left TO %% #-------------------------------------------------------------------------- # START AND TOP-LEVEL RULES #-------------------------------------------------------------------------- template: block { $factory->template($_[1]) } ; block: chunks { $factory->block($_[1]) } | /* NULL */ { $factory->block() } ; chunks: chunks chunk { push(@{$_[1]}, $_[2]) if defined $_[2]; $_[1] } | chunk { defined $_[1] ? [ $_[1] ] : [ ] } ; chunk: TEXT { $factory->textblock($_[1]) } | statement ';' { return '' unless $_[1]; $_[0]->location() . $_[1]; } ; statement: directive | defblock | anonblock | capture | macro | use | view | rawperl | expr { $factory->get($_[1]) } | META metadata { $_[0]->add_metadata($_[2]); } | /* empty statement */ ; directive: setlist { $factory->set($_[1]) } | atomdir | condition | switch | loop | try | perl ; #-------------------------------------------------------------------------- # DIRECTIVE RULES #-------------------------------------------------------------------------- atomexpr: expr { $factory->get($_[1]) } | atomdir ; atomdir: GET expr { $factory->get($_[2]) } | CALL expr { $factory->call($_[2]) } | SET setlist { $factory->set($_[2]) } | DEFAULT setlist { $factory->default($_[2]) } | INSERT nameargs { $factory->insert($_[2]) } | INCLUDE nameargs { $factory->include($_[2]) } | PROCESS nameargs { $factory->process($_[2]) } | THROW nameargs { $factory->throw($_[2]) } | RETURN { $factory->return() } | STOP { $factory->stop() } | CLEAR { "\$output = '';"; } | LAST { $_[0]->block_label('last ', ';') } | NEXT { $_[0]->in_block('FOR') ? $factory->next($_[0]->block_label) : $_[0]->block_label('next ', ';') } | DEBUG nameargs { if ($_[2]->[0]->[0] =~ /^'(on|off)'$/) { $_[0]->{ DEBUG_DIRS } = ($1 eq 'on'); $factory->debug($_[2]); } else { $_[0]->{ DEBUG_DIRS } ? $factory->debug($_[2]) : ''; } } | wrapper | filter ; condition: IF expr ';' block else END { $factory->if(@_[2, 4, 5]) } | atomexpr IF expr { $factory->if(@_[3, 1]) } | UNLESS expr ';' block else END { $factory->if("!($_[2])", @_[4, 5]) } | atomexpr UNLESS expr { $factory->if("!($_[3])", $_[1]) } ; else: ELSIF expr ';' block else { unshift(@{$_[5]}, [ @_[2, 4] ]); $_[5]; } | ELSE ';' block { [ $_[3] ] } | /* NULL */ { [ undef ] } ; switch: SWITCH expr ';' block case END { $factory->switch(@_[2, 5]) } ; case: CASE term ';' block case { unshift(@{$_[5]}, [ @_[2, 4] ]); $_[5]; } | CASE DEFAULT ';' block { [ $_[4] ] } | CASE ';' block { [ $_[3] ] } | /* NULL */ { [ undef ] } ; loop: FOR loopvar ';' { $_[0]->enter_block('FOR') } block END { $factory->foreach(@{$_[2]}, $_[5], $_[0]->leave_block) } | atomexpr FOR loopvar { $factory->foreach(@{$_[3]}, $_[1]) } | WHILE expr ';' { $_[0]->enter_block('WHILE') } block END { $factory->while(@_[2, 5], $_[0]->leave_block) } | atomexpr WHILE expr { $factory->while(@_[3, 1]) } ; loopvar: IDENT ASSIGN term args { [ @_[1, 3, 4] ] } | IDENT IN term args { [ @_[1, 3, 4] ] } | term args { [ 0, @_[1, 2] ] } ; wrapper: WRAPPER nameargs ';' block END { $factory->wrapper(@_[2, 4]) } | atomexpr WRAPPER nameargs { $factory->wrapper(@_[3, 1]) } ; try: TRY ';' block final END { $factory->try(@_[3, 4]) } ; final: CATCH filename ';' block final { unshift(@{$_[5]}, [ @_[2,4] ]); $_[5]; } | CATCH DEFAULT ';' block final { unshift(@{$_[5]}, [ undef, $_[4] ]); $_[5]; } | CATCH ';' block final { unshift(@{$_[4]}, [ undef, $_[3] ]); $_[4]; } | FINAL ';' block { [ $_[3] ] } | /* NULL */ { [ 0 ] } # no final ; use: USE lnameargs { $factory->use($_[2]) } ; view: VIEW nameargs ';' { $_[0]->push_defblock(); } block END { $factory->view(@_[2,5], $_[0]->pop_defblock) } ; perl: PERL ';' { ${$_[0]->{ INPERL }}++; } block END { ${$_[0]->{ INPERL }}--; $_[0]->{ EVAL_PERL } ? $factory->perl($_[4]) : $factory->no_perl(); } ; rawperl: RAWPERL { ${$_[0]->{ INPERL }}++; $rawstart = ${$_[0]->{'LINE'}}; } ';' TEXT END { ${$_[0]->{ INPERL }}--; $_[0]->{ EVAL_PERL } ? $factory->rawperl($_[4], $rawstart) : $factory->no_perl(); } ; filter: FILTER lnameargs ';' block END { $factory->filter(@_[2,4]) } | atomexpr FILTER lnameargs { $factory->filter(@_[3,1]) } ; defblock: defblockname blockargs ';' template END { my $name = join('/', @{ $_[0]->{ DEFBLOCKS } }); pop(@{ $_[0]->{ DEFBLOCKS } }); $_[0]->define_block($name, $_[4]); undef } ; defblockname: BLOCK blockname { push(@{ $_[0]->{ DEFBLOCKS } }, $_[2]); $_[2]; } ; blockname: filename | LITERAL { $_[1] =~ s/^'(.*)'$/$1/; $_[1] } ; blockargs: metadata | /* NULL */ ; anonblock: BLOCK blockargs ';' block END { local $" = ', '; print STDERR "experimental block args: [@{ $_[2] }]\n" if $_[2]; $factory->anon_block($_[4]) } ; capture: ident ASSIGN mdir { $factory->capture(@_[1, 3]) } ; macro: MACRO IDENT '(' margs ')' mdir { $factory->macro(@_[2, 6, 4]) } | MACRO IDENT mdir { $factory->macro(@_[2, 3]) } ; mdir: directive | BLOCK ';' block END { $_[3] } ; margs: margs IDENT { push(@{$_[1]}, $_[2]); $_[1] } | margs COMMA { $_[1] } | IDENT { [ $_[1] ] } ; metadata: metadata meta { push(@{$_[1]}, @{$_[2]}); $_[1] } | metadata COMMA | meta ; meta: IDENT ASSIGN LITERAL { for ($_[3]) { s/^'//; s/'$//; s/\\'/'/g }; [ @_[1,3] ] } | IDENT ASSIGN '"' TEXT '"' { [ @_[1,4] ] } | IDENT ASSIGN NUMBER { [ @_[1,3] ] } ; #-------------------------------------------------------------------------- # FUNDAMENTAL ELEMENT RULES #-------------------------------------------------------------------------- term: lterm | sterm ; lterm: '[' list ']' { "[ $_[2] ]" } | '[' range ']' { "[ $_[2] ]" } | '[' ']' { "[ ]" } | '{' hash '}' { "{ $_[2] }" } ; sterm: ident { $factory->ident($_[1]) } | REF ident { $factory->identref($_[2]) } | '"' quoted '"' { $factory->quoted($_[2]) } | LITERAL | NUMBER ; list: list term { "$_[1], $_[2]" } | list COMMA | term ; range: sterm TO sterm { $_[1] . '..' . $_[3] } ; hash: params | /* NULL */ { "" } ; params: params param { "$_[1], $_[2]" } | params COMMA | param ; param: LITERAL ASSIGN expr { "$_[1] => $_[3]" } | item ASSIGN expr { "$_[1] => $_[3]" } ; ident: ident DOT node { push(@{$_[1]}, @{$_[3]}); $_[1] } | ident DOT NUMBER { push(@{$_[1]}, map {($_, 0)} split(/\./, $_[3])); $_[1]; } | node ; node: item { [ $_[1], 0 ] } | item '(' args ')' { [ $_[1], $factory->args($_[3]) ] } ; item: IDENT { "'$_[1]'" } | '${' sterm '}' { $_[2] } | '$' IDENT { $_[0]->{ V1DOLLAR } ? "'$_[2]'" : $factory->ident(["'$_[2]'", 0]) } ; expr: expr BINOP expr { "$_[1] $_[2] $_[3]" } | expr '/' expr { "$_[1] $_[2] $_[3]" } | expr '+' expr { "$_[1] $_[2] $_[3]" } | expr DIV expr { "int($_[1] / $_[3])" } | expr MOD expr { "$_[1] % $_[3]" } | expr CMPOP expr { "$_[1] $CMPOP{ $_[2] } $_[3]" } | expr CAT expr { "$_[1] . $_[3]" } | expr AND expr { "$_[1] && $_[3]" } | expr OR expr { "$_[1] || $_[3]" } | NOT expr { "! $_[2]" } | expr '?' expr ':' expr { "$_[1] ? $_[3] : $_[5]" } | '(' assign ')' { $factory->assign(@{$_[2]}) } | '(' expr ')' { "($_[2])" } | term ; setlist: setlist assign { push(@{$_[1]}, @{$_[2]}); $_[1] } | setlist COMMA | assign ; assign: ident ASSIGN expr { [ $_[1], $_[3] ] } | LITERAL ASSIGN expr { [ @_[1,3] ] } ; # The 'args' production constructs a list of named and positional # parameters. Named parameters are stored in a list in element 0 # of the args list. Remaining elements contain positional parameters args: args expr { push(@{$_[1]}, $_[2]); $_[1] } | args param { push(@{$_[1]->[0]}, $_[2]); $_[1] } | args ident ASSIGN expr { push(@{$_[1]->[0]}, "'', " . $factory->assign(@_[2,4])); $_[1] } | args COMMA { $_[1] } | /* init */ { [ [ ] ] } ; # These are special case parameters used by INCLUDE, PROCESS, etc., which # interpret barewords as quoted strings rather than variable identifiers; # a leading '$' is used to explicitly specify a variable. It permits '/', # '.' and '::' characters, allowing it to be used to specify filenames, etc. # without requiring quoting. lnameargs: lvalue ASSIGN nameargs { push(@{$_[3]}, $_[1]); $_[3] } | nameargs ; lvalue: item | '"' quoted '"' { $factory->quoted($_[2]) } | LITERAL ; nameargs: '$' ident args { [ [$factory->ident($_[2])], $_[3] ] } | names args { [ @_[1,2] ] } | names '(' args ')' { [ @_[1,3] ] } ; names: names '+' name { push(@{$_[1]}, $_[3]); $_[1] } | name { [ $_[1] ] } ; name: '"' quoted '"' { $factory->quoted($_[2]) } | filename { "'$_[1]'" } | LITERAL ; filename: filename DOT filepart { "$_[1].$_[3]" } | filepart ; filepart: FILENAME | IDENT | NUMBER ; # The 'quoted' production builds a list of 'quotable' items that might # appear in a quoted string, namely text and identifiers. The lexer # adds an explicit ';' after each directive it finds to help the # parser identify directive/text boundaries; we're not interested in # them here so we can simply accept and ignore by returning undef quoted: quoted quotable { push(@{$_[1]}, $_[2]) if defined $_[2]; $_[1] } | /* NULL */ { [ ] } ; quotable: ident { $factory->ident($_[1]) } | TEXT { $factory->text($_[1]) } | ';' { undef } ; %%