Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge branch 'master' of git@github.com:rakudo/rakudo
  • Loading branch information
moritz committed Feb 16, 2009
2 parents beac378 + a0a3902 commit c4f0f93
Show file tree
Hide file tree
Showing 4 changed files with 53 additions and 13 deletions.
18 changes: 16 additions & 2 deletions src/builtins/guts.pir
Expand Up @@ -573,10 +573,24 @@ Add a trait with the given C<type> and C<name> to C<metaclass>.
## get the (parrot)class object associated with name
$P0 = compreg 'Perl6'
$P0 = $P0.'parse_name'(name)
$P0 = get_hll_namespace $P0
$P0 = get_class $P0
$S0 = pop $P0
$P0 = get_hll_global $P0, $S0

## Do we have a role here?
$I0 = isa $P0, 'Role'
if $I0 goto need_to_pun
$I0 = isa $P0, 'Perl6Role'
if $I0 goto need_to_pun_role
goto have_class
need_to_pun_role:
$P0 = $P0.'!select'()
need_to_pun:
$P0 = $P0.'!pun'()

## add it as parent to metaclass
have_class:
$P1 = get_hll_global ['Perl6Object'], '$!P6META'
$P0 = $P1.'get_parrotclass'($P0)
metaclass.'add_parent'($P0)
.return ()

Expand Down
13 changes: 13 additions & 0 deletions src/builtins/io.pir
Expand Up @@ -148,6 +148,19 @@ It is an error to use bare C<unlink> without arguments.
.end


=item prompt

Shows the supplied message and then waits for input from $*IN.

=cut

.sub 'prompt'
.param string prompt
'print'(prompt)
$P0 = get_hll_global "$IN"
.tailcall $P0.'readline'()
.end

=back

=cut
Expand Down
28 changes: 20 additions & 8 deletions src/classes/Role.pir
Expand Up @@ -232,22 +232,19 @@ just here so postcircumfix:[ ] doesn't explode).
We also add some methods to the Parrot roles.
=item new
=item !pun
Puns the role to a class and instantiates it.
Puns the role to a class and returns that class.
=cut
.namespace ["Role"]
.sub 'new' :method
.param pmc pos_args :slurpy
.param pmc name_args :slurpy :named
.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
.tailcall pun.'new'(pos_args :flat, name_args :flat :named)
.return (pun)
make_pun:
# Otherwise, need to create a punned class.
Expand All @@ -265,7 +262,22 @@ Puns the role to a class and instantiates it.
# Stash it away, then instantiate it.
setprop self, '$!pun', proto
.tailcall proto.'new'(pos_args :flat, name_args :flat :named)
.return (proto)
.end
=item new
Puns the role to a class and instantiates it.
=cut
.sub 'new' :method
.param pmc pos_args :slurpy
.param pmc name_args :slurpy :named
.local pmc pun
pun = self.'!pun'()
.tailcall pun.'new'(pos_args :flat, name_args :flat :named)
.end
Expand Down
7 changes: 4 additions & 3 deletions src/parser/actions.pm
Expand Up @@ -217,6 +217,7 @@ method when_statement($/) {
my $match_past := process_smartmatch(
PAST::Var.new( :name('$_') ),
$( $<EXPR> ),
$<EXPR><expr>
);

# Use the smartmatch result as the condition.
Expand Down Expand Up @@ -2510,7 +2511,7 @@ method EXPR($/, $key) {
# rest fall through to a call to .ACCEPTS.
my $lhs := $( $/[0] );
my $rhs := $( $/[1] );
make process_smartmatch($lhs, $rhs);
make process_smartmatch($lhs, $rhs, $/[1]);
}
elsif ~$type eq 'prefix:|' {
# Need to make it flatten the argument.
Expand Down Expand Up @@ -3004,8 +3005,8 @@ sub transform_to_multi($past) {

# Hanldes syntactic forms of smart-matching (factored out here since it's used
# by infix:~~ and the when statement.
sub process_smartmatch($lhs, $rhs) {
if $rhs.isa(PAST::Stmts) && $rhs<invocant_holder> {
sub process_smartmatch($lhs, $rhs, $rhs_pt) {
if $rhs_pt<noun><dotty> {
# Method truth - just call RHS.
$rhs<invocant_holder>[0] := $lhs;
return PAST::Op.new(
Expand Down

0 comments on commit c4f0f93

Please sign in to comment.