moved parser construction into a module

diff --git a/MANIFEST b/MANIFEST
index 619b75f..e52b6bd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3,6 +3,7 @@ Makefile.PL
 MANIFEST
 README
 lib/Keyword.pm
+lib/Keyword/Declare.pm
 lib/Keyword/Parser.pm
 lib/Keyword/Parse/Ident.pm
 lib/Keyword/Parse/Block.pm

diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index 1ecbca5..bbd92d1 100644 (file)
--- a/lib/Keyword.pm
+++ b/lib/Keyword.pm
@@ -5,6 +5,7 @@ use Devel::Declare;
 use B::Hooks::EndOfScope;
 use Data::Dumper;
 use Keyword::Declare;
+use Keyword::Parser;
 use Keyword::Parse::Block;
 use Keyword::Parse::Proto;
 use Keyword::Parse::Ident;
@@ -38,37 +39,33 @@ sub import {
 
 #parses keyword signature
 sub keyword_parser {
-       my $parser = Keyword::Declare->new;
-       $parser->next_token;
-       $parser->skip_ws;
+       my $kd = Keyword::Declare->new;
+       $kd->next_token;
+       $kd->skip_ws;
 
        #strip out the name of new keyword
-       my $keyword = Keyword::Parse::Ident::parse_ident($parser) or
-       die "expecting identifier for keyword near:\n".$parser->line;
+       my $keyword = Keyword::Parse::Ident::parse_ident($kd) or
+       die "expecting identifier for keyword near:\n".$kd->line;
 
-       $parser->skip_ws;
+       $kd->skip_ws;
 
        #extract the prototype
-       my $proto = Keyword::Parse::Proto::parse_proto($parser) or
-       die "expecting prototype for keyword at:\n".$parser->line;
-
-       #produce list of parse routines and there actions from prototype
-       my $plist = proto_to_parselist($proto);
+       my $proto = Keyword::Parse::Proto::parse_proto($kd)     or
+       die "expecting prototype for keyword at:\n".$kd->line;
 
-       #produce sub that executes these routines
-       my $psub = mk_parser($plist,$keyword);
+       my $parser = Keyword::Parser->new({proto=>$proto, module=>$KW_MODULE});
 
        no strict 'refs';
-       *{$KW_MODULE."::import"} = mk_import($psub, $keyword);
+       *{$KW_MODULE."::import"} = mk_import($parser->build, $keyword);
 
-       $parser->skip_ws;
-       my $l = $parser->line;
+       $kd->skip_ws;
+       my $l = $kd->line;
        my $code =  "BEGIN { Keyword::eos()}; ".kw_proto_to_code($proto);
-       substr($l, $parser->offset+1, 0) = $code;
-       $parser->line($l);
+       substr($l, $kd->offset+1, 0) = $code;
+       $kd->line($l);
 
        #install shadow for keyword routine
-       $parser->shadow($parser->package."::".$keyword);
+       $kd->shadow($kd->package."::".$keyword);
 }
 
 # parses the parse keyword
@@ -150,70 +147,6 @@ sub kw_proto_to_code {
 
 sub debug { warn "DEBUG: @_\n" if $DEBUG; }
 
-#converts prototype to a list of parse and action subs
-sub proto_to_parselist {
-       my $proto = shift;
-       $proto =~ s/\s+//g; #
-       
-       my @pa;
-
-       for my $ident (split /\,/, $proto){
-               $ident =~ /^[a-z]{1}\w+[\?]?$/i or  
-                       die "bad identifier '$ident' in prototype.";
-               
-               #foptional if ident postfixed with a '?'
-               my $opt;
-               $ident =~ s/\?//g and $opt = 1 if $ident =~ /\?$/;
-
-               my $p = {name=>$ident, opt=>$opt};
-               no strict 'refs';
-               if($ident eq 'ident') {
-                       $p->{parse} = \&{'Keyword::Parse::Ident::parse_ident'};
-                       $p->{action} = \&{$KW_MODULE."::action_ident"};
-                       push @pa, $p;
-               }
-               elsif($ident eq 'proto') {
-                       $p->{parse} = \&{'Keyword::Parse::Proto::parse_proto'};
-                       $p->{action} = \&{$KW_MODULE."::action_proto"};
-                       push @pa, $p;
-               }
-               elsif($ident eq 'block') {
-                       $p->{parse} = \&{'Keyword::Parse::Block::new'};
-                       $p->{action} = sub{return @_};
-                       push @pa, $p;
-               }
-               else {  #custom parse routine
-                       $p->{parse} = \&{$KW_MODULE."::parse_$ident"};
-                       $p->{action} = \&{$KW_MODULE."::action_$ident"};
-                       push @pa, $p;
-               }
-       }
-
-       return \@pa;
-}
-
-sub mk_parser {
-       my ($plist,$keyword) = @_;
-       return sub {
-               my $parser = Keyword::Declare->new;
-               $parser->next_token;
-               $parser->skip_ws;
-
-               my @arg;
-
-               #call each parse routine and action
-               for my $r (@$plist) {
-                       #TODO: add evals
-                       my $match = &{$r->{parse}}($parser); 
-                       $parser->skip_ws;
-                       die "failed to match parse action $r->{name}" unless $match or $r->{opt};
-                       debug("matched '$match' for $r->{name}");
-                       push @arg, &{$r->{action}}($match);
-               }
-
-               &{$Keyword::__keyword_block}(@arg);
-       };
-}
 
 # build import routine for new keyword module
 sub mk_import {

diff --git a/lib/Keyword/Parser.pm b/lib/Keyword/Parser.pm
new file mode 100644 (file)
index 0000000..3764fa4
--- /dev/null
+++ b/lib/Keyword/Parser.pm
@@ -0,0 +1,96 @@
+package Keyword::Parser;
+use strict;
+use warnings;
+use Keyword::Declare;
+
+our %BUILTIN = (
+       proto => 'Keyword::Parse::Proto::parse_proto',
+       ident => 'Keyword::Parse::Ident::parse_ident',
+       block => 'Keyword::Parse::Block::new',
+);
+
+sub new {
+       my ($class, $self) = @_;
+       $self->{proto} or die 'no proto provided';
+       $self->{module} or die 'no module provided';
+       bless($self,$class);    
+}
+
+sub build {
+       my $self = shift;
+       $self->_build_ident_list;
+       $self->_lookup_routines;
+       $self->declare(Keyword::Declare->new);
+       
+       return sub {
+               my @arg;
+               $self->declare->next_token;
+               $self->declare->skip_ws;
+
+               #call each parse routine and action
+               for my $pa (@{$self->{plist}}) {
+                       push @arg, $self->exec($pa);    
+               }
+
+               return &{$Keyword::__keyword_block}(@arg);
+       };
+}
+
+sub declare {
+       my ($self, $d) = @_;
+       $self->{declare} = $d if $d;
+       return $self->{declare};
+}
+
+#executes a parse routine and its action
+sub exec {
+       my ($self, $pa) = @_;
+       my $match = &{$pa->{parse}}($self->declare); 
+       $self->declare->skip_ws;
+       die "failed to parse $pa->{name}" unless $match or $pa->{opt};
+       return &{$pa->{action}}($match);
+}
+
+sub _build_ident_list {
+       my $self = shift;
+       $self->{proto} =~ s/\s//g;
+       my @i = split /\,/, $self->{proto};
+       for my $ident (@i){
+               $ident =~ /^[a-z]{1}\w+[\?]?$/i or 
+               die "bad identifier '$ident' in prototype.";
+               my $opt;
+               $ident =~ s/\?//g and $opt = 1 if $ident =~ /\?$/;
+               push @{$self->{plist}}, {name=>lc($ident),optional=>$opt};
+       }
+}
+
+sub _lookup_routines {
+       my $self = shift;
+       for my $p (@{$self->{plist}}) {
+               $p->{parse} = $self->_find_parse_sub($p->{name});
+               $p->{action} = $self->_find_action_sub($p->{name});
+       }
+}
+
+sub _find_parse_sub {
+       my ($self, $ident) = @_;
+       no strict 'refs';
+       if (exists $BUILTIN{$ident}) {
+               return \&{$BUILTIN{$ident}};
+       }
+       else {
+               #       "$self->{module}"->can("parse_$ident");
+               return \&{$self->{module}."::parse_$ident"};
+       }
+}
+
+sub _find_action_sub {
+       my ($self, $ident) = @_;
+       no strict 'refs';
+       if($ident eq 'block') {
+               return sub {@_};
+       }
+       else {
+               return \&{$self->{module}."::action_$ident"};
+       }
+}