From 5cb546e17ec830bbaffe4085e7bc27610588bd8d Mon Sep 17 00:00:00 2001
From: Jonathan Worthington <jnthn@jnthn.net>
Date: Sun, 23 May 2010 01:09:13 +0200
Subject: [PATCH] Make sure that since we build meta-ops once globally, we
 install them at the top of the tree, otherwise we get nasty problems. This
 uncovered a bootstrapping issue, so done a little re-ordering.

---
 build/Makefile.in    |  2 +-
 src/Perl6/Actions.pm | 19 +++++++++++++------
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/build/Makefile.in b/build/Makefile.in
index 84579643b89..5da558c5dff 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -164,6 +164,7 @@ CHEATS_PIR = \
 
 CORE_SOURCES = \
   src/core/traits.pm \
+  src/core/metaops.pm \
   src/core/operators.pm \
   src/glue/subset.pm \
   src/cheats/trait-export.pm \
@@ -193,7 +194,6 @@ CORE_SOURCES = \
   src/core/Pair.pm \
   src/core/Range.pm \
   src/core/RangeIter.pm \
-  src/core/metaops.pm \
   src/core/EnumMap.pm \
   src/core/Hash.pm \
   src/core/Enum.pm \
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index 1a706059f74..a1a9edc430c 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -2078,7 +2078,7 @@ method prefixish($/) {
         my $opsub := '&prefix:<' ~ $<OPER>.Str ~ '<<>';
         unless %*METAOPGEN{$opsub} {
             my $base_op := '&prefix:<' ~ $<OPER>.Str ~ '>';
-            @BLOCK[0].loadinit.push(PAST::Op.new(
+            get_outermost_block().loadinit.push(PAST::Op.new(
                 :pasttype('bind'),
                 PAST::Var.new( :name($opsub), :scope('package') ),
                 PAST::Op.new(
@@ -2098,7 +2098,7 @@ method infixish($/) {
         my $sym := ~$<infix><sym>;
         my $opsub := "&infix:<$sym=>";
         unless %*METAOPGEN{$opsub} {
-            @BLOCK[0].loadinit.push(
+            get_outermost_block().loadinit.push(
                 PAST::Op.new( :name('!gen_assign_metaop'), $sym,
                               :pasttype('call') )
             );
@@ -2129,7 +2129,7 @@ method infixish($/) {
                 $helper := '&zipwith';
             }
 
-            @BLOCK[0].loadinit.push(
+            get_outermost_block().loadinit.push(
                 PAST::Op.new( :pasttype('bind'),
                               PAST::Var.new( :name($opsub), :scope('package') ),
                               PAST::Op.new( :pasttype('callmethod'),
@@ -2149,7 +2149,7 @@ method prefix_circumfix_meta_operator:sym<reduce>($/) {
     my $opsub := '&prefix:<' ~ ~$/ ~ '>';
     unless %*METAOPGEN{$opsub} {
         my $base_op := '&infix:<' ~ $<op>.Str ~ '>';
-        @BLOCK[0].loadinit.push(PAST::Op.new(
+        get_outermost_block().loadinit.push(PAST::Op.new(
             :pasttype('bind'),
             PAST::Var.new( :name($opsub), :scope('package') ),
             PAST::Op.new(
@@ -2180,7 +2180,7 @@ sub make_hyperop($/) {
         my $base_op := '&infix:<' ~ $<infixish>.Str ~ '>';
         my $dwim_lhs := $<opening> eq '<<' || $<opening> eq '«';
         my $dwim_rhs := $<closing> eq '>>' || $<closing> eq '»';
-        @BLOCK[0].loadinit.push(PAST::Op.new(
+        get_outermost_block().loadinit.push(PAST::Op.new(
             :pasttype('bind'),
             PAST::Var.new( :name($opsub), :scope('package') ),
             PAST::Op.new(
@@ -2213,7 +2213,7 @@ method postfixish($/) {
             my $opsub := '&postfix:<>>' ~ $<OPER>.Str ~ '>';
             unless %*METAOPGEN{$opsub} {
                 my $base_op := '&postfix:<' ~ $<OPER>.Str ~ '>';
-                @BLOCK[0].loadinit.push(PAST::Op.new(
+                get_outermost_block().loadinit.push(PAST::Op.new(
                     :pasttype('bind'),
                     PAST::Var.new( :name($opsub), :scope('package') ),
                     PAST::Op.new(
@@ -2949,6 +2949,13 @@ sub is_lexical($name) {
     return 0;
 }
 
+# Gets the outermost block. We sometimes want to install global things in
+# it, e.g. generated meta-ops.
+sub get_outermost_block() {
+    our @BLOCK;
+    return @BLOCK[+@BLOCK - 1];
+}
+
 # Looks to see if a variable has been set up as an alias to an attribute.
 sub is_attr_alias($name) {
     our @BLOCK;