Author: pmichaud
Date: Thu Dec 4 12:03:34 2008
New Revision: 33487
Added:
trunk/languages/perl6/t/00-parrot/09-pir.t (contents, props changed)
Modified:
trunk/MANIFEST
trunk/languages/perl6/src/parser/actions.pm
trunk/languages/perl6/src/parser/grammar.pg
trunk/languages/perl6/src/parser/quote_expression.pir
Log:
[rakudo]: Add inline PIR to Perl 6 subroutines.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu Dec 4 12:03:34 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools\dev\mk_manifest_and_skip.pl Wed Dec 3 12:59:07 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Dec 4 19:55:16 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2173,6 +2173,7 @@
languages/perl6/t/00-parrot/06-op-inplace.t [perl6]
languages/perl6/t/00-parrot/07-op-string.t [perl6]
languages/perl6/t/00-parrot/08-regex.t [perl6]
+languages/perl6/t/00-parrot/09-pir.t [perl6]
languages/perl6/t/01-sanity/01-tap.t [perl6]
languages/perl6/t/01-sanity/02-counter.t [perl6]
languages/perl6/t/01-sanity/03-equal.t [perl6]
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Thu Dec 4 12:03:34 2008
@@ -2699,17 +2699,7 @@
method quote_expression($/, $key) {
my $past;
- if $key eq 'quote_regex' {
- our $?NS;
- $past := PAST::Block.new(
- $<quote_regex>,
- :compiler('PGE::Perl6Regex'),
- :namespace(Perl6::Compiler.parse_name( $?NS )),
- :blocktype('declaration'),
- :node( $/ )
- );
- }
- elsif $key eq 'quote_concat' {
+ if $key eq 'quote_concat' {
if +$<quote_concat> == 1 {
$past := $( $<quote_concat>[0] );
}
@@ -2724,6 +2714,19 @@
}
}
}
+ elsif $key eq 'quote_regex' {
+ our $?NS;
+ $past := PAST::Block.new(
+ $<quote_regex>,
+ :compiler('PGE::Perl6Regex'),
+ :namespace(Perl6::Compiler.parse_name( $?NS )),
+ :blocktype('declaration'),
+ :node( $/ )
+ );
+ }
+ elsif $key eq 'quote_pir' {
+ $past := PAST::Op.new( :inline( $<quote_pir> ), :node($/) );
+ }
make $past;
}
Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg (original)
+++ trunk/languages/perl6/src/parser/grammar.pg Thu Dec 4 12:03:34 2008
@@ -720,6 +720,7 @@
| q
[ q <.ws> <quote_expression: :qq>
| w <.ws> <quote_expression: :q :w>
+ | ':PIR' <.ws> <quote_expression: :PIR>
| <.ws> <quote_expression: :q>
]
]
Modified: trunk/languages/perl6/src/parser/quote_expression.pir
==============================================================================
--- trunk/languages/perl6/src/parser/quote_expression.pir (original)
+++ trunk/languages/perl6/src/parser/quote_expression.pir Thu Dec 4
12:03:34 2008
@@ -94,11 +94,15 @@
lastpos -= stoplen
options['stop'] = stop
- ## handle :regex parsing
.local pmc p6regex, quote_regex
$I0 = options['regex']
- unless $I0 goto word_start
+ if $I0 goto regex_start
+ $I0 = options['PIR']
+ if $I0 goto pir_start
+ goto word_start
+
regex_start:
+ ## handle :regex parsing
p6regex = get_root_global ['parrot';'PGE';'Perl6Regex'], 'regex'
mob.'to'(pos)
quote_regex = p6regex(mob, options :flat :named)
@@ -109,6 +113,18 @@
mob[key] = quote_regex
goto succeed
+ pir_start:
+ ## scan to closing brackets
+ $I0 = index target, stop, pos
+ if $I0 < 0 goto fail
+ .local string pir
+ $I1 = $I0 - pos
+ pir = substr target, pos, $I1
+ pos = $I0
+ key = 'quote_pir'
+ mob[key] = pir
+ goto succeed
+
## handle word parsing
word_start:
## set up escapes based on flags
Added: trunk/languages/perl6/t/00-parrot/09-pir.t
==============================================================================
--- (empty file)
+++ trunk/languages/perl6/t/00-parrot/09-pir.t Thu Dec 4 12:03:34 2008
@@ -0,0 +1,30 @@
+#!./parrot perl6.pbc
+
+# check inline PIR
+
+use v6;
+
+say '1..4';
+
+## inline directly
+q:PIR { say 'ok 1' };
+
+## assigned to a variable
+my $a = q:PIR { %r = box 'ok 2' };
+say $a;
+
+## within a subroutine
+sub foo($x) {
+ q:PIR {
+ $P0 = find_lex '$x'
+ say $P0
+ }
+}
+foo('ok 3');
+
+## as the result of a return
+sub bar() {
+ return q:PIR { %r = box 'ok 4' };
+}
+say bar();
+
