[SPOILER] I love parsing. Parsity parse parse parse

Randy tells me he has been having a rough week, and he is also a
little bummed that there were so few posted solutions to his quiz.  So
I thought I would whip one up for him.  But for some perverse reason,
I whipped up the least useful plausible solution I could.

I used my ancient "py" tool to build the expression parser.  "py" is
one of the weirdest, hackiest hacks I've ever written.  It is a tool
for writing parser programs in Perl, and in some ways it works very
well.  But the way it works is totally bizarre.  You first write a
YACC specification for the grammar you want to parse, and then you run
GNU 'bison' on the specification, in verbose debugging mode.  Then you
run 'py'.  'py' looks at bison's debugging output and reconstructs a
parser for you, written in glorious Perl 4.

On my web page about py, I said:

        Well, it's an awfully silly idea, but it certainly did work,
        and I've been happy with it.  If I got to hacker heaven and
        they asked me what hacks I'd done that would justify letting
        me in, I think I'd mention 'py'.  It was clever, unusual,
        interesting, and satisfied the required constraints.  It was a
        silly project, but a very successful one.

Ten years later, I stil feel about the same.  It warms my evil little
heart to use py again.  (Full details and downloads are at
http://perl.plover.com/py/ .)

Anyway, the resulting module is in three files.  You get Parse.pm,
which requires in two auxiliary files: 'py-skel.pl' is the canned,
table-driven parser produced by 'py', and 'parse-rules.pl' is the
handwritten lexer, some support functions, and the front end.  The
front end is a function called 'parse'.  It gets two arguments.  The
first is the string containing the expression you want to parse.  The
second is a callback function that wil be invoked whenever the parser
wants to evaluate an expression of the form "{blah blah blah}".  It's
up to the callback to decide what value these expressions have.  For
example, it might decide that "{Text::Template}" should evaluate to
the version number of the Text::Template module, and look up and
return the appropriate number.  By changing the callback function, you
can assign any meaning you want to the "{...}" expressions.

'parse' then evaluates the expression and returns the result.

Expressions may have the form

        {blah blah}   (meaning is assigned by the callback function)
        12345         (numbers)
        "..."         (strings)

        expr > expr   
        expr < expr   
        expr >= expr   
        expr <= expr  (numeric comparison operators)

        expr == expr  (these are overloaded to do string comparison 
        expr != expr   if the right-hand argument is a string constant)


        expr && expr  (boolean operators, with the correct precedence 
        expr || expr   and overloading)
        ! expr

        ( expr )

The parser I wrote actually compiles the expression into an abstract
syntax tree, and then evaluates it recursively.  I did this because
that's the easiest way to get the short-circuiting semantics I
wanted.  I omitted the almost-always-useless ^^ operator.

Without further explanation, then, here is Parse.pm, which is just the
tables for the table-driven parser:

-------------------- Parse.pm starts here
#!/usr/bin/perl
# parse language described in parse.output
# Perl source code automatically generated at Tue Sep 28 00:04:34 2004 by
# py v.0.1 25 Aug 1995
# Source code copyright 1995 M-J. Dominus ([email protected])
#

package Parse;
require 'py-skel.pl';
require 'parse-rules.pl';

local $; = "\034";
%act = (
"0negated_expression",	'goto 8',
"0(",	'shift 5',
"0value",	'goto 11',
"0expr",	'goto 32',
"0boolean_expression",	'goto 10',
"0disjunction",	'goto 6',
"0ATOM",	'shift 1',
"0conjunction",	'goto 7',
"0NUMBER",	'shift 3',
"0!",	'shift 2',
"0atomic_expression",	'goto 9',
"0STRING",	'shift 4',
"1\$default",	'reduce 17',
"1End_of_Input",	'goto $',
"1||",	'reduce 16',
"1)",	'reduce 16',
"1&&",	'reduce 16',
"2(",	'shift 5',
"2atomic_expression",	'goto 12',
"2ATOM",	'shift 1',
"2boolean_expression",	'goto 10',
"2value",	'goto 11',
"2NUMBER",	'shift 3',
"2STRING",	'shift 4',
"3\$default",	'reduce 18',
"4\$default",	'reduce 19',
"5boolean_expression",	'goto 10',
"5negated_expression",	'goto 8',
"5atomic_expression",	'goto 9',
"5STRING",	'shift 4',
"5ATOM",	'shift 1',
"5(",	'shift 5',
"5conjunction",	'goto 7',
"5value",	'goto 11',
"5disjunction",	'goto 13',
"5!",	'shift 2',
"5NUMBER",	'shift 3',
"6\$default",	'reduce 1',
"7||",	'shift 14',
"7\$default",	'reduce 2',
"8&&",	'shift 15',
"8\$default",	'reduce 4',
"9\$default",	'reduce 6',
"10\$default",	'reduce 9',
"11==",	'shift 16',
"11!=",	'shift 17',
"11>=",	'shift 19',
"11>",	'shift 18',
"11<=",	'shift 21',
"11<",	'shift 20',
"12\$default",	'reduce 7',
"13)",	'shift 22',
"14value",	'goto 11',
"14STRING",	'shift 4',
"14negated_expression",	'goto 8',
"14ATOM",	'shift 1',
"14(",	'shift 5',
"14atomic_expression",	'goto 9',
"14NUMBER",	'shift 3',
"14conjunction",	'goto 7',
"14!",	'shift 2',
"14disjunction",	'goto 23',
"14boolean_expression",	'goto 10',
"15NUMBER",	'shift 3',
"15STRING",	'shift 4',
"15boolean_expression",	'goto 10',
"15ATOM",	'shift 1',
"15atomic_expression",	'goto 9',
"15!",	'shift 2',
"15negated_expression",	'goto 8',
"15conjunction",	'goto 24',
"15value",	'goto 11',
"15(",	'shift 5',
"16NUMBER",	'shift 3',
"16STRING",	'shift 4',
"16ATOM",	'shift 25',
"16value",	'goto 26',
"17NUMBER",	'shift 3',
"17ATOM",	'shift 25',
"17STRING",	'shift 4',
"17value",	'goto 27',
"18value",	'goto 28',
"18STRING",	'shift 4',
"18NUMBER",	'shift 3',
"18ATOM",	'shift 25',
"19ATOM",	'shift 25',
"19NUMBER",	'shift 3',
"19STRING",	'shift 4',
"19value",	'goto 29',
"20value",	'goto 30',
"20NUMBER",	'shift 3',
"20STRING",	'shift 4',
"20ATOM",	'shift 25',
"21NUMBER",	'shift 3',
"21STRING",	'shift 4',
"21ATOM",	'shift 25',
"21value",	'goto 31',
"22\$default",	'reduce 8',
"23\$default",	'reduce 3',
"24\$default",	'reduce 5',
"25\$default",	'reduce 17',
"26\$default",	'reduce 10',
"27\$default",	'reduce 11',
"28\$default",	'reduce 12',
"29\$default",	'reduce 13',
"30\$default",	'reduce 14',
"31\$default",	'reduce 15',
"32End_of_Input",	'goto 33',
"33End_of_Input",	'goto 34',
"34\$default",	'accept',
);

@length = (0, 1, 1, 3, 1, 3, 1, 2, 3, 1, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, );

@rhs = ('', 'expr', 'disjunction', 'disjunction', 'conjunction', 'conjunction', 'negated_expression', 'negated_expression', 'atomic_expression', 'atomic_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'value', 'value', 'value', );

@rule = (
  '',
  'expr -> disjunction',
  'disjunction -> conjunction',
  'disjunction -> conjunction || disjunction',
  'conjunction -> negated_expression',
  'conjunction -> negated_expression && conjunction',
  'negated_expression -> atomic_expression',
  'negated_expression -> ! atomic_expression',
  'atomic_expression -> \'(\' disjunction \')\'',
  'atomic_expression -> boolean_expression',
  'boolean_expression -> value == value',
  'boolean_expression -> value != value',
  'boolean_expression -> value > value',
  'boolean_expression -> value >= value',
  'boolean_expression -> value < value',
  'boolean_expression -> value <= value',
  'boolean_expression -> ATOM',
  'value -> ATOM',
  'value -> NUMBER',
  'value -> STRING',
);


"Cogito, ergo sum.";

-------------------- Parse.pm ends here


The interesting code is mostly in parse-rules.pl, which contains the
expression evaluator, the lexer, the rules for contructing the AST,
and the front-end parse() function:

-------------------- parse-rules.pl starts here
#
# Reduction rules for parse.pl
# Perl source code automatically generated at Tue Sep 28 00:49:22 2004 by
# py v.0.1 25 Aug 1995
# Source code copyright 1995 M-J. Dominus ([email protected])
#

# rule 1
# expr -> disjunction
sub rule_1 {
  return $_[0];
}

# rule 2
# disjunction -> conjunction
sub rule_2 {
  return $_[0];
}

# rule 3
# disjunction -> conjunction OR disjunction
sub rule_3 {
  return ['||', $_[0], $_[2]];
}

# rule 4
# conjunction -> negated_expression
sub rule_4 {
  return $_[0];
}

# rule 5
# conjunction -> negated_expression AND conjunction
sub rule_5 {
  return ['&&', $_[0], $_[2]];
}

# rule 6
# negated_expression -> atomic_expression
sub rule_6 {
  return $_[0];
}

# rule 7
# negated_expression -> NOT atomic_expression
sub rule_7 {
  return ['!', $_[1]];
}

# rule 8
# atomic_expression -> '(' disjunction ')'
sub rule_8 {
  return $_[1];
}

# rule 9
# atomic_expression -> boolean_expression
sub rule_9 {
  return $_[0];
}

# rule 10
# boolean_expression -> value EQ value
sub rule_10 {
  return ['==', $_[0], $_[2]];
}

# rule 11
# boolean_expression -> value NE value
sub rule_11 {
  return ['!=', $_[0], $_[2]];
}

# rule 12
# boolean_expression -> value GT value
sub rule_12 {
  return ['>', $_[0], $_[2]];
}

# rule 13
# boolean_expression -> value GE value
sub rule_13 {
  return ['>=', $_[0], $_[2]];
}

# rule 14
# boolean_expression -> value LT value
sub rule_14 {
  return ['<', $_[0], $_[2]];
}

# rule 15
# boolean_expression -> value LE value
sub rule_15 {
  return ['<=', $_[0], $_[2]];
}

# rule 16
# boolean_expression -> ATOM
sub rule_16 {
  return ['ATOM', $_[0]];
}

# rule 17
# value -> ATOM
sub rule_17 {
  return ['ATOM', $_[0]];
}

# rule 18
# value -> NUMBER
sub rule_18 {
  return ['NUMBER', $_[0]];
}

# rule 19
# value -> STRING
sub rule_19 {
  return ['STRING', $_[0]];
}

# Main program
#
sub parse {
  my ($string, $callback) = @_;
  set_target($string);
  return if yyparse() != 0;
  my $result = shift @values;
  evaluate($result, $callback);
}

my %op = ('>' =>  sub { $_[0] > $_[1] },
          '<' =>  sub { $_[0] < $_[1] },
          '>=' =>  sub { $_[0] >= $_[1] },
          '<=' =>  sub { $_[0] <= $_[1] },
          '!' =>  sub { ! $_[0] },
          );

sub evaluate {
  my ($expression, $callback) = @_;
  die unless ref $expression;

  my ($primary, @args) = @$expression;
  if ($primary eq 'ATOM') { return $callback->(@args) }
  if ($primary eq 'STRING' || $primary eq 'NUMBER') {
    return $args[0];            # unbox
  }

  # Short-circuiting
  if ($primary eq '&&') {
    my $RESULT = 1;
    for (@args) {
      $RESULT &&= evaluate($_, $callback);
      last unless $RESULT;
    }
    return $RESULT;
  } elsif ($primary eq '||') {
    my $RESULT = undef;
    for (@args) {
      $RESULT ||= evaluate($_, $callback);
      last if $RESULT;
    }
    return $RESULT;
  }  

  # Overloaded == and != operators
  if ($primary eq "==" || $primary eq "!=") {
    my $result;
    if ($args[1][0] eq 'STRING') {
      $result = evaluate($args[0], $callback) eq $args[1][1];
    } else {
      $result = evaluate($args[0], $callback) == $args[1][1];
    }
    return $primary eq "!=" ? !$result : $result;
  }

  # Ordinary operators
  my @vals = map evaluate($_, $callback), @args;
  return $op{$primary}->(@vals);
}

#
# Lexer
#
my $target;

sub set_target {
  $target = shift;
}

sub yylex {
    $target =~ /\G([()])/gc && return $1;
    $target =~ /\G( && | \|\| | ! )/xgc && return $1;
    $target =~ /\G( [=!]= | [<>]=? )/xgc && return $1;
    $target =~ /\G\{([^\}]*)\}/xgc && do { $yylval = $1; return 'ATOM' };
    $target =~ /\G\s+/gc && redo;
    $target =~ /\G([\d.]+)/gc && do { $yylval = $1; return 'NUMBER' };
    $target =~ /\G"([^"]*)"/gc && do { $yylval = $1; return 'STRING' };
    $target =~ /\G$/gc && return 'End_of_Input';
    $target =~ /\G(.)/gc && return 'HUH?';
}

