Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Implement get_exports method

  • Loading branch information...
commit 995adc303070adf3db9927eba6dce0231a5816e1 1 parent a0bd505
@sorear sorear authored
Showing with 126 additions and 3 deletions.
  1. +30 −0 nt/exports.t
  2. +96 −3 perl5.pir
View
30 nt/exports.t
@@ -0,0 +1,30 @@
+# vim: ft=perl6
+
+plan(9);
+
+pir::load_bytecode('perl5.pbc');
+my $perl5 := pir::compreg__ps('perl5');
+
+my $module := $perl5.load_module('Text::Tabs');
+
+ok(pir::defined($module), "Text::Tabs loaded OK");
+
+my $exports := $perl5.get_exports($module);
+
+ok(pir::defined($exports), "Got export list");
+
+my $sub := $exports<sub>;
+my $var := $exports<var>;
+
+ok(pir::defined($sub), "sub export field exists");
+ok(pir::defined($var), "var export field exists");
+
+ok(pir::defined($sub<expand>), "expand sub exported");
+ok($sub<expand>("foo\tbar") eq "foo bar", "expand sub works");
+
+ok(pir::defined($sub<unexpand>), "unexpand sub exported");
+ok($sub<unexpand>("foo bar") eq "foo\tbar", "unexpand sub works");
+
+ok(pir::defined($var<tabstop>), "tabstop var exported");
+# TODO: Provide a way to interact with data.
+
View
99 perl5.pir
@@ -25,7 +25,7 @@ Creates the compiler using a C<PCT::HLLCompiler> object.
$P1 = loadlib 'blizkost_group', $P0
load_bytecode 'PCT.pbc'
- $P2 = split ' ', '$!interp $!requirer'
+ $P2 = split ' ', '$!interp $!requirer $!export-lister'
$P0 = get_root_global ['parrot'], 'P6metaclass'
$P1 = $P0.'new_class'('Perl5::Compiler', 'parent'=>'PCT::HLLCompiler', 'attr'=>$P2)
@@ -53,15 +53,74 @@ to the blizkost compiler.
# We maintain one P5Interpreter (Perl heap) per Parrot heap (compreg object),
# to avoid suprising duplication. TODO: locking.
.sub '!force' :method
- .local pmc p5i, requirer
+ .local pmc p5i, requirer, exportlister, support
p5i = getattribute self, "$!interp"
unless null p5i goto have_interp
p5i = new 'P5Interpreter'
setattribute self, "$!interp", p5i
- requirer = p5i('sub { my ($n) = @_; $n =~ s|::|/|g; $n .= ".pm"; require $n }')
+ # unfortunately, the Perl 5 C API only allows making evals in scalar context
+ support = p5i(<<"End_Init_Code")
+my $req = sub {
+ my ($module_name) = @_;
+ # Yes, this is portable.
+ $module_name =~ s|::|/|g;
+ $module_name .= ".pm";
+ require $module_name;
+};
+
+my $explist = sub {
+ my ($module_name, @tags) = @_;
+ # should already be loaded
+ my @output;
+
+ my %sigils = (SCALAR => '$', ARRAY => '@', HASH => '%', IO => '*');
+
+ %Blizkost::ImportZone:: = ();
+ {
+ package Blizkost::ImportZone;
+ $module_name->import(@tags);
+ }
+
+ for my $name (keys %Blizkost::ImportZone::) {
+ my $gref = \$Blizkost::ImportZone::{$name};
+
+ my %things;
+
+ for my $type (qw/SCALAR ARRAY HASH IO/) {
+ my $ref = *{$gref}{$type};
+ next unless defined $ref;
+
+ $things{$type} = $ref;
+ }
+
+ if (keys %things > 1) {
+ for my $used_type (keys %things) {
+ push @output, 'var', ($sigils{$used_type} . $name),
+ $things{$used_type};
+ }
+ } elsif (keys %things == 1) {
+ my $used_type = (keys %things)[0];
+ push @output, 'var', $name, $things{$used_type};
+ }
+
+ if (defined *{$gref}{CODE}) {
+ push @output, 'sub', $name, *{$gref}{CODE};
+ }
+ }
+
+ return @output;
+};
+
+{ requirer => $req, exportlister => $explist };
+End_Init_Code
+
+ requirer = support["requirer"]
+ exportlister = support["exportlister"]
+
setattribute self, "$!requirer", requirer
+ setattribute self, "$!export-lister", exportlister
have_interp:
.end
@@ -130,6 +189,40 @@ Implements the PDD-31 library loading interface.
.return (name_str)
.end
+.sub 'get_exports' :method
+ .param pmc module_name
+ .param pmc imports :slurpy
+
+ self.'!force'()
+
+ .local pmc expiter, expout
+
+ $P0 = getattribute self, '$!export-lister'
+ ($P0 :slurpy) = $P0(module_name, imports :flat)
+ expiter = iter $P0
+
+ expout = new 'Hash'
+ $P0 = new 'Hash'
+ expout["sub"] = $P0
+ $P0 = new 'Hash'
+ expout["var"] = $P0
+
+ again:
+ unless expiter, the_end
+
+ $P1 = shift expiter
+ $P0 = expout[$P1]
+
+ $P1 = shift expiter
+ $P2 = shift expiter
+ $P0[$P1] = $P2
+
+ goto again
+
+ the_end:
+ .return(expout)
+.end
+
=back
=cut
Please sign in to comment.
Something went wrong with that request. Please try again.