Run program bodies within the lexical scope of the setting. There's s…

…till some things that aren't going to work out just yet, but this is at least the first 80%. :-) Also fix up a $*SCOPE leakage that meant we accidentally the our-scope for many things that should have been has or my scoped. Please re-configure; this may also break some code that wasn't assuming lexical scope by default.

build/Makefile.in

@@ -205,6 +205,7 @@ CORE_SOURCES = \
   src/cheats/match-bool.pm \
   src/cheats/setup-io.pm \
   src/glue/subset.pm \
+  src/core/YOU_ARE_HERE.pm \
 
 # SETTING = \
 #   src/setting/traits.pm \

src/Perl6/Actions.pm

@@ -51,6 +51,14 @@ method comp_unit($/, $key?) {
     # Create the block for the mainline code.
     my $mainline := @BLOCK.shift;
     $mainline.push($<statementlist>.ast);
+
+    # If it's the setting, just need to run the mainline.
+    if $*SETTING_MODE {
+        $mainline.hll($?RAKUDO_HLL);
+        $mainline.pirflags(':init :load');
+        make $mainline;
+        return 1;
+    }
 
     # Create a block for the entire compilation unit.
     our $?RAKUDO_HLL;
@@ -417,6 +425,9 @@ method statement_control:sym<use>($/) {
         elsif ~$<module_name> eq 'MONKEY_TYPING' {
             $*MONKEY_TYPING := 1;
         }
+        elsif ~$<module_name> eq 'SETTING_MODE' {
+            $*SETTING_MODE := 1;
+        }
         else {
             need($<module_name>);
             import($/);
@@ -580,6 +591,25 @@ method term:sym<type_declarator>($/)    { make $<type_declarator>.ast; }
 method term:sym<statement_prefix>($/)   { make $<statement_prefix>.ast; }
 method term:sym<lambda>($/)             { make create_code_object($<pblock>.ast, 'Block', 0, ''); }
 
+method term:sym<YOU_ARE_HERE>($/) {
+    my $past := PAST::Block.new(
+        :name('!YOU_ARE_HERE'),
+        PAST::Var.new( :name('mainline'), :scope('parameter') ),
+        PAST::Op.new( :pasttype('callmethod'), :name('set_outer'),
+            PAST::Var.new( :name('mainline'), :scope('lexical') ),
+            PAST::Var.new( :scope('keyed'), PAST::Op.new( :pirop('getinterp P') ), 'sub' )
+        ),
+        PAST::Op.new( :pasttype('call'), PAST::Var.new( :name('mainline'), :scope('lexical') ) )
+    );
+    @BLOCK[0][0].push(PAST::Var.new(
+        :name('!YOU_ARE_HERE'), :isdecl(1), :viviself($past), :scope('lexical')
+    ));
+    make PAST::Op.new( :pasttype('call'),
+        PAST::Var.new( :name('!YOU_ARE_HERE'), :scope('lexical') ),
+        PAST::Block.new( )
+    );
+}
+
 method name($/) { }
 
 method module_name($/) {
@@ -2586,7 +2616,7 @@ sub emit_routine_traits($routine, @trait_list, $type,  $sig_setup_block) {
     $routine.loadinit.push(PAST::Op.new(
         :pasttype('bind'),
         PAST::Var.new( :name('trait_subject'), :scope('register'), :isdecl(1) ),
-        create_code_object(PAST::Var.new( :name('block'), :scope('register') ), $type, 0,  $sig_setup_block)
+        create_code_object(PAST::Var.new( :name('block'), :scope('register') ), $type, $*MULTINESS eq 'multi',  $sig_setup_block)
     ));
     for @trait_list {
         my $ast := $_.ast;

src/Perl6/Grammar.pm

@@ -241,6 +241,7 @@ token comp_unit {
     :my $*IN_DECL;                             # what declaration we're in
     :my $*IMPLICIT;                            # whether we allow an implicit param
     :my $*MONKEY_TYPING := 0;                  # whether augment/supersede are allowed
+    :my $*SETTING_MODE := 0;                   # are we compiling the SETTING
     :my $*LEFTSIGIL;                           # sigil of LHS for item vs list assignment
     :my $*SCOPE := '';                         # which scope declarator we're under
     :my $*MULTINESS := '';                     # which multi declarator we're under
@@ -920,6 +921,8 @@ token trait_mod:sym<handles> { <sym>:s <term> }
 
 proto token term { <...> }
 
+token term:sym<YOU_ARE_HERE> { <sym> <.nofun> }
+
 token term:sym<self> { <sym> <.nofun> }
 
 token term:sym<Nil>  { <sym> <.nofun> }
@@ -1170,6 +1173,7 @@ INIT {
 }
 
 token termish {
+    :my $*SCOPE := "";
     <prefixish>*
     <term>
     [

src/cheats/eval.pm

@@ -1,4 +1,5 @@
 our sub eval(Str $code) {
+    my $*IN_EVAL = 1;
     Q:PIR {
         .local pmc interp, caller, code, pbc, result, exception, parrotex
         interp = getinterp

src/cheats/object.pir

@@ -1,19 +1,5 @@
 # method cheats for Mu
 
-# most of these can potentially go into CORE, when we have 'augment' working.
-
-.namespace ['Mu']
-
-.sub 'print' :method
-    $P0 = get_hll_global '&print'
-    .tailcall $P0(self)
-.end
-
-.sub 'say' :method
-    $P0 = get_hll_global '&say'
-    .tailcall $P0(self)
-.end
-
 .namespace []
 
 .sub '&prefix:<defined>'

src/core/Mu.pm

@@ -11,6 +11,14 @@ augment class Mu {
     multi method perl {
         self.WHAT.substr(0, -2) ~ '.new()';
     }
+
+    method print() {
+        print(self);
+    }
+
+    method say() {
+        say(self);
+    }
 
     method Capture() {
         my %attrs;

src/core/Rat.pm

@@ -2,7 +2,7 @@ class Rat does Real {
     has $.numerator;
     has $.denominator;
 
-    sub gcd(Int $a is copy, Int $b is copy) {
+    our sub gcd(Int $a is copy, Int $b is copy) {
         $a = -$a if ($a < 0);
         $b = -$b if ($b < 0);
         while $a > 0 && $b > 0 {

src/core/YOU_ARE_HERE.pm

@@ -0,0 +1 @@
+YOU_ARE_HERE;

src/core/operators.pm

@@ -480,8 +480,8 @@ our multi sub infix:<X>($a, $b) { &infix:<X>($a.list, $b.list) }
 # to define it, because the normal || is short-circuit and special cased by
 # the grammar. Same goes for 'or'
 
-multi sub infix:<||>(Mu $a, Mu $b) { $a || $b }
-multi sub infix:<or>(Mu $a, Mu $b) { $a or $b }
+our multi sub infix:<||>(Mu $a, Mu $b) { $a || $b }
+our multi sub infix:<or>(Mu $a, Mu $b) { $a or $b }
 
 # Eliminate use of this one, but keep the pir around for
 # the moment, as it may come in handy elsewhere.
@@ -494,18 +494,18 @@ multi sub infix:<or>(Mu $a, Mu $b) { $a or $b }
 # I think.  But this is a quick fix to get some basic functionality
 # working.
 
-multi sub infix:<+>(Whatever, $rhs) {
+our multi sub infix:<+>(Whatever, $rhs) {
     -> $a { $a + $rhs; };
 }
 
-multi sub infix:<+>($lhs, Whatever) {
+our multi sub infix:<+>($lhs, Whatever) {
     -> $a { $lhs + $a; };
 }
 
-multi sub infix:<+>(Whatever, Whatever) {
+our multi sub infix:<+>(Whatever, Whatever) {
     -> $a, $b { $a + $b; };
 }
 
-multi sub infix:<->(Whatever, $rhs) {
+our multi sub infix:<->(Whatever, $rhs) {
     -> $a { $a - $rhs; };
 }

src/core/traits.pm

@@ -1,6 +1,7 @@
 # Need to be able to augment in the setting, and this is the first file, so we
 # put this here.
 use MONKEY_TYPING;
+use SETTING_MODE;
 
 # XXX Signature is wrong really - will fix once we can parse other things.
 our multi trait_mod:<is>(Mu $child, Mu $parent) {

src/glue/run.pir

@@ -32,9 +32,6 @@ of the compilation unit.
     $P0 = info
     set_hll_global ['PROCESS'], '$EXECUTABLE_NAME', $P0
 
-
-
-
     # Ignore the args when executed as a library (not main program)
     unless args goto unit_start_0
 
@@ -66,6 +63,15 @@ of the compilation unit.
 
     # INIT time
     '!fire_phasers'('INIT')
+
+    # Give it to the setting installer, so we run it within the lexical
+    # scope of the current setting. Don't if we're in eval, though.
+    $P0 = find_dynamic_lex '$*IN_EVAL'
+    if null $P0 goto in_setting
+    unless $P0 goto in_setting
     $P0 = mainline()
     .return ($P0)
+  in_setting:
+    $P0 = '!YOU_ARE_HERE'(mainline)
+    .return ($P0)
 .end

src/glue/subset.pm

@@ -10,7 +10,7 @@ role SubType {
     }
 }
 
-sub CREATE_SUBSET_TYPE($original, $checker) {
+our sub CREATE_SUBSET_TYPE($original, $checker) {
     # XXX Ideally we'd be able to just replace all of what follows
     # with a simple:
     #     my $subtype = $original but SubType($checker);