VMXTemplate/template.yp

# Контекстно-свободная Parse::Yapp-грамматика шаблонизатора
#
# Компилировать так: yapp -s -o VMXTemplate/Parser.pm -t template.skel.pm template.yp
#
# {{ двойные скобки }} нужно исключительно чтобы маркеры начала и конца подстановки
# были уникальны в грамматике. Вместо них обычно используются { одинарные }, а
# выбор корректной лексемы - скобки или маркера - делает лексический анализатор.
# Но зато вместо { фигурных скобок } можно выбрать себе любые другие маркеры!
#
# Все выражения представляются массивами из двух-трёх значений:
# [ код выражения, флаг экранирования, флаг принудительной подстановки ]
# Флаг экранирования == true, если это выражение HTML-безопасно, и 'i', если оно не только
# HTML-безопасно, но ещё и численно. При включённом auto_escape небезопасные выражения
# прогоняются через экранирование (обычно через 's').
# Флаг принудительной подстановки используется функциями типа INCLUDE, чтобы подставлять результат,
# даже когда no_code_subst == true.
#
# Кстати:
# * Олдстайл BEGIN .. END ликвидирован
# * Возможно, нужно добавить в каком-то виде foreach ... as key => value
#
# P.S: Комментарии типа "#{" и "#}" служат, чтобы у тупого Parse::Yapp'а число скобок сходилось

%start template

%token literal
%token name

%token '..'
%token '||'
%token 'OR'
%token 'XOR'
%token 'AND'
%token '&&'
%token '&'
%token '=='
%token '!='
%token '<'
%token '>'
%token '<='
%token '>='
%token '+'
%token '-'
%token '*'
%token '/'
%token '%'
%token '('
%token ')'
%token '!'
%token 'NOT'
%token '{'
%token '}'
%token ','
%token '=>'
%token '['
%token ']'
%token '<!--'
%token '-->'
%token '{{'
%token '}}'

%left '..'
%left '||' 'OR' 'XOR'
%left '&&' 'AND'
%nonassoc '==' '!=' '<' '>' '<=' '>='
%left '+' '-'
%left '&'
%left '*' '/' '%'

# Директивы

%%

template: chunks {
    $_[0]->{functions}->{':main'}->{body} = "sub {\nmy \$self = shift;\nmy \$stack = [];\nmy \$t = '';\n".$_[1]."\nreturn \$t;\n}\n";
    '';
  }
;
chunks: {
    '';
  }
| chunks error {
    # Exit error recovery
    $_[0]->YYErrok;
    # Skip current token
    ${$_[0]->{TOKEN}} = undef;
    $_[1];
  }
| chunks chunk {
    $_[1] .
    '# line '.(1+$_[0]->{lexer}->{lineno}).' "'.$_[0]->{options}->{input_filename}."\"\n".
    $_[2];
  }
;
chunk: literal {
    ($_[1][0] ne "''" && $_[1][0] ne '""' ? '$t .= ' . $_[1][0] . ";\n" : '');
  }
| '<!--' code_chunk '-->' {
    $_[2];
  }
| '{{' exp '}}' {
    '$t .= ' . ($_[2][1] || !$_[0]->{options}->{auto_escape} ? $_[2][0] : $_[0]->compile_function($_[0]->{options}->{auto_escape}, [ $_[2] ])->[0]) . ";\n";
  }
;
code_chunk: c_if | c_set | c_fn | c_for | exp {
    ($_[1][2] || !$_[0]->{options}->{no_code_subst} ? '$t .= ' : '') .
    ($_[1][1] || !$_[0]->{options}->{auto_escape} ? $_[1][0] : $_[0]->compile_function($_[0]->{options}->{auto_escape}, [ $_[1] ])->[0]) . ";\n";
  }
;
c_if: 'IF' exp '-->' chunks '<!--' 'END' {
    "if (" . $_[2][0] . ") {\n" . $_[4] . "}\n";
  }
| 'IF' exp '-->' chunks '<!--' 'ELSE' '-->' chunks '<!--' 'END' {
    "if (" . $_[2][0] . ") {\n" . $_[4] . "} else {\n" . $_[8] . "}\n";
  }
| 'IF' exp '-->' chunks c_elseifs chunks '<!--' 'END' {
    "if (" . $_[2][0] . ") {\n" . $_[4] . $_[5] . $_[6] . "}\n";
  }
