Merge branch 'master' of github.com:perl6/nqp into execname

src/NQP/Optimizer.nqp

@@ -1,20 +1,163 @@
 use NQPP6QRegex;
 
 class NQP::Optimizer {
+    # Variable declarations and usages within a block.
+    my class BlockVars {
+        # Hash mapping variable names declared in the block to the QAST::Var
+        # of its declaration.
+        has %!decls;
+
+        # Usages of variables in this block, or unioned in from an inlined
+        # immediate block.
+        has %!usages_flat;
+
+        # Usages of variables in this block, or unioned in from a non-inlined
+        # immediate block or a declaration block.
+        has %!usages_inner;
+
+        # If lowering is, for some reason, poisoned.
+        has $!poisoned;
+
+        method add_decl($var) {
+            %!decls{$var.name} := $var;
+        }
+
+        method add_usage($var) {
+            my $name   := $var.name;
+            my @usages := %!usages_flat{$name};
+            unless @usages {
+                @usages := [];
+                %!usages_flat{$name} := @usages;
+            }
+            nqp::push(@usages, $var);
+        }
+
+        method poison_lowering() { $!poisoned := 1; }
+
+        method get_decls() { %!decls }
+
+        method get_usages_flat() { %!usages_flat }
+
+        method get_usages_inner() { %!usages_inner }
+
+        method is_flattenable() {
+            for %!decls {
+                return 0 if $_.value.scope eq 'lexical';
+                return 0 if $_.value.decl eq 'param';
+            }
+            1
+        }
+
+        method incorporate_inner($vars_info, $flattened) {
+            # We'll exclude anything that the inner or flattened thing has as
+            # a declaration, since those are its own.
+            my %decls := $vars_info.get_decls;
+
+            # Inner ones always go into our inners set.
+            add_to_set(%!usages_inner, $vars_info.get_usages_inner, %decls);
+
+            # Flat ones depend on if we flattened this block into ourself.
+            add_to_set($flattened ?? %!usages_flat !! %!usages_inner,
+                $vars_info.get_usages_flat, %decls);
+
+            sub add_to_set(%set, %to_add, %exclude) {
+                for %to_add {
+                    my $name := $_.key;
+                    next if nqp::existskey(%exclude, $name);
+                    my @existing := %set{$name};
+                    if @existing {
+                        for $_.value { nqp::push(@existing, $_) }
+                        #nqp::splice(@existing, $_.value, 0, 0);
+                    }
+                    else {
+                        %set{$name} := $_.value;
+                    }
+                }
+            }
+        }
+
+        method lexicals_to_locals() {
+            return 0 if $!poisoned;
+            for %!decls {
+                # We're looking for lexical var or param decls.
+                my $qast := $_.value;
+                my str $scope := $qast.scope;
+                next unless $scope eq 'lexical';
+                my str $decl := $qast.decl;
+                next unless $decl eq 'param' || $decl eq 'var';
+
+                # Consider name. Can't lower if it's used by any nested blocks.
+                my str $name := $_.key;
+                unless nqp::existskey(%!usages_inner, $name) {
+                    # Lowerable if it's a normal variable.
+                    next if nqp::chars($name) < 2;
+                    if $name ne 'self' && $name ne '$/' {
+                        my str $sigil := nqp::substr($name, 0, 1);
+                        next unless $sigil eq '$' || $sigil eq '@' || $sigil eq '%';
+                        next unless nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $name, 1);
+                    }
+
+                    # Seems good; lower it.
+                    my $new_name := $qast.unique('__lowered_lex');
+                    $qast.scope('local');
+                    $qast.name($new_name);
+                    if %!usages_flat{$name} {
+                        for %!usages_flat{$name} {
+                            $_.scope('local');
+                            $_.name($new_name);
+                        }
+                    }
+                }
+            }
+        }
+    }
+
     has @!block_stack;
+    has @!block_var_stack;
     has %!adverbs;
 
     method optimize($ast, *%adverbs) {
         %!adverbs := %adverbs;
         @!block_stack := [$ast[0]];
+        @!block_var_stack := [BlockVars.new];
         self.visit_children($ast);
         $ast;
     }
 
     method visit_block($block) {
+        # Push block and a new block vars tracking block.
         @!block_stack.push($block);
+        @!block_var_stack.push(BlockVars.new);
+
+        # Visit all children, which includes nested blocks.
         self.visit_children($block);
+
+        # Methods with late-bound names poison lowering.
+        if nqp::substr($block.name, 0, 12) eq '!!LATENAME!!' {
+            self.poison_lowering();
+        }
+
+        # Pop the block and the vars info.
         @!block_stack.pop();
+        my $vars_info := @!block_var_stack.pop();
+
+        # Lower any declarations we can.
+        $vars_info.lexicals_to_locals();
+
+        # If the block has no lexical declarations remaining, and it was an
+        # immediate block, then flatten it in.
+        my int $flattened := 0;
+        if $block.blocktype eq 'immediate' || $block.blocktype eq 'immediate_static' {
+            if $vars_info.is_flattenable {
+                my @innards := $block.list;
+                $block := QAST::Stmts.new( |@innards );
+                $flattened := 1;
+            }
+        }
+
+        # Incorporate this block's info into outer block's info.
+        @!block_var_stack[nqp::elems(@!block_var_stack) - 1].incorporate_inner($vars_info, $flattened);
+
         $block;
     }
 
