in reply to Parsing and converting Fortran expression [solved]

Fun problem, I enjoyed it, thank you.

This passes your test case ( should teach you to give good test cases :) 

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1139915

use strict; # recursive descent parser using /\G/gc and C generator
use warnings;

my $had = $_ = @ARGV ? "@ARGV" : '.not.foo(1,bar(2)+1,3).and.baz(4,5)'
+;
my $want = '! foo[2][bar[1]][0] && baz[4][3]';

my $answer = expr();
/\G\s* \z /gcx or error(); # verify complete parse
#use YAML; print Dump $answer;

print "had  $had\nwant $want\ngot  ",  $answer->C, "\n";

sub AND::C { '((' . $_[0][0]->C . ') && (' . $_[0][1]->C . '))' }
sub PLUS::C { '((' . $_[0][0]->C . ') + (' . $_[0][1]->C . '))' }
sub NOT::C { '( !(' . $_[0][0]->C . '))' }
sub NUMBER::C { $_[0][0] }
sub ARRAY::C { $_[0][0] . $_[0][1]->C }
sub SUBS::C
  {
  return join '', map { '[(' . $_->C . ')-1]' } reverse @{ $_[0] };
  }

sub expr # left associative => term ([+-] term)*
  {
  my $left = term();
  $left = bless [ $left, term() ], 'AND' while /\G\s* \.and\. /gcx;
  return $left;
  }

sub term # left associative => item ([+] item)*
  {
  my $left = item();
  $left = bless [ $left, item() ], 'PLUS' while /\G\s* \+ /gcx;
  return $left;
  }

sub list
  {
  my $left = bless [ expr() ], 'SUBS';
  push @$left, expr() while /\G\s* , /gcx;
  return $left;
  }

sub item # number, unary minus or (expr)
  {
  /\G\s* (\d+) /gcx and return bless [$1], 'NUMBER';
  /\G\s* \.not\. /gcx and return bless [ item() ], 'NOT';
  /\G\s* (\w+) \s* \( /gcx and do{ # array
    my $arr = $1;
    my $value = list();
    /\G\s* \) /gcx or error();
    return bless [ $arr, $value ], 'ARRAY';
    };
  /\G\s* \( /gcx and # parens
    do{ my $value = expr(); /\G\s* \) /gcx or error(); return $value }
+;
  error();
  }

sub error { die s/\G/ SYNTAX ERROR->/r, "\n" }

[download]

produces 

had  .not.foo(1,bar(2)+1,3).and.baz(4,5)
want ! foo[2][bar[1]][0] && baz[4][3]
got  ((( !(foo[(3)-1][(((bar[(2)-1]) + (1)))-1][(1)-1]))) && (baz[(5)-
+1][(4)-1]))

[download]

There are some (hehehe) extra parens and a few expressions that are not reduced, but any good C compiler will handle that for you. :)

Replies are listed 'Best First'.
Re^2: Parsing and converting Fortran expression
by Anonymous Monk on Aug 26, 2015 at 03:10 UTC

    Alternate version without intermediate parse tree, just building the C code directly. 

    #!/usr/bin/perl

# http://perlmonks.org/?node_id=1139915

use strict; # recursive descent parser using /\G/gc and C generator
use warnings;

my $had = $_ = @ARGV ? "@ARGV" : '.not.foo(1,bar(2)+1,3).and.baz(4,5)'
+;
my $want = '! foo[2][bar[1]][0] && baz[4][3]';

my $answer = expr();
/\G\s* \z /gcx or error(); # verify complete parse

print "had  $had\nwant $want\ngot  $answer\n";

sub expr # left associative => term (.and. term)*
  {
  my $left = term();
  $left = "(($left) && (" . term() . '))' while /\G\s* \.and\. /gcx;
  return $left;
  }

sub term # left associative => item ([+] item)*
  {
  my $left = item();
  $left = "(($left)+(" . item() . '))' while /\G\s* \+ /gcx;
  return $left;
  }

sub list
  {
  my $left = '[(' . expr() . ')-1]';
  $left = '[(' . expr() . ")-1]$left"  while /\G\s* , /gcx;
  return $left;
  }

sub item # number, .not. minus, array, or (expr)
  {
  /\G\s* (\d+) /gcx and return $1;
  /\G\s* \.not\. /gcx and return '!(' . item() . ')';
  /\G\s* (\w+) \s* \( /gcx and do{ # array
    my $arr = $1;
    my $value = list();
    /\G\s* \) /gcx or error();
    return $arr . $value;
    };
  /\G\s* \( /gcx and # parens
    do{ my $value = expr(); /\G\s* \) /gcx or error(); return $value }
+;
  error();
  }

sub error { die s/\G/ SYNTAX ERROR->/r, "\n" }

    [download]
[reply]
[d/l]

      Thanks, this is almost perfect!

      With a few modifications I could use it right away. (Those modifications were required mostly because my original specs were not complete enough. I've added this to handle all logical operators I needed:

      sub op {
  {
    '.and.'  => '&&',
    '.or.'   => '||',
    '.eq.'   => '==',
    '.ne.'   => '!=',
    '.eqv.'  => '==',
    '.neqv.' => '!=',
    '.lt.'   => '<',
    '.gt.'   => '>',
    '.le.'   => '<=',
    '.ge.'   => '>=',
  }->{$_[0]} // $_[0];
}

# left associative => term (.and. term)*
sub expr { 
  my $left = term();
  $left = "(($left) " . op($1) . " (" . term() . '))' while /\G\s* (\.
+\w+\.) /gcx;
  return $left;
}

      [download]

      )

      (I'm the OP, I just can't log in from here, but I'll upvote when I get the chance)

      Thanks again!

[reply]
[d/l]

In Section Seekers of Perl Wisdom