http://qs321.pair.com?node_id=678124


in reply to RFC: Parsing with perl - Regexes and beyond

How would Chomsky categorise this? (Update: Corrected c&p typo per Erez post below.) 

#! perl -slw
use strict;

$|++;

my %ops = (
    '+' => sub{ $_[ 0 ] + $_[ 1 ] },
    '-' => sub{ $_[ 0 ] - $_[ 1 ] },
    '*' => sub{ $_[ 0 ] * $_[ 1 ] },
    '/' => sub{ $_[ 0 ] / $_[ 1 ] },
    '**'=> sub{ $_[ 0 ] ** $_[ 1 ] },
);

my @presedence = (
    qr[\*\*],
    qr[\*|/],
    qr[\+|-],
);

my $reVar = qr[[a-z]+];
my $reConst = qr[ [+-]? (?:\d+\.)? \d+ (?: [eE] [+-]? \d+ )? ]x;
my $reArg = qr[$reVar|$reConst];
my $reOps = qr[@{[ join '|', map{ quotemeta } keys %ops ]}];
my $reTokenise = qr[\s*($reArg)(?:\s*($reOps))?];

sub parseEvalExpr {
    my $expr = shift;

    if( $expr =~ m[$reOps \s+ $reArg \s+ $reOps]x ) {
        for my $opset ( @presedence ) {
            return "($expr)" 
                if $expr =~ s[ ( $reArg \s+ $opset \s+ $reArg ) ]{($1)
+}x;
        }
    }
    my @tokens = $expr =~ m[$reTokenise]g;
    pop @tokens unless defined $tokens[ $#tokens ];
    while( @tokens > 1 ) {
        ( my( $arg1, $op, $arg2 ), @tokens ) = @tokens;
        unshift @tokens, $ops{ $op }->( $arg1, $arg2 );
    }
    return $tokens[ 0 ];
}

while( <DATA> ) {
    chomp;
    my $testResult = eval;
    printf "'$_' = ";
    warn "Unbalanced parens '$_'" and next unless tr[(][] == tr[)][];
    while( m[[()\s]] ) {
        s[ \( ( [^()]+ ) \) ]{ parseEvalExpr( $1 ) }xe while m[[()]];
        $_ = parseEvalExpr( $_ );
    }
    print;
    printf STDERR "*** Discrepancy! Eval gets: %s\n", $testResult 
        unless $_ eq $testResult;
}

__DATA__
1 + 2
2 - 1
2 * 1
1 / 2
(((7 + 5) * (9 + 13)) / ((4 + 3) * (17 - 2 + 3)))
23 ** 2
1.1e10 ** -10
1 + 2 * 3
3 + 2 ** 2 ** 2 * 3

[download]

Output

c:\test>expr_parser.pl
'1 + 2' = 3
'2 - 1' = 1
'2 * 1' = 2
'1 / 2' = 0.5
'(((7 + 5) * (9 + 13)) / ((4 + 3) * (17 - 2 + 3)))' = 2.0952380952381
'23 ** 2' = 529
'1.1e10 ** -10' = 3.85543289429532e-101
'1 + 2 * 3' = 7
'3 + 2 ** 2 ** 2 * 3' = 51

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Replies are listed 'Best First'.
Re^2: Parsing with perl - Regexes and beyond
by moritz (Cardinal) on Apr 03, 2008 at 09:10 UTC
    How would Chompsky categorise this?

    He wouldn't, because you didn't specify a grammar. You implemented one in a Turing machine (aka perl).

    The implicit, underlying grammar for parsing is not in RE. It's in CFL, even in DCFL. In this case it's LL(1) (you need one character lookahead to distinguish * and ** tokens).

    Ironically you usually think of LL(1) in terms of top down parsers, that is "all grammars that can be matched by recursive descending parsers with one token lookahead" (not an exact definition, of course), but you use a bottom up technique.

    The technique is none of the standard techniques I know, which all read the input string (or stream) from left to right, while you perform multiple passes (with while( m[[()\s]] )).

    Update:

    The computation of the result doesn't work in CFL, of course. If you're really a tough guy you can evaluate such things in context sensitive grammars (but it's much work), and for that you need, in general, a linearly bounded Turing machine (LTM).

    In the normal computation model you can't modify the input tape, and the size of a supplemental, rw-tape is the size the "linear" refers to. And since the algorithm above uses a complete copy of the input string, it also uses (at least) a LBM ;-)

[reply]
[d/l]
[select]
Re^2: Parsing with perl - Regexes and beyond
by Erez (Priest) on Apr 03, 2008 at 09:46 UTC

    Is Chompsky a play on Noam Chomsky and chomp, or we're talking about a different person here?

    Software speaks in tongues of man.
    Stop saying 'script'. Stop saying 'line-noise'.
    We have nothing to lose but our metaphors.

[reply]
[d/l]
      Maybe it's just a typo? At least it was from me ;-)

      But it's indeed Noam Chomsky we're talking about.

[reply]
Re^2: Parsing with perl - Regexes and beyond
by tybalt89 (Monsignor) on Sep 20, 2016 at 22:33 UTC

    I tried running this code. Sometimes it worked and sometimes it failed.

    Unusual for perl...

    Then I remembered that recently hashes were randomized = bingo!

    The line 

    my $reOps = qr[@{[ join '|', map{ quotemeta } keys %ops ]}];

    [download]

    needs to be changed to 

    my $reOps = qr[@{[ join '|', map{ quotemeta }
  sort { length $b <=> length $a } keys %ops ]}];

    [download]

    to keep * from being matched before **

[reply]
[d/l]
[select]

      Your correction needs a small correction:) We need to do the sort by length after the quotemetaing:

      my $reOps = qr[@{[ join '|', sort { length $b <=> length $a } map{ quo
+temeta } keys %ops ]}];

      [download]
      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
      are you finally got an account? i suspect (and wish) you are one of the quality AnonymousMonk used to lurk here around.

      Anyway welcome to the monastery tybalt89!

      L*

      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
[reply]
[d/l]

        Thank you!

        Your suspicion is correct, I have been lurking around. Most of my AnonymousMonk postings can be identified by the code block having the thread URL in a comment on the third line, like Re^2: Parsing with perl - Regexes and beyond in this thread.

[reply]

      Thanks for the heads up. I'll amend the post above with your fix just in case someone else comes looking.

      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
Re^2: Parsing with perl - Regexes and beyond
by Anonymous Monk on Sep 18, 2016 at 21:19 UTC

    Why so big? And notice all the modules it takes to parse (snicker :).

    It has to be correct because it passes all your test cases :) 

    #!/usr/bin/perl

