From ad9e0081511a86b4b6b341614e0b0701215477e7 Mon Sep 17 00:00:00 2001
From: pmichaud <pmichaud@pobox.com>
Date: Thu, 14 May 2009 01:53:40 -0500
Subject: [PATCH] Add ability to declare infix: subs.

---
 build/PARROT_REVISION |  2 +-
 src/parser/actions.pm | 12 +++++++++++-
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/build/PARROT_REVISION b/build/PARROT_REVISION
index 5da0e4943dc..fe1bf7c8a27 100644
--- a/build/PARROT_REVISION
+++ b/build/PARROT_REVISION
@@ -1 +1 @@
-38720
+38768
diff --git a/src/parser/actions.pm b/src/parser/actions.pm
index 4e30f6bd01a..d5736b0af45 100644
--- a/src/parser/actions.pm
+++ b/src/parser/actions.pm
@@ -767,7 +767,7 @@ method routine_def($/) {
     if $<deflongname> {
         my $name := ~$<deflongname>[0];
         my $match := Perl6::Grammar::opname($name, :grammar('Perl6::Grammar') );
-        if $match { $name := ~$match<category> ~ ':' ~ ~$match[0]; }
+        if $match { $name := add_optoken($block, $match); }
         our @?BLOCK;
         my $existing := @?BLOCK[0].symbol($name);
         if $existing && !$existing<is_proto> && !$existing<is_multi> {
@@ -3099,6 +3099,16 @@ sub make_sigparam($var) {
     }
     $sigparam;
 }
+
+
+sub add_optoken($block, $match) {
+    my $?OPTABLE := 
+        Q:PIR { %r = get_hll_global ['Perl6';'Grammar'], '$optable' };
+    my $name := ~$match<category> ~ ':' ~ ~$match[0];
+    my $category := $match<category>;
+    $?OPTABLE.newtok($name, :equiv('infix:+'));
+    $name;
+}
     
 
 # Local Variables: