[mm] implement exportation (of packages)

sorear · Sep 19, 2010 · ad61227 · ad61227
1 parent fbc89d5
commit ad61227
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 21 deletions.
diff --git a/src/Metamodel.pm b/src/Metamodel.pm
@@ -41,13 +41,15 @@ our $global;
     use Moose;
 
     # zyg entries can point to other stashes, to Lexical::Simple, to StaticSub
+    # important: if a stash points to a lexical, it's binding to the static
+    # version of the lexical
     has zyg => (isa => 'HashRef', is => 'ro',
         default => sub { +{} });
     # undef here -> stub like my class Foo { ... }
     has obj => (isa => 'Maybe[Metamodel::Package]', is => 'rw');
     has parent => (isa => 'Maybe[Metamodel::Stash]', is => 'ro');
 
-    sub bind_pkg {
+    sub bind_name {
         my ($self, $name, $sub) = @_;
         $self->zyg->{$name} = $sub;
     }
@@ -323,6 +325,13 @@ our $global;
             body => $body);
     }
 
+    sub add_exports { my ($self, $name, $thing, $tags) = @_;
+        for my $tag (@$tags) {
+            my $repo = $self->cur_pkg->subpkg('EXPORT')->subpkg($tag);
+            $repo->bind_name($name, $thing);
+        }
+    }
+
     sub close { }
 
     no Moose;
@@ -478,9 +487,11 @@ sub Op::PackageDef::begin {
 
     if ($self->ourpkg) {
         my $pkg = $opensubs[-1]->find_pkg($self->ourpkg);
-        $pkg->bind_pkg($self->var, $ns);
+        $pkg->bind_name($self->var, $ns);
     }
 
+    $opensubs[-1]->add_exports($self->var, $ns, $self->exports);
+
     if (!$self->stub) {
         my $obj  = $pclass->new(name => $self->name);
         my $body = $self->body->begin(body_of => $obj, cur_pkg => $ns,

diff --git a/src/Op.pm b/src/Op.pm
@@ -629,25 +629,6 @@ use CgOp;
     has exports => (is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] });
     has ourpkg => (is => 'ro', isa => 'Maybe[ArrayRef[Str]]');
 
-    sub decl_class { 'Decl::Package' }
-    sub lift_decls {
-        my ($self) = @_;
-        my @r = $self->decl_class->new(stub => $self->stub, var => $self->var,
-            ($self->has_name ? (name => $self->name) : ()),
-            ($self->stub ? () : (body => $self->body,
-                    bodyvar => $self->bodyvar)),
-            ourpkg => $self->ourpkg);
-
-        for my $tag (@{ $self->exports }) {
-            for my $sym ($self->var, $self->var . '::') {
-                push @r, Decl::PackageAlias->new(slot => $sym,
-                    name => $sym, path => [ 'OUR', 'EXPORT', $tag ]);
-            }
-        }
-
-        @r;
-    }
-
     sub code {
         my ($self, $body) = @_;
         if ($self->stub) {