Skip to content

Commit

Permalink
use our own ModuleLoader, jnthn++
Browse files Browse the repository at this point in the history 
This has the consequene that we cant use Config.pm from Terms.pm. Turned it around.
  • Loading branch information
@FROGGS
FROGGS committed Sep 16, 2013
1 parent 27b050e commit ebdcd7c
Show file tree
Hide file tree
Showing 7 changed files with 114 additions and 86 deletions.
2 changes: 1 addition & 1 deletion Makefile
View file
Expand Up @@ -15,7 +15,7 @@ HAS_ICU = 0
# as the goal is that all tests must pass without fudge
HARNESS_WITH_FUDGE = $(PERL) t/harness --fudge --keep-exit-code --add_use_v5 --icu=$(HAS_ICU)

all: blib blib/Perl5.pbc blib/Perl5/Config.pbc blib/Perl5/Terms.pbc
all: blib blib/Perl5.pbc blib/Perl5/Config.pbc blib/Perl5/Terms.pbc blib/Perl5/ModuleLoader.pbc

blib/Perl5/World.pbc: lib/Perl5/World.nqp
$(NQP) --vmlibs=perl6_ops --target=pir --stagestats --output=blib/Perl5/World.pir lib/Perl5/World.nqp
Expand Down
1 change: 1 addition & 0 deletions lib/Perl5.nqp
View file
@@ -1,5 +1,6 @@
use Perl6::Grammar;
use Perl5::Grammar;
use Perl5::ModuleLoader;