1;

-------------------- parse-rules.pl ends here

The parser itself is in py-skel.pl, and is available from
http://perl.plover.com/py/package/py-skel.pl .

A demonstration program might look like this:

        use Parse;

        $Parse::yydebug = 1 if $ENV{YYDEBUG};

        # This function assigns the meanings of the {...} expressions
        sub callback {
          print "Call back for value of {@_} macro\n";
          return 1 if $_[0] eq "ONE";
          return 2 if $_[0] eq "TWO";
          return 3 if $_[0] eq "THREE";
          return "00" if $_[0] eq "double zero";
          return 0;
        }

        my $result = Parse::parse('{ONE} > 2 || {TWO} < 3 && {THREE}  == 3', \&callback);
        print $result ? "yes\n" : "no\n";


The result here is 'true', and by playing around with the conditions
you can see that the short-circuiting is working properly.

Notice that you can enable py's built-in diagnostic output by setting
YYDEBUG.

If you don't like the overloading semantics, they are easy to change.
For example, it would be the work of a few minutes to have the parser
raise an error if you try to compare a number with a string using
"==", or to overload "<" to behave like "lt" when operating on
strings.  

Anyway, my goal was to provide the most useless and absurd possible
working solution, and Randy will have to judge how well I succeeded.

Share and enjoy!