# Parse::Yapp grammar for SLN
%{ no warnings 'uninitialized'; %}
# expected one shift/reduce conflict for H
%expect 1
%%
ctab: ctab_bracket { +{ chain => [], attr => $_[1] } }
| atom chain ctab_bracket { +{ chain => [ $_[1], @{$_[2]} ],
attr => $_[3] } } ;
chain: /* empty */ { [] }
| bondatom chain { [ @{$_[1]}, @{$_[2]}, ] }
| '(' bondatom chain ')' chain {
[ $_[1], @{$_[2]}, @{$_[3]}, $_[4], @{$_[5]} ] }
;
bondatom: bond atom { [@_[1,2]]}
| bond closure { [@_[1,2]]}
;
bond: /* empty */ { +{type => '-'} }
| bond_symbol bond_bracket { +{
type => $_[1],
attr => $_[2]
}
}
;
closure: '@' NUM { +{closure => $_[2]} }
;
bond_symbol: '-' | '=' | '#' | '.' | ':';
atom: symbol atom_bracket hcount { +{
symbol => $_[1],
id => $_[2][0],
hcount => $_[3],
attr => $_[2][1],
}
}
;
symbol: UC lc_str { $_[1] . $_[2] }
;
lc_str: #empty
| lc_str LC { $_[1] . $_[2] }
;
UC: UC_NON_H | H;
ALPHA: UC | LC ;
ALNUM: ALPHA | NUM;
WORD: ALNUM | '_';
atom_bracket: #empty
| '[' NUM ':' attr ']' { [@_[2,4]] }
| '[' attr ']' { [undef, $_[2]] }
| '[' NUM ']' { [$_[2], undef] }
;
bond_bracket: #empty
| '[' attr ']' { $_[2] }
;
ctab_bracket: #empty
| '<' attr '>' { $_[2] }
;
hcount: #empty
| H NUM { $_[2] }
| H { 1 }
;
attr: # empty
| attr_list;
attr_list: key_val
| attr_list ';' key_val { +{%{$_[1]}, %{$_[3]}} }
;
key_val: key '=' value { +{lc($_[1]) => $_[3]} }
| key { +{lc($_[1]) => 'TRUE' } }
| charge { +{charge => $_[1] } }
;
value: STRING | string;
key: ALPHA key_tail { $_[1] . $_[2] } ;
key_tail: #empty
| key_tail WORD { $_[1] . $_[2] }
;
charge: '+' NUM { $_[2] }
| '-' NUM { -$_[2] }
| '+' { 1 }
| '-' { -1 }
;
string: #empty
| string string_char { $_[1] . $_[2] }
;
string_char: WORD | OTHER_CHAR | '+' | '-' | '.';
#special chars: s/^([<>[\];=_()\@#.:+-])//s
%%
sub _Error {
exists $_[0]->YYData->{ERRMSG}
and do {
warn $_[0]->YYData->{ERRMSG};
delete $_[0]->YYData->{ERRMSG};
return;
};
warn "Syntax error.\n";
}
sub _Lexer {
my($parser)=shift;
$parser->YYData->{INPUT}
#or $parser->YYData->{INPUT} = <STDIN>
or return('',undef);
$parser->YYData->{INPUT}=~s/^[ \t]//;
for ($parser->YYData->{INPUT}) {
s/^([0-9]+(?:\.[0-9]+)?)//
and return('NUM',$1);
s/^(H)//
and return('H',$1);
s/^([A-Z])//
and return('UC_NON_H',$1);
s/^([a-z])//
and return('LC',$1);
s/^"(.*?)"//s
and return('STRING',$1);
s/^([<>[\];=_()\@#.:+-])//s
and return($1,$1); # "special" character
s/^(.)//s
and return('OTHER_CHAR',$1);
}
}
sub run {
my($self)=shift;
$self->YYData->{INPUT} = shift;
$self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
}