Here's a patch to re-fix comparisions in the Scheme compiler. The
patch:
- Makes (<),(>),(<=),(>=) and (=) behave correctly on more than two
args.
- Adds tests to affirm this and fixes tests that were incorrect.
Sidenote: I don't think it's going to be possible to do static type
inference with Scheme... At least not once we have (set) and (let)
anyway! As a result, I think we need move everything into PMCs ASAP.
After that we won't need a more complicated _save() and _restore()
system since we'll only be ever be generating Px register references.
Does that make sense to you?
-sam
PS: CVS! CVS! CVS CVS CVS!
diff -ru scheme.orig/Scheme/Generator.pm scheme/Scheme/Generator.pm
--- scheme.orig/Scheme/Generator.pm Sat Oct 20 11:10:01 2001
+++ scheme/Scheme/Generator.pm Tue Oct 23 11:29:46 2001
@@ -250,8 +250,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");
@@ -266,8 +267,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");
@@ -282,8 +284,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");
@@ -298,8 +301,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");
@@ -314,8 +318,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");
Only in scheme/t/arith: #logic44.pasm#
Only in scheme/t/arith: .#logic44.pasm
diff -ru scheme.orig/t/arith/logic.t scheme/t/arith/logic.t
--- scheme.orig/t/arith/logic.t Sat Oct 20 18:53:20 2001
+++ scheme/t/arith/logic.t Tue Oct 23 11:32:23 2001
@@ -1,6 +1,6 @@
#! perl -w
-use Scheme::Test tests => 49;
+use Scheme::Test tests => 51;
###
### Zero?
@@ -194,9 +194,9 @@
(write (> 2 1 0))
CODE
-#output_is(<<'CODE', 0, 'write (> 2 1 1))');
-#(write (> 2 1 1))
-#CODE
+output_is(<<'CODE', 0, 'write (> 2 1 1))');
+(write (> 2 1 1))
+CODE
###
### LEQ (<=)
@@ -218,8 +218,8 @@
(write (<= 2 1 0))
CODE
-output_is(<<'CODE', 0, 'write (<= 2 1 1))');
-(write (<= 2 1 1))
+output_is(<<'CODE', 1, 'write (<= 1 2 2))');
+(write (<= 1 2 2))
CODE
###
@@ -246,7 +246,10 @@
(write (>= 2 1 1))
CODE
-output_is(<<'CODE', 1, 'write (>= 2 1 2))');
+output_is(<<'CODE', 0, 'write (>= 2 1 2))');
(write (>= 2 1 2))
CODE
+output_is(<<'CODE', 0, 'write (>= 2 3 2))');
+(write (>= 2 3 2))
+CODE
