Skip to content
Permalink
Browse files

Add $?DISTRIBUTION (#2574)

Add a variable to give module authors a way to access *any* file in their distribution as well as the distribution meta data.

It might seem like `$?FILE` can provide everything required, but some `CompUnit::Repository` may not have an e.g. on-disk representation of the files listed in the meta data -- this allows IO access using the file names as listed in the meta data regardless of the `CompUnit::Repository` that loaded it.

Some uses:

* `say "Version: " ~ $?DISTRIBUTION.meta<ver>`
* `$?DISTRIBUTION.content('lib/Any/Module/In/Distribution.pm6').open.slurp(:close)`
* `$?DISTRIBUTION.content('resources/libraries/p5helper').open.slurp(:close)` ( similar to `%?RESOURCES<libraries/p5helper>.IO.open.slurp(:close)` )
  • Loading branch information...
ugexe committed Dec 31, 2018
1 parent 420abcb commit 32d480aba043245d380ae1d2f089c9bb76412d01
@@ -3018,6 +3018,22 @@ class Perl6::Actions is HLL::Actions does STDActions {
$past := QAST::WVal.new( :value($*W.find_symbol(['Nil'])) );
}
}
elsif $name eq '$?DISTRIBUTION' {
my $distribution := nqp::getlexdyn('$*DISTRIBUTION');
unless $distribution {
my $Distribution := $*W.find_symbol(['CompUnit', 'Repository', 'Distribution']);
$distribution := $Distribution.from-precomp();
}
if $distribution {
$past := QAST::WVal.new( :value($distribution) );
if nqp::isnull(nqp::getobjsc($distribution)) {
$*W.add_object_if_no_sc($distribution);
}
}
else {
$past := QAST::WVal.new( :value($*W.find_symbol(['Nil'])) );
}
}
elsif $name eq '&?BLOCK' || $name eq '&?ROUTINE' {
if $*IN_DECL eq 'variable' {
$*W.throw($/, 'X::Syntax::Variable::Twigil',
@@ -246,7 +246,7 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
my $modules = $rakudo_precomp_loading ?? Rakudo::Internals::JSON.from-json: $rakudo_precomp_loading !! [];
die "Circular module loading detected trying to precompile $path" if $modules.Set{$path.Str}:exists;
%env<RAKUDO_PRECOMP_LOADING> = Rakudo::Internals::JSON.to-json: [|$modules, $path.Str];
%env<RAKUDO_PRECOMP_DIST> = $*RESOURCES ?? $*RESOURCES.Str !! '{}';
%env<RAKUDO_PRECOMP_DIST> = $*DISTRIBUTION ?? $*DISTRIBUTION.serialize !! '{}';

$RMD("Precompiling $path into $bc ($lle $profile $optimize)") if $RMD;
my $perl6 = $*EXECUTABLE.absolute
@@ -73,6 +73,7 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
with self!matching-dist($spec) {
my $name = $spec.short-name;
my $id = self!comp-unit-id($name);
my $*DISTRIBUTION = $_;
my $*RESOURCES = Distribution::Resources.new(:repo(self), :dist-id(''));
my $source-handle = $_.content($_.meta<provides>{$name});
my $precomp-handle = $precomp.try-load(
@@ -221,6 +222,7 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C

method !distribution {
return $!distribution if $!distribution.defined;

# Path contains a META6.json file, so only use paths/modules explicitly declared therein ( -I ./ )
my $dist = $!prefix.add('META6.json').f
?? Distribution::Path.new($!prefix)
@@ -241,12 +243,12 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
!! ($_ => $_)
}).Slip,
)),
resources => %files.keys.grep(*.starts-with('resources/')).map(*.substr(10)).List, # already grepped resources/ for %files, so reuse that information
resources => %files.keys.grep(*.starts-with('resources/')).map(*.substr(10)).List.eager, # already grepped resources/ for %files, so reuse that information
provides => &ls($!prefix.absolute).grep(*.ends-with(any(@extensions))).map({ $_.subst(:g, /\//, "::").subst(:g, /\:\:+/, '::').subst(/^.*?'::'/, '').subst(/\..*/, '') => $_ }).hash,
));
};

return $!distribution = CompUnit::Repository::Distribution.new($dist);
return $!distribution = $_.clone(:dist-id($_.Str)) with CompUnit::Repository::Distribution.new($dist, :repo(self));
}

method resource($dist-id, $key) {
@@ -257,6 +259,12 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
}
}