@@ -27,8 +170,22 @@ class NQP::Optimizer {
             return self.visit_handle($op);
         }
 
-        # Visit children first.
-        self.visit_children($op);
+        # A for loop must have its block treated as a declaration; besides
+        # that, visit children as normal.
+        if $opname eq 'for' {
+            my $orig := $op[1].blocktype;
+            $op[1].blocktype('declaration');
+            self.visit_children($op);
+            $op[1].blocktype($orig);
+        }
+        else {
+            self.visit_children($op);
+        }
+
+        # nqp::ctx and nqp::curlexpad capture the current context and so poisons lowering
+        if $opname eq 'ctx' || $opname eq 'curlexpad' {
+            self.poison_lowering();
+        }
 
         # Consider numeric ops we can simplify.
         my $typeinfo := nqp::chars($opname) > 2
@@ -114,6 +271,27 @@ class NQP::Optimizer {
         $handle;
     }
 
+    method visit_var($var) {
+        my str $scope := $var.scope;
+        if $scope eq 'attribute' || $scope eq 'positional' || $scope eq 'associative' {
+            self.visit_children($var);
+        } else {
+            my int $top := nqp::elems(@!block_var_stack) - 1;
+            my $decl    := $var.decl;
+            if $decl {
+                @!block_var_stack[$top].add_decl($var);
+                if $decl eq 'param' && $var.default -> $default {
+                    my $stmts_def := QAST::Stmts.new( $default );
+                    self.visit_children($stmts_def);
+                    $var.default($stmts_def[0]);
+                }
+            }
+            else {
+                @!block_var_stack[$top].add_usage($var);
+            }
+        }
+    }
+
     method visit_children($node, :$skip_selectors) {
         my int $i := 0;
         unless nqp::isstr($node) || !nqp::defined($node) {
@@ -122,11 +300,14 @@ class NQP::Optimizer {
                     my $visit := $node[$i];
                     if nqp::istype($visit, QAST::Op) {
                         $node[$i] := self.visit_op($visit)
+                    } elsif nqp::istype($visit, QAST::Var) {
+                        self.visit_var($visit);
                     } elsif nqp::istype($visit, QAST::Block) {
                         $node[$i] := self.visit_block($visit)
                     } elsif nqp::istype($visit, QAST::Want) {
                         self.visit_children($visit, :skip_selectors)
                     } elsif nqp::istype($visit, QAST::Regex) {
+                        self.poison_lowering();
                         QRegex::Optimizer.new().optimize($visit, @!block_stack[+@!block_stack - 1], |%!adverbs);
                     } else {
                         self.visit_children($visit);
@@ -158,4 +339,10 @@ class NQP::Optimizer {
             nqp::die("No compile-time value for $name");
         }
     }
+
+    method poison_lowering() {
+        for @!block_var_stack {
+            $_.poison_lowering();
+        }
+    }
 }

src/vm/jvm/ModuleLoader.nqp

@@ -8,7 +8,15 @@ knowhow ModuleLoader {
         # Put any explicitly specified path on the start of the list.
         my $explicit;
         if !nqp::isnull($explicit_path) {
-            try { my $hack; $explicit := %*COMPILING<%?OPTIONS>{$explicit_path}; }
+            try {
+                my $compiling := %*COMPILING;
+                unless nqp::isnull(%*COMPILING) {
+                    my $options := $compiling<%?OPTIONS>;
+                    unless nqp::isnull($options) {
+                        $explicit := $options{$explicit_path};
+                    }
+                }
+            }
         }
         if !nqp::isnull($explicit) && nqp::defined($explicit) {
             nqp::push(@search_paths, $explicit);
@@ -55,7 +63,15 @@ knowhow ModuleLoader {
             my $*CTXSAVE := self;
             my $*MAIN_CTX := ModuleLoader;
             my $boot_mode;
-            try { my $hack; $boot_mode := %*COMPILING<%?OPTIONS><bootstrap>; }
+            try {
+                my $compiling := %*COMPILING;
+                unless nqp::isnull(%*COMPILING) {
+                    my $options := $compiling<%?OPTIONS>;
+                    unless nqp::isnull($options) {
+                        $boot_mode := $options<bootstrap>;
+                    }
+                }
+            }
             $boot_mode := !nqp::isnull($boot_mode) && $boot_mode;
             my $preserve_global := nqp::getcurhllsym('GLOBAL');
             nqp::usecompileehllconfig() if $boot_mode;
@@ -166,7 +182,15 @@ knowhow ModuleLoader {
                 my $*CTXSAVE := self;
                 my $*MAIN_CTX := ModuleLoader;
                 my $boot_mode;
-                try { my $hack; $boot_mode := %*COMPILING<%?OPTIONS><bootstrap>; }
+                try {
+                    my $compiling := %*COMPILING;
+                    unless nqp::isnull(%*COMPILING) {
+                        my $options := $compiling<%?OPTIONS>;
+                        unless nqp::isnull($options) {
+                            $boot_mode := $options<bootstrap>;
+                        }
+                    }
+                }
                 $boot_mode := !nqp::isnull($boot_mode) && $boot_mode;
                 my $preserve_global := nqp::getcurhllsym('GLOBAL');
                 nqp::usecompileehllconfig() if $boot_mode;