| 'IF' exp '-->' chunks c_elseifs chunks '<!--' 'ELSE' '-->' chunks '<!--' 'END' {
    "if (" . $_[2][0] . ") {\n" . $_[4] . $_[5] . $_[6] . "} else {\n" . $_[10] . "}\n";
  }
;
c_elseifs: '<!--' elseif exp '-->' {
    #{
    "} elsif (" . $_[3][0] . ") {\n";
    #}
  }
| c_elseifs chunks '<!--' elseif exp '-->' {
    #{
    $_[1] . $_[2] . "} elsif (" . $_[5][0] . ") {\n";
    #}
  }
;
c_set: 'SET' varref '=' exp {
    $_[2][0] . ' = ' . $_[4][0] . ";\n";
  }
| 'SET' varref '-->' chunks '<!--' 'END' {
    "push \@\$stack, \$t;\n\$t = '';\n" . $_[4] . $_[2][0] . " = \$t;\n\$t = pop(\@\$stack);\n";
  }
;
fn_def: fn name '(' arglist ')' {
    $_[0]->{functions}->{$_[2]} = {
      name => $_[2],
      args => $_[4],
      line => $_[0]->{lexer}->line,
      pos => $_[0]->{lexer}->pos,
      body => '',
    };
  }
;
c_fn: fn_def '=' exp {
    $_[1]->{body} = "sub {\nmy \$self = shift;\nreturn ".$_[3].";\n}\n";
    '';
  }
| fn_def '-->' chunks '<!--' 'END' {
    $_[1]->{body} = "sub {\nmy \$self = shift;\nmy \$stack = [];\nmy \$t = '';\n".$_[3]."\nreturn \$t;\n}\n";
    '';
  }
