Skip to content

Instantly share code, notes, and snippets.

@masak
Created December 6, 2015 22:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save masak/32f236bca8f2857d82fc to your computer and use it in GitHub Desktop.
Save masak/32f236bca8f2857d82fc to your computer and use it in GitHub Desktop.
Relevant and irrelevant parts of 87288285f6
$ git diff
diff --git a/src/core/CompUnit/PrecompilationStore/File.pm b/src/core/CompUnit/PrecompilationStore/File.pm
index a66d255..e103e50 100644
--- a/src/core/CompUnit/PrecompilationStore/File.pm
+++ b/src/core/CompUnit/PrecompilationStore/File.pm
@@ -35,9 +35,7 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore {
CompUnit::PrecompilationId $precomp-id,
Str:D $path)
{
- my $dest = self!dir($compiler-id, $precomp-id);
- $dest.mkdir;
- $path.IO.copy($dest.child($precomp-id.IO));
+ $path.IO.copy(self.destination($compiler-id, $precomp-id));
}
method delete(CompUnit::PrecompilationId $compiler-id, CompUnit::PrecompilationId $precomp-id)
diff --git a/src/core/CompUnit/Repository/FileSystem.pm b/src/core/CompUnit/Repository/FileSystem.pm
index 2c5a474..229a5a5 100644
--- a/src/core/CompUnit/Repository/FileSystem.pm
+++ b/src/core/CompUnit/Repository/FileSystem.pm
@@ -26,9 +26,11 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
my $base := $!prefix.abspath ~ $dir-sep ~ $name.subst(:g, "::", $dir-sep) ~ '.';
my $compunit;
+ return %!loaded{$name} if %!loaded{$name}:exists;
+
if $handle {
return %!loaded{$name} = %seen{$base} = CompUnit.new(
- $base, :name($name), :extension(''), :has-precomp, :$handle, :repo(self)
+ $base, :name($name), :extension(''), :has-precomp, :$handle, :repo(self)
);
}
else {
@@ -41,7 +43,7 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
!! $!prefix.abspath ~ $dir-sep ~ $file;
$compunit = %seen{$path} = CompUnit.new(
- $path, :name($name), :extension(''), :has_source, :repo(self)
+ $path, :name($name), :extension(''), :has-source, :repo(self)
) if IO::Path.new-from-absolute-path($path).f;
}
}
$ git diff --staged
diff --git a/src/core/CompUnit/PrecompilationRepository.pm b/src/core/CompUnit/PrecompilationRepository.pm
index 2ba2aa7..37cbf6b 100644
--- a/src/core/CompUnit/PrecompilationRepository.pm
+++ b/src/core/CompUnit/PrecompilationRepository.pm
@@ -1,11 +1,21 @@
-role CompUnit::PrecompilationRepository {
- method load(CompUnit::PrecompilationId $id) returns CompUnit {
- CompUnit
+{
+ my $i;
+ role CompUnit::PrecompilationRepository {
+ has $!i = $i++;
+
+ method load(CompUnit::PrecompilationId $id) returns CompUnit {
+ CompUnit
+ }
+
+ method may-precomp() {
+ $i < 3 # number of next repo after None and the first Default
+ }
}
}
BEGIN CompUnit::PrecompilationRepository::<None> := CompUnit::PrecompilationRepository.new;
+class CompUnit { ... }
class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationRepository {
has CompUnit::PrecompilationStore $.store;
@@ -27,6 +37,36 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
CompUnit::Handle
}
}
+
+ method precompile(CompUnit:D $compunit, CompUnit::PrecompilationId $id) {
+ my $io = self.store.destination($*PERL.compiler.id, $id);
+ my $path = $compunit.path;
+ die "Cannot pre-compile over a newer existing file: $io"
+ if $io.e && $io.modified > $path.modified;
+
+ my Mu $opts := nqp::atkey(%*COMPILING, '%?OPTIONS');
+ my $lle = !nqp::isnull($opts) && !nqp::isnull(nqp::atkey($opts, 'll-exception'))
+ ?? ' --ll-exception'
+ !! '';
+ %*ENV<RAKUDO_PRECOMP_WITH> = CREATE-INCLUDE-SPECS(@*INC);
+
+RAKUDO_MODULE_DEBUG("Precomping with %*ENV<RAKUDO_PRECOMP_WITH>")
+ if $*RAKUDO_MODULE_DEBUG;
+
+ my $cmd = "$*EXECUTABLE$lle --target={$*VM.precomp-target} --output=$io $path";
+ my $proc = shell("$cmd 2>&1", :out, :!chomp);
+ %*ENV<RAKUDO_PRECOMP_WITH>:delete;
+
+ my $result = '';
+ $result ~= $_ for $proc.out.lines;
+ $proc.out.close;
+ if $proc.status -> $status { # something wrong
+ $result ~= "Return status $status\n";
+ fail $result if $result;
+ }
+ note $result if $result;
+ True
+ }
}
# vim: ft=perl6 expandtab sw=4
diff --git a/src/core/CompUnit/PrecompilationStore/File.pm b/src/core/CompUnit/PrecompilationStore/File.pm
index 903129a..a66d255 100644
--- a/src/core/CompUnit/PrecompilationStore/File.pm
+++ b/src/core/CompUnit/PrecompilationStore/File.pm
@@ -22,6 +22,15 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore {
$path ~~ :e ?? $path.Str !! Str
}
+ method destination(CompUnit::PrecompilationId $compiler-id,
+ CompUnit::PrecompilationId $precomp-id)
+ returns IO::Path
+ {
+ my $dest = self!dir($compiler-id, $precomp-id);
+ $dest.mkdir;
+ $dest.child($precomp-id.IO)
+ }
+
method store(CompUnit::PrecompilationId $compiler-id,
CompUnit::PrecompilationId $precomp-id,
Str:D $path)
diff --git a/src/core/CompUnit/Repository/FileSystem.pm b/src/core/CompUnit/Repository/FileSystem.pm
index 5e95c0f..2c5a474 100644
--- a/src/core/CompUnit/Repository/FileSystem.pm
+++ b/src/core/CompUnit/Repository/FileSystem.pm
@@ -1,5 +1,6 @@
class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does CompUnit::Repository {
has %!loaded;
+ has $!precomp;
my %extensions =
Perl6 => <pm6 pm>,
@@ -64,8 +65,16 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
}
if $compunit {
- $compunit.load(:$line);
- return %!loaded{$compunit.name} = $compunit;
+ if $precomp.may-precomp and $precomp.precompile($compunit, $id) {
+ $handle = $precomp.load($id);
+ return %!loaded{$name} = %seen{$base} = CompUnit.new(
+ $base, :name($name), :extension(''), :has-precomp, :$handle, :repo(self)
+ );
+ }
+ else {
+ $compunit.load(:$line);
+ return %!loaded{$compunit.name} = $compunit;
+ }
}
return self.next-repo.need($spec, $precomp, :$line) if self.next-repo;
@@ -108,13 +117,14 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
}
method precomp-repository() returns CompUnit::PrecompilationRepository {
- CompUnit::PrecompilationRepository::Default.new(
+ $!precomp := CompUnit::PrecompilationRepository::Default.new(
:store(
CompUnit::PrecompilationStore::File.new(
:prefix(self.prefix.child('.precomp')),
)
),
- );
+ ) unless $!precomp;
+ $!precomp
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment