[svn:parrot] r12382 - trunk/languages/perl6/lib

[pmichaud]

Author: pmichaud
Date: Wed Apr 19 14:30:12 2006
New Revision: 12382

Modified:
   trunk/languages/perl6/lib/grammar_optok.pge
   trunk/languages/perl6/lib/past2pir.tge

Log:
[perl6]:
* Fix chained operators definitions.
* t/00-parrot/04-op-cmp.t passes


Modified: trunk/languages/perl6/lib/grammar_optok.pge
==============================================================================
--- trunk/languages/perl6/lib/grammar_optok.pge (original)
+++ trunk/languages/perl6/lib/grammar_optok.pge Wed Apr 19 14:30:12 2006
@@ -263,67 +263,84 @@
 
 ## chaining binary
 proto 'infix:==' is precedence('11=') is assoc('chain')
+    is pasttype('chain')
     is pir("    $I0 = cmp_num %0, %1\n    $I0 = iseq $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:!=' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_num %0, %1\n    $I0 = isne $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:<' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_num %0, %1\n    $I0 = islt $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:<=' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_num %0, %1\n    $I0 = isle $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:>' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_num %0, %1\n    $I0 = isgt $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:>=' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_num %0, %1\n    $I0 = isge $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:~~' is equiv('infix:==')
+    is pasttype('chain')
     { ... }
 
 proto 'infix:!~' is equiv('infix:==')
+    is pasttype('chain')
     { ... }
 
 proto 'infix:=~' is equiv('infix:==')
+    is pasttype('chain')
     is pir<"    'die'('brain-o. use ~~ or ~= instead.')">
     { ... }
 
 proto 'infix:eq' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_str %0, %1\n    $I0 = iseq $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:ne' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_str %0, %1\n    $I0 = isne $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:lt' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_str %0, %1\n    $I0 = islt $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:le' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_str %0, %1\n    $I0 = isle $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:gt' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_str %0, %1\n    $I0 = isgt $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:ge' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = cmp_str %0, %1\n    $I0 = isge $I0, 0\n    %t = $I0")
     { ... }
 
 proto 'infix:=:=' is equiv('infix:==')
+    is pasttype('chain')
     { ... }
 
 proto 'infix:===' is equiv('infix:==')
+    is pasttype('chain')
     is pir("    $I0 = issame %0, %1")
     { ... }
 

Modified: trunk/languages/perl6/lib/past2pir.tge
==============================================================================
--- trunk/languages/perl6/lib/past2pir.tge      (original)
+++ trunk/languages/perl6/lib/past2pir.tge      Wed Apr 19 14:30:12 2006
@@ -80,7 +80,7 @@
   op_dispatch:
     if $S0 != 'chain' goto op_normal
     $P0 = children[0]
-    $S0 = op['assoc']
+    $S0 = $P0['pasttype']
     if $S0 == 'chain' goto op_chain
 
   op_normal:
@@ -150,7 +150,7 @@
     $P1 = tree.'get'('pir', $P0)
     pir .= $P1
     $P3 = $P0['ret']
-    pir.'emit'(fmt, $P2, $P3, 'r'=>ret, 'f'=>subname)
+    pir.'emit'(fmt, $P2, $P3, 'r'=>ret, 'f'=>subname, 't'=>ret)
     pir.'emit'("  chain_%0_end:", id)
     goto end