Possibilities of event-based parsing

[ Sorry, this mail has gotten a bit long. ]

[ Warning: visionary rambling ahead. ]

I want to separate the grammar from the actions so that one grammar
can be used modularly for many purposes. The reasons for wanting to
do so are given in loving detail below.

XML::Parser and HTML::Parser use callbacks to do that; 
XML::Parser::PerlSAX
uses an event handling object on which methods are called at
appropriate times during the parse. This wouldn't work for P::RD
as only the finished parse tree determines what events (start/end
of grammar, start/end of rule etc.) should be raised. That is, we
shouldn't raise events during the parse for backtracking reasons.

Walking the parse tree constructed using the <autotree> directive,
as shown by Damian in
http://archive.develooper.com/[email protected]/msg00029.html,
can help there.

To make things even easier, I've written 
Parse::RecDescent::AutoTreeWalker,
which you can hand a parse tree and it calls back handler subs at
appropriate times. The advantage of using this module is that you
don't have to specify subroutines for uninteresting points in the
parse tree that do nothing more but traverse subnodes.

Per Damian's example, rule names are still treated as package names,
but the AutoTreeWalker checks for three special subroutines in
those packages if and when the corresponding nodes in the parse
tree are encountered:

         sub myrulename::start { ... }

is called when the node is encountered during parse tree traversal,
but before subnodes are processed.

         sub myrulename::end   { ... }

is called after those subnodes have been processed

         sub myrulename::order { ... }

is called before subnodes of a given node are processed. The sub
is given the names (hash keys) of those subnodes and expected to
return an ordered list (or sublist) of those names. This is useful
to indicate the order in which subnodes should be traversed, as
this is a tree structure. The SQL example below will make this
obvious.

Why didn't I package this up as a module? Several reasons. First,
it's destined to be part of a bigger distribution. Second, I wanted
to elicit some feedback from this list.

Anyway, all that's quite nice, but I've got bigger plans for it.
Using a metagrammar (a grammar that can parse P::RD grammars) you
could write a grammar beautifier, validator etc. All you have to
change is the event handler subs called by walk(); the metagrammar
itself can be modular. You could also generate documentation for
a grammar, in POD, HTML, LaTeX etc.

You could parse (E)BNF and convert it to a P::RD grammar. You could
use the metagrammar to take any specific grammar and insert breakpoint
actions that you can then use to view the parse in the debugger.

You could use the metagrammar to preprocess other grammars and
implement new kinds of directives, like <include:somefile.prd> that
includes a modular grammar at the specific point.

You could parse regular expressions and create the equivalent
grammar.

The possibilities are endless, and separating the grammar from the
actions gives you a lot of reusability.

Following is the necessary code to illustrate all that.

-----------cut-----------cut-----------cut-----------cut-----------cut----------

package Parse::RecDescent::AutoTreeWalker;

use base 'Exporter';

our %EXPORT_TAGS = (all => [ qw/walk WALK_NEXT WALK_TERM/ ]);
our @EXPORT_OK   = @{ $EXPORT_TAGS{all} };

use constant WALK_NEXT => 'walk_next';
use constant WALK_TERM => 'walk_term';

sub walk {
         my $node = shift;

         my $nref = ref($node);
         return unless $nref;

         if ($nref eq 'ARRAY') {
                 for my $el (@$node) { walk($el) }
                 return;
         }

         my $rv = WALK_NEXT;
         $rv = $node->start if $node->can('start');

         if ($rv ne WALK_TERM) {
                 my @items = keys %$node;
                 @items = $node->order(@items) if $node->can('order');
                 for my $item (@items) {
                         my $val = $node->{$item};
                         next unless ref $val;
                         for my $el (ref $val eq 'ARRAY' ? @$val : $val) {
                                 walk($el);
                         }
                 }
         }

         $rv = $node->end if $node->can('end');
}

1;

