Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Fix several HLL issues.
* Put modifications to parrot;Role in the right place
* Fixes for calling Perl 6 functions from the Parrot HLL namespace
* Assorted fixes for enums
  • Loading branch information
tene committed May 14, 2009
1 parent 7b56f00 commit 2a4dd87
Show file tree
Hide file tree
Showing 6 changed files with 37 additions and 193 deletions.
1 change: 1 addition & 0 deletions build/Makefile.in
Expand Up @@ -43,6 +43,7 @@ SOURCES = perl6.pir \
src/parser/quote_expression.pir \
src/parrot/ClassHOW.pir \
src/parrot/Protoobject.pir \
src/parrot/Role.pir \
src/parrot/misc.pir \
src/parrot/state.pir \
src/gen_uprop.pir \
Expand Down
1 change: 1 addition & 0 deletions perl6.pir
Expand Up @@ -304,6 +304,7 @@ Currently this does the equivalent of EXPORTALL on the core namespaces.
## HLL namespace.
.HLL 'parrot'
.include 'src/parrot/ClassHOW.pir'
.include 'src/parrot/Role.pir'
.include 'src/parrot/Protoobject.pir'
.include 'src/parrot/misc.pir'
.include 'src/parrot/state.pir'
Expand Down
182 changes: 0 additions & 182 deletions src/classes/Role.pir
Expand Up @@ -231,188 +231,6 @@ just here so postcircumfix:[ ] doesn't explode).
.end
=back
=head1 Methods on Parrot Roles
We also add some methods to the Parrot roles.
=item !pun
Puns the role to a class and returns that class.
=cut
.namespace ["Role"]
.sub '!pun' :method
# See if we have already created a punned class; use it if so.
.local pmc pun
pun = getprop '$!pun', self
if null pun goto make_pun
.return (pun)
make_pun:
# Otherwise, need to create a punned class.
.local pmc p6meta, metaclass, proto
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
metaclass = new ['Class']
$P0 = box 'class'
setprop metaclass, 'pkgtype', $P0
# Compose ourself and any roles we do.
.local pmc role_list, roles_it
role_list = new 'ResizablePMCArray'
push role_list, self
role_list = '!get_flattened_roles_list'(role_list)
roles_it = iter role_list
roles_it_loop:
unless roles_it goto roles_it_loop_end
$P0 = shift roles_it
$I0 = does metaclass, $P0
if $I0 goto roles_it_loop
metaclass.'add_role'($P0)
'!compose_role_attributes'(metaclass, $P0)
goto roles_it_loop
roles_it_loop_end:
# XXX Would be nice to call !meta_compose here; for some reason, Parrot
# ends up calling the wrong multi-variant. Something to investigate, when
# I/someone has the energy for it.
proto = p6meta.'register'(metaclass, 'parent'=>'Any')
# Set name (don't use name=>... in register so we don't make a
# namespace entry though).
$P0 = self.'Str'()
$P1 = proto.'HOW'()
setattribute $P1, 'shortname', $P0
# Stash it away, then instantiate it.
setprop self, '$!pun', proto
.return (proto)
.end
=item ACCEPTS
=cut
.sub 'ACCEPTS' :method
.param pmc topic
# First, check if this role is directly done by the topic.
$I0 = does topic, self
if $I0 goto done
# Otherwise, need to consider subtypes in the parameters.
.local pmc all_variants, it, want_rf, our_types, cur_variant
$P0 = getprop '$!owner', self
all_variants = getattribute $P0, '@!created'
want_rf = getprop '$!orig_role', self
our_types = getprop '@!type_args', self
it = iter all_variants
it_loop:
unless it goto it_loop_end
cur_variant = shift it
# We can exclude a variant if it wasn't from the same role factory.
$P0 = cur_variant['role']
$P1 = getprop '$!orig_role', $P0
eq_addr $P1, want_rf, same_variant
goto it_loop
same_variant:

# Also we can exclude it if our topic doens't do it.
$I0 = does topic, $P0
unless $I0 goto it_loop

# If it's from the same variant, check all types of the role we're
# considering here are broader-or-equal types.
.local pmc check_types
check_types = cur_variant['pos_args']
$I0 = elements check_types
$I1 = elements our_types
if $I0 != $I1 goto it_loop
$I0 = 0
type_loop:
if $I0 >= $I1 goto type_loop_end
$P0 = our_types[$I0]
$P1 = check_types[$I0]
$I2 = $P0.'ACCEPTS'($P1)
unless $I2 goto it_loop
inc $I0
goto type_loop
type_loop_end:

# If we get here, we found a role that through the subtypes of its
# parameters is applicable.
$I0 = 1
goto done
it_loop_end:

# If we get here, no applicable roles.
$I0 = 0
done:
$P0 = 'prefix:?'($I0)
.return ($P0)
.end
.sub 'REJECTS' :method
.param pmc topic
$P0 = self.'ACCEPTS'(topic)
.tailcall 'prefix:!'($P0)
.end


=item perl

=cut