# http://perlmonks.org/?node=678124

use strict;   # browseruk.pl - modified Pratt parser by tybalt89
use warnings; # https://en.wikipedia.org/wiki/Pratt_parser
sub err { die "ERROR  ", s/\G/ <@_> /r, "\n" }

sub expr # two statement parser - precedences: (3 **) (2 * /) (1 + -)
  {
  my $answer =
    /\G\s* - /gcx    ? -expr(3) :  # unary minus
    /\G\s* \+ /gcx   ? +expr(3) :  # unary plus
    /\G\s* \( /gcx   ? ( expr(0), /\G\s* \) /gcx || err 'missing )' )[
+0] :
    /\G\s* ((?:\d+(?:\.\d*)?|\.\d+)(e[+-]?\d+)?) /gcx ? $1 :
    err 'bad operand';
  $answer =
    /\G\s* \*\* /gcx ? $answer ** expr(3) :
    $_[0] > 2        ? return $answer     :
    /\G\s* \* /gcx   ? $answer * expr(3)  :
    /\G\s* \/ /gcx   ? $answer / expr(3)  :
    $_[0] > 1        ? return $answer     :
    /\G\s* \+ /gcx   ? $answer + expr(2)  :
    /\G\s* \- /gcx   ? $answer - expr(2)  : return $answer while 1;
  }

for ( @ARGV ? @ARGV : <DATA> ) # source as commandline args or DATA
  {
  my $answer = expr(0);
  /\G\s*\z/gc ? print s/\s*\z/ = $answer\n/r : err 'incomplete parse';
  $answer == eval or print "MISMATCH with perl @{[ eval ]}\n";
  }

__DATA__
1 + 2
2 - 1
2 * 1
1 / 2
(((7 + 5) * (9 + 13)) / ((4 + 3) * (17 - 2 + 3)))
23 ** 2
1.1e10 ** -10
1 + 2 * 3
3 + 2 ** 2 ** 2 * 3

    [download]
[reply]
[d/l]

In Section Meditations