Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Almost complete refactor CompUnit and CURL::File 
A CompUnit object now has always the source file as its "path", even if the
source file cannot be found.

CURL::File has been utterly simplified, as it turned to be impossible to
smartmatch finding files.  So now it only looks for the existence of the
file, and returns that.  Thanks to Scalar[0] indexing, this is compatible
with the API.
  • Loading branch information
@lizmat
lizmat committed Aug 1, 2014
1 parent 9fd23d0 commit 8bada16
Show file tree
Hide file tree
Showing 2 changed files with 112 additions and 71 deletions.
104 changes: 79 additions & 25 deletions src/core/CompUnit.pm
View file
Expand Up @@ -3,40 +3,87 @@ class CompUnit {
has Str $.from;
has Str $.name;
has Str $.extension;
has Str $.precomp-ext;
has IO::Path $.path;
has Str $!WHICH;
has Bool $.loaded = False;
has Bool $.has-source;
has Bool $.has-precomp;
has Bool $.is-loaded;

my $slash := IO::Spec.rootdir;
my Lock $global = Lock.new;
my $default-from = 'Perl6';
my %instances;

method new( $path is copy, :$name, :$extension, :$from = $default-from ) {

# remove precomp extension if a precomp file
my $precomp-ext = $*VM.precomp-ext;
$path = $path.subst(/\.($precomp-ext)$/,"");
my $has-precomp = ?$0;

# set name / extension if not already given
if !$name or !$extension {
my $file;
for $path.rindex($slash) -> $i {
$file = $i.defined ?? $path.substr($i+1) !! $path;
}
# no $slash in char class
if $file ~~ m/ (<-[\\/.]>+) . (<-[.]>+) $/ {
$name ||= ~$0;
$extension ||= ~$1;
}
}

# sanity test
my $has-source;
$path = IO::Spec.rel2abs($path);
for $path.IO -> $io {
return Nil if !$io.e or $io.d;
return Nil if $io.d; # cannot be a directory

# do we have a precomp?
$has-source = $io.e;
$has-precomp ||= "$path.$precomp-ext".IO.e;
return Nil unless $has-source or $has-precomp;
}
$global.protect( { %instances{$path} //=
self.bless(:$path,:$name,:$extension,:$from) } );

$global.protect( { %instances{$path} //= self.bless(
:$path,
:$name,
:$extension,
:$precomp-ext,
:$from,
:$has-source,
:$has-precomp,
:!is-loaded,
) } );
}

