From: Robin Edwards <robin.ge@gmail.com>
Date: Tue, 15 Dec 2009 19:41:10 +0000 (+0000)
Subject: moved parser construction into a module
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1e9e66cdc7697343ce593827972e5d62346fe6f7;p=p5sagit%2FDevel-Declare-Keyword.git

moved parser construction into a module
---

diff --git a/MANIFEST b/MANIFEST
index 619b75f..e52b6bd 100644
--- 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
--- 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
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"};
+	}
+}