Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Start to refactor hanlding of module loading. Also stub in some setti…
…ng loading bits.
  • Loading branch information
jnthn committed May 7, 2011
1 parent 40c47c3 commit 35b6a71
Show file tree
Hide file tree
Showing 5 changed files with 204 additions and 55 deletions.
9 changes: 8 additions & 1 deletion build/Makefile.in
Expand Up @@ -53,6 +53,8 @@ DOCDIR = @prefix@/share/doc
PERL6_PIR = src/gen/perl6.pir
PERL6_PBC = perl6.pbc
PERL6_EXE = perl6$(EXE)
PERL6_ML = src/gen/perl6-moduleloader.pir
PERL6_ML_PBC = Perl6/ModuleLoader.pbc
PERL6_ST = src/gen/perl6-symboltable.pir
PERL6_ST_PBC = Perl6/SymbolTable.pbc
PERL6_G = src/gen/perl6-grammar.pir
Expand Down Expand Up @@ -170,7 +172,12 @@ $(PERL6_PBC): $(PERL6_G_PBC) $(PERL6_A_PBC) src/perl6.p6
$(NQP_EXE) --target=pir --output=src/gen/perl6.pir src/perl6.p6
$(PARROT) $(PARROT_ARGS) -o $(PERL6_PBC) src/gen/perl6.pir

