Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
First incomplete cut of subset type declaration. Seems to essentially… 
… work, at least with a few basic tests.
  • Loading branch information
@jnthn
jnthn committed Jun 14, 2011
1 parent a181c92 commit c6d592d
Show file tree
Hide file tree
Showing 3 changed files with 109 additions and 62 deletions.
99 changes: 56 additions & 43 deletions src/Perl6/Actions.pm
View file
Expand Up @@ -1463,51 +1463,32 @@ class Perl6::Actions is HLL::Actions {
}

method type_declarator:sym<subset>($/) {
# Figure out our refinee.
my $of_trait := has_compiler_trait($<trait>, '&trait_mod:<of>');
my $refinee := $of_trait ??
$of_trait[0] !!
PAST::Var.new( :name('Any'), :namespace([]), :scope('package') );

# Construct subset and install it in the right place.
my $cons_past := PAST::Op.new(
:name('&CREATE_SUBSET_TYPE'),
$refinee,
$<EXPR> ?? where_blockify($<EXPR>[0].ast) !!
PAST::Var.new( :name('True'), :namespace('Bool'), :scope('package') )
);

# Stick it somewhere appropriate.
if $<longname> {
my $name := $<longname>[0].Str;
if $*SCOPE eq '' || $*SCOPE eq 'our' {
# Goes in the package.
@PACKAGE[0].block.loadinit.push(PAST::Op.new(
:pasttype('bind_6model'),
PAST::Var.new( :name($name), :scope('package') ),
$cons_past
));
$*ST.cur_lexpad().symbol($name, :scope('package') );
}
elsif $*SCOPE eq 'my' {
# Install in the lexpad.
$*ST.cur_lexpad()[0].push(PAST::Var.new(
:name($name), :isdecl(1),
:viviself($cons_past), :scope('lexical')
));
$*ST.cur_lexpad().symbol($name, :scope('lexical') );
}
else {
$/.CURSOR.panic("Cannot declare a subset with scope declarator " ~ $*SCOPE);
}
make PAST::Var.new( :name($name) );
# We refine Any by default; "of" may override.
my $refinee := $*ST.find_symbol(['Any']);

# If we have a refinement, make sure it's thunked if needed. If none,
# just always true.
my $refinement := make_where_block($<EXPR> ?? $<EXPR>[0].ast !!
PAST::Op.new( :pirop('perl6_booleanize__PI'), 1 ));

# Create the meta-object.
my $subset := $<longname> ??
$*ST.create_subset(%*HOW<subset>, $refinee, $refinement) !!
$*ST.create_subset(%*HOW<subset>, $refinee, $refinement, :name($<longname>[0].Str));

# Apply traits.
for $<trait> {
($_.ast)($subset) if $_.ast;
}
else {
if $*SCOPE ne '' && $*SCOPE ne 'anon' {
$/.CURSOR.panic('A ' ~ $*SCOPE ~ ' scoped subset must have a name.');
}
make $cons_past;

# Install it as needed.
if $<longname> {
$*ST.install_package($/, $<longname>[0], ($*SCOPE || 'our'),
'subset', $*PACKAGE, $*ST.cur_lexpad(), $subset);
}

# We evaluate to the refinement type object.
make $*ST.get_object_sc_ref_past($subset);
}

method type_declarator:sym<constant>($/) {
Expand Down Expand Up @@ -2998,6 +2979,7 @@ class Perl6::Actions is HLL::Actions {
sub reference_to_code_object($code_obj, $past_block) {
my $ref := $*ST.get_object_sc_ref_past($code_obj);
$ref<past_block> := $past_block;
$ref<code_object> := $code_obj;
return $ref;
}

Expand All @@ -3007,6 +2989,7 @@ class Perl6::Actions is HLL::Actions {
$code
);
$closure<block_past> := $code<block_past>;
$closure<code_object> := $code<code_object>;
return $closure;
}

Expand All @@ -3016,6 +2999,36 @@ class Perl6::Actions is HLL::Actions {
my $sig := $*ST.create_signature([]);
return $*ST.create_code_object($past, 'Code', $sig);
}

sub make_where_block($expr) {
# If it's already a block, nothing to do at all.
if $expr<past_block> {
return $expr<code_object>;
}

# Build a block that'll smartmatch the topic against the
# expression.
my $past := PAST::Block.new(
PAST::Stmts.new(
PAST::Var.new( :name('$_'), :scope('lexical'), :isdecl(1) )
),
PAST::Stmts.new(
PAST::Op.new(
:pasttype('callmethod'), :name('ACCEPTS'),
$expr,
PAST::Var.new( :name('$_'), :scope('lexical') )
)));
($*ST.cur_lexpad())[0].push($past);

# Give it a signature and create code object.
my $sig := $*ST.create_signature([
$*ST.create_parameter(hash(
variable_name => '$_',
nominal_type => $*ST.find_symbol(['Mu'])
))]);
add_signature_binding_code($past, $sig);
return $*ST.create_code_object($past, 'Block', $sig);
}

sub add_implicit_var($block, $name) {
$block[0].push(PAST::Var.new( :name($name), :scope('lexical'), :isdecl(1) ));
Expand Down
23 changes: 4 additions & 19 deletions src/Perl6/Grammar.pm
View file
Expand Up @@ -927,25 +927,10 @@ grammar Perl6::Grammar is HLL::Grammar {
%args<repr> := $*REPR;
$*PACKAGE := $*ST.pkg_create_mo(%*HOW{$*PKGDECL}, |%args);

# Install it in the symbol table.
# Install it in the symbol table if needed.
if $longname {
if $*SCOPE eq 'my' {
if +$longname<name><morename> == 0 {
$*ST.install_lexical_symbol($outer, ~$longname<name>, $*PACKAGE);
}
else {
$/.CURSOR.panic("Cannot use multi-part package name with 'my' scope");
}
}
elsif $*SCOPE eq 'our' {
$*ST.install_package_symbol($*OUTERPACKAGE, ~$longname<name>, $*PACKAGE);
if +$longname<name><morename> == 0 {
$*ST.install_lexical_symbol($outer, ~$longname<name>, $*PACKAGE);
}
}
else {
$/.CURSOR.panic("Cannot use $*SCOPE scope with $*PKGDECL");
}
$*ST.install_package($/, $longname, $*SCOPE, $*PKGDECL,
$*OUTERPACKAGE, $outer, $*PACKAGE);
}
}

Expand Down Expand Up @@ -1331,7 +1316,7 @@ grammar Perl6::Grammar is HLL::Grammar {
:s
[
[
[ <longname> { $/.CURSOR.add_name($<longname>[0].Str); } ]?
[ <longname> ]?
{ $*IN_DECL := '' }
<trait>*
[ where <EXPR('e=')> ]?
Expand Down
49 changes: 49 additions & 0 deletions src/Perl6/SymbolTable.pm
View file
Expand Up @@ -158,6 +158,27 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
self.add_event(:deserialize_past($fixups), :fixup_past($fixups));
}

# Factors out deciding where to install package-y things.
method install_package($/, $longname, $scope, $pkgdecl, $package, $outer, $symbol) {
if $scope eq 'my' {
if +$longname<name><morename> == 0 {
self.install_lexical_symbol($outer, ~$longname<name>, $symbol);
}
else {
$/.CURSOR.panic("Cannot use multi-part package name with 'my' scope");
}
}
elsif $scope eq 'our' {
self.install_package_symbol($package, ~$longname<name>, $symbol);
if +$longname<name><morename> == 0 {
self.install_lexical_symbol($outer, ~$longname<name>, $symbol);
}
}
else {
$/.CURSOR.panic("Cannot use $*SCOPE scope with $pkgdecl");
}
}

# Installs a lexical symbol. Takes a PAST::Block object, name and
# the object to install. Does an immediate installation in the
# compile-time block symbol table, and ensures that the installation
Expand Down Expand Up @@ -814,6 +835,34 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
return $curried;
}

# Creates a subset type meta-object/type object pair.
method create_subset($how, $refinee, $refinement, :$name) {
# Create the meta-object and add to root objects.
my %args := hash(:refinee($refinee), :refinement($refinement));
if pir::defined($name) { %args<name> := $name; }
my $mo := $how.new_type(|%args);
my $slot := self.add_object($mo);

# Add an event. There's no fixup to do, just a type object to create
# on deserialization.
my $setup_call := PAST::Op.new(
:pasttype('callmethod'), :name('new_type'),
self.get_object_sc_ref_past($how),
self.get_object_sc_ref_past($refinement),
self.get_object_sc_ref_past($refinee)
);
$setup_call[1].named('refinement');
$setup_call[2].named('refinee');
if pir::defined($name) {
$setup_call.push(PAST::Val.new( :value($name), :named('name') ));
}
self.add_event(:deserialize_past(
self.set_slot_past($slot, self.set_cur_sc($setup_call))));

# Result is just the object.
return $mo;
}

# Applies a trait.
method apply_trait($trait_sub_name, *@pos_args, *%named_args) {
# Locate the trait sub to apply.
Expand Down

0 comments on commit c6d592d

Please sign in to comment.