#============================================================= -*-Perl-*-
#
# Parser.yp
#
# DESCRIPTION
# Definition of the parser grammar for the Template Toolkit language.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# 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 }
;
%%