$(PERL6_ST_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/SymbolTable.pm
$(PERL6_ML_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/ModuleLoader.pm
$(NQP_EXE) --target=pir --output=$(PERL6_ML) --encoding=utf8 \
src/Perl6/ModuleLoader.pm
$(PARROT) $(PARROT_ARGS) -o $(PERL6_ML_PBC) $(PERL6_ML)

$(PERL6_ST_PBC): $(NQP_EXE) $(PERL6_ML_PBC) src/Perl6/SymbolTable.pm
$(NQP_EXE) --target=pir --output=$(PERL6_ST) --encoding=utf8 \
src/Perl6/SymbolTable.pm
$(PARROT) $(PARROT_ARGS) -o $(PERL6_ST_PBC) $(PERL6_ST)
Expand Down
53 changes: 2 additions & 51 deletions src/Perl6/Actions.pm
Expand Up @@ -437,55 +437,12 @@ class Perl6::Actions is HLL::Actions {
make $past;
}

sub need($module_name) {
# Build up adverbs hash if we have them. Note that we need a hash
# for now (the compile time call) and an AST that builds said hash
# for the runtime call once we've compiled the module.
my $name := $module_name<longname><name>.Str;
my %adverbs;
my $adverbs_ast := PAST::Op.new(
:name('&circumfix:<{ }>'), PAST::Op.new( :name('&infix:<,>') )
);
if $module_name<longname><colonpair> {
for $module_name<longname><colonpair> {
my $ast := $_.ast;
$adverbs_ast[0].push($ast);
%adverbs{$ast[1].value()} := $ast[2].value();
}
}

# Need to immediately load module and get lexicals stubbed in.
Perl6::Module::Loader.need($name, %adverbs);

# Also need code to do the actual loading emitting (though need
# won't repeat its work if already carried out; we mainly need
# this for pre-compilation to PIR to work).
my @ns := pir::split__PSS('::', 'Perl6::Module');
$*ST.cur_lexpad().loadinit.push(
PAST::Op.new( :pasttype('callmethod'), :name('need'),
PAST::Var.new( :name('Loader'), :namespace(@ns), :scope('package') ),
$name,
PAST::Op.new( :pirop('getattribute PPS'), $adverbs_ast, '$!storage' )
));
}

method statement_control:sym<import>($/) {
my $past := PAST::Stmts.new( :node($/) );
import($/);
make $past;
}

sub import($/) {
my $name := $<module_name><longname><name>.Str;
Perl6::Module::Loader.stub_lexical_imports($name, $*ST.cur_lexpad());
my @ns := pir::split__PSS('::', 'Perl6::Module');
$*ST.cur_lexpad().push(
PAST::Op.new( :pasttype('callmethod'), :name('import'),
PAST::Var.new( :name('Loader'), :namespace(@ns), :scope('package') ),
$name
));
}

method statement_control:sym<use>($/) {
my $past := PAST::Stmts.new( :node($/) );
if $<version> {
Expand Down Expand Up @@ -518,19 +475,12 @@ class Perl6::Actions is HLL::Actions {
),
);
}
elsif ~$<module_name> eq 'MONKEY_TYPING' {
$*MONKEY_TYPING := 1;
}
elsif ~$<module_name> eq 'FORBID_PIR' {
$FORBID_PIR := 1;
}
elsif ~$<module_name> eq 'Devel::Trace' {
$STATEMENT_PRINT := 1;
}
else {
need($<module_name>);
import($/);
}
}
make $past;
}
Expand Down Expand Up @@ -766,11 +716,12 @@ class Perl6::Actions is HLL::Actions {
method name($/) { }

method module_name($/) {
# XXX Needs re-doing.
my @name := Perl6::Grammar::parse_name(~$<longname>);
my $var := PAST::Var.new(
:name(@name.pop),
:namespace(@name),
:scope(is_lexical(~$<longname>) ?? 'lexical' !! 'package')
:scope('package')
);
if $<arglist> {
my $past := $<arglist>[0].ast;
Expand Down
27 changes: 26 additions & 1 deletion src/Perl6/Grammar.pm
Expand Up @@ -406,10 +406,35 @@ grammar Perl6::Grammar is HLL::Grammar {
}

token statement_control:sym<use> {
:my $longname;
:my $*IN_DECL := 'use';
:my $*SCOPE := 'use';
<sym> <.ws>
[
| <version>
| <module_name> [ <.spacey> <arglist> ]?
| <module_name>
{
$longname := $<module_name><longname>;

# Some modules are handled in the actions are just turn on a
# setting of some kind.
if $longname.Str eq 'MONKEY_TYPING' {
$*MONKEY_TYPING := 1;
$longname := "";
}
elsif $longname.Str eq 'FORBID_PIR' ||
$longname.Str eq 'Devel::Trace' ||
$longname.Str eq 'fatal' {
$longname := "";
}
}
[
|| <.spacey> <arglist>
{
$/.CURSOR.panic("arglist case of use not yet implemented");
}
|| { $longname && $*ST.load_module(~$longname); }
]
]
<.ws>
}
Expand Down
119 changes: 119 additions & 0 deletions src/Perl6/ModuleLoader.pm
@@ -0,0 +1,119 @@
# XXX Very simplistic for now - really we'll need to steal much of the stuff
# in the existing Perl6::Module::Loader and Perl6::Module::Locator, though enough
# of it is wrong (e.g. importing) that this will look quite different anyway.
class Perl6::ModuleLoader {
my %modules_loaded;
my %settings_loaded;

method ctxsave() {
$*MAIN_CTX := Q:PIR {
getinterp $P0
%r = $P0['context';1]
};
$*CTXSAVE := 0;
}

method load_module($module_name, $cur_GLOBALish) {
# If we didn't already do so, load the module and capture
# its mainline. Otherwise, we already loaded it so go on
# with what we already have.
my $module_ctx;
my $path := pir::join('/', pir::split('::', $module_name)) ~ '.pbc';
try {
my $prefix := %*COMPILING<%?OPTIONS><module-path>;
if $prefix {
$path := "$prefix/$path";
}
}
if pir::defined(%modules_loaded{$path}) {
$module_ctx := %modules_loaded{$path};
}
else {
my $*CTXSAVE := self;
my $*MAIN_CTX;
my $preserve_global := pir::get_hll_global__Ps('GLOBAL');
pir::load_bytecode($path);
pir::set_hll_global__vsP('GLOBAL', $preserve_global);
%modules_loaded{$path} := $module_ctx := $*MAIN_CTX;
}

# Provided we have a mainline...
if pir::defined($module_ctx) {
# Merge any globals.
my $UNIT := pir::getattribute__PPs($module_ctx, 'lex_pad');
unless pir::isnull($UNIT<GLOBALish>) {
merge_globals($cur_GLOBALish, $UNIT<GLOBALish>);
}
}

return $module_ctx;
}

# XXX This is a really dumb and minimalistic GLOBAL merger.
# For a much more complete one, see sorear++'s work in
# Niecza. This one will likely evolve towards that.
my $stub_how := 'KnowHOW';
sub 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 $target.WHO {
%known_symbols{$_.key} := 1;
}
for $source.WHO {
my $sym := $_.key;
if !%known_symbols{$sym} {
($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.WHAT.HOW.name($source_mo) eq $stub_how;
my $target_mo := ($target.WHO){$sym}.HOW;
my $target_is_stub := $target_mo.WHAT.HOW.name($target_mo) eq $stub_how;
if $source_is_stub && $target_is_stub {
# Leave target as is, and merge the nested symbols.
merge_globals(($target.WHO){$sym}, $_.value);
}
# XXX Two other recursive cases go here.
else {
pir::die("Merging GLOBAL symbols failed: duplicate definition of symbol $sym");
}
}
}
}

method load_setting($setting_name) {
my $setting;

if $setting_name ne 'NULL' {
# Add path prefix and .setting suffix.
my $path := "$setting_name.setting.pbc";
try {
my $prefix := %*COMPILING<%?OPTIONS><setting-path>;
if $prefix {
$path := "$prefix/$path";
}
}

# Unless we already did so, load the setting.
unless pir::defined(%settings_loaded{$path}) {
my $*CTXSAVE := self;
my $*MAIN_CTX;
my $preserve_global := pir::get_hll_global__Ps('GLOBAL');
pir::load_bytecode($path);
pir::set_hll_global__vsP('GLOBAL', $preserve_global);
unless pir::defined($*MAIN_CTX) {
pir::die("Unable to load setting $setting_name; maybe it is missing a YOU_ARE_HERE?");
}
%settings_loaded{$path} := $*MAIN_CTX;
}

$setting := %settings_loaded{$path};
}

return $setting;
}
}
51 changes: 49 additions & 2 deletions src/Perl6/SymbolTable.pm
@@ -1,4 +1,5 @@
use NQPHLL;
use Perl6::ModuleLoader;

# This builds upon the SerializationContextBuilder to add the specifics
# needed by Rakudo Perl 6.
Expand All @@ -25,8 +26,54 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
}

# Loads a setting.
method load_setting($name) {
# XXX TODO
method load_setting($setting_name) {
# Do nothing for the NULL setting.
if $setting_name ne 'NULL' {
# Load it immediately, so the compile time info is available.
# Once it's loaded, set it as the outer context of the code
# being compiled.
my $setting := %*COMPILING<%?OPTIONS><outer_ctx>
:= Perl6::ModuleLoader.load_setting($setting_name);

# Do load for pre-compiled situation.
self.add_event(:deserialize_past(PAST::Stmts.new(
PAST::Op.new(
:pirop('load_bytecode vs'), 'Perl6/ModuleLoader.pbc'
),
PAST::Op.new(
:pasttype('callmethod'), :name('set_outer_ctx'),
PAST::Var.new( :name('block'), :scope('register') ),
PAST::Op.new(
:pasttype('callmethod'), :name('load_setting'),
PAST::Var.new( :name('ModuleLoader'), :namespace([]), :scope('package') ),
$setting_name
)
)
)));

return pir::getattribute__PPs($setting, 'lex_pad');
}
}

# Loads a module immediately, and also makes sure we load it
# during the deserialization.
method load_module($module_name, $cur_GLOBALish) {
# Immediate loading.
my $module := Perl6::ModuleLoader.load_module($module_name, $cur_GLOBALish);

# Make sure we do the loading during deserialization.
self.add_event(:deserialize_past(PAST::Stmts.new(
PAST::Op.new(
:pirop('load_bytecode vs'), 'Perl6/ModuleLoader.pbc'
),
PAST::Op.new(
:pasttype('callmethod'), :name('load_module'),
PAST::Var.new( :name('ModuleLoader'), :namespace([]), :scope('package') ),
$module_name,
self.get_slot_past_for_object($cur_GLOBALish)
))));

return pir::getattribute__PPs($module, 'lex_pad');
}

# Creates a meta-object for a package, adds it to the root objects and
Expand Down

0 comments on commit 35b6a71

Please sign in to comment.