Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: rakudo-p5/v5
base: 493d9efdc2
...
head fork: rakudo-p5/v5
compare: e94280ce6e
Checking mergeability… Don't worry, you can still create the pull request.
  • 2 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
View
9 Makefile
@@ -4,11 +4,15 @@ RM_F = perl -MExtUtils::Command -e rm_f
all: blib/perl5.pbc
-blib/perl5.pbc: lib/v5.pm blib/Perl6/P5Actions.pbc blib/Perl6/P5Grammar.pbc
+blib/perl5.pbc: lib/v5.pm blib/Perl6/P5World.pbc blib/Perl6/P5Actions.pbc blib/Perl6/P5Grammar.pbc
$(NQP) --vmlibs=perl6_group,perl6_ops --target=pir --stagestats --output=blib/perl5.pir lib/v5.pm
$(PARROT) -o blib/perl5.pbc blib/perl5.pir
+blib/Perl6/P5World.pbc: lib/Perl6/P5World.pm
+ $(NQP) --vmlibs=perl6_group,perl6_ops --target=pir --stagestats --output=blib/Perl6/P5World.pir lib/Perl6/P5World.pm
+ $(PARROT) -o blib/Perl6/P5World.pbc blib/Perl6/P5World.pir
+
blib/Perl6/P5Actions.pbc: lib/Perl6/P5Actions.pm
$(NQP) --vmlibs=perl6_group,perl6_ops --target=pir --stagestats --output=blib/Perl6/P5Actions.pir lib/Perl6/P5Actions.pm
$(PARROT) -o blib/Perl6/P5Actions.pbc blib/Perl6/P5Actions.pir
@@ -18,6 +22,7 @@ blib/Perl6/P5Grammar.pbc: lib/Perl6/P5Grammar.pm
$(PARROT) -o blib/Perl6/P5Grammar.pbc blib/Perl6/P5Grammar.pir
clean:
- $(RM_F) blib/Perl6/*.pbc blib/Perl6/*.pir
+ $(RM_F) blib/*.pbc blib/*.pir blib/Perl6/*.pbc blib/Perl6/*.pir
+
test:
PERL6LIB=blib prove -e perl6 t/v5/basic.t
View
403 lib/Perl6/P5Actions.pm
@@ -203,30 +203,30 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
}
method deflongname($/) {
- if $<colonpair> {
- my $name := ~$<name>;
- if $<colonpair>[0] {
- $name := $name ~ ':';
- }
- if $<colonpair>[0]<identifier> {
- $name := $name ~ ~$<colonpair>[0]<identifier>;
- }
- if $<colonpair>[0]<coloncircumfix> -> $cf {
- if $cf<circumfix> -> $op_name {
- $name := $name ~ '<' ~ $*W.colonpair_nibble_to_str($/, $op_name<nibble>) ~ '>';
- }
- else {
- $name := $name ~ '<>';
- }
- }
- make $name;
- }
- else {
+# if $<colonpair> {
+# my $name := ~$<name>;
+# if $<colonpair>[0] {
+# $name := $name ~ ':';
+# }
+# if $<colonpair>[0]<identifier> {
+# $name := $name ~ ~$<colonpair>[0]<identifier>;
+# }
+# if $<colonpair>[0]<coloncircumfix> -> $cf {
+# if $cf<circumfix> -> $op_name {
+# $name := $name ~ '<' ~ $*W.colonpair_nibble_to_str($/, $op_name<nibble>) ~ '>';
+# }
+# else {
+# $name := $name ~ '<>';
+# }
+# }
+# make $name;
+# }
+# else {
make $*W.disect_deflongname($/).name(
:dba("$*IN_DECL declaration"),
:decl<routine>,
);
- }
+# }
}
# Turn $code into "for lines() { $code }"
@@ -453,9 +453,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
make $<pod_block>.ast;
}
- method pod_configuration($/) {
- make Perl6::Pod::make_config($/);
- }
+# method pod_configuration($/) {
+# make Perl6::Pod::make_config($/);
+# }
method pod_block:sym<delimited>($/) {
make Perl6::Pod::any_block($/);
@@ -1194,7 +1194,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
## Terms
method term:sym<fatarrow>($/) { make $<fatarrow>.ast; }
- method term:sym<colonpair>($/) { make $<colonpair>.ast; }
+# method term:sym<colonpair>($/) { make $<colonpair>.ast; }
method term:sym<variable>($/) { make $<variable>.ast; }
method term:sym<package_declarator>($/) { make $<package_declarator>.ast; }
method term:sym<scope_declarator>($/) { make $<scope_declarator>.ast; }
@@ -1223,36 +1223,36 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
!! QAST::Var.new( :name('Nil'), :scope('lexical') );
}
- method colonpair($/) {
- if $*key {
- if $<var> {
- make make_pair($*key, $<var>.ast);
- }
- elsif $*value ~~ NQPMatch {
- my $val_ast := $*value.ast;
- if $val_ast.isa(QAST::Stmts) && +@($val_ast) == 1 {
- $val_ast := $val_ast[0];
- }
- make make_pair($*key, $val_ast);
- }
- else {
- make make_pair($*key, QAST::Op.new(
- :op('p6bool'),
- QAST::IVal.new( :value($*value) )
- ));
- }
- }
- elsif $<fakesignature> {
- make $<fakesignature>.ast;
- }
- else {
- make $*value.ast;
- }
- }
+# method colonpair($/) {
+# if $*key {
+# if $<var> {
+# make make_pair($*key, $<var>.ast);
+# }
+# elsif $*value ~~ NQPMatch {
+# my $val_ast := $*value.ast;
+# if $val_ast.isa(QAST::Stmts) && +@($val_ast) == 1 {
+# $val_ast := $val_ast[0];
+# }
+# make make_pair($*key, $val_ast);
+# }
+# else {
+# make make_pair($*key, QAST::Op.new(
+# :op('p6bool'),
+# QAST::IVal.new( :value($*value) )
+# ));
+# }
+# }
+# elsif $<fakesignature> {
+# make $<fakesignature>.ast;
+# }
+# else {
+# make $*value.ast;
+# }
+# }
- method colonpair_variable($/) {
- make make_variable($/, [~$/]);
- }
+# method colonpair_variable($/) {
+# make make_variable($/, [~$/]);
+# }
sub make_pair($key_str, $value) {
my $key := $*W.add_string_constant($key_str);
@@ -1958,10 +1958,10 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
method routine_def($/) {
my $block;
- if $<onlystar> {
- $block := $<onlystar>.ast;
- }
- else {
+# if $<onlystar> {
+# $block := $<onlystar>.ast;
+# }
+# else {
$block := $<blockoid>.ast;
$block.blocktype('declaration');
if is_clearly_returnless($block) {
@@ -1978,41 +1978,43 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
else {
$block[1] := wrap_return_handler($block[1]);
}
- }
+# }
# Obtain parameters, create signature object and generate code to
# call binder.
- if $block<placeholder_sig> && $<multisig> {
- $*W.throw($/, ['X', 'Signature', 'Placeholder'],
- placeholder => $block<placeholder_sig>[0]<placeholder>,
- );
- }
+# if $block<placeholder_sig> && $<multisig> {
+# $*W.throw($/, ['X', 'Signature', 'Placeholder'],
+# placeholder => $block<placeholder_sig>[0]<placeholder>,
+# );
+# }
my %sig_info;
- if $<multisig> {
- %sig_info := $<multisig>[0].ast;
- }
- else {
- %sig_info<parameters> := $block<placeholder_sig> ?? $block<placeholder_sig> !!
- [];
- }
+# if $<multisig> {
+# %sig_info := $<multisig>[0].ast;
+# }
+# else {
+# %sig_info<parameters> := $block<placeholder_sig> ?? $block<placeholder_sig> !!
+# [];
+ %sig_info<parameters> := [];
+# }
my @params := %sig_info<parameters>;
set_default_parameter_type(@params, 'Any');
- my $signature := create_signature_object($<multisig> ?? $<multisig>[0] !! $/, %sig_info, $block);
+# my $signature := create_signature_object($<multisig> ?? $<multisig>[0] !! $/, %sig_info, $block);
+ my $signature := create_signature_object($/, %sig_info, $block);
add_signature_binding_code($block, $signature, @params);
# Needs a slot that can hold a (potentially unvivified) dispatcher;
# if this is a multi then we'll need it to vivify to a MultiDispatcher.
- if $*MULTINESS eq 'multi' {
- $*W.install_lexical_symbol($block, '$*DISPATCHER', $*W.find_symbol(['MultiDispatcher']));
- }
- else {
+# if $*MULTINESS eq 'multi' {
+# $*W.install_lexical_symbol($block, '$*DISPATCHER', $*W.find_symbol(['MultiDispatcher']));
+# }
+# else {
add_implicit_var($block, '$*DISPATCHER');
- }
+# }
$block[0].unshift(QAST::Op.new(:op('p6takedisp')));
# Set name.
if $<deflongname> {
- $block.name(~$<deflongname>[0].ast);
+ $block.name(~$<deflongname>.ast);
}
# Finish code object, associating it with the routine body.
@@ -2021,23 +2023,23 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
$*W.finish_code_object($code, $block, $*MULTINESS eq 'proto', :yada(is_yada($/)));
# attach return type
- if $*OFTYPE {
- my $sig := $code.signature;
- if $sig.has_returns {
- my $prev_returns := $sig.returns;
- $*W.throw($*OFTYPE, 'X::Redeclaration',
- what => 'return type for',
- symbol => $code,
- postfix => " (previous return type was "
- ~ $prev_returns.HOW.name($prev_returns)
- ~ ')',
- );
- }
- $sig.set_returns($*OFTYPE.ast);
- }
+# if $*OFTYPE {
+# my $sig := $code.signature;
+# if $sig.has_returns {
+# my $prev_returns := $sig.returns;
+# $*W.throw($*OFTYPE, 'X::Redeclaration',
+# what => 'return type for',
+# symbol => $code,
+# postfix => " (previous return type was "
+# ~ $prev_returns.HOW.name($prev_returns)
+# ~ ')',
+# );
+# }
+# $sig.set_returns($*OFTYPE.ast);
+# }
# Document it
- Perl6::Pod::document($/, $code, $*DOC);
+# Perl6::Pod::document($/, $code, $*DOC);
# Install PAST block so that it gets capture_lex'd correctly and also
# install it in the lexpad.
@@ -2052,54 +2054,54 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
# If it's a multi, need to associate it with the surrounding
# proto.
# XXX Also need to auto-multi things with a proto in scope.
- my $name := '&' ~ ~$<deflongname>[0].ast;
- if $*MULTINESS eq 'multi' {
- # Do we have a proto in the current scope?
- my $proto;
- if $outer.symbol($name) {
- $proto := $outer.symbol($name)<value>;
- }
- else {
- unless $*SCOPE eq '' || $*SCOPE eq 'my' {
- $*W.throw($/, 'X::Declaration::Scope::Multi',
- scope => $*SCOPE,
- declaration => 'multi',
- );
- }
- # None; search outer scopes.
- my $new_proto;
- try {
- $proto := $*W.find_symbol([$name]);
- }
- if $proto && $proto.is_dispatcher {
- # Found in outer scope. Need to derive.
- $new_proto := $*W.derive_dispatcher($proto);
- }
- else {
- $new_proto := self.autogenerate_proto($/, $block.name, $outer[0]);
- }
-
- # Install in current scope.
- $*W.install_lexical_symbol($outer, $name, $new_proto, :clone(1));
- $proto := $new_proto;
- }
+ my $name := '&' ~ ~$<deflongname>.ast;
+# if $*MULTINESS eq 'multi' {
+# # Do we have a proto in the current scope?
+# my $proto;
+# if $outer.symbol($name) {
+# $proto := $outer.symbol($name)<value>;
+# }
+# else {
+# unless $*SCOPE eq '' || $*SCOPE eq 'my' {
+# $*W.throw($/, 'X::Declaration::Scope::Multi',
+# scope => $*SCOPE,
+# declaration => 'multi',
+# );
+# }
+# # None; search outer scopes.
+# my $new_proto;
+# try {
+# $proto := $*W.find_symbol([$name]);
+# }
+# if $proto && $proto.is_dispatcher {
+# # Found in outer scope. Need to derive.
+# $new_proto := $*W.derive_dispatcher($proto);
+# }
+# else {
+# $new_proto := self.autogenerate_proto($/, $block.name, $outer[0]);
+# }
+#
+# # Install in current scope.
+# $*W.install_lexical_symbol($outer, $name, $new_proto, :clone(1));
+# $proto := $new_proto;
+# }
- # Ensure it's actually a dispatcher.
- unless $proto.is_dispatcher {
- $*W.throw($/, ['X', 'Redeclaration'],
- what => 'routine',
- symbol => ~$<deflongname>[0].ast,
- );
- }
+# # Ensure it's actually a dispatcher.
+# unless $proto.is_dispatcher {
+# $*W.throw($/, ['X', 'Redeclaration'],
+# what => 'routine',
+# symbol => ~$<deflongname>.ast,
+# );
+# }
- # Install the candidate.
- $*W.add_dispatchee_to_proto($proto, $code);
- }
- else {
+# # Install the candidate.
+# $*W.add_dispatchee_to_proto($proto, $code);
+# }
+# else {
# Install.
if $outer.symbol($name) {
$*W.throw($/, ['X', 'Redeclaration'],
- symbol => ~$<deflongname>[0].ast,
+ symbol => ~$<deflongname>.ast,
what => 'routine',
);
}
@@ -2127,31 +2129,31 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
declaration => 'sub',
);
}
- }
- }
- elsif $*MULTINESS {
- $*W.throw($/, 'X::Anon::Multi', multiness => $*MULTINESS);
+# }
}
+# elsif $*MULTINESS {
+# $*W.throw($/, 'X::Anon::Multi', multiness => $*MULTINESS);
+# }
# Apply traits.
- for $<trait> -> $t {
- if $t.ast { $*W.ex-handle($t, { ($t.ast)($code) }) }
- }
- if $<onlystar> {
- # Protect with try; won't work when declaring the initial
- # trait_mod proto in CORE.setting!
- try $*W.apply_trait($/, '&trait_mod:<is>', $*DECLARAND, :onlystar(1));
- }
+# for $<trait> -> $t {
+# if $t.ast { $*W.ex-handle($t, { ($t.ast)($code) }) }
+# }
+# if $<onlystar> {
+# # Protect with try; won't work when declaring the initial
+# # trait_mod proto in CORE.setting!
+# try $*W.apply_trait($/, '&trait_mod:<is>', $*DECLARAND, :onlystar(1));
+# }
# Add inlining information if it's inlinable; also mark soft if the
# appropriate pragma is in effect.
if $<deflongname> {
- if $*SOFT {
- $*W.find_symbol(['&infix:<does>'])($code, $*W.find_symbol(['SoftRoutine']));
- }
- else {
+# if $*SOFT {
+# $*W.find_symbol(['&infix:<does>'])($code, $*W.find_symbol(['SoftRoutine']));
+# }
+# else {
self.add_inlining_info_if_possible($/, $code, $block, @params);
- }
+# }
}
my $closure := block_closure(reference_to_code_object($code, $past));
@@ -2310,10 +2312,10 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
method method_def($/) {
my $past;
- if $<onlystar> {
- $past := $<onlystar>.ast;
- }
- else {
+# if $<onlystar> {
+# $past := $<onlystar>.ast;
+# }
+# else {
$past := $<blockoid>.ast;
$past.blocktype('declaration');
if is_clearly_returnless($past) {
@@ -2325,7 +2327,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
else {
$past[1] := wrap_return_handler($past[1]);
}
- }
+# }
my $name;
if $<longname> {
@@ -2363,9 +2365,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
for $<trait> {
if $_.ast { ($_.ast)($code) }
}
- if $<onlystar> {
- $*W.apply_trait($/, '&trait_mod:<is>', $*DECLARAND, :onlystar(1));
- }
+# if $<onlystar> {
+# $*W.apply_trait($/, '&trait_mod:<is>', $*DECLARAND, :onlystar(1));
+# }
# Install method.
if $name {
@@ -2420,7 +2422,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
# Finish code object, associating it with the routine body.
if $<deflongname> {
- $block.name(~$<deflongname>[0].ast);
+ $block.name(~$<deflongname>.ast);
}
my $code := $*DECLARAND;
$*W.attach_signature($code, $signature);
@@ -2439,11 +2441,11 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
my $past;
if $<deflongname> {
- my $name := '&' ~ ~$<deflongname>[0].ast;
+ my $name := '&' ~ ~$<deflongname>.ast;
# Install.
if $outer.symbol($name) {
$/.CURSOR.panic("Illegal redeclaration of macro '" ~
- ~$<deflongname>[0].ast ~ "'");
+ ~$<deflongname>.ast ~ "'");
}
if $*SCOPE eq '' || $*SCOPE eq 'my' {
$*W.install_lexical_symbol($outer, $name, $code);
@@ -2609,12 +2611,12 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
0
}
- method onlystar($/) {
- my $BLOCK := $*CURPAD;
- $BLOCK.push(QAST::Op.new( :op('p6multidispatch') ));
- $BLOCK.node($/);
- make $BLOCK;
- }
+# method onlystar($/) {
+# my $BLOCK := $*CURPAD;
+# $BLOCK.push(QAST::Op.new( :op('p6multidispatch') ));
+# $BLOCK.node($/);
+# make $BLOCK;
+# }
method regex_declarator:sym<regex>($/, $key?) {
make $<regex_def>.ast;
@@ -2634,9 +2636,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
my %sig_info := $<signature> ?? $<signature>[0].ast !! hash(parameters => []);
if $*MULTINESS eq 'proto' {
- unless $<onlystar> {
+# unless $<onlystar> {
$/.CURSOR.panic("Proto regex body must be \{*\} (or <*> or <...>, which are deprecated)");
- }
+# }
my $proto_body := QAST::Op.new(
:op('callmethod'), :name('!protoregex'),
QAST::Var.new( :name('self'), :scope('local') ),
@@ -3225,16 +3227,16 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
$/.CURSOR.panic("Type " ~ ~$<typename><longname> ~
" cannot be used as a nominal type on a parameter");
}
- for ($<typename><longname> ?? $<typename><longname><colonpair> !! $<typename><colonpair>) {
- if $_<identifier> {
- if $_<identifier>.Str eq 'D' {
- %*PARAM_INFO<defined_only> := 1;
- }
- elsif $_<identifier>.Str eq 'U' {
- %*PARAM_INFO<undefined_only> := 1;
- }
- }
- }
+# for ($<typename><longname> ?? $<typename><longname><colonpair> !! $<typename><colonpair>) {
+# if $_<identifier> {
+# if $_<identifier>.Str eq 'D' {
+# %*PARAM_INFO<defined_only> := 1;
+# }
+# elsif $_<identifier>.Str eq 'U' {
+# %*PARAM_INFO<undefined_only> := 1;
+# }
+# }
+# }
}
}
elsif $<value> {
@@ -3346,7 +3348,8 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
}
method trait($/) {
- make $<trait_mod> ?? $<trait_mod>.ast !! $<colonpair>.ast;
+# make $<trait_mod> ?? $<trait_mod>.ast !! $<colonpair>.ast;
+ make $<trait_mod>.ast;
}
method trait_mod:sym<is>($/) {
@@ -3892,9 +3895,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
make $<capterm>.ast;
}
- method term:sym<onlystar>($/) {
- make QAST::Op.new( :op('p6multidispatchlex') );
- }
+# method term:sym<onlystar>($/) {
+# make QAST::Op.new( :op('p6multidispatchlex') );
+# }
method args($/) {
my $past;
@@ -4244,20 +4247,20 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
}
if $key eq 'POSTFIX' {
# If may be an adverb.
- if $<colonpair> {
- my $target := $past := $/[0].ast;
- if nqp::istype($target, QAST::Op) && $target.op eq 'p6type' {
- $target := $target[0];
- }
- unless nqp::istype($target, QAST::Op) && ($target.op eq 'call' || $target.op eq 'callmethod') {
- $/.CURSOR.panic("You can't adverb that");
- }
- my $cpast := $<colonpair>.ast;
- $cpast[2].named(compile_time_value_str($cpast[1], 'LHS of pair', $/));
- $target.push($cpast[2]);
- make $past;
- return 1;
- }
+# if $<colonpair> {
+# my $target := $past := $/[0].ast;
+# if nqp::istype($target, QAST::Op) && $target.op eq 'p6type' {
+# $target := $target[0];
+# }
+# unless nqp::istype($target, QAST::Op) && ($target.op eq 'call' || $target.op eq 'callmethod') {
+# $/.CURSOR.panic("You can't adverb that");
+# }
+# my $cpast := $<colonpair>.ast;
+# $cpast[2].named(compile_time_value_str($cpast[1], 'LHS of pair', $/));
+# $target.push($cpast[2]);
+# make $past;
+# return 1;
+# }
# Method calls may be to a foreign language, and thus return
# values may need type mapping into Perl 6 land.
@@ -6000,7 +6003,7 @@ class Perl6::P5QActions is HLL::Actions does STDActions {
method escape:sym<' '>($/) { make mark_ww_atom($<quote>.ast); }
method escape:sym<" ">($/) { make mark_ww_atom($<quote>.ast); }
- method escape:sym<colonpair>($/) { make mark_ww_atom($<colonpair>.ast); }
+# method escape:sym<colonpair>($/) { make mark_ww_atom($<colonpair>.ast); }
sub mark_ww_atom($ast) {
$ast<ww_atom> := 1;
$ast;
View
125 lib/Perl6/P5Grammar.pm
@@ -2,9 +2,8 @@ use QRegex;
use NQPP6QRegex;
use NQPP5QRegex;
use Perl6::P5Actions;
-use Perl6::World;
+use Perl6::P5World;
use Perl6::Pod; # XXX do we need that?
-#use Perl6::Grammar;
role startstop5[$start,$stop] {
token starter { $start }
@@ -48,7 +47,7 @@ role STD5 {
self.HOW.mixin(self, startstop5.HOW.curry(startstop5, $start, $stop));
}
method unbalanced($stop) {
- self.HOW.mixin(self, stop.HOW.curry(stop, $stop));
+ self.HOW.mixin(self, stop5.HOW.curry(stop5, $stop));
}
token starter { <!> }
@@ -347,8 +346,8 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
my $file := nqp::getlexdyn('$?FILES');
my $source_id := nqp::sha1(self.target());
my $*W := nqp::isnull($file) ??
- Perl6::World.new(:handle($source_id)) !!
- Perl6::World.new(:handle($source_id), :description($file));
+ Perl6::P5World.new(:handle($source_id)) !!
+ Perl6::P5World.new(:handle($source_id), :description($file));
$*W.add_initializations();
my $cursor := self.comp_unit;
@@ -542,6 +541,10 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
# Lexer routines #
##################
+ token end_keyword {
+ <!before <[ \( \\ ' \- ]> || \h* '=>'> »
+ }
+
token ENDSTMT {
[
| \h* $$ <.ws> <?MARKER('endstmt')>
@@ -1530,7 +1533,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
# || <.panic: "Malformed $*SCOPE">
# }
token scoped($*SCOPE) {
- #<.end_keyword>
+ <.end_keyword>
:dba('scoped declarator')
[
# :my $*DOC := $*DECLARATOR_DOCS;
@@ -1551,8 +1554,8 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
# <DECL=multi_declarator>
# | <DECL=multi_declarator>
] <.ws>
- || <.ws><typo_typename> <!>
- || <.malformed($*SCOPE)>
+ #|| <.ws><typo_typename> <!>
+ #|| <.malformed($*SCOPE)>
]
}
@@ -1561,10 +1564,15 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
token scope_declarator:sym<our> { <sym> <scoped('our')> }
token scope_declarator:sym<state> { <sym> <scoped('state')> }
- rule package_declarator:sym<package> {
+ #rule package_declarator:sym<package> {
+ # :my $*OUTERPACKAGE := $*PACKAGE;
+ # :my $*PKGDECL := 'package';
+ # <sym> <package_def>
+ #}
+ token package_declarator:sym<package> {
:my $*OUTERPACKAGE := $*PACKAGE;
:my $*PKGDECL := 'package';
- <sym> <package_def>
+ <sym> <.end_keyword> <package_def>
}
rule package_declarator:sym<require> { # here because of declarational aspects
@@ -1635,7 +1643,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
:my $*CURPAD;
:my $*DOC := $*DECLARATOR_DOCS;
:my $*DOCEE;
- <.attach_docs>
+# <.attach_docs>
# Meta-object will live in here; also set default REPR (a trait
# may override this, e.g. is repr('...')).
@@ -1834,7 +1842,8 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
<declarator>
}
- rule routine_declarator:sym<sub> { <sym> <routine_def> }
+ #rule routine_declarator:sym<sub> { <sym> <routine_def> }
+ token routine_declarator:sym<sub> { <sym> <.end_keyword> <routine_def> }
rule parensig {
:dba('signature')
@@ -1851,33 +1860,47 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
return self;
}
+# rule routine_def {
+# :my $*CURLEX;
+# :my $*IN_DECL := 1;
+# :my $*DECLARAND;
+# [
+# || <deflongname>
+# <.newlex(1)>
+# <parensig>?
+# <trait>*
+# <!{
+# $*IN_DECL := 0;
+# }>
+# <blockoid>:!s
+# { @*MEMOS[self.pos]<endstmt> := 2; }
+# <.checkyada>
+# <.getsig>
+# || <?before \W>
+# <.newlex(1)>
+# <parensig>?
+# <trait>*
+# <!{
+# $*IN_DECL := 0;
+# }>
+# <blockoid>:!s
+# <.checkyada>
+# <.getsig>
+# ] || <.panic: "Malformed routine">
+# }
rule routine_def {
- :my $*CURLEX;
- :my $*IN_DECL := 1;
- :my $*DECLARAND;
- [
- || <deflongname>
- <.newlex(1)>
- <parensig>?
- <trait>*
- <!{
- $*IN_DECL := 0;
- }>
- <blockoid>:!s
- { @*MEMOS[self.pos]<endstmt> := 2; }
- <.checkyada>
- <.getsig>
- || <?before \W>
- <.newlex(1)>
- <parensig>?
- <trait>*
- <!{
- $*IN_DECL := 0;
- }>
- <blockoid>:!s
- <.checkyada>
- <.getsig>
- ] || <.panic: "Malformed routine">
+ :my $*IN_DECL := 'sub';
+ :my $*METHODTYPE;
+ :my $*IMPLICIT := 0;
+ :my $*DOC := $*DECLARATOR_DOCS;
+ :my $*DOCEE;
+ :my $*DECLARAND := $*W.stub_code_object('Sub');
+ <deflongname>
+ <.newlex>
+ [ '(' <multisig> ')' ]?
+ <trait>*
+ { $*IN_DECL := 0; }
+ <blockoid>
}
rule trait {
@@ -2222,21 +2245,14 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
token sigil:sym<*> { <sym> }
token sigil:sym<$#> { <sym> }
-# token deflongname {
-# :dba('new name to be defined')
-# <name>
-# { self.add_routine( ~$<name> ) if $*IN_DECL; }
-# }
token deflongname {
:dba('new name to be defined')
- <name> <colonpair>*
+ <name>
+# { self.add_routine( ~$<name> ) if $*IN_DECL; }
}
-# token longname {
-# <name>
-# }
token longname {
- <name> {} [ <?before ':' <+alpha+[\< \[ \« ]>> <colonpair> ]*
+ <name>
}
token name {
@@ -2246,20 +2262,9 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
]
}
- #token morename {
- # '::' <identifier>?
- #}
token morename {
:my $*QSIGIL := '';
- '::'
- [
- || <?before '(' | <alpha> >
- [
- | <identifier>
- | :dba('indirect name') '(' ~ ')' <EXPR>
- ]
- || <?before '::'> <.typed_panic: "X::Syntax::Name::Null">
- ]?
+ '::' <identifier>?
}
token subname {
View
48 lib/Perl6/P5World.pm
@@ -0,0 +1,48 @@
+use Perl6::World;
+
+class Perl6::P5World is Perl6::World {
+ # Takes a longname and turns it into an object representing the
+ # name.
+ # We just need that here to override Perl6::World's version of it which
+ # relies on the existance of <colonpair>.
+ method disect_longname($longname) {
+ say("method P5 disect_longname($longname)");
+ # Set up basic info about the long name.
+ my $result := nqp::create(LongName);
+ nqp::bindattr($result, LongName, '$!match', $longname);
+
+ # Pick out the pieces of the name.
+ my @components;
+ my $name := $longname<name>;
+ if $name<identifier> {
+ @components.push(~$name<identifier>);
+ }
+ for $name<morename> {
+ if $_<identifier> {
+ @components.push(~$_<identifier>[0]);
+ }
+ elsif $_<EXPR> {
+ my $EXPR := $_<EXPR>[0].ast;
+ @components.push($EXPR);
+ }
+ else {
+ # Either it's :: as a name entirely, in which case it's anon,
+ # or we're ending in ::, in which case it implies .WHO.
+ if +@components {
+ nqp::bindattr_i($result, LongName, '$!get_who', 1);
+ }
+ }
+ }
+ nqp::bindattr($result, LongName, '@!components', @components);
+
+ # Stash colon pairs with names; incorporate non-named one into
+ # the last part of the name (e.g. for infix:<+>). Need to be a
+ # little cheaty when compiling the setting due to bootstrapping.
+ my @pairs;
+ nqp::bindattr($result, LongName, '@!colonpairs', @pairs);
+
+ $result
+ }
+}
+
+# vim: ft=perl6
View
37 test.pl
@@ -0,0 +1,37 @@
+
+say "hello from P6";
+if 1 {
+ say 1;
+}
+
+{
+ use perl5;
+ use strict;
+ use feature 'say'; # say does work without it though
+
+ #package Main;
+
+ if( 2 ) {
+ say("2: hello from P5");
+ }
+ if( 0 ) {
+ say "you should never see this";
+ }
+ say "you should never see this" if 0;
+ say "you should never see this" unless 1;
+ unless ( "" ) { print "3\n"; }
+ say 4;
+ say "5: 1..5";
+ $_ = 7;
+ for (6..9) { say $_ }
+ for (10..13) {
+ say $_;
+ }
+ sub a { say 14; }; a();
+ my $s = 15;
+ say $s;
+ #sub b ($x) { say $x } # Method 'multisig' not found for invocant of class 'Perl6::P5Grammar'
+ #for my $x (10..13) { say $x; } # scoped variables not yet implemented. Sorry.
+}
+
+say "16";

No commit comments for this range

Something went wrong with that request. Please try again.