Skip to content

Commit

Permalink
Get anonymous classes (mostly) working. Passes all the anonymous clas…
Browse files Browse the repository at this point in the history
…s tests apart from those that depend on Numeric and Stringy. Also we can remove some hacky stuff I put in earlier.
  • Loading branch information
jnthn committed Apr 20, 2010
1 parent 22805bd commit ea1760c
Show file tree
Hide file tree
Showing 4 changed files with 30 additions and 18 deletions.
13 changes: 11 additions & 2 deletions src/Perl6/Compiler/Package.pm
Expand Up @@ -94,10 +94,15 @@ method name_adverbs() {
}

# This method drives the code generation and fixes up the block.
# XXX Need to support lexical and anonymous.
method finish($block) {
my $decl := PAST::Stmts.new();

# Emit code to install the current scope as $*SCOPE.
$decl.push(PAST::Op.new( :pasttype('bind'),
PAST::Var.new( :scope('lexical'), :name('$*SCOPE'), :isdecl(1) ),
~$!scope || 'our'
));

# Create or look up meta-class.
my $how := $!how;
my @how := Perl6::Grammar::parse_name(~$how);
Expand Down Expand Up @@ -191,7 +196,11 @@ method finish($block) {
$decl.push(PAST::Op.new( :pasttype('callmethod'), :name('compose'), $meta_reg, $obj_reg ));

# Check scope and put decls in the right place.
if $!scope eq 'our' || $!scope eq 'augment' {
if $!scope eq 'anon' || $!name eq '' {
$block.blocktype('immediate');
$block.push($decl);
}
elsif $!scope eq 'our' || $!scope eq 'augment' {
my $init_decl_name := $block.unique('!class_init_');
my @ns := Perl6::Grammar::parse_name($name);
$block.push(PAST::Block.new( :name($init_decl_name), :blocktype('declaration'), $decl ));
Expand Down
9 changes: 6 additions & 3 deletions src/cheats/parrot/P6role.pir
Expand Up @@ -25,13 +25,16 @@ Puns the role to a class and returns that class.
.return (pun)
make_pun:

# Otherwise, need to create a punned class.
# Otherwise, need to create a punned class; set a $*SCOPE that is not
# 'our' just to ensure that we don't try and associate with a Parrot
# namespace.
$P0 = box 'anon'
.lex '$*SCOPE', $P0
.local pmc ClassHOW, temp, meta, proto
ClassHOW = get_root_global ['perl6'], 'ClassHOW'
null $P0
$P1 = getprop '$!owner', self
$P1 = getattribute $P1, '$!shortname'
temp = ClassHOW.'new'($P0, 'name'=>$P1)
temp = ClassHOW.'new'($P1)
meta = temp.'HOW'()
meta.'add_composable'(temp, self)
proto = meta.'compose'(temp)
Expand Down
23 changes: 11 additions & 12 deletions src/metamodel/ClassHOW.pir
Expand Up @@ -91,21 +91,23 @@ Creates a new instance of the meta-class and returns it in an associated
=cut

.sub 'new' :method
.param pmc name :optional
.param pmc name
.param pmc options :named :slurpy
.local pmc how, parrotclass, nsarray, ns
if null name goto anon_class

# Named class that we should associate with the Parrot namespace.
# If we have a named and our-scoped class, we want to associate it with a
# Parrot namespace for langauge inter-op.
if name == '' goto no_parrot_ns_assoc
$P0 = find_dynamic_lex '$*SCOPE'
unless $P0 == 'our' goto no_parrot_ns_assoc
$P0 = get_hll_global [ 'Perl6';'Grammar' ], 'parse_name'
nsarray = $P0(name)
ns = get_hll_namespace nsarray
parrotclass = newclass ns
goto have_parrotclass

# Anonymous class - at least from a namespae point of view. Just create a new
# Parrot class and we're done.
anon_class:
# Don't want to associate with a Parrot namespace.
no_parrot_ns_assoc:
parrotclass = new ['Class']

# Stash in metaclass instance.
Expand All @@ -119,11 +121,8 @@ Creates a new instance of the meta-class and returns it in an associated
setattribute how, '$!attributes', $P0

# If we have a name option, use that as the short name.
$P0 = options['name']
if null $P0 goto no_alt_name
setattribute how, 'shortname', $P0
setattribute how, 'longname', $P0
no_alt_name:
setattribute how, 'shortname', name
setattribute how, 'longname', name

# If we have ver and auth, store them.
$P0 = options['ver']
Expand Down Expand Up @@ -788,7 +787,7 @@ correct protocol.
# Make ClassHOW instance.
.local pmc ctb, how
ctb = self.'new'()
ctb = self.'new'('')
how = ctb.'HOW'()
setattribute how, 'parrotclass', parrotclass
Expand Down
3 changes: 2 additions & 1 deletion src/metamodel/RoleToInstanceApplier.nqp
Expand Up @@ -22,7 +22,8 @@ class Perl6::Metamodel::RoleToInstanceApplier;

method apply($target, @composees) {
# Make anonymous subclass.
my $subclass := $target.HOW.new;
my $*SCOPE := 'anon';
my $subclass := $target.HOW.new('');
$subclass.HOW.add_parent($subclass, $target.WHAT);

# Add all of our given composees to it.
Expand Down

0 comments on commit ea1760c

Please sign in to comment.