From c4b8459641c006711c5b3b58cff29fdbd7ef8acc Mon Sep 17 00:00:00 2001
From: pmichaud <pmichaud@pobox.com>
Date: Mon, 26 Oct 2009 15:21:23 -0500
Subject: [PATCH] [nqp]:  Add relational ops, prefix ops.

---
 src/HLL/Actions.pm |  2 +-
 src/NQP/Actions.pm |  1 +
 src/NQP/Grammar.pm | 22 ++++++++++-
 t/nqp/10-cmp.t     | 98 ++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 120 insertions(+), 3 deletions(-)
 create mode 100644 t/nqp/10-cmp.t

diff --git a/src/HLL/Actions.pm b/src/HLL/Actions.pm
index 50ed43c..ef81a22 100644
--- a/src/HLL/Actions.pm
+++ b/src/HLL/Actions.pm
@@ -7,7 +7,7 @@ method EXPR($/, $key?) {
         $past := PAST::Op.new( :node($/) );
         if $<OPER><O><pasttype> { $past.pasttype( ~$<OPER><O><pasttype> ); }
         elsif $<OPER><O><pirop>    { $past.pirop( ~$<OPER><O><pirop> ); }
-        else {
+        unless $past.name {
             if $key eq 'LIST' { $key := 'infix'; }
             my $name := Q:PIR {
                 $P0 = find_lex '$key'
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
index 7efbb90..5c180ec 100644
--- a/src/NQP/Actions.pm
+++ b/src/NQP/Actions.pm
@@ -217,6 +217,7 @@ NQP::Grammar.O(':prec<v=>, :assoc<unary>', '%symbolic_unary');
 NQP::Grammar.O(':prec<u=>, :assoc<left>',  '%multiplicative');
 NQP::Grammar.O(':prec<t=>, :assoc<left>',  '%additive');
 NQP::Grammar.O(':prec<r=>, :assoc<list>',  '%concatenation'); 
+NQP::Grammar.O(':prec<m=>, :assoc<left>',  '%relational');
 NQP::Grammar.O(':prec<i=>, :assoc<right>', '%assignment');
 NQP::Grammar.O(':prec<g=>, :assoc<list>, :nextterm<nulltermish>',  '%comma');
 NQP::Grammar.O(':prec<f=>, :assoc<list>',  '%list_infix');
diff --git a/src/NQP/Grammar.pm b/src/NQP/Grammar.pm
index de819e4..6d7c960 100644
--- a/src/NQP/Grammar.pm
+++ b/src/NQP/Grammar.pm
@@ -165,7 +165,9 @@ token postfix:sym<++> { <sym>  <O('%autoincrement')> }
 
 token infix:sym<**>   { <sym>  <O('%exponentiation, :pirop<pow>')> }
 
-token prefix:sym<->   { <sym>  <O('%symbolic_unary')> }
+token prefix:sym<+>   { <sym>  <O('%symbolic_unary, :pirop<set N*>')> }
+token prefix:sym<~>   { <sym>  <O('%symbolic_unary, :pirop<set S*>')> }
+token prefix:sym<->   { <sym>  <O('%symbolic_unary, :pirop<neg>')> }
 token prefix:sym<?>   { <sym>  <O('%symbolic_unary, :pirop<istrue>')> }
 token prefix:sym<!>   { <sym>  <O('%symbolic_unary, :pirop<isfalse>')> }
 
@@ -178,6 +180,22 @@ token infix:sym<->    { <sym>  <O('%additive, :pirop<sub>')> }
 
 token infix:sym<~>    { <sym>  <O('%concatenation , :pirop<concat>')> }
 
+token infix:sym«==»   { <sym>  <O('%relational, :pirop<iseq INn>')> }
+token infix:sym«!=»   { <sym>  <O('%relational, :pirop<isne INn>')> }
+token infix:sym«<=»   { <sym>  <O('%relational, :pirop<isle INn>')> }
+token infix:sym«>=»   { <sym>  <O('%relational, :pirop<isge INn>')> }
+token infix:sym«<»    { <sym>  <O('%relational, :pirop<islt INn>')> }
+token infix:sym«>»    { <sym>  <O('%relational, :pirop<isgt INn>')> }
+token infix:sym«eq»   { <sym>  <O('%relational, :pirop<iseq ISs>')> }
+token infix:sym«ne»   { <sym>  <O('%relational, :pirop<isne ISs>')> }
+token infix:sym«le»   { <sym>  <O('%relational, :pirop<isle ISs>')> }
+token infix:sym«ge»   { <sym>  <O('%relational, :pirop<isge ISs>')> }
+token infix:sym«lt»   { <sym>  <O('%relational, :pirop<islt ISs>')> }
+token infix:sym«gt»   { <sym>  <O('%relational, :pirop<isgt ISs>')> }
+token infix:sym«=:=»  { <sym>  <O('%relational, :pirop<issame>')> }
+
+
 token infix:sym<:=>   { <sym>  <O('%assignment, :pasttype<bind>')> }
+token infix:sym<::=>  { <sym>  <O('%assignment, :pasttype<bind>')> }
 
-token infix:sym<,>    { <sym>  <O('%comma')> }
+token infix:sym<,>    { <sym>  <O('%comma, :pasttype<list>')> }
diff --git a/t/nqp/10-cmp.t b/t/nqp/10-cmp.t
new file mode 100644
index 0000000..ff331c0
--- /dev/null
+++ b/t/nqp/10-cmp.t
@@ -0,0 +1,98 @@
+#! nqp
+
+# check comparisons
+
+say('1..19');
+
+##Integers, positive and negative
+
+if 1 == 1 { say("ok 1 # numeric equality, integers"); }
+
+unless 1 == 2 {
+    say("ok 2 # numeric equality, integers, not equal");
+}
+
+if -3 == -3 { say("ok 3 # numeric equality, negative integers"); }
+
+if 1 != 2 { say("ok 4 # numeric inequality, integers"); }
+
+unless 1 != 1 {
+    say("ok 5 # numeric inequality, equal, integers");
+}
+
+unless -2 != -2 {
+    say("ok 6 # numeric inequality, equal, negative integers");
+}
+
+##Strings
+
+if "eq" eq "eq" { say("ok 7 # string equality"); }
+
+unless "one" eq "two" {
+    say("ok 8 # string equality, not equal");
+}
+
+if "ONE" ne "TWO" { say("ok 9 # string inequality"); }
+
+unless "STRING" ne "STRING" {
+    say("ok 10 # string inequality, equal");
+}
+
+##Coerce strings into integers
+
+if "11" ne ~11 {
+    print("not ");
+}
+say("ok 11 # coerce integer 11 into string eleven");
+
+if "-12" ne ~-12 {
+    print("not ");
+}
+say("ok 12 # coerce integer -12 into string twelve");
+
+##Coerce integers into strings
+
+if 13 ne +"13" {
+    print("not ");
+}
+say("ok 13 # coerce string 13 into an integer");
+
+if -14 ne +"-14" {
+    print("not ");
+}
+say("ok 14 # coerce string -14 into an integer");
+
+##Containers
+
+if (1,2) =:= (1,2) {
+    print("not ");
+}
+say("ok 15 # container equality, unnamed arrays");
+
+my @a := (1, 2);
+
+unless @a =:= @a {
+    print("not ");
+}
+say("ok 16 # container equality, self");
+
+my @b := @a;
+
+unless @a =:= @b {
+    print("not ");
+}
+say("ok 17 # container equality, named arrays");
+  
+my $x := 'foo';
+my $y := $x;
+my $z := 'foo';
+
+unless $x =:= $y {
+    print("not ");
+}
+say("ok 18 # container equality, string binding");
+
+if $x =:= $z {
+    print("not ");
+}
+say("ok 19 # container equality, string value");