method distribution(Str $id? --> Distribution) {
# CURFS is a single-distribution repository so there is no need for $id
# ( similar to $dist-id of method resource )
return self!distribution;
}

method precomp-store(--> CompUnit::PrecompilationStore:D) {
$!precomp-store //= CompUnit::PrecompilationStore::File.new(
:prefix(self.prefix.add('.precomp')),
@@ -258,6 +258,7 @@ sub MAIN(:$name, :$auth, :$ver, *@, *%) {
PROCESS::<$REPO> := self; # Precomp files should only depend on downstream repos
my $precomp = $*REPO.precomp-repository;
my $repo-prefix = self!repo-prefix;
my $*DISTRIBUTION = CompUnit::Repository::Distribution.new($dist, :repo(self), :$dist-id);
my $*RESOURCES = Distribution::Resources.new(:repo(self), :$dist-id);
my %done;

@@ -552,6 +553,7 @@ sub MAIN(:$name, :$auth, :$ver, *@, *%) {
my $id = $loader.basename;
return $_ with %!loaded{$id};

my $*DISTRIBUTION = CompUnit::Repository::Distribution.new($_, :repo(self), :dist-id(.dist-id));
my $*RESOURCES = Distribution::Resources.new(:repo(self), :dist-id(.dist-id));
my $repo-prefix = self!repo-prefix;
my $handle = $precomp.try-load(
@@ -607,7 +609,7 @@ sub MAIN(:$name, :$auth, :$ver, *@, *%) {
return %!loaded.values;
}

method distribution($id) {
method distribution(Str $id --> Distribution) {
InstalledDistribution.new(self!read-dist($id), :prefix(self.prefix))
}

@@ -31,13 +31,26 @@ role Distribution::Locally does Distribution {
class CompUnit::Repository::Distribution does Distribution {
has Distribution $!dist handles <content prefix>;
has $!meta;
submethod BUILD(:$!meta, :$!dist --> Nil) { }
method new(Distribution $dist) {
my $meta = $dist.meta.hash;
has $.repo;
has $.dist-id;
has $.repo-name;

submethod TWEAK(|) {
my $meta = $!dist.meta.hash;
$meta<ver> //= $meta<version>;
$meta<auth> //= $meta<authority> // $meta<author>;
self.bless(:$dist, :$meta);
$!meta = $meta;

$!repo-name //= $!repo.name if ($!repo.?name // '') ne '';
$!repo = $!repo.path-spec if $!repo.defined && $!repo !~~ Str;
}

submethod BUILD(:$!dist, :$!repo, :$!dist-id, :$!repo-name --> Nil) { }

method new(Distribution $dist, *%_) {
self.bless(:$dist, |%_)
}

method meta { $!meta }

method Str() {
@@ -50,6 +63,28 @@ class CompUnit::Repository::Distribution does Distribution {
method id() {
return nqp::sha1(self.Str);
}

method from-precomp(CompUnit::Repository::Distribution:U: --> CompUnit::Repository::Distribution) {
if %*ENV<RAKUDO_PRECOMP_DIST> -> \dist {
my %data := Rakudo::Internals::JSON.from-json: dist;
my $repo := %data<repo-name>
?? CompUnit::RepositoryRegistry.repository-for-name(%data<repo-name>)
!! CompUnit::RepositoryRegistry.repository-for-spec(%data<repo>);
my $dist := $repo.distribution(%data<dist-id>);
self.new($dist, :repo(%data<repo>), :repo-name(%data<repo-name>), :dist-id(%data<dist-id>));
}
else {
Nil
}
}

method serialize() {
Rakudo::Internals::JSON.to-json: {:$.repo, :$.repo-name, :$.dist-id}
}

method perl {
self.^name ~ ".new({$!dist.perl}, repo => {$!repo.perl}, repo-name => {$!repo-name.perl})";
}
}

class Distribution::Hash does Distribution::Locally {
@@ -610,6 +610,7 @@ S11-modules/require.t
S11-modules/runtime.t
S11-repository/curli-install.t
S11-repository/cur-candidates.t
S11-repository/cur-current-distribution.t
S12-attributes/class.t
S12-attributes/clone.t
S12-attributes/defaults.t
@@ -552,6 +552,8 @@ S11-modules/need.t
S11-modules/nested.t
S11-modules/require.t
S11-repository/curli-install.t
S11-repository/cur-candidates.t
S11-repository/cur-current-distribution.t
S12-attributes/class.t
S12-attributes/clone.t
S12-attributes/defaults.t

0 comments on commit 32d480a

Please sign in to comment.
You can’t perform that action at this time.