sub EXPORT(*@a) {
Perl5::Grammar.HOW.trace-on(Perl5::Grammar) if nqp::getenvhash()<V5TRACE> eq 'Perl5::Grammar';
Expand Down
3 changes: 3 additions & 0 deletions lib/Perl5/Config.pm
View file
Expand Up @@ -2,6 +2,8 @@
use v6.0.0;

sub EXPORT(|) {
use Perl5::Terms;

my %ex;
%ex<%Config> = {
'Author' => '',
Expand Down Expand Up @@ -1138,5 +1140,6 @@ sub EXPORT(|) {
'git_uncommitted_changes' => '',
'git_commit_id_title' => ''
};
%ex<intsize> := $*CONFIG_INTSZIE;
%ex
}
20 changes: 11 additions & 9 deletions lib/Perl5/Grammar.nqp
View file
Expand Up @@ -1460,25 +1460,27 @@ grammar Perl5::Grammar is HLL::Grammar does STD5 {
|| <module_name> <version=versionish>?
[ <.spacey> <arglist> <?{ $<arglist><arg>[0]<EXPR> }> ]?
{
my $longname := ~$<module_name><longname>;
my $longname := $<module_name><longname>;
my $lnd := $*W.dissect_longname($longname);
my $name := $lnd.name;
my $arglist;

if $<arglist><arg>[0]<EXPR> {
$arglist := $*W.compile_time_evaluate($/,
$<arglist><arg>[0]<EXPR>.ast);
$arglist := nqp::getattr($arglist.list.eager,
$*W.find_symbol(['List']), '$!items');
}

if nqp::existskey(%pragma_defaults, $longname) {
$arglist := %pragma_defaults{$longname} unless $<arglist><arg>[0]<EXPR>;
self.pragma($longname, $arglist, 1);
$longname := '' unless $longname eq 'warnings';
if nqp::existskey(%pragma_defaults, $name) {
$arglist := %pragma_defaults{$name} unless $<arglist><arg>[0]<EXPR>;
self.pragma($name, $arglist, 1);
$name := '' unless $name eq 'warnings';
}

if $longname {
my $module := $*W.load_module($/, $longname, nqp::hash( 'from', 'Perl5' ), $*GLOBALish);
do_import($/, $module, $longname, $arglist);
if $name {
my $module := $*W.load_module($/, $name, nqp::hash( 'from', 'Perl5' ), $*GLOBALish);
do_import($/, $module, $name, $arglist);
$/.CURSOR.import_EXPORTHOW($module);
}
}
Expand Down
95 changes: 89 additions & 6 deletions lib/Perl5/ModuleLoader.nqp
View file
@@ -1,9 +1,19 @@

use Perl6::ModuleLoader;

class Perl5::ModuleLoader {
my %modules_loaded := Perl6::ModuleLoader.modules_loaded();
my $V5MLDEBUG := +nqp::getenvhash()<V5MLDEBUG>;

class Perl5::ModuleLoader does Perl6::ModuleLoaderVMConfig {
my %modules_loaded;

method ctxsave() {
$V5MLDEBUG && say("Perl5::ModuleLoader.ctxsave()");
$*MAIN_CTX := nqp::ctxcaller(nqp::ctx());
$*CTXSAVE := 0;
}

method search_path(%opts) {
$V5MLDEBUG && say("Perl5::ModuleLoader.search_path(" ~ dump_hash(%opts) ~ ")");
# See if we have an @*INC set up, and if so just use that.
my $PROCESS := nqp::gethllsym('perl6', 'PROCESS');

Expand Down Expand Up @@ -45,11 +55,12 @@ class Perl5::ModuleLoader {
@search_paths
}

method load_module($module_name, %opts, *@GLOBALish, :$line, :$file?) {
method load_module($module_name, %opts, *@GLOBALish, :$line, :$file) {
$V5MLDEBUG && say("Perl5::ModuleLoader.load_module($module_name, " ~ dump_hash(%opts) ~ ", +\@GLOBALish=" ~ +@GLOBALish ~ ", :\$line=$line, :\$file=$file)");
# Locate all the things that we potentially could load. Choose
# the first one for now (XXX need to filter by version and auth).
my @prefixes := self.search_path(%opts);
my @candidates := Perl6::ModuleLoader.locate_candidates($module_name, @prefixes, :$file);
my @prefixes := self.search_path( %opts );
my @candidates := self.locate_candidates($module_name, @prefixes, :$file);
if +@candidates == 0 {
if nqp::defined($file) {
nqp::die("Could not find file '$file' for module $module_name");
Expand Down Expand Up @@ -132,7 +143,6 @@ class Perl5::ModuleLoader {
my $*MAIN_CTX;
$eval();
%modules_loaded{%chosen<key>} := $module_ctx := $*MAIN_CTX;

}
nqp::bindhllsym('perl6', 'GLOBAL', $preserve_global);
CATCH {
Expand All @@ -156,6 +166,79 @@ class Perl5::ModuleLoader {
return {};
}
}

# This is a first cut of the globals merger. For another approach,
# see sorear++'s work in Niecza. That one is likely more "pure"
# than this, but that would seem to involve copying too, and the
# details of exactly what that entails are a bit hazy to me at the
# moment. We'll see how far this takes us.
my $stub_how := 'Perl6::Metamodel::PackageHOW';
sub merge_globals($target, $source) {
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals(\$target, \$source)");
# Start off merging top-level symbols. Easy when there's no
# overlap. Otherwise, we need to recurse.
my %known_symbols;
for stash_hash($target) {
%known_symbols{$_.key} := 1;
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals: %known_symbols<{$_.key}> := 1;");
}
for stash_hash($source) {
my $sym := $_.key;
if !%known_symbols{$sym} {
($target.WHO){$sym} := $_.value;
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals: (\$target.WHO)<{$sym}> := \$_.value;");
}
elsif ($target.WHO){$sym} =:= $_.value {
# No problemo; a symbol can't conflict with itself.
}
else {
my $source_mo := $_.value.HOW;
my $source_is_stub := $source_mo.HOW.name($source_mo) eq $stub_how;
my $target_mo := ($target.WHO){$sym}.HOW;
my $target_is_stub := $target_mo.HOW.name($target_mo) eq $stub_how;
if $source_is_stub && $target_is_stub {
# Both stubs. We can safely merge the symbols from
# the source into the target that's importing them.
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals: merge_globals((\$target.WHO)<{$sym}>, \$_.value);");
merge_globals(($target.WHO){$sym}, $_.value);
}
elsif $source_is_stub {
# The target has a real package, but the source is a
# stub. Also fine to merge source symbols into target.
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals: merge_globals((\$target.WHO)<{$sym}>, \$_.value);");
merge_globals(($target.WHO){$sym}, $_.value);
}
elsif $target_is_stub {
# The tricky case: here the interesting package is the
# one in the module. So we merge the other way around
# and install that as the result.
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals: merge_globals(\$_.value, (\$target.WHO)<$sym>);");
merge_globals($_.value, ($target.WHO){$sym});
($target.WHO){$sym} := $_.value;
$V5MLDEBUG && say("Perl5::ModuleLoader.merge_globals: (\$target.WHO)<{$sym}> := \$_.value;");
}
else {
nqp::die("Merging GLOBAL symbols failed: duplicate definition of symbol $sym");
}
}
}
}

sub stash_hash($pkg) {
my $hash := $pkg.WHO;
unless nqp::ishash($hash) {
$hash := $hash.FLATTENABLE_HASH();
}
$hash
}

sub dump_hash($hash) {
my $dump := '{ ';
for $hash {
$dump := $dump ~ $_.key ~ ' => ' ~ $_.value ~ ' ';
}
$dump ~ '}'
}
}

Perl6::ModuleLoader.register_language_module_loader('Perl5', Perl5::ModuleLoader);
Expand Down
14 changes: 9 additions & 5 deletions lib/Perl5/Terms.pm
View file
@@ -1,4 +1,6 @@

use v6.0.0;

my %SIG;

use Perl5::warnings ();
Expand All @@ -14,6 +16,8 @@ sub P5die (:$cat, *@a) is hidden_from_backtrace {
}
}

# We can't use modules here which will be exposed to user land. So we turn it around.
my $CONFIG_INTSIZE = 4;
my $INPUT_RECORD_SEPARATOR = "\n";
my $SUBSCRIPT_SEPARATOR = chr(28);
my $VERSION_MAJOR = 5; # well, we have to say something
Expand Down Expand Up @@ -104,6 +108,7 @@ sub EXPORT(|) {
# So we need an accessor, the grammar token '$/' can use, and a way to support the English module.
# I choosed $*-vars, because they can't be used from Perl5 directly because of its grammar.
%ex<$*INPUT_RECORD_SEPARATOR> := $INPUT_RECORD_SEPARATOR;
%ex<$*CONFIG_INTSIZE> := $CONFIG_INTSIZE;

%ex
}
Expand Down Expand Up @@ -244,7 +249,6 @@ multi trait_mod:<is>(Routine:D $r, :$lvalue!) is export {
$r.set_rw();
}

use Perl5::Config;
use MONKEY_TYPING;

sub _P5do( $file ) is hidden_from_backtrace {
Expand Down Expand Up @@ -755,7 +759,7 @@ augment class Str {
loop( -> $a is copy {
$a = &prefix:<P5+>($a);
my @b;
@b.push( ($a +> ($_ * 0x08)) % 0x100 ) for ^%Config<intsize>;
@b.push( ($a +> ($_ * 0x08)) % 0x100 ) for ^$CONFIG_INTSIZE;
@b
} );
}
Expand Down Expand Up @@ -889,16 +893,16 @@ augment class Str {
when 'i' {
for ^$amount {
my $a = 0;
$a +|= next_byte() +< ($_ * 0x08) for ^%Config<intsize>;
$a -= 2 ** (8 * %Config<intsize>) if $a >= (2 ** (8 * %Config<intsize>)) / 2;
$a +|= next_byte() +< ($_ * 0x08) for ^$CONFIG_INTSIZE;
$a -= 2 ** (8 * %Config<intsize>) if $a >= (2 ** (8 * $CONFIG_INTSIZE)) / 2;
@fields.push($a)
}
}
# unsigned int
when 'I' {
for ^$amount {
my $a = 0;
for ^%Config<intsize> { # usually 4 or 8
for ^$CONFIG_INTSIZE { # usually 4 or 8
$a +|= next_byte() +< ($_ * 0x08);
}
@fields.push($a)
Expand Down
65 changes: 0 additions & 65 deletions rakudo.patch
View file
Expand Up @@ -57,68 +57,3 @@ index 2879dfe..5309301 100644
<.ws>
}

diff --git a/src/Perl6/ModuleLoader.nqp b/src/Perl6/ModuleLoader.nqp
index b57beb8..03cb32d 100644
--- a/src/Perl6/ModuleLoader.nqp
+++ b/src/Perl6/ModuleLoader.nqp
@@ -25,14 +25,31 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig {
$*CTXSAVE := 0;
}

- method search_path() {
+ method search_path(:$from) {
# See if we have an @*INC set up, and if so just use that.
my $PROCESS := nqp::gethllsym('perl6', 'PROCESS');
+ if $from && !nqp::isnull($PROCESS) && nqp::existskey($PROCESS.WHO, '%CUSTOM_LIB') {
+ my $INC := ($PROCESS.WHO)<%CUSTOM_LIB>;
+ if nqp::defined($INC) {
+ my %INC := $INC.FLATTENABLE_HASH();
+ if nqp::existskey(%INC, $from) {
+ my @INC := %INC<Perl5>.FLATTENABLE_LIST();
+ if +@INC {
+ return @INC;
+ }
+ }
+ }
+ }
+
if !nqp::isnull($PROCESS) && nqp::existskey($PROCESS.WHO, '@INC') {
my $INC := ($PROCESS.WHO)<@INC>;
if nqp::defined($INC) {
my @INC := $INC.FLATTENABLE_LIST();
if +@INC {
+ if $from {
+ my %conf := pir::getinterp__P()[pir::const::IGLOBALS_CONFIG_HASH];
+ nqp::push(@INC, %conf<libdir> ~ %conf<versiondir> ~ '/languages/' ~ nqp::lc($from) ~ '/lib');
+ }
return @INC;
}
}
@@ -64,14 +81,14 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig {
return %language_module_loaders{%opts<from>}.load_module($module_name,
%opts, |@GLOBALish, :$line, :$file);
}
- else {
- nqp::die("Do not know how to load code from " ~ %opts<from>);
- }
+ #~ else {
+ #~ nqp::die("Do not know how to load code from " ~ %opts<from>);
+ #~ }
}

# Locate all the things that we potentially could load. Choose
# the first one for now (XXX need to filter by version and auth).
- my @prefixes := self.search_path();
+ my @prefixes := self.search_path( :from(%opts<from>) );
my @candidates := self.locate_candidates($module_name, @prefixes, :$file);
if +@candidates == 0 {
if nqp::defined($file) {
@@ -153,7 +170,7 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig {
# Get the compiler and compile the code, then run it
# (which runs the mainline and captures UNIT).
my $?FILES := %chosen<pm>;
- my $eval := nqp::getcomp('perl6').compile($source);
+ my $eval := nqp::getcomp('perl6').compile($source, :M(%opts<from>));
my $*CTXSAVE := self;
my $*MAIN_CTX;
$eval();

0 comments on commit ebdcd7c

Please sign in to comment.