For this, you have to know that the get_tok function gets the next token as a string, and unget_tok pushes a token back so that it's the next token get_tok will read. The following code will parse expressions, and is called at various places from the code that parses statements.

{
my($pars_expr1,$pars_expr2);
my %binops= (
    # fun(args), var[index], and var.elt will be handled specially in 
+code
    "+", "add", "-", "sub", "*", "mul", 
    "/", "div", "div", "idiv", "mod", "mod",
    "<", "lt", "=", "eq", ">", "gt", "<=", "le", "<>", "ne", ">=", "ge
+",
    "es", "and", "vagy", "or", 
    );
my %binoppr= (
    "+", 50, "-", 50, "*", 40, 
    "/", 40, "div", 40, "mod", 40,
    "<", 60, "=", 60, ">", 60, "<=", 60, "<>", 60, ">=", 60,
    "es", 40, "vagy", 50, 
    # all operators with the same precedence are left-to-right associa
+tive,
    # eg: a-b-c ==> (a-b)-c
    );
my %unops= (
    # (expr), +expr are handled specially by code
    "-", "neg", "nem", "not", 
    );
my %unoppr= (
    "-", 30, "nem", 30,
    );
my %unfunc= (    
    "kerekit", "round", "round", "round", "egeszresz", "floor",
    "sqr", "sqr", "sqrt", "sqrt",
    );
# More precedences hard-coded in the code below:
# maximal:137, unary+:30, unary():-INF, unary functions:30,
# binary[]:20, binary.:20, binary():20
$pars_expr1= sub {
    my($t,$f,$x,$u,$p,$g);
    ($p,)= @_;
    $t= get_tok ();
    $t=~ m!^\d! and
        return [$t=~/[.eE]/?"qf":"qi", 0+$t];
    is_id $t and
        return ["var", $t];
    $f= $unops{$t} and do {
        $g= $unoppr{$t};
        return [$f, $pars_expr2->($g<$p?$g:$p)];
        };
    $t eq "(" and do {
        $x= $pars_expr2->(137);
        ($u= get_tok) eq ")" or
            die qq!error parsing expr at "$u": ")" expected!;
        return $x;
        };
    $t eq "+" and
        return $pars_expr2->(30<$p?30:$p);
    $f= $unfunc{$t} and 30<=$p and do {
        ($u= get_tok) eq "(" or
            die qq!parse error at "$u": "(" expected!;
        $x= $pars_expr2->(137);
        ($u= get_tok) eq ")" or
            die qq!parse error at "$u": ")" expected!;
        return [$f, $x];
        };
    $t eq "'" and
        return ["qs", get_tok];
    die qq(error parsing expr at "$t": expr expected);
    };
$pars_expr2= sub {
    my($o,$f,$y,$x,$u,$p,$g);
    ($p,)= @_;
    $x= $pars_expr1->($p);
    {
    $o= get_tok;
    $f= $binops{$o} and
        ($g= $binoppr{$o})<=$p and 
        do {
        $y= $pars_expr2->($g-1);
        $x= [$f, $x, $y];
        redo;
        };
    $o eq "." and 20<=$p and
        do {
        $$x[0] eq "var" or
            die qq(parse error at ".": expression cannot be dotted);
        $y= get_tok;
        is_id $y or
            die qq(parse error at "$y": record field expected);
        push @$x, $y;
        redo;
        };
    $o eq "[" and 20<=$p and
        do {
        $$x[0] eq "var" or
            die qq(parse error at "[": expression cannot be subscripte
+d);
        $y= $pars_expr2->(137);
        ($u= get_tok) eq "]" or
            die qq(parse error at "$u": "]" expected);
        push @$x, $y;
        redo;
        };
    }; 
    unget_tok $o;
    $x;
    };
sub pars_expr () {
    $pars_expr2->(137);
    };
sub pars_lvalue () {
    $pars_expr2->(20);
    };
};
[download]