cvsuser 04/05/23 23:30:13
Modified: languages/perl6/P6C IMCC.pm Rules.pm
languages/perl6/P6C/IMCC Binop.pm
languages/perl6/P6C/IMCC/ExtRegex Adapter.pm
Removed: languages/perl6/P6C/IMCC rule.pm
Log:
Remove original regex implementation.
Revision Changes Path
1.36 +1 -34 parrot/languages/perl6/P6C/IMCC.pm
Index: IMCC.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/IMCC.pm,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -w -r1.35 -r1.36
--- IMCC.pm 8 May 2004 16:44:58 -0000 1.35
+++ IMCC.pm 24 May 2004 06:30:05 -0000 1.36
@@ -1617,7 +1617,7 @@
# Rules have a set of undeclared parameters.
- if ($x->is_rule && ! $ENV{ORIGINAL_REGEXES}) {
+ if ($x->is_rule) {
unshift(@params, P6C::Rules::rule_vars());
}
@@ -2192,7 +2192,6 @@
=cut
package P6C::rule;
-use P6C::IMCC::rule;
use P6C::IMCC ':all';
require P6C::Util;
@@ -2202,36 +2201,6 @@
return $ret;
}
-sub orig_regex_val {
- my $x = shift;
- my $fail = genlabel 'match_failed';
- my $precode;
- my $rxstr = gentmp 'str';
- my $rxpos = gentmp 'int';
- my $isback = gentmp 'int';
- my $fake_back = genlabel 'XXX';
- code(<<END);
- restore $rxstr
- rx_popindex $rxpos, $fake_back
-END
- $x->{ctx}{rx_pos} = $rxpos;
- $x->{ctx}{rx_thing} = $rxstr;
- $x->{ctx}{rx_fail} = $fail;
- my $ret = $x->{ctx}{rx_matchobj} = $x->prepare_match_object;
- my $back = P6C::IMCC::rule::rx_val($x);
- my $end = genlabel 'end';
- fixup_label($fake_back, $back);
- code(<<END);
- rx_pushindex $rxpos
- goto $end
-$fail:
- $ret = new PerlUndef
- rx_pushmark
-$end:
-END
- return scalar_in_context($ret, $x->{ctx});
-}
-
=item B<val()> : rule -> match obj
Generate code defining a rule
@@ -2257,8 +2226,6 @@
=cut
sub val {
- return orig_regex_val(@_) if $ENV{ORIGINAL_REGEXES};
-
my ($rule) = @_;
# FIXME
1.2 +0 -4 parrot/languages/perl6/P6C/Rules.pm
Index: Rules.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/Rules.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- Rules.pm 29 Jan 2004 05:51:54 -0000 1.1
+++ Rules.pm 24 May 2004 06:30:05 -0000 1.2
@@ -38,8 +38,6 @@
sub adjust_rule {
my ($func) = @_;
- return if $ENV{ORIGINAL_REGEXES};
-
if (! defined($func->params)) {
$func->params(new P6C::signature);
}
@@ -85,7 +83,6 @@
sub adjust_call {
my ($call) = @_;
- return if $ENV{ORIGINAL_REGEXES};
my $args = $call->args;
my $LIT = 'P6C::IMCC::ExtRegex::literal';
@@ -93,7 +90,6 @@
($LIT->new(type => 'IntList')), # stack -- HACK!! FIXME!!
($LIT->new(type => 'str')), # input
($LIT->new(type => 'int')) ); # pos
- $DB::single = 1 unless $args->isa('P6C::ValueList');
die unless $args->isa('P6C::ValueList');
# if ($args->isa('P6C::ValueList')) {
unshift @{ $args->vals }, @argvals;
1.19 +0 -47 parrot/languages/perl6/P6C/IMCC/Binop.pm
Index: Binop.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/IMCC/Binop.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- Binop.pm 23 May 2004 05:12:47 -0000 1.18
+++ Binop.pm 24 May 2004 06:30:09 -0000 1.19
@@ -338,51 +338,6 @@
return scalar_in_context($res, $ctx);
}
-sub sm_expr_pattern_orig {
- my ($e, $r, $ctx) = @_;
- my $val = $e->val;
- my $begin = genlabel 'startre';
- my $adv = $r->{ctx}{rx_fail} = genlabel 'advance';
- my $str = $r->{ctx}{rx_thing} = gentmp 'str';
- my $pos = $r->{ctx}{rx_pos} = gentmp 'int';
- my $basepos = gentmp 'int';
- my $fail = genlabel 'rx_fail';
- my $end = genlabel 'rx_end';
- code(<<END);
- rx_clearstack # XXX: good old non-reentrant engine.
- rx_initstack
- $str = $val
-
- $pos = 0
- $basepos = 0
- goto $begin
-$adv:
- $pos = $basepos
- rx_advance $str, $pos, $fail
- inc $basepos
-$begin:
-END
- my $ret = $r->{ctx}{rx_matchobj} = $r->prepare_match_object;
- $r->{ctx}{rx_pos} = $pos;
- $r->{ctx}{rx_thing} = $str;
- $r->{ctx}{rx_fail} = $adv;
- P6C::IMCC::rule::rx_val($r);
- code(<<END);
- goto $end
-$fail:
- $ret = new PerlUndef
-$end:
-END
- if ($ctx->type eq 'bool') {
- my $itmp = gentmp 'int';
- code(<<END);
- $itmp = defined $ret
-END
- return primitive_in_context($itmp, 'int', $ctx);
- }
- return scalar_in_context($ret, $ctx);
-}
-
=head1 sm_expr_pattern($expr,$R,$ctx)
Generate code to match the string $expr against the regex $R.
@@ -391,8 +346,6 @@
my $namespace_ctr = 0;
sub sm_expr_pattern {
- return &sm_expr_pattern_orig if $ENV{ORIGINAL_REGEXES};
-
my ($expr, $R, $ctx) = @_;
my $namespace = "regex".++$namespace_ctr;
1.3 +8 -4 parrot/languages/perl6/P6C/IMCC/ExtRegex/Adapter.pm
Index: Adapter.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/IMCC/ExtRegex/Adapter.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Adapter.pm 29 Apr 2004 07:01:15 -0000 1.2
+++ Adapter.pm 24 May 2004 06:30:13 -0000 1.3
@@ -117,10 +117,9 @@
my ($self, $tree, $ctx) = @_;
my $atom = $tree->atom;
+
my $R;
- if (UNIVERSAL::can($atom, 'rx_val')) {
- $R = $self->convert($atom);
- } elsif (ref($atom) eq 'ARRAY') {
+ if (ref($atom) eq 'ARRAY') {
# Codeblock
$R = op('code' => [ $atom, $ctx ]);
} elsif (UNIVERSAL::can($atom, 'type') && $atom->type eq 'PerlArray') {
@@ -128,8 +127,13 @@
} elsif ($atom->isa('P6C::sv_literal') && is_string($atom->type)) {
$R = $self->convert_sv_literal($atom, $ctx);
} else {
+ my ($stem) = ref($atom) =~ /^P6C::(\w+)$/;
+ if (defined($stem) && $self->can("convert_$stem")) {
+ $R = $self->convert($atom);
+ } else {
$R = op('string' => [ $atom, $ctx ]);
}
+ }
if ($tree->capture) {
return op('group' => [ $R, ++$PAREN ]); # FIXME!!!
