Skip to content

Commit

Permalink
[mm] start metamodel hackery for settings
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Sep 27, 2010
1 parent 924e9b8 commit 383ed07
Show file tree
Hide file tree
Showing 4 changed files with 38 additions and 68 deletions.
43 changes: 15 additions & 28 deletions src/CompilerDriver.pm
View file
Expand Up @@ -112,8 +112,9 @@ sub find_module {
last REUSE unless -f $symlfile;
my $meta = Storable::retrieve($symlfile);

for my $dmod (keys %{ $meta->{deps} }) {
my ($dpath, $dtime) = @{ $meta->{deps}{$dmod} };
for my $dmod ($meta->name, keys %{ $meta->tdeps }) {
my $dpath = $meta->get_unit($dmod)->filename;
my $dtime = $meta->get_unit($dmod)->modtime;

my ($npath) = CompilerDriver::find_module($dmod, 0) or do {
$self->sorry("Dependancy $dmod of $module cannot be located");
Expand All @@ -133,7 +134,7 @@ sub find_module {
}
}

return $meta->{'syml'};
return $meta->syml;
}

$self->sys_compile_module($module, $symlfile, $modfile);
Expand All @@ -156,7 +157,7 @@ sub find_module {

my $astf = File::Spec->catfile($builddir, "$settingx.store");
if (-e $astf) {
return Storable::retrieve($astf)->{'syml'};
return Storable::retrieve($astf)->syml;
}

$self->sorry("Unable to load setting $setting.");
Expand Down Expand Up @@ -185,32 +186,22 @@ sub compile {
}

local $::stagetime = $args{stagetime};
local %::UNITREFS;
local %::UNITREFSTRANS;
local %::UNITDEPSTRANS;
local $::SETTING_UNIT;
local $::niecza_mod_symbols;
local $::YOU_WERE_HERE;
local $::UNITNAME = $name // 'MAIN';
$::UNITNAME =~ s/::/./g;
local $::SAFEMODE = $safe;
$STD::ALL = {};
my ($filename, $modtime);

if ($lang ne 'NULL') {
my $metasetting = metadata_for($lang);
$::SETTING_UNIT = $metasetting->{unit};
$::UNITREFS{$lang} = 1;
$::UNITREFSTRANS{$lang} = 1;
%::UNITREFSTRANS = (%::UNITREFSTRANS, %{ $metasetting->{trefs} });
}

if (defined($name) && !$setting) {
my $rp = Cwd::realpath($path);
$::UNITDEPSTRANS{$name} = [ $rp, ((stat $rp)[9]) ];
$::SETTING_UNIT = metadata_for($lang);
}

if (defined($name)) {
$::UNITREFSTRANS{$name} = 1;
$filename = Cwd::realpath($path);
$modtime = ((stat $filename)[9]);
}

my ($m, $a) = defined($path) ? (parsefile => $path) : (parse => $code);
Expand All @@ -236,32 +227,28 @@ sub compile {
delete $ast->{mod};
close $fh;
if (defined $name) {
my $blk = { deps => \%::UNITDEPSTRANS,
refs => \%::UNITREFS,
trefs => \%::UNITREFSTRANS,
unit => $ast,
syml => $::niecza_mod_symbols };
store $blk, File::Spec->catfile($builddir, "$basename.store");
$ast->syml($::niecza_mod_symbols);
$ast->filename($filename);
$ast->modtime($modtime);
store $ast, File::Spec->catfile($builddir, "$basename.store");
}
$ast = undef;
} ],
[ 'gmcs', sub {
delete $::UNITREFS{$basename};
my @args;
if ($args{selfcontained}) {
@args = ("gmcs",
"/out:" . $args{selfcontained},
(map { File::Spec->catfile($libdir, $_) }
"Kernel.cs", "Cursor.cs"),
(map { build_file($_ . ".cs") }
(sort keys %::UNITREFSTRANS)),
(sort keys %{ $ast->tdeps })),
$csfile);
} else {
@args = ("gmcs",
(defined($name) ? ("/target:library") : ()),
"/lib:$builddir",
"/r:Kernel.dll",
(map { "/r:$_.dll" } sort keys %::UNITREFS),
(map { "/r:$_.dll" } sort keys %{ $ast->tdeps }),
"/out:$outfile",
$csfile);
}
Expand Down
23 changes: 18 additions & 5 deletions src/Metamodel.pm
View file
Expand Up @@ -427,6 +427,10 @@ our $unit;
has xref => (isa => 'ArrayRef', is => 'ro', default => sub { [] });
has tdeps => (isa => 'HashRef[Metamodel::Unit]', is => 'ro');

has filename => (isa => 'Str', is => 'rw');
has modtime => (isa => 'Num', is => 'rw');
has syml => (is => 'rw');

# we like to delete staticsubs in the optimizer, so visiting them is
# a tad harder
has packages => (isa => 'ArrayRef[Metamodel::Package]', is => 'ro',
Expand Down Expand Up @@ -542,19 +546,21 @@ sub Body::begin {
my $self = shift;
my %args = @_;

my $top = @opensubs ? $opensubs[-1] : undef;
my $top = @opensubs ? $opensubs[-1] : $args{top};
my $rtop = !$top ? $top : Scalar::Util::blessed($top) ? $top :
$unit->deref($top);

my $metabody = Metamodel::StaticSub->new(
outer => $top // ($unit->setting ?
$unit->get_unit($unit->setting)->bottom_ref : undef),
outer => $top,
body_of => $args{body_of},
cur_pkg => $args{cur_pkg} // ($top ? $top->cur_pkg : [ 'GLOBAL' ]),
cur_pkg => $args{cur_pkg} // (@opensubs ? $opensubs[-1]->cur_pkg :
[ 'GLOBAL' ]), # cur_pkg does NOT propagate down from settings
augmenting => $args{augmenting},
name => $self->name,
returnable => $self->returnable,
gather_hack=> $args{gather_hack},
class => $self->class,
run_once => $args{once} && (!defined($top) || $top->run_once));
run_once => $args{once} && (!defined($rtop) || $rtop->run_once));

$unit->get_stash(@{ $metabody->cur_pkg });

Expand Down Expand Up @@ -596,6 +602,13 @@ sub Op::begin {
$_->begin for $self->zyg;
}

sub Op::YouAreHere::begin {
my $self = shift;
$unit->bottom_ref($unit->make_ref($opensubs[-1]));
$opensubs[-1]->strong_used(1);
$opensubs[-1]->create_static_pad;
}

sub Op::Lexical::begin {
my $self = shift;

Expand Down
29 changes: 2 additions & 27 deletions src/Niecza/Actions.pm
View file
Expand Up @@ -2110,13 +2110,8 @@ sub statement_control__S_use { my ($cl, $M) = @_;
}

my $meta = CompilerDriver::metadata_for($name);
$::UNITREFS{$name} = 1;
$::UNITREFSTRANS{$name} = 1;
%::UNITDEPSTRANS = (%::UNITDEPSTRANS, %{ $meta->{deps} });
%::UNITREFSTRANS = (%::UNITREFSTRANS, %{ $meta->{trefs} });
my %symbols;
$symbols{$name} = [ $name ];
$symbols{$name . '::'} = [ $name . '::' ];

my $pkg = $M->find_stash($name);
if ($pkg->{really}) {
Expand All @@ -2129,7 +2124,7 @@ sub statement_control__S_use { my ($cl, $M) = @_;
# XXX This code is wrong. It either needs to be more integrated with STD,
# or less.
for my $exp (keys %{ $pkg->{'EXPORT::'}->{'DEFAULT::'} }) {
$symbols{$exp} = [ $name . '::', 'EXPORT::', 'DEFAULT::', $exp ];
$symbols{$exp} = [ $name, 'EXPORT', 'DEFAULT', $exp ];
}

$M->{_ast} = Op::Use->new(node($M), unit => $name, symbols => \%symbols);
Expand Down Expand Up @@ -2454,31 +2449,11 @@ sub comp_unit { my ($cl, $M) = @_;
my $body;
my $sl = $M->{statementlist}{_ast};

if (!$::YOU_WERE_HERE && $::UNITNAME ne 'MAIN') {
$sl = Op::StatementList->new(node($M), children => [ $sl,
Op::YouAreHere->new(save_only => 1, unitname => $::UNITNAME)]);
}

$body = $cl->sl_to_block('mainline', $sl, subname => 'mainline');
if ($::YOU_WERE_HERE) {
$body = Body->new(
type => 'mainline', file => '(generated)', text => '',
name => 'install',
signature => Sig->new(params => [
Sig::Parameter->new(name => '!mainline',
slot => '!mainline')]),
do => Op::CallSub->new(node($M),
invocant => Op::CgOp->new(optree => [ 'newscalar',
[ 'rawsget', $::SETTINGNAME . ".Installer" ] ]),
positionals => [Op::SubDef->new(
var => $cl->gensym, body => $body)]));
}

my $sn = $::SETTINGNAME; $sn =~ s/::/./g;
$M->{_ast} = Unit->new(mainline => $body, name => $::UNITNAME,
($::SETTING_RESUME ? (setting => $::SETTING_RESUME) : ()),
is_setting => (!!$::YOU_WERE_HERE),
setting_name => $sn);
is_setting => (!!$::YOU_WERE_HERE), setting_name => $sn);
}

1;
11 changes: 3 additions & 8 deletions src/Op.pm
View file
Expand Up @@ -166,17 +166,12 @@ use CgOp;
extends 'Op';

has unitname => (isa => 'Str', is => 'ro', clearer => 'drop_unitname');
has save_only => (isa => 'Bool', is => 'ro', default => 0);

sub lift_decls {
my $un = $_[0]->unitname; $_[0]->drop_unitname;
Decl::SaveEnv->new(unitname => $un)
}

sub code {
my ($self, $body) = @_;
$self->save_only ? CgOp::null('Variable') :
CgOp::subcall(CgOp::fetch(CgOp::scopedlex('!mainline')));
# this should be a little fancier so closure can work
CgOp::subcall(CgOp::fetch(CgOp::rawscall('Kernel.ContextHelper',
CgOp::callframe, CgOp::clr_string('*resume_' . $self->unitname))));
}

__PACKAGE__->meta->make_immutable;
Expand Down

0 comments on commit 383ed07

Please sign in to comment.