This module aims to provide an easy interface to Devel::Declare.
PLAN
+* STOP BLOCKLESS BEING EXECUTED AT COMPILE TIME
* find usescases from: http://cpants.perl.org/dist/used_by/Devel-Declare
* and go through perl's -existing- keywords print $fh "sddfsd". $f, $c etc
* look at ... metalua ... and common lisp reader macros.
#strip out the name of new keyword
my $keyword = parse_ident($kd) or
- croak "expecting identifier for keyword near:\n".$kd->line;
+ confess "expecting identifier for keyword near:\n".$kd->line;
$kd->skip_ws;
#extract the prototype
my $proto = parse_proto($kd) or
- croak "expecting prototype for keyword at:\n".$kd->line;
+ confess "expecting prototype for keyword at:\n".$kd->line;
my $b = 1 if $proto =~ /block/i;
- my $parser = Keyword::Parser->new({proto=>$proto, module=>$KW_MODULE, noblock=>$b});
+ my $parser = Keyword::Parser->new({proto=>$proto,
+ module=>$KW_MODULE, noblock=>$b, keyword=>$keyword});
no strict 'refs';
*{$KW_MODULE."::import"} = mk_import($parser->build, $keyword, $b);
#strip out the name of parse routine
my $name = parse_ident($kd) or
- croak "expecting identifier for parse near:\n".$kd->line;
+ confess "expecting identifier for parse near:\n".$kd->line;
$kd->skip_ws;
my $proto = parse_proto($kd) or
- croak "expecting prototype for parse at:\n".$kd->line;
+ confess "expecting prototype for parse at:\n".$kd->line;
$kd->skip_ws;
my $l = $kd->line;
#strip out the name of action
my $name = parse_ident($kd) or
- croak "expecting identifier for action near:\n".$kd->line;
+ confess "expecting identifier for action near:\n".$kd->line;
$kd->skip_ws;
my $proto = parse_proto($kd) or
- croak "expecting prototype for action at:\n".$kd->line;
+ confess "expecting prototype for action at:\n".$kd->line;
$kd->skip_ws;
my $l = $kd->line;
};
}
else {
- *{$module_user."::$keyword"} = sub { };
+ *{$module_user."::$keyword"} = sub {
+ $Keyword::__keyword_block_ret; };
}
};
}
package Keyword::Declare;
use strict;
use warnings;
+use Carp;
use Devel::Declare;
# maybe subclass Devel::Declare::Context::Simple?
return ${$self->{offset}};
}
+sub inc_offset {
+ my ($self, $offset) = @_;
+ if($offset) {
+ ${$self->{offset}} += $offset;
+ }
+ else {
+ ${$self->{offset}}++;
+ }
+ return ${$self->{offset}};
+}
sub next_token {
my ($self) = @_;
${$self->{offset}} += Devel::Declare::toke_move_past_token($self->offset);
}
+sub skip_to {
+ my ($self, $name) = @_;
+ my $toke = "";
+ while ($toke ne $name) {
+ my $len = $self->scan_word(1);
+ my $l = $self->line;
+ $toke = substr($l, $self->offset, $len);
+ $self->offset($len + $self->offset);
+ $self->inc_offset;
+ confess "couldn't find '$name' on this line" if $toke and $toke =~ /\n/;
+ }
+ return $toke;
+}
+
+sub strip_to_char {
+ my ($self, $char) = @_;
+ my $str = "";
+ while ($str !~ /$char/) {
+ my $l = $self->line;
+ $str .= substr($l, $self->offset, 1);
+ substr($l, $self->offset, 1) = '';
+ $self->line($l);
+ }
+ return $str;
+}
+
+sub terminate {
+ my ($self) = shift;
+ my $l = $self->line;
+ substr($l, $self->offset, 1) = ';';
+ $self->line($l);
+}
+
sub skip_ws {
my ($self) = @_;
- ${$self->{offset}} += Devel::Declare::toke_skipspace($self->offset);
+ ${$self->{offset}} += Devel::Declare::toke_skipspace($self->offset);
}
sub scan_word {
use warnings;
use Carp;
use Keyword::Declare;
+use Data::Dumper;
our %BUILTIN = (
proto => 'Keyword::Parse::Proto::parse_proto',
sub new {
my ($class, $self) = @_;
- $self->{proto} or croak 'no proto provided';
- $self->{module} or croak 'no module provided';
+ $self->{proto} or confess 'no proto provided';
+ $self->{module} or confess 'no module provided';
+ $self->{keyword} or confess 'no keyword provided';
bless($self,$class);
}
return sub {
my @arg;
- $self->declare->next_token;
- $self->declare->skip_ws;
+ $self->declare->skip_to($self->{keyword});
#call each parse routine and action
for my $pa (@{$self->{plist}}) {
push @arg, $self->exec($pa);
}
-
+
&{$Keyword::__keyword_block}(@arg);
};
}
my ($self, $pa) = @_;
my $match = &{$pa->{parse}}($self->declare);
$self->declare->skip_ws;
- croak "failed to parse $pa->{name}" unless $match or $pa->{opt};
+ confess "failed to parse $pa->{name}" unless $match or $pa->{opt};
return &{$pa->{action}}($match);
}
my @i = split /\,/, $self->{proto};
for my $ident (@i){
$ident =~ /^[a-z]{1}\w+[\?]?$/i or
- croak "bad identifier '$ident' in prototype.";
+ confess "bad identifier '$ident' in prototype.";
my $opt;
$ident =~ s/\?//g and $opt = 1 if $ident =~ /\?$/;
push @{$self->{plist}}, {name=>lc($ident),optional=>$opt};