『Rubyを256倍使うための本 無道編』の 09.errmsg/intp.y を移植(Perl 版)

%{
%}

%token IDENT NUMBER STRING

%%

program :
        | program stmt '\n'
            {
              $lineno++;
            }
        | program '\n'
            {
              $lineno++;
            }
;

stmt    : primary
        | assign
        | IDENT args
            {
              stmt = do_funcall(IDENT, args);
            }
;

funcall : IDENT '(' args ')'
            {
              funcall = do_funcall(IDENT, args);
            }
        | IDENT '(' ')'
            {
              funcall = do_funcall(IDENT, []);
            }
;

a1@args : primary
            {
              a1 = [primary];
            }
        | a2@args ',' primary
            {
              push(@{a1}, primary);
            }
;

assign  : IDENT '=' primary
            {
              assign = do_assign(IDENT, primary);
            }
;

primary : IDENT   { primary = do_varref( IDENT ) }
        | NUMBER
        | STRING
        | funcall
;

%%

$lexbuf = '';
%vtable;
$lineno = 1;

sub do_funcall
{
    my ($func, $args) = @_;

    my $cmd = "$func(" . join(",", @$args) . ");";
    #print "* do_funcall $cmd\n";
    eval $cmd;
}

sub do_assign
{
    my ($vname, $val) = @_;

    $vtable{$vname} = $val;
}

sub do_varref
{
    my ($vname) = @_;

    if (exists($vtable{$vname})) {
        return $vtable{$vname};
    } else {
        eval $vname;
    }
}

sub yylex
{
    while (1) {
        if ($lexbuf =~ /^([\t ]+)/) {
            $lexbuf = substr($lexbuf, length($1));
        }
        last if ($lexbuf ne '');
        #if (!($lexbuf = <STDIN>)) {
        if (!($lexbuf = <>)) {
            #print "return 0\n";
            return 0;
        }
    }

    if ($lexbuf =~ /^(\d+)/) {
        $yylval = $1 - 0;
        $lexbuf = substr($lexbuf, length($1));
        return $NUMBER;
    } elsif ($lexbuf =~ /^([a-zA-Z_]\w*)/) {
        $yylval = $1;
        $lexbuf = substr($lexbuf, length($1));
        return $IDENT;
    } elsif ($lexbuf =~ /^"(?:[^"\\]+|\\.)*"/) {
        $yylval = $&;
        $lexbuf = substr($lexbuf, length($&));
        return $STRING;
    } else {
        my $ret = ord($lexbuf);
        $lexbuf = substr($lexbuf, 1);
        return $ret;
    }
}

sub yyerror
{
    my ($msg) = @_;
    print "$ARGV:$lineno: $msg\n";
}

exit &yyparse();

で、

print((

を入力すると、

foo:1: syntax error