method BUILD( :$path, :$!name, :$!extension, :$!from ) {
method BUILD(
:$path,
:$!name,
:$!extension,
:$!precomp-ext,
:$!from,
:$!has-source,
:$!has-precomp,
:$!is-loaded,
) {
$!lock = Lock.new;
$!WHICH = "{self.^name}|$path";
$!path = $path.path;
self
}

method WHICH() { self.DEFINITE ?? $!WHICH !! self.^name }
method Str() { self.DEFINITE ?? $!path.Str !! Nil }
method gist() { self.DEFINITE ?? "{self.name}:{$!path.Str}" !! self.^name }
method perl() { self.DEFINITE
?? "CompUnit.new('{$!path.Str}',:name<$!name>,:extension<$!extension>{",:from<$!from>" if $!from ne $default-from})"
!! self.^name;
method WHICH(--> Str) { self.DEFINITE ?? $!WHICH !! self.^name }
method Str(--> Str) { self.DEFINITE ?? $!path.Str !! Nil }
method gist(--> Str) {
self.DEFINITE ?? "{self.name}:{$!path.Str}" !! self.^name;
}
method perl(--> Str) { self.DEFINITE ?? nextsame() !! self.^name }

method key() {
$!extension eq $*VM.precomp-ext ?? $*VM.precomp-ext !! 'pm';
method key(--> Str) {
$!has-precomp ?? $!precomp-ext !! $!extension;
}

# same magic I'm not sure we need
Expand All @@ -62,15 +109,15 @@ class CompUnit {
$!lock.protect( {

# nothing to do
return $!loaded if $!loaded;
return $!is-loaded if $!is-loaded;

my $candi = self.candidates($module_name, :auth(%opts<auth>), :ver(%opts<ver>))[0];
my %chosen;
if $candi {
%chosen<pm> :=
$candi<provides>{$module_name}<pm><file>;
%chosen<load> :=
$candi<provides>{$module_name}{$*VM.precomp-ext}<file>;
$candi<provides>{$module_name}{$!precomp-ext}<file>;
%chosen<key> := %chosen<pm> // %chosen<load>;
}
$p6ml.load_module(
Expand All @@ -84,25 +131,32 @@ class CompUnit {
} );
}

method precomped() { $!extension eq $*VM.precomp-ext }

method precomp-path() {
my $ext := $!extension; # cannot use attributes in regex
$!path.subst(/$ext$/,$*VM.precomp-ext);
}
method precomp-path(--> Str) { "$!path.$!precomp-ext" }

method precomp($output = self.precomp-path, :$force) {
method precomp($output = self.precomp-path, :$force --> Bool) {
die "Cannot pre-compile an already pre-compiled file: $!path"
if self.precomped;
if $.has-precomp;
die "Cannot pre-compile over an existing file: $output"
if !$force and $output.IO.e;
?shell("$*EXECUTABLE --target={$*VM.precomp-target} --output=$output $!path");
my Bool $result = ?shell("$*EXECUTABLE --target={$*VM.precomp-target} --output=$output $!path");

$!has-precomp = $result if $output eq self.precomp-path;
$result;
}
}

# TEMPORARY ACCESS TO COMPUNIT INTERNALS UNTIL WE CAN LOAD DIRECTLY
multi postcircumfix:<{ }> (CompUnit \c, "provides" ) {
my % = ( c.name => { c.key => { file => c.path } } );
my % = (
c.name => {
c.key => {
file => c.has-precomp ?? c.precomp-path !! c.path
}
}
);
}
multi postcircumfix:<{ }> (CompUnit \c, "key" ) {
c.key;
}
multi postcircumfix:<{ }> (CompUnit \c, "ver" ) {
Version.new('0');
Expand Down
79 changes: 33 additions & 46 deletions src/core/CompUnitRepo/Local/File.pm
View file
@@ -1,67 +1,54 @@
class CompUnitRepo::Local::File does CompUnitRepo::Locally {
has Hash $!potentials;

my $precomp := $*VM.precomp-ext;
my Str $precomp-ext := $*VM.precomp-ext;
my Int $precomp-ext-dot := $precomp-ext.chars + 1;
my %extensions =
Perl6 => ($precomp,'pm6','pm'),
Perl5 => ($precomp,'pm5','pm'),
NQP => ($precomp,'nqp'),
JVM => ($precomp,);
my $anyextensions = any($precomp,<pm6 pm5 pm nqp>);
my $slash := IO::Spec.rootdir;
Perl6 => <pm6 pm>,
Perl5 => <pm5 pm>,
NQP => <nqp>,
JVM => ();
my Str $slash := IO::Spec.rootdir;

# global cache of files seen
my %seen;

method install($source, $from?) { ... }
method files($file, :$name, :$auth, :$ver) { ... }

method candidates(
$name = /./,
$name,
:$from = 'Perl6',
:$file, # not used here (yet)
:$auth, # not used here (yet)
:$ver, # not usde here (yet)
:$no-precomp,
:$ver, # not used here (yet)
) {
my @extensions := $no-precomp
?? %extensions{$from}[1..*]
!! %extensions{$from};

my @candidates;
for ( $!potentials //= self.potentials ).keys -> $root {
next unless $root ~~ $name; # not right name
# sorry, cannot handle this one
return () unless %extensions{$from}:exists;

my $base := $!path ~ $slash ~ $name.subst(:g, "::", $slash) ~ '.';
if %seen{$base} -> $found {
return $found;
}

my $candidate := $!potentials{$root};
# have extensions to check
if %extensions{$from} -> @extensions {
for @extensions -> $extension {
if $candidate{$extension} -> $sig { # use this extension
@candidates.push: CompUnit.new(|$sig, :$extension);
last;
}
my $path = $base ~ $extension;
return %seen{$base} = CompUnit.new($path,:$name,:$extension)
if $path.IO.f;
}
}
@candidates;
}

method short-id() { 'file' }

submethod potentials {
my Hash $potentials = {};

for $!path.contents -> $path {
my $file = ~$path;

# We loop over one element to be able to 'last' out of if.
for $file.rindex(".") -> $i {
last unless $i.defined; # could not find any ext

my $ext = $file.substr($i + 1);
last unless $ext ~~ $anyextensions; # not right ext

my $root = $file.substr(0,$i);
my $j := $root.rindex($slash);
$root = $root.substr($j + 1) if $j.defined;

$potentials{$root}{$ext} := \($file, :name($root) );
}
# no extensions to check, just check compiled version
elsif $base ~ $precomp-ext -> $path {
return %seen{$base} = CompUnit.new($path, :$name)
if $path.IO.f;
}
$potentials;

# alas
();
}

method short-id() { 'file' }
}

0 comments on commit 8bada16

Please sign in to comment.