Here's a patch to fix logical ops in the Parrot Scheme compiler. The
patch:
- Implements (min) and (max) which had stubs and some =pod'd out code
which I couldn't understand.
- Fixes (=), (<), (>), (<=) and (>=) to work with more than 2 operands.
Added tests where they were missing and fixed tests that were
incorrectly passing.
After this patch "make test" has no failures on my box. Question:
- Why does Scheme::Generator::_save(2) return an array of three
elements? I tried to "fix" _save() and that just broke things...
I must be missing something!
-sam
PS: Can we get this into languages/scheme?
diff -ru scheme.orig/Scheme/Generator.pm scheme/Scheme/Generator.pm
--- scheme.orig/Scheme/Generator.pm Thu Oct 18 15:44:43 2001
+++ scheme/Scheme/Generator.pm Sat Oct 20 17:36:19 2001
@@ -244,8 +244,9 @@
$self->_add_inst('','set',["I$return",0]);
$self->_generate($node->{children}[0],$temp[0]);
for(1..$#{$node->{children}}) {
- $self->_generate($node->{children}[1],$temp[1]);
+ $self->_generate($node->{children}[$_],$temp[1]);
$self->_add_inst('','ne',["I$temp[0]","I$temp[1]","DONE_$label"]);
+ ($temp[0], $temp[1]) = ($temp[1], $temp[0]);
}
$self->_add_inst('','set',["I$return",1]);
$self->_add_inst("DONE_$label");
@@ -260,8 +261,9 @@
$self->_add_inst('','set',["I$return",0]);
$self->_generate($node->{children}[0],$temp[0]);
for(1..$#{$node->{children}}) {
- $self->_generate($node->{children}[1],$temp[1]);
+ $self->_generate($node->{children}[$_],$temp[1]);
$self->_add_inst('','ge',["I$temp[0]","I$temp[1]","DONE_$label"]);
+ ($temp[0], $temp[1]) = ($temp[1], $temp[0]);
}
$self->_add_inst('','set',["I$return",1]);
$self->_add_inst("DONE_$label");
@@ -276,8 +278,9 @@
$self->_add_inst('','set',["I$return",0]);
$self->_generate($node->{children}[0],$temp[0]);
for(1..$#{$node->{children}}) {
- $self->_generate($node->{children}[1],$temp[1]);
+ $self->_generate($node->{children}[$_],$temp[1]);
$self->_add_inst('','le',["I$temp[0]","I$temp[1]","DONE_$label"]);
+ ($temp[0], $temp[1]) = ($temp[1], $temp[0]);
}
$self->_add_inst('','set',["I$return",1]);
$self->_add_inst("DONE_$label");
@@ -292,8 +295,9 @@
$self->_add_inst('','set',["I$return",0]);
$self->_generate($node->{children}[0],$temp[0]);
for(1..$#{$node->{children}}) {
- $self->_generate($node->{children}[1],$temp[1]);
+ $self->_generate($node->{children}[$_],$temp[1]);
$self->_add_inst('','gt',["I$temp[0]","I$temp[1]","DONE_$label"]);
+ ($temp[0], $temp[1]) = ($temp[1], $temp[0]);
}
$self->_add_inst('','set',["I$return",1]);
$self->_add_inst("DONE_$label");
@@ -308,8 +312,9 @@
$self->_add_inst('','set',["I$return",0]);
$self->_generate($node->{children}[0],$temp[0]);
for(1..$#{$node->{children}}) {
- $self->_generate($node->{children}[1],$temp[1]);
+ $self->_generate($node->{children}[$_],$temp[1]);
$self->_add_inst('','lt',["I$temp[0]","I$temp[1]","DONE_$label"]);
+ ($temp[0], $temp[1]) = ($temp[1], $temp[0]);
}
$self->_add_inst('','set',["I$return",1]);
$self->_add_inst("DONE_$label");
@@ -385,59 +390,32 @@
sub _op_max {
my ($self,$node,$return) = @_;
- my $label = $self->_gensym();
-
- my @temp = _save(1);
- $self->_generate($node->{children}[0],$return);
-
- _restore(@temp);
+ my ($targ) = _save(1);
-=pod
-
- $self->__build_children($node);
-
- $self->_add_inst('','set',[$return,$registers[0]]);
-
- $self->_add_inst('', 'lt', [$registers[0],$return,$label]);
- $self->_add_inst('', 'set',[$return,$registers[0]]);
- for(1..$#registers) {
- my $tmp_label = "NEXT_".$self->_gensym();
- $self->_add_inst($label,'lt' ,[$registers[$_],$return,$tmp_label]);
- $self->_add_inst('', 'set',[$return,$registers[$_]]);
- $label = $tmp_label;
+ $self->_generate($node->{children}[0], $return);
+ for (1 .. $#{$node->{children}}) {
+ my $label = $self->_gensym();
+ $self->_generate($node->{children}[$_], $targ);
+ $self->_add_inst('','le',["I$targ","I$return","SKIP_$label"]);
+ $self->_add_inst('','set',["I$return","I$targ"]);
+ $self->_add_inst("SKIP_$label");
}
- $self->_add_inst($label);
-
-=cut
-
+ _restore($targ);
}
sub _op_min {
+ my ($self,$node,$return) = @_;
+ my ($targ) = _save(1);
-=pod
-
- my $self = shift;
- my $node = shift;
- my $return = "I$node->{register}";
-
- $self->__build_children($node);
- my @registers = map { "I$_->{register}" } @{$node->{children}};
-
- $self->_add_inst('','set',[$return,$registers[0]]);
-
- my $label = "NEXT_".$self->_gensym();
- $self->_add_inst('', 'gt', [$registers[0],$return,$label]);
- $self->_add_inst('', 'set',[$return,$registers[0]]);
- for(1..$#registers) {
- my $tmp_label = "NEXT_".$self->_gensym();
- $self->_add_inst($label,'gt' ,[$registers[$_],$return,$tmp_label]);
- $self->_add_inst('', 'set',[$return,$registers[$_]]);
- $label = $tmp_label;
+ $self->_generate($node->{children}[0], $return);
+ foreach (1 .. $#{$node->{children}}) {
+ my $label = $self->_gensym();
+ $self->_generate($node->{children}[$_], $targ);
+ $self->_add_inst('','ge',["I$targ","I$return","SKIP_$label"]);
+ $self->_add_inst('','set',["I$return","I$targ"]);
+ $self->_add_inst("SKIP_$label");
}
- $self->_add_inst($label);
-
-=cut
-
+ _restore($targ);
}
sub _op_plus {
diff -ru scheme.orig/t/arith/logic.t scheme/t/arith/logic.t
--- scheme.orig/t/arith/logic.t Mon Oct 15 19:36:46 2001
+++ scheme/t/arith/logic.t Sat Oct 20 17:29:01 2001
@@ -1,6 +1,6 @@
#! perl -w
-use Scheme::Test tests => 43;
+use Scheme::Test tests => 54;
###
### Zero?
@@ -143,15 +143,19 @@
CODE
output_is(<<'CODE', 1, 'write (= 0 0 0))');
-(write (= 0 0))
+(write (= 0 0 0))
+CODE
+
+output_is(<<'CODE', 0, 'write (= 0 0 1))');
+(write (= 0 0 1))
CODE
output_is(<<'CODE', 0, 'write (= 1 2 3))');
-(write (= 1 0))
+(write (= 1 2 3))
CODE
output_is(<<'CODE', 0, 'write (= 0 1 1))');
-(write (= 0 1))
+(write (= 0 1 1))
CODE
###
@@ -174,6 +178,10 @@
(write (< 1 1 1))
CODE
+output_is(<<'CODE', 0, 'write (< 1 2 1))');
+(write (< 1 2 1))
+CODE
+
###
### Greater (>)
###
@@ -218,6 +226,42 @@
(write (<= 2 1 1))
CODE
+output_is(<<'CODE', 0, 'write (<= 2 1 2))');
+(write (<= 2 1 2))
+CODE
+
+output_is(<<'CODE', 0, 'write (<= 1 2 1))');
+(write (<= 1 2 1))
+CODE
+
###
### GEQ (>=)
###
+
+output_is(<<'CODE', 1, 'write (>= 0 0))');
+(write (>= 0 0))
+CODE
+
+output_is(<<'CODE', 1, 'write (>= 1 0))');
+(write (>= 1 0))
+CODE
+
+output_is(<<'CODE', 0, 'write (>= 1 2))');
+(write (>= 1 2))
+CODE
+
+output_is(<<'CODE', 1, 'write (>= 2 1 0))');
+(write (>= 2 1 0))
+CODE
+
+output_is(<<'CODE', 1, 'write (>= 2 1 1))');
+(write (>= 2 1 1))
+CODE
+
+output_is(<<'CODE', 0, 'write (>= 2 1 2))');
+(write (>= 2 1 2))
+CODE
+
+output_is(<<'CODE', 0, 'write (>= 1 2 1))');
+(write (>= 1 2 1))
+CODE
