Author: pmichaud
Date: Thu Jan 8 14:10:27 2009
New Revision: 35225
Modified:
branches/rvar2/languages/perl6/src/builtins/guts.pir
branches/rvar2/languages/perl6/src/parser/actions.pm
Log:
[rakudo]: Some basic trait handling for subs.
I'll probably want to refactor this (to avoid the code
duplication) but this works for now.
Modified: branches/rvar2/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/guts.pir (original)
+++ branches/rvar2/languages/perl6/src/builtins/guts.pir Thu Jan 8
14:10:27 2009
@@ -384,11 +384,17 @@
$P0 = compreg 'Perl6'
nsarray = $P0.'parse_name'(name)
+ if type == 'package' goto package
+ if type == 'module' goto package
if type == 'class' goto class
if type == 'grammar' goto class
if type == 'role' goto role
'die'("Unsupported package declarator ", type)
+ package:
+ $P0 = get_hll_namespace nsarray
+ .return ($P0)
+
class:
.local pmc metaclass, ns
ns = get_hll_namespace nsarray
@@ -451,14 +457,15 @@
.end
-=item !meta_compose(Role role)
+=item !meta_compose()
+
+Default meta composer -- does nothing.
-Compose the role.
=cut
-.sub '!meta_compose' :multi(['Role'])
- .param pmc role
+.sub '!meta_compose' :multi()
+ .param pmc metaclass
# Currently, nothing to do.
.end
@@ -596,6 +603,47 @@
.end
+=item !sub_trait(sub, type, trait, arg?)
+
+=cut
+
+.sub '!sub_trait'
+ .param pmc block
+ .param string type
+ .param string trait
+ .param pmc arg :optional
+ .param int has_arg :opt_flag
+
+ if has_arg goto have_arg
+ null arg
+ have_arg:
+
+ $S0 = concat '!sub_trait_', trait
+ $P0 = find_name $S0
+ if null $P0 goto done
+ $P0(trait, block, arg)
+ done:
+.end
+
+
+=item !sub_trait_export(trait, block, arg)
+
+=cut
+
+.sub '!sub_trait_export'
+ .param string trait
+ .param pmc block
+ .param pmc arg
+
+ .local pmc blockns, exportns
+ blockns = block.'get_namespace'()
+ $P0 = split '::', 'EXPORT::ALL'
+ exportns = blockns.'make_namespace'($P0)
+ $S0 = block
+ exportns[$S0] = block
+.end
+
+
=item !compose_role_attributes(class, role)
Helper method to compose the attributes of a role into a class.
Modified: branches/rvar2/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/actions.pm (original)
+++ branches/rvar2/languages/perl6/src/parser/actions.pm Thu Jan 8
14:10:27 2009
@@ -859,45 +859,73 @@
method routine_def($/) {
- my $past := $( $<block> );
- $past.blocktype('declaration');
+ my $block := $( $<block> );
+ $block.blocktype('declaration');
if $<deflongname> {
my $name := ~$<deflongname>[0];
- $past.name( $name );
+ $block.name( $name );
our @?BLOCK;
@?BLOCK[0].symbol( $name, :scope('package') );
}
- $past.control('return_pir');
- block_signature($past);
- make $past;
+ $block.control('return_pir');
+ block_signature($block);
+
+ if $<trait> {
+ my $loadinit := $block.loadinit();
+ my $blockreg := PAST::Var.new( :name('block'), :scope('register') );
+ for @($<trait>) {
+ # Trait nodes come in as PAST::Op( :name('list') ).
+ # We just modify them to call !sub_trait and add
+ # 'block' as the first argument.
+ my $trait := $( $_ );
+ $trait.name('!sub_trait');
+ $trait.unshift($blockreg);
+ $loadinit.push($trait);
+ }
+ }
+ make $block;
}
method method_def($/) {
- my $past := $( $<block> );
- $past.blocktype('method');
+ my $block := $( $<block> );
+ $block.blocktype('method');
if $<longname> {
- $past.name( ~$<longname> );
+ $block.name( ~$<longname> );
}
# Add lexical 'self'.
- $past[0].unshift(
+ $block[0].unshift(
PAST::Var.new( :name('self'), :scope('lexical'), :isdecl(1),
:viviself( PAST::Var.new( :name('self'), :scope('register' ) ) )
)
);
+ $block.control('return_pir');
+ block_signature($block);
# Ensure there's an invocant in the signature.
- block_signature($past);
- $past.loadinit().push(PAST::Op.new(
+ $block.loadinit().push(PAST::Op.new(
:pasttype('callmethod'),
:name('!add_implicit_self'),
PAST::Var.new( :name('signature'), :scope('register') )
));
- $past.control('return_pir');
- make $past;
+ if $<trait> {
+ my $loadinit := $block.loadinit();
+ my $blockreg := PAST::Var.new( :name('block'), :scope('register') );
+ for @($<trait>) {
+ # Trait nodes come in as PAST::Op( :name('list') ).
+ # We just modify them to call !sub_trait and add
+ # 'block' as the first argument.
+ my $trait := $( $_ );
+ $trait.name('!sub_trait');
+ $trait.unshift($blockreg);
+ $loadinit.push($trait);
+ }
+ }
+
+ make $block;
}