;
c_for: for varref '=' exp '-->' chunks '<!--' 'END' {
    my @varref = @{$_[2]};
    my @exp = @{$_[4]};
    my $cs = $_[6];
    #{
    my $varref_index = substr($varref[0], 0, -1) . ".'_index'}";
    "push \@\$stack, ".$varref[0].", ".$varref_index.", 0;
foreach my \$item (array_items($exp[0])) {
".$varref[0]." = \$item;
".$varref_index." = \$stack->[\$#\$stack]++;
".$cs."}
pop \@\$stack;
".$varref_index." = pop(\@\$stack);
".$varref[0]." = pop(\@\$stack);
";
  }
;
fn: 'FUNCTION' | 'BLOCK' | 'MACRO' ;
for: 'FOR' | 'FOREACH' ;
elseif: 'ELSE' 'IF' | 'ELSIF' | 'ELSEIF' ;

# Выражения

exp: exp '..' exp {
    [ '(' . $_[1][0] . ' . ' . $_[3][0] . ')', $_[1][1] && $_[3][1] ];
  }
| exp '||' exp {
    [ '(' . $_[1][0] . ' || ' . $_[3][0] . ')', $_[1][1] && $_[3][1] ];
  }
| exp 'OR' exp {
    [ '(' . $_[1][0] . ' || ' . $_[3][0] . ')', $_[1][1] && $_[3][1] ];
  }
| exp 'XOR' exp {
    [ '(' . $_[1][0] . ' XOR ' . $_[3][0] . ')', 1 ];
  }
| exp '&&' exp {
    [ '(' . $_[1][0] . ' && ' . $_[3][0] . ')', 1 ];
  }
| exp 'AND' exp {
    [ '(' . $_[1][0] . ' && ' . $_[3][0] . ')', 1 ];
  }
| exp '==' exp {
    [ '(' . $_[1][0] . ($_[1][1] eq 'i' || $_[3][1] eq 'i' ? ' == ' : ' eq ') . $_[3][0] . ')', 1 ];
  }
| exp '!=' exp {
    [ '(' . $_[1][0] . ($_[1][1] eq 'i' || $_[3][1] eq 'i' ? ' != ' : ' ne ') . $_[3][0] . ')', 1 ];
  }
| exp '<' exp {
    [ '(' . $_[1][0] . ($_[1][1] eq 'i' || $_[3][1] eq 'i' ? ' < ' : ' lt ') . $_[3][0] . ')', 1 ];
  }
| exp '>' exp {
    [ '(' . $_[1][0] . ($_[1][1] eq 'i' || $_[3][1] eq 'i' ? ' > ' : ' gt ') . $_[3][0] . ')', 1 ];
  }
| exp '<=' exp {
    [ '(' . $_[1][0] . ($_[1][1] eq 'i' || $_[3][1] eq 'i' ? ' <= ' : ' le ') . $_[3][0] . ')', 1 ];
  }
| exp '>=' exp {
    [ '(' . $_[1][0] . ($_[1][1] eq 'i' || $_[3][1] eq 'i' ? ' >= ' : ' ge ') . $_[3][0] . ')', 1 ];
  }
| exp '+' exp {
    [ '(' . $_[1][0] . ' + ' . $_[3][0] . ')', 'i' ];
  }
| exp '-' exp {
    [ '(' . $_[1][0] . ' - ' . $_[3][0] . ')', 'i' ];
  }
| exp '&' exp {
    [ '(' . $_[1][0] . ' & ' . $_[3][0] . ')', 'i' ];
  }
| exp '*' exp {
    [ '(' . $_[1][0] . ' * ' . $_[3][0] . ')', 'i' ];
  }
| exp '/' exp {
    [ '(' . $_[1][0] . ' / ' . $_[3][0] . ')', 'i' ];
  }
| exp '%' exp {
    [ '(' . $_[1][0] . ' % ' . $_[3][0] . ')', 'i' ];
  }
| p10
;
p10: p11
| '-' p11 {
    [ '(-'.$_[2][0].')', 1 ];
  }
;
p11: nonbrace
| '(' exp ')' varpath {
    [ '('.$_[2][0].')'.$_[4], 0 ];
  }
| '!' p11 {
    [ '(!'.$_[2][0].')', 1 ];
  }
| 'NOT' p11 {
    [ '(!'.$_[2][0].')', 1 ];
  }
;
nonbrace: '{' hash '}' {
    [ "{ " . $_[2] . " }", 1 ];
  }
| literal
| varref
| name '(' ')' {
    $_[0]->compile_function($_[1], []);
  }
| name '(' list ')' {
    $_[0]->compile_function($_[1], $_[3]);
  }
| name '(' gthash ')' {
    [ "\$self->_call_block('".addcslashes($_[1], "'")."', { ".$_[3]." }, '".addcslashes($_[0]->{lexer}->errorinfo(), "'")."')", 1 ];
  }
| name nonbrace {
    $_[0]->compile_function($_[1], [ $_[2] ]);
  }
;
list: exp {
    [ $_[1] ];
  }
| exp ',' list {
    [ $_[1], @{$_[3]} ];
  }
;
arglist: name {
    [ $_[1] ];
  }
| name ',' arglist {
    [ $_[1], @{$_[3]} ];
  }
| {
    [];
  }
;
hash: pair
| pair ',' hash {
    $_[1] . ', ' . $_[3];
  }
| {
    '';
  }
;
gthash: gtpair
| gtpair ',' gthash {
    $_[1] . ', ' . $_[3];
  }
;
pair: exp ',' exp {
    $_[1][0] . ' => ' . $_[3][0];
  }
| gtpair
;
gtpair: exp '=>' exp {
    $_[1][0] . ' => ' . $_[3][0];
  }
;
varref: name {
    [ "\$self->{tpldata}{'".addcslashes($_[1], "'")."'}", 0 ];
  }
| varref varpart {
    [ $_[1][0] . $_[2], 0 ];
  }
;
varpart: '.' namekw {
    "->{'".addcslashes($_[2], "'")."'}";
  }
| '[' exp ']' {
    ($_[2][1] eq 'i' ? '->['.$_[2][0].']' : "->{".$_[2][0]."}");
  }
| '.' namekw '(' ')' {
    '->'.$_[2].'()';
  }
| '.' namekw '(' list ')' {
    '->'.$_[2].'('.join(', ', map { $_->[0] } @{$_[4]}).')';
  }
;
varpath: {
    '';
  }
| varpath varpart {
    $_[1] . $_[2];
  }
;
namekw: name | 'IF' | 'END' | 'ELSE' | 'ELSIF' | 'ELSEIF' | 'SET' | 'OR' | 'XOR' | 'AND' | 'NOT' | 'FUNCTION' | 'BLOCK' | 'MACRO' | 'FOR' | 'FOREACH'
;

%%