[PATCH] Re-fixes comparisions in Parrot Scheme compiler

[Sam Tregar]

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