Only store needed bits in the aux setting file, not the whole 2MB AST…

… store
sorear · Jul 25, 2010 · 242a88c · 242a88c
1 parent 7227acd
commit 242a88c
Show file tree

Hide file tree

Showing 4 changed files with 24 additions and 12 deletions.
diff --git a/Body.pm b/Body.pm
@@ -13,6 +13,7 @@ use CgOp ();
     has enter     => (isa => 'ArrayRef[Op]', is => 'ro',
         default => sub { [] });
     has outer     => (isa => 'Body', is => 'rw', init_arg => undef);
+    has setting   => (is => 'rw');
     has decls     => (isa => 'ArrayRef', is => 'ro', default => sub { [] });
     has code      => (isa => 'CodeGen', is => 'ro', init_arg => undef,
         lazy => 1, builder => 'gen_code');
@@ -112,10 +113,25 @@ use CgOp ();
         } elsif ($self->outer) {
             return 1 + $self->outer->lex_level($var);
         } else {
+            my $i = 1;
+            my $st = $self->setting;
+            while ($st) {
+                return $i if ($st->{$var});
+                $i++;
+                $st = $st->{'OUTER::'};
+            }
             return -1e99999;
         }
     }
 
+    sub gen_setting {
+        my ($self) = @_;
+        my %h = %{ $self->lexical };
+        $h{'OUTER::'} = $self->outer ? $self->outer->gen_setting :
+            $self->setting;
+        \%h;
+    }
+
     # In order to support proper COMMON semantics on package variables
     # we have only one operation here - autovivifying lookup.
     #

diff --git a/CodeGen.pm b/CodeGen.pm
@@ -517,19 +517,15 @@ use 5.010;
     sub scopelex {
         my ($self, $name, $set) = @_;
         my $body = $self->body // $self->bodies->[-1];
+        my $order = 0;
         if ($self->letdepths->{$name}) {
             $name = "let!${name}!" . ($self->letdepths->{$name} - 1);
-        }
-        my ($order, $scope) = (0, $body);
-        if (! $self->lex2type->{$name}) {
-            while ($scope && !$scope->lexical->{$name}) {
-                $scope = $scope->outer;
-                $order++;
+        } else {
+            $order = $body->lex_level($name);
+            if ($order < 0) {
+                die "Failed to resolve lexical $name in " . $body->name;
             }
         }
-        if (!$scope) {
-            die "Failed to resolve lexical $name in " . $body->name;
-        }
         if ($set) {
             $self->lexput($order, $name);
         } else {

diff --git a/Decl.pm b/Decl.pm
@@ -255,7 +255,7 @@ use CgOp;
         my ($self, $body) = @_;
 
         # XXX ought not to have side effects here.
-        $::SETTING_RESUME = $body;
+        $::SETTING_RESUME = $body->gen_setting;
         my $n = $self->unitname;
         $n =~ s/::/./g;
 

diff --git a/Unit.pm b/Unit.pm
@@ -14,14 +14,14 @@ use 5.010;
     has name     => (isa => 'Str', is => 'ro', required => 1);
     has code     => (isa => 'CodeGen', is => 'ro', init_arg => undef, lazy => 1,
         builder => 'gen_code');
-    has setting  => (isa => 'Body', is => 'ro');
+    has setting  => (is => 'ro');
 
     has is_setting => (isa => 'Bool', is => 'ro');
     has setting_name => (isa => 'Str', is => 'ro');
 
     sub gen_code {
         my ($self) = @_;
-        $self->mainline->outer($self->setting) if $self->setting;
+        $self->mainline->setting($self->setting) if $self->setting;
         CodeGen->know_module($self->csname($self->setting_name));
         CodeGen->know_module($self->csname);
         CodeGen->new(name => 'BOOT', entry => 1,