Skip to content

Commit

Permalink
added p5disect_longname to work around a missing token
Browse files Browse the repository at this point in the history
  • Loading branch information
@FROGGS
FROGGS committed Mar 23, 2013
1 parent c261fd3 commit 3eefed5
Show file tree
Hide file tree
Showing 2 changed files with 49 additions and 113 deletions.
146 changes: 42 additions & 104 deletions lib/Perl6/P5Actions.pm
View file
Expand Up @@ -6,6 +6,11 @@ use Perl6::Ops;
use QRegex; use QRegex;
use QAST; use QAST;


sub p5disect_longname( $longname ) {
$longname<colonpair> := nqp::list();
$*W.disect_longname( $longname )
}

my role STDActions { my role STDActions {
method quibble($/) { method quibble($/) {
make $<nibble>.ast; make $<nibble>.ast;
Expand Down Expand Up @@ -203,30 +208,10 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
} }


method deflongname($/) { method deflongname($/) {
# if $<colonpair> { make p5disect_longname($/).name(
# my $name := ~$<name>; :dba("$*IN_DECL declaration"),
# if $<colonpair>[0] { :decl<routine>,
# $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 }" # Turn $code into "for lines() { $code }"
Expand Down Expand Up @@ -453,9 +438,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
make $<pod_block>.ast; make $<pod_block>.ast;
} }


# method pod_configuration($/) { method pod_configuration($/) {
# make Perl6::Pod::make_config($/); make Perl6::Pod::make_config($/);
# } }


method pod_block:sym<delimited>($/) { method pod_block:sym<delimited>($/) {
make Perl6::Pod::any_block($/); make Perl6::Pod::any_block($/);
Expand Down Expand Up @@ -987,7 +972,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
method package_declarator:sym<require>($/) { method package_declarator:sym<require>($/) {
my $past := QAST::Stmts.new(:node($/)); my $past := QAST::Stmts.new(:node($/));
my $name_past := $<module_name> my $name_past := $<module_name>
?? $*W.disect_longname($<module_name><longname>).name_past() ?? p5disect_longname($<module_name><longname>).name_past()
!! $<EXPR>[0].ast; !! $<EXPR>[0].ast;


$past.push(QAST::Op.new( $past.push(QAST::Op.new(
Expand Down Expand Up @@ -1224,30 +1209,10 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
} }


# method colonpair($/) { # method colonpair($/) {
# if $*key { # make make_pair($*key, QAST::Op.new(
# if $<var> { # :op('p6bool'),
# make make_pair($*key, $<var>.ast); # QAST::IVal.new( :value($*value) )
# } # ));
# 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($/) { # method colonpair_variable($/) {
Expand Down Expand Up @@ -1343,7 +1308,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
else { else {
my $indirect; my $indirect;
if $<desigilname> && $<desigilname><longname> { if $<desigilname> && $<desigilname><longname> {
my $longname := $*W.disect_longname($<desigilname><longname>); my $longname := p5disect_longname($<desigilname><longname>);
if $longname.contains_indirect_lookup() { if $longname.contains_indirect_lookup() {
if $*IN_DECL { if $*IN_DECL {
$*W.throw($/, ['X', 'Syntax', 'Variable', 'IndirectDeclaration']); $*W.throw($/, ['X', 'Syntax', 'Variable', 'IndirectDeclaration']);
Expand Down Expand Up @@ -2408,16 +2373,16 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
); );
} }
my %sig_info; my %sig_info;
if $<multisig> { # if $<multisig> {
%sig_info := $<multisig>[0].ast; # %sig_info := $<multisig>[0].ast;
} # }
else { # else {
%sig_info<parameters> := $block<placeholder_sig> ?? $block<placeholder_sig> !! %sig_info<parameters> := $block<placeholder_sig> ?? $block<placeholder_sig> !!
[]; [];
} # }
my @params := %sig_info<parameters>; my @params := %sig_info<parameters>;
set_default_parameter_type(@params, 'Any'); set_default_parameter_type(@params, 'Any');
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); add_signature_binding_code($block, $signature, @params);


# Finish code object, associating it with the routine body. # Finish code object, associating it with the routine body.
Expand Down Expand Up @@ -2611,12 +2576,12 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
0 0
} }


# method onlystar($/) { method onlystar($/) {
# my $BLOCK := $*CURPAD; my $BLOCK := $*CURPAD;
# $BLOCK.push(QAST::Op.new( :op('p6multidispatch') )); $BLOCK.push(QAST::Op.new( :op('p6multidispatch') ));
# $BLOCK.node($/); $BLOCK.node($/);
# make $BLOCK; make $BLOCK;
# } }


method regex_declarator:sym<regex>($/, $key?) { method regex_declarator:sym<regex>($/, $key?) {
make $<regex_def>.ast; make $<regex_def>.ast;
Expand Down Expand Up @@ -2727,7 +2692,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {


# Get, or find, enumeration base type and create type object with # Get, or find, enumeration base type and create type object with
# correct base type. # correct base type.
my $longname := $<longname> ?? $*W.disect_longname($<longname>) !! 0; my $longname := $<longname> ?? p5disect_longname($<longname>) !! 0;
my $name := $<longname> ?? $longname.name() !! $<variable><desigilname>; my $name := $<longname> ?? $longname.name() !! $<variable><desigilname>;


my $type_obj; my $type_obj;
Expand Down Expand Up @@ -2874,7 +2839,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
QAST::Op.new( :op('p6bool'), QAST::IVal.new( :value(1) ) )); QAST::Op.new( :op('p6bool'), QAST::IVal.new( :value(1) ) ));


# Create the meta-object. # Create the meta-object.
my $longname := $<longname> ?? $*W.disect_longname($<longname>[0]) !! 0; my $longname := $<longname> ?? p5disect_longname($<longname>[0]) !! 0;
my $subset := $<longname> ?? my $subset := $<longname> ??
$*W.create_subset(%*HOW<subset>, $refinee, $refinement, :name($longname.name())) !! $*W.create_subset(%*HOW<subset>, $refinee, $refinement, :name($longname.name())) !!
$*W.create_subset(%*HOW<subset>, $refinee, $refinement); $*W.create_subset(%*HOW<subset>, $refinee, $refinement);
Expand Down Expand Up @@ -2965,9 +2930,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
make $<EXPR>.ast; make $<EXPR>.ast;
} }


method multisig($/) { # method multisig($/) {
make $<signature>.ast; # make $<signature>.ast;
} # }


method fakesignature($/) { method fakesignature($/) {
my $fake_pad := $*W.pop_lexpad(); my $fake_pad := $*W.pop_lexpad();
Expand Down Expand Up @@ -3227,16 +3192,6 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
$/.CURSOR.panic("Type " ~ ~$<typename><longname> ~ $/.CURSOR.panic("Type " ~ ~$<typename><longname> ~
" cannot be used as a nominal type on a parameter"); " 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;
# }
# }
# }
} }
} }
elsif $<value> { elsif $<value> {
Expand Down Expand Up @@ -3348,7 +3303,6 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
} }


method trait($/) { method trait($/) {
# make $<trait_mod> ?? $<trait_mod>.ast !! $<colonpair>.ast;
make $<trait_mod>.ast; make $<trait_mod>.ast;
} }


Expand Down Expand Up @@ -3376,7 +3330,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {


# If we have a type name then we need to dispatch with that type; otherwise # If we have a type name then we need to dispatch with that type; otherwise
# we need to dispatch with it as a named argument. # we need to dispatch with it as a named argument.
my @name := $*W.disect_longname($<longname>).components(); my @name := p5disect_longname($<longname>).components();
if $*W.is_name(@name) { if $*W.is_name(@name) {
my $trait := $*W.find_symbol(@name); my $trait := $*W.find_symbol(@name);
make -> $declarand { make -> $declarand {
Expand Down Expand Up @@ -3481,7 +3435,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
# runs after CHECK time. # runs after CHECK time.
my $past := $<methodop>.ast; my $past := $<methodop>.ast;
if $<methodop><longname> { if $<methodop><longname> {
my @parts := $*W.disect_longname($<methodop><longname>).components(); my @parts := p5disect_longname($<methodop><longname>).components();
my $name := @parts.pop; my $name := @parts.pop;
if @parts { if @parts {
my $methpkg := $*W.find_symbol(@parts); my $methpkg := $*W.find_symbol(@parts);
Expand Down Expand Up @@ -3524,7 +3478,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
if $<longname> { if $<longname> {
# May just be .foo, but could also be .Foo::bar. Also handle the # May just be .foo, but could also be .Foo::bar. Also handle the
# macro-ish cases. # macro-ish cases.
my @parts := $*W.disect_longname($<longname>).components(); my @parts := p5disect_longname($<longname>).components();
my $name := @parts.pop; my $name := @parts.pop;
if +@parts { if +@parts {
$past.unshift($*W.symbol_lookup(@parts, $/)); $past.unshift($*W.symbol_lookup(@parts, $/));
Expand Down Expand Up @@ -3895,9 +3849,9 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
make $<capterm>.ast; make $<capterm>.ast;
} }


# method term:sym<onlystar>($/) { method term:sym<onlystar>($/) {
# make QAST::Op.new( :op('p6multidispatchlex') ); make QAST::Op.new( :op('p6multidispatchlex') );
# } }


method args($/) { method args($/) {
my $past; my $past;
Expand Down Expand Up @@ -4246,22 +4200,6 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
} }
} }
if $key eq 'POSTFIX' { 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;
# }

# Method calls may be to a foreign language, and thus return # Method calls may be to a foreign language, and thus return
# values may need type mapping into Perl 6 land. # values may need type mapping into Perl 6 land.
$past.unshift($/[0].ast); $past.unshift($/[0].ast);
Expand Down Expand Up @@ -5007,7 +4945,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
# GenericHOW, though whether/how it's used depends on context. # GenericHOW, though whether/how it's used depends on context.
if $<longname> { if $<longname> {
if nqp::substr(~$<longname>, 0, 2) ne '::' { if nqp::substr(~$<longname>, 0, 2) ne '::' {
my $longname := $*W.disect_longname($<longname>); my $longname := p5disect_longname($<longname>);
my $type := $*W.find_symbol($longname.type_name_parts('type name')); my $type := $*W.find_symbol($longname.type_name_parts('type name'));
if $<arglist> { if $<arglist> {
$type := $*W.parameterize_type($type, $<arglist>, $/); $type := $*W.parameterize_type($type, $<arglist>, $/);
Expand Down
16 changes: 7 additions & 9 deletions lib/Perl6/P5Grammar.pm
View file
Expand Up @@ -2,7 +2,6 @@ use QRegex;
use NQPP6QRegex; use NQPP6QRegex;
use NQPP5QRegex; use NQPP5QRegex;
use Perl6::P5Actions; use Perl6::P5Actions;
use Perl6::P5World;
use Perl6::Pod; # XXX do we need that? use Perl6::Pod; # XXX do we need that?


role startstop5[$start,$stop] { role startstop5[$start,$stop] {
Expand Down Expand Up @@ -307,7 +306,6 @@ role STD5 {
} }


grammar Perl6::P5Grammar is HLL::Grammar does STD5 { grammar Perl6::P5Grammar is HLL::Grammar does STD5 {

# use DEBUG; # use DEBUG;


# method TOP ($STOP = 0) { # method TOP ($STOP = 0) {
Expand Down Expand Up @@ -1654,7 +1652,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
{ unless $*SCOPE { $*SCOPE := 'our'; } } { unless $*SCOPE { $*SCOPE := 'our'; } }


[ [
[ <longname> { $longname := $*W.disect_longname($<longname>[0]); } ]? [ <longname> { $longname := p5disect_longname($<longname>[0]); } ]?
<.newlex> <.newlex>


[ :dba('generic role') [ :dba('generic role')
Expand Down Expand Up @@ -1897,7 +1895,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
:my $*DECLARAND := $*W.stub_code_object('Sub'); :my $*DECLARAND := $*W.stub_code_object('Sub');
<deflongname> <deflongname>
<.newlex> <.newlex>
[ '(' <multisig> ')' ]? #[ '(' <multisig> ')' ]?
<trait>* <trait>*
{ $*IN_DECL := 0; } { $*IN_DECL := 0; }
<blockoid> <blockoid>
Expand Down Expand Up @@ -2254,7 +2252,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
token longname { token longname {
<name> <name>
} }

token name { token name {
[ [
| <identifier> <morename>* | <identifier> <morename>*
Expand Down Expand Up @@ -2699,9 +2697,9 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {


token unitstopper { $ } token unitstopper { $ }


method balanced ($start,$stop) { self.mixin( Perl6::P5Grammar::startstop[$start,$stop] ); } method balanced ($start,$stop) { self.mixin( Perl6::P5Grammar::startstop5[$start,$stop] ); }
method unbalanced ($stop) { self.mixin( Perl6::P5Grammar::stop[$stop] ); } method unbalanced ($stop) { self.mixin( Perl6::P5Grammar::stop5[$stop] ); }
method unitstop ($stop) { self.mixin( Perl6::P5Grammar::unitstop[$stop] ); } method unitstop ($stop) { self.mixin( Perl6::P5Grammar::unitstop5[$stop] ); }


token charname { token charname {
[ [
Expand Down Expand Up @@ -3568,7 +3566,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
token term:sym<name> { token term:sym<name> {
<longname> <longname>
:my $*longname; :my $*longname;
{ say("token term:sym<name> longname:" ~ ~$<longname>); $*longname := $*W.disect_longname($<longname>) } { say("token term:sym<name> longname:" ~ ~$<longname>); $*longname := p5disect_longname($<longname>) }
[ [
|| <?{ nqp::substr($<longname>.Str, 0, 2) eq '::' || $*W.is_name($*longname.components()) }> || <?{ nqp::substr($<longname>.Str, 0, 2) eq '::' || $*W.is_name($*longname.components()) }>
<.unsp>? <.unsp>?
Expand Down

0 comments on commit 3eefed5

Please sign in to comment.