.sub 'perl' :method
.local pmc args, it
args = getprop '@!type_args', self
$P0 = getprop '$!shortname', self
$S0 = $P0
$S0 = concat $S0, '['
it = iter args
it_loop:
unless it goto it_loop_end
$P0 = shift it
$S1 = $P0.'perl'()
$S0 = concat $S1
goto it_loop
it_loop_end:
$S0 = concat ']'
.return ($S0)
.end

=item WHICH

=cut

.sub 'WHICH' :method
$I0 = get_addr self
.return ($I0)
.end


=item WHAT

=cut

.sub 'WHAT' :method
.return (self)
.end


=item Str (vtable get_string)

=cut

.sub 'Str' :method :vtable('get_string')
$P0 = getprop '$!owner', self
$S0 = $P0
.return ($S0)
.end

=back
=cut
Expand Down
9 changes: 6 additions & 3 deletions src/parrot/ClassHOW.pir
Expand Up @@ -31,7 +31,8 @@ Tests role membership.
.tailcall type.'ACCEPTS'(obj)
not_p6role:
$I0 = does obj, type
.tailcall 'prefix:?'($I0)
.const 'Sub' $P1 = 'prefix:?'
.tailcall $P1($I0)
.end


Expand Down Expand Up @@ -282,7 +283,8 @@ Dispatches to method of the given name on this class or one of its parents.
goto values_it_loop
values_it_loop_end:
type = obj.'!type'()
.tailcall '!MAKE_JUNCTION'(type, res_list)
.const 'Sub' $P1 = '!MAKE_JUNCTION'
.tailcall $P1(type, res_list)

whatever_closure:
if name == 'WHAT' goto proto_done # XXX And this is why .WHAT needs to become a macro...
Expand All @@ -292,7 +294,8 @@ Dispatches to method of the given name on this class or one of its parents.
obj = obj.'!select'()
pun_role:
obj = obj.'!pun'()
.tailcall '!dispatch_method'(obj, name, pos_args :flat, name_args :flat :named)
.const 'Sub' $P1 = '!dispatch_method'
.tailcall $P1(obj, name, pos_args :flat, name_args :flat :named)
.end


Expand Down
34 changes: 27 additions & 7 deletions src/parrot/Role.pir
Expand Up @@ -25,16 +25,33 @@ Puns the role to a class and returns that class.
# Otherwise, need to create a punned class.
.local pmc p6meta, metaclass, proto
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
p6meta = get_root_global [.RAKUDO_HLL ; 'Perl6Object'], '$!P6META'
metaclass = new ['Class']
$P0 = box 'class'
setprop metaclass, 'pkgtype', $P0
metaclass.'add_role'(self)
# Compose ourself and any roles we do.
.local pmc role_list, roles_it
role_list = new 'ResizablePMCArray'
push role_list, self
.const 'Sub' $P1 = '!get_flattened_roles_list'
role_list = $P1(role_list)
roles_it = iter role_list
roles_it_loop:
unless roles_it goto roles_it_loop_end
$P0 = shift roles_it
$I0 = does metaclass, $P0
if $I0 goto roles_it_loop
metaclass.'add_role'($P0)
.const 'Sub' $P1 = '!compose_role_attributes'
$P1(metaclass, $P0)
goto roles_it_loop
roles_it_loop_end:
# XXX Would be nice to call !meta_compose here; for some reason, Parrot
# ends up calling the wrong multi-variant. Something to investigate, when
# I/someone has the energy for it.
'!compose_role_attributes'(metaclass, self)
proto = p6meta.'register'(metaclass, 'parent'=>'Any')
$S0 = concat .RAKUDO_HLL, ';Any'
proto = p6meta.'register'(metaclass, 'parent'=>$S0)
# Set name (don't use name=>... in register so we don't make a
# namespace entry though).
Expand Down Expand Up @@ -108,13 +125,15 @@ Puns the role to a class and returns that class.
# If we get here, no applicable roles.
$I0 = 0
done:
$P0 = 'prefix:?'($I0)
.const 'Sub' $P0 = 'prefix:?'
$P0 = $P0($I0)
.return ($P0)
.end
.sub 'REJECTS' :method
.param pmc topic
$P0 = self.'ACCEPTS'(topic)
.tailcall 'prefix:!'($P0)
.const 'Sub' $P1 = 'prefix:!'
.tailcall $P1($P0)
.end


Expand All @@ -125,7 +144,8 @@ Puns the role to a class and returns that class.
.sub 'perl' :method
.local pmc args, it
args = getprop '@!type_args', self
$S0 = self.'Str'()
$P0 = getprop '$!shortname', self
$S0 = $P0
$S0 = concat $S0, '['
it = iter args
it_loop:
Expand Down
3 changes: 2 additions & 1 deletion src/parser/actions.pm
Expand Up @@ -684,11 +684,12 @@ method enum_declarator($/, $key) {
our @?BLOCK;
my $getvals_sub := PAST::Compiler.compile(PAST::Block.new(
:blocktype('declaration'),
:hll($?RAKUDO_HLL),
PAST::Op.new(
:pasttype('call'),
:name('!create_anon_enum'),
$values
)
),
));
my %values := $getvals_sub();
for %values.keys() {
Expand Down

0 comments on commit 2a4dd87

Please sign in to comment.