%left COMMA
%left AND OR
%left NOT
%left DOT
%left COMPOP
%left BINOP
%left TO
#STEP
%%
#------------------------------------------------------------------------
# START AND TOP-LEVEL RULES
#------------------------------------------------------------------------
block: chunks { $factory->create(Block => $_[1]) }
| /* NULL */ { $factory->create(Block => []) }
;
chunks: chunks chunk { push(@{$_[1]}, $_[2]) if defined $_[2];
$_[1] }
| chunk { defined $_[1] ? [ $_[1] ] : [ ] }
;
chunk: TEXT { $factory->create(Text => $_[1]) }
| directive ';'
;
directive: atomdir
| catch
| condition
| loop
| defblock
| perl
| macro
| userdef
| debug
| /* NULL - empty directive */
;
#------------------------------------------------------------------------
# DIRECTIVE RULES
#------------------------------------------------------------------------
atomdir: GET term { $factory->create(Get => $_[2]) }
| CALL term { $factory->create(Call => $_[2]) }
| SET setlist { $factory->create(Set => $_[2]) }
| DEFAULT setlist { unshift(@{$_[2]}, OP_DEFAULT);
$factory->create(Set => $_[2]) }
| USE useparam { $factory->create(Use => @{$_[2]}) }
| INCLUDE file setopt { $factory->create(Include => @_[2,3]) }
| PROCESS file setopt { $factory->create(Process => @_[2,3]) }
| THROW textdot term { $factory->create(Throw => @_[2,3]) }
| ERROR term { $factory->create(Error => $_[2]) }
| return { $factory->create(Return => $_[1]) }
| setlist { $factory->create(Set => $_[1]) }
| term { $factory->create(Get => $_[1]) }
| filter /* permits filter chaining */
;
return: RETURN { STATUS_RETURN }
| STOP { STATUS_STOP }
| BREAK { STATUS_DONE }
;
catch: CATCH textdot ';'
block END { $factory->create(Catch =>, @_[2, 4]) }
| CATCH ';'
block END { $factory->create(Catch => undef, $_[3]) }
;
condition: IF expr ';'
block else END { $factory->create(If => @_[2, 4, 5]) }
| atomdir IF expr { $factory->create(If => @_[3, 1]) }
| UNLESS expr ';' # Wayne's World.... NOT!
block else END { push(@{$_[2]}, OP_NOT);
$factory->create(If => @_[2, 4, 5]) }
| atomdir UNLESS expr { push(@{$_[3]}, OP_NOT);
$factory->create(If => @_[3, 1]) }
;
else: ELSE ';' block { $_[3] }
| ELSIF expr ';'
block else { $factory->create(If => @_[2, 4, 5]) }
| /* NULL */
;
loop: FOR loopvar ';'
block END { $factory->create(For => @{$_[2]}, $_[4]) }
| atomdir FOR loopvar { $factory->create(For => @{$_[3]}, $_[1]) }
| WHILE expr ';'
block END { $factory->create(While => @_[2, 4]) }
| atomdir WHILE expr { $factory->create(While => @_[3, 1]) }
;
loopvar: IDENT ASSIGN term args
{ [ @_[1, 3, 4] ] }
| IDENT ASSIGN term COMMA args
{ [ @_[1, 3, 5] ] }
| term args { [ undef, @_[1, 2] ] }
| term COMMA args { [ undef, @_[1, 3] ] }
;
filter: FILTER useparam ';'
block END { $factory->create(Filter => @{$_[2]}, $_[4]) }
| atomdir FILTER useparam
{ $factory->create(Filter => @{$_[3]}, $_[1]) }
;
defblock: BLOCK textdot ';'
block END { $_[0]->define_block(@_[2, 4]); undef }
| BLOCK ';'
block END { $_[3] }
;
perl: PERL ';'
block END { $factory->create(Perl => $_[3]) }
;
macro: MACRO IDENT directive
{ $factory->create(Macro => @_[2, 3]) }
| MACRO IDENT '(' mlist ')' directive
{ $factory->create(Macro => @_[2, 6, 4]) }
;
userdef: UDIR { $factory->create(Userdef => $_[1]) }
| UBLOCK ';'
block END { $factory->create(Userdef => @_[1, 3]) }
;
debug: DEBUG TEXT { $factory->create(Debug => $_[2]) }
;
#------------------------------------------------------------------------
# FUNDAMENTAL ELEMENT RULES
#------------------------------------------------------------------------
term: LITERAL { [ OP_LITERAL, $_[1] ] }
| ident { [ OP_IDENT, $_[1] ] }
| REF ident { [ OP_REF, $_[2] ] }
| '[' range ']' { [ OP_RANGE, $_[2] ] }
| '[' list ']' { [ OP_LIST, $_[2] ] }
| '[' list ']' '(' args ')' { [ OP_ITER, @_[2, 5] ] }
| '{' params '}' { [ OP_HASH, $_[2] ] }
| '"' quoted '"' { [ OP_QUOTE, $_[2] ] }
| term BINOP term { push(@{$_[1]}, @{$_[3]},
OP_BINOP, $_[2]); $_[1] }
;
ident: ident DOT item { push(@{$_[1]}, $_[3]); $_[1] }
| ident DOT LITERAL { push(@{$_[1]}, [ $_[3], 0 ]); $_[1] }
| item { [ $_[1] ] }
| '$' item { [ $_[2] ] }
;
item: '${' term '}' { [ $_[2], 0 ] }
| '${' term '}' '(' args ')' { [ @_[2, 5] ] }
| IDENT '(' args ')' { [ @_[1, 3] ] }
| IDENT { [ $_[1], 0 ] }
;
assign: ident ASSIGN term { push(@{$_[3]}, OP_ASSIGN, $_[1]);
$_[3] }
| LITERAL ASSIGN term { push(@{$_[3]}, OP_ASSIGN, $_[1]);
$_[3] }
;
list: list term { push(@{$_[1]}, $_[2]); $_[1] }
| list COMMA { $_[1] }
| term { [ $_[1] ] }
;
setlist: setlist assign { push(@{$_[1]}, @{$_[2]}); $_[1] }
| setlist COMMA { $_[1] }
| assign
;
setopt: setlist
| /* NULL */ { [ ] }
;
range: term TO term { [ @_[1, 3] ] }
# | term TO term
# STEP term { [ @_[1, 3, 5] ] }
;
param: LITERAL ASSIGN term { [ $_[1], $_[3] ] }
| IDENT ASSIGN term { [ $_[1], $_[3] ] }
;
paramlist: paramlist param { push(@{$_[1]}, $_[2]); $_[1] }
| paramlist COMMA { $_[1] }
| param { [ $_[1] ] }
;
params: paramlist
| /* NULL */ { [ ] }
;
arg: param
| term { [ 0, $_[1] ] }
;
arglist: arglist arg { push(@{$_[1]}, $_[2]); $_[1] }
| arglist COMMA { $_[1] }
| arg { [ $_[1] ] }
;
args: arglist { [ OP_ARGS, $_[1] ] }
| /* NULL */ { [ OP_ARGS, [ ] ] }
;
# list of macro arguments
mlist: mlist IDENT { push(@{$_[1]}, $_[2]); $_[1] }
| mlist COMMA { $_[1] }
| IDENT { [ $_[1] ] }
;
expr: expr COMPOP expr { push(@{$_[1]}, @{$_[3]},
OP_BINOP, $_[2]); $_[1] }
| expr AND expr { push(@{$_[1]}, OP_AND, $_[3]);
$_[1] }
| expr OR expr { push(@{$_[1]}, OP_OR, $_[3]);
$_[1] }
| NOT expr { push(@{$_[2]}, OP_NOT);
$_[2] }
| '(' expr ')' { $_[2] }
| assign
| term
;
# this is a special case parameter used by INCLUDE, PROCESS, etc., which
# interprets 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 sans quotes
file: '$' ident { [ OP_IDENT, $_[2] ] }
| '"' quoted '"' { [ OP_QUOTE, $_[2] ] }
| '/' textdot { '/' . $_[2] }
| textdot
| LITERAL
;
# concatenates a sequence of identifiers, periods and/or slashes into
# a single string
textdot: textdot DOT IDENT { $_[1] .= "$_[2]$_[3]"; $_[1] }
| textdot '/' IDENT { $_[1] .= "$_[2]$_[3]"; $_[1] }
| IDENT
;
# useparam is used by USE, FILTER, etc., to specify optional params
# after a textdot option,
useparam: IDENT ASSIGN textdot '(' args ')' { [ @_[3, 5, 1] ] }
| IDENT ASSIGN textdot { [ $_[3], undef, $_[1] ] }
| textdot '(' args ')' { [ $_[1], $_[3], undef ] }
| textdot { [ $_[1], undef, undef ] }
;
# constructs an array containing the contents of an explicitly quoted
# string consisting of text and/or embedded variable references.
# we ignore undef generated by ';' separator in 'quotable' rule below
quoted: quoted quotable { push(@{$_[1]}, $_[2])
if defined $_[2]; $_[1] }
| /* NULL */ { [ ] }
;
# the tokeniser 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
quotable: ident { [ OP_IDENT, $_[1] ] }
| TEXT { [ OP_LITERAL, $_[1] ] }
| ';' { undef }
;
%%