-----------cut-----------cut-----------cut-----------cut-----------cut----------

Here is an example of a grammar and input using this module. It's
supposed to parse a very limited subset of SQL, just enough to
parse a few simple 'create table' statements. Suggestions on how
to make the grammar simpler are welcome.

-----------cut-----------cut-----------cut-----------cut-----------cut----------

<autotree>

start      : table_def(s) /^\Z/
table_def  : /create/i /table/i table_name '(' table_item(s /,/) ')' ';'
table_name : /\w+/
table_item : field_def | constraint_def
field_def  : field_name field_type field_prop(s?)
field_name : /\w+/

field_type : char_type | varchar_type | int_type  | decimal_type |
              date_type | time_type    | text_type | serial_type

char_type    : /char/i '(' size ')'
varchar_type : /varchar/i '(' size ')'
int_type     : /int4/i
decimal_type : /decimal/i '(' size ',' precision ')'
date_type    : /date/i
time_type    : /time/i
text_type    : /text/i
serial_type  : /serial/i

constraint_def : /constraint/i constraint_name /foreign/i /key/i
     '(' cons_field_name ')' /references/i ref_table_name '(' 
ref_field_name ')'

cons_field_name : /\w+/
ref_field_name  : /\w+/
ref_table_name  : /\w+/
field_prop      : default_prop | notnull_prop | constraint_prop | pk_prop
default_prop    : /default/i ( single_quote_value | double_quote_value )
notnull_prop    : /not/i /null/i
constraint_prop : /constraint/i constraint_name pk_prop
pk_prop         : /primary/i /key/i
constraint_name : /\w+/

single_quote_value : "'" <skip:''> /.*?(?=')/ "'"
double_quote_value : '"' <skip:''> /.*?(?=")/ '"'

size      : /\d+/
precision : /\d+/

-----------cut-----------cut-----------cut-----------cut-----------cut----------

Here's a sample SQL file with some create statements (capitalization not
my own, this was generated):

-----------cut-----------cut-----------cut-----------cut-----------cut----------

CREATE TABLE Countries(
	id serial CONSTRAINT PK_Countries1 PRIMARY KEY,
	code2 varchar(2),
	code3 varchar(3),
	name varchar(255)
);


CREATE TABLE Parameters(
	id serial CONSTRAINT PK_Parameters1 PRIMARY KEY,
	Code varchar(40),
	Name varchar(255),
	Unit varchar(25)
);

-----------cut-----------cut-----------cut-----------cut-----------cut----------

Now the parse tree returned by this grammar and input, when walked using 
the
following program, outputs POD that describes the schema.

-----------cut-----------cut-----------cut-----------cut-----------cut----------

	use Parse::RecDescent::AutoTreeWalker 'walk';
	...
	$tree = $parser->start(...);
	walk($tree);

	# __DIRECTIVE1__ in table_def is the "table_item(s /,/)"

     sub table_def::order { qw/table_name __DIRECTIVE1__/ }
     sub field_def::order { qw/field_name field_type field_prop/ }

     sub table_name::start { print qq!

     =head2 $_[0]->{__VALUE__}

     This table has the following fields:

     =over 4

     ! }

     sub table_def::end      { print "=back\n\n" }
     sub field_name::start   { print "=item $_[0]->{__VALUE__}\n\n" }

     sub char_type::start    { print 
"char($_[0]->{size}{__VALUE__})\n\n" }
     sub varchar_type::start { print 
"varchar($_[0]->{size}{__VALUE__})\n\n" }
     sub int_type::start     { print "int4\n\n" }
     sub serial_type::start  { print "serial number (int4)\n\n" }

     sub pk_prop::start      { print "This is the primary key.\n\n" }

-----------cut-----------cut-----------cut-----------cut-----------cut----------

Marcel

--
Aspect-Oriented Perl            http://codewerk.unixbeard.net/aspects/
cpan> install Aspect