to support lexical self, some pair parsing and printing, preceded by test file

[p6rt]

Migrated from rt.perl.org#51658 (status was 'resolved')

Searchable as RT51658$

[p6rt]

From @cognominal

# use v6-alpha; # use Test; # plan 3; # test for lexical self. # and for some pair parsing and printing.

# should print : # hi # :a # :!a # :a(1) # :a\<1> # :a(" > ")

class A { method h { "hi" }; method g { if (1) { self.h(); } } }; my $o = A.new; # ok 'hi' eq $o.g() say $o.h;

## See S02 for pair semantic # note the test are dependant on the choice of the perl representation.

say :a.value; # Method 'perl' not found for invocant of class 'Boolean' # should print True or Bool​::True

say :a.perl; # ok :a.perl eq '​:a'

say :!a.perl; # ok :!a.perl eq '​:!a'

# not that the printing representation does not yet parse # for the next two examples.

my $a = 1 ; say :$a.perl; # ok :$a.perl eq '​:a(1)'

my $a = "1"; say :$a.perl; # ok :$a.perl eq '​:a\<1>'

my $a = " > "; say :$a.perl; # ok :$a.perl eq '​:a\<1>'

# TBD; parse, but does not yet print # my @​a; @​a[0]=1; # say :@​a.perl;

---

affected files : languages/perl6/src/parser/actions.pm languages/perl6/src/parser/grammar.pg languages/perl6/src/classes/Pair.pir

Index​: languages/perl6/src/parser/actions.pm

--- languages/perl6/src/parser/actions.pm (revision 26310) +++ languages/perl6/src/parser/actions.pm (working copy) @​@​ -30,10 +30,12 @​@​   our $?BLOCK;   our @​?BLOCK;   our $?BLOCK_SIGNATURED; + our $?IS_METHOD; + our $?IN_METHOD;   ## when entering a block, use any $?BLOCK_SIGNATURED if it exists,   ## otherwise create an empty block with an empty first child to   ## hold any parameters we might encounter inside the block. - if ($key eq 'open') { + if $key eq 'open' {   if $?BLOCK_SIGNATURED {   $?BLOCK := $?BLOCK_SIGNATURED;   $?BLOCK_SIGNATURED := 0; @​@​ -62,8 +64,18 @​@​   unless $?BLOCK.symbol('$!') {   $init.push( PAST​::Var.new( :name('$!'), :isdecl(1) ) );   $?BLOCK.symbol( '$!', :scope('lexical') ); } + if $?IS_METHOD { + $init.push(PAST​::Var.new( + :name('self'), + :isdecl(1) + )); + $?BLOCK.symbol('self', :scope('lexical')); + $?IS_METHOD := 0; + $init.push( PAST​::Op.new( :inline( " store_lex 'self', self"))); + } +   } - if ($key eq 'close') { + if $key eq 'close' {   my $past := @​?BLOCK.shift();   $?BLOCK := @​?BLOCK[0];   $past.push($($\)); @​@​ -122,12 +134,12 @​@​   :pasttype('if'),   :node( $/ )   ); - if ( $\ ) { + if $\ {   my $else := $( $\[0] );   $else.blocktype('immediate');   $past.push( $else );   } - while ($count != 0) { + while $count != 0 {   $count := $count - 1;   $expr := $( $\[$count] );   $then := $( $\[$count] ); @​@​ -294,12 +306,12 @​@​ method statement_prefix($/) {   my $past := $($\);   my $sym := ~$\; - if ($sym eq 'do') { + if $sym eq 'do' {   # fall through, just use the statement itself   }   ## after the code in the try block is executed, bind $! to Undef,   ## and set up the code to catch an exception, in case one is thrown - elsif ($sym eq 'try') { + elsif $sym eq 'try' {   ## Set up code to execute \ as a try node, and   ## set $! to Undef if successful.   my $exitpir := " new %r, 'Undef'\n store_lex '$!', %r"; @​@​ -319,62 +331,58 @​@​ }

-method plurality_declarator($/) { - my $past := $( $\<routine_declarator> ); - if $\ eq 'multi' { - my $pirflags := ~ $past.pirflags(); - my $arity := $past.arity(); - if $arity == 0 { $pirflags := $pirflags ~ ' :multi()'; } - elsif $arity == 1 { $pirflags := $pirflags ~ ' :multi(_)'; } - else { - $pirflags := $pirflags ~ ' :multi(_'; - my $count := 1; - while $count != $arity { - $pirflags := $pirflags ~ ',_'; - $count := $count + 1; +method routine($/, $key) { + our $?IS_METHOD; + our $?IN_METHOD; + if $key eq 'decls' { + $?IS_METHOD := 0; + $?IN_METHOD := 0; + if (~$\ eq 'method') { + $?IS_METHOD := 1; # reset in inner blocks + $?IN_METHOD := 1; # not reset in inner blocks + } + } else { + my $past := $($\<routine_def>); + if $\ eq 'multi' { + my $pirflags := ~ $past.pirflags(); + my $arity := $past.arity(); + if $arity == 0 { $pirflags := $pirflags ~ ' :multi()'; } + elsif $arity == 1 { $pirflags := $pirflags ~ ' :multi(_)'; } + else { + $pirflags := $pirflags ~ ' :multi(_'; + my $count := 1; + while $count != $arity { + $pirflags := $pirflags ~ ',_'; + $count := $count + 1; + } + $pirflags := $pirflags ~ ')';   } - $pirflags := $pirflags ~ ')'; + $past.pirflags($pirflags);   } - $past.pirflags($pirflags); - } - make $past; -}

- -method routine_declarator($/, $key) { - if $key eq 'sub' { - my $past := $($\<routine_def>);   $past.blocktype('declaration'); + if $?IN_METHOD { + $past.pirflags('​:method'); + }   $past.node($/);   make $past; +   } - elsif $key eq 'method' { - my $past := $($\<method_def>); - $past.blocktype('declaration'); - $past.pirflags('​:method'); - $past.node($/); - make $past; - } }

- method routine_def($/) { + our $?IS_METHOD;   my $past := $( $\ );   if $\ {   $past.name( ~$\[0] ); - our $?BLOCK; - $?BLOCK.symbol(~$\[0], :scope('package')); + if $?IS_METHOD { + our $?BLOCK; + $?BLOCK.symbol(~$\[0], :scope('package')); + }   }   make $past; }

-method method_def($/) { - my $past := $( $\ ); - if $\ { - $past.name( ~$\[0] ); - } - make $past; -}

method signature($/) {   my $params := PAST​::Stmts.new( :node($/) ); @​@​ -468,7 +476,7 @​@​ method methodop($/, $key) {   my $past;

- if ($key eq 'null') { + if $key eq 'null' {   $past := PAST​::Op.new();   }   else { @​@​ -535,8 +543,12 @​@​

method noun($/, $key) {   my $past; + our $?IN_METHOD;   if $key eq 'self' { - $past := PAST​::Stmts.new( PAST​::Op.new( :inline('%r = self'), :node( $/ ) ) ); + unless $?IN_METHOD { + $/.panic("can't use 'self' outside a method"); + } + $past := PAST​::Stmts.new( PAST​::Op.new( :inline(" %r = find_lex 'self'"), :node( $/ ) ) );   }   elsif $key eq 'undef' {   $past := PAST​::Op.new( @​@​ -781,6 +793,9 @​@​

method scoped($/) { + if $\ { + $/.panic('statically typed variables are not yet implemented'); + }   my $past := $( $\<variable_decl> );   make $past; } @​@​ -966,13 +981,13 @​@​

method circumfix($/, $key) {   my $past; - if ($key eq '( )') { + if $key eq '( )' {   $past := $( $\ );   } - if ($key eq '[ ]') { + if $key eq '[ ]' {   $past := $( $\ );   } - elsif ($key eq '{ }') { + elsif $key eq '{ }' {   $past := $( $\ );   }   make $past; @​@​ -1048,15 +1063,15 @​@​

method quote_expression($/, $key) {   my $past; - if ($key eq 'quote_regex') { + if $key eq 'quote_regex' {   $past := PAST​::Block.new( $\<quote_regex>,   :compiler('PGE​::Perl6Regex'),   :blocktype('declaration'),   :node( $/ )   )   } - elsif ($key eq 'quote_concat') { - if ( +$\<quote_concat> == 1 ) { + elsif $key eq 'quote_concat' { + if +$\<quote_concat> == 1 {   $past := $( $\<quote_concat>[0] );   }   else { @​@​ -1090,10 +1105,10 @​@​

method quote_term($/, $key) {   my $past; - if ($key eq 'literal') { + if $key eq 'literal' {   $past := PAST​::Val.new( :value( ~$\<quote_literal> ), :returns('Perl6Str'), :node($/) );   } - if ($key eq 'variable') { + if $key eq 'variable' {   $past := $( $\ );   }   make $past; @​@​ -1127,9 +1142,9 @​@​

method semilist($/) {   my $past := PAST​::Op.new( :node($/) ); - if ($\) { + if $\ {   my $expr := $($\[0]); - if ($expr.name() eq 'infix​:,') { + if $expr.name() eq 'infix​:,' {   for @​($expr) {   $past.push( $_ );   } @​@​ -1144,10 +1159,10 @​@​

method listop($/, $key) {   my $past; - if ($key eq 'arglist') { + if $key eq 'arglist' {   $past := $( $\ );   } - if ($key eq 'noarg') { + if $key eq 'noarg' {   $past := PAST​::Op.new( );   }   $past.name( ~$\ ); @​@​ -1160,7 +1175,7 @​@​ method arglist($/) {   my $past := PAST​::Op.new( :node($/) );   my $expr := $($\); - if ($expr.name() eq 'infix​:,') { + if $expr.name() eq 'infix​:,' {   for @​($expr) {   $past.push( $_ );   } @​@​ -1173,7 +1188,7 @​@​

method EXPR($/, $key) { - if ($key eq 'end') { + if $key eq 'end' {   make $($\);   }   else { @​@​ -1239,13 +1254,12 @​@​   make $past; }

- method colonpair($/, $key) {   my $pair_key;   my $pair_val;

  if $key eq 'false' { - my $pair_key := PAST​::Val.new( :value(~$\) ); + $pair_key := PAST​::Val.new( :value(~$\) );   $pair_val := PAST​::Var.new(   :name('False'),   :namespace('Bool'), @​@​ -1253,10 +1267,9 @​@​   );   }   elsif $key eq 'value' { - my $pair_key := PAST​::Val.new( :value(~$\) ); + $pair_key := PAST​::Val.new( :value(~$\) );   if $\ { - # XXX TODO - $/.panic('postcircumfix on colonpair not yet implemented'); + $pair_val := PAST​::Val.new( :value($\))   }   else {   $pair_val := PAST​::Var.new( @​@​ -1266,7 +1279,12 @​@​   );   }   } - else { + elsif $key eq 'varname' { + my $nm := $\\; + my $idx := $\\; + $pair_key := PAST​::Val.new( :value( ~$nm || ~$idx) ); + $pair_val := $( $\ ); + } else {   $/.panic($key ~ " pairs not yet implemented.");   }

Index​: languages/perl6/src/parser/grammar.pg

--- languages/perl6/src/parser/grammar.pg (revision 26310) +++ languages/perl6/src/parser/grammar.pg (working copy) @​@​ -299,15 +299,11 @​@​

#### Subroutine and method definitions ####

-rule plurality_declarator { - $\=[multi|proto|only] \<routine_declarator> {*} +rule routine { + $\=[multi|proto|only|''] $\=[sub|method] {*} #= decls + \<routine_def> {*} #= def }

-token routine_declarator { - | $\='sub' \<routine_def> {*} #= sub - | $\='method' \<method_def> {*} #= method -} - rule routine_def {   \? \?   \* @​@​ -315,13 +311,6 @​@​   {*} }

-rule method_def { - \? \? - \* - \ - {*} -} - rule trait {   | \<trait_auxiliary>   | \<trait_verb> @​@​ -431,8 +420,7 @​@​ token noun {   | \<package_declarator> {*} #= package_declarator   | \<scope_declarator> {*} #= scope_declarator - | \<plurality_declarator> {*} #= plurality_declarator - | \<routine_declarator> {*} #= routine_declarator + | \ {*} #= routine   | \ {*} #= circumfix   | \ {*} #= variable   | \ {*} #= subcall @​@​ -479,7 +467,7 @​@​

rule scoped { - \<variable_decl> {*} + \? \<variable_decl> {*} }

rule scope_declarator { @​@​ -657,10 +645,10 @​@​ token colonpair {   '​:'   [ - | '!' \ {*} #= false + || '!' \ {*} #= false   | \ [ \<.unsp>? \ ]? {*} #= value   | \ {*} #= structural - | \ \? \ {*} #= varname + | \ {*} #= varname   ] }

Index​: languages/perl6/src/classes/Pair.pir

--- languages/perl6/src/classes/Pair.pir (revision 26310) +++ languages/perl6/src/classes/Pair.pir (working copy) @​@​ -17,6 +17,84 @​@​   $P1('Pair', 'Pair') .end

+ +.sub get_string :method + $S0 = self.'perl'() + return ( $S0 ) +.end + +# should be pedagogical and gives the smartest representation of a pair +.sub perl :method + $P0 = self.'key'() + $P1 = self.'value'() + $S0 = $P0.'WHAT'() + $S1 = $P1.'WHAT'() + if $S0 != 'Str' goto keyisnotstring + $S2 = $P0 + $S3 = escape $S2 + if $S3 != $S2 goto keyescaped + if $S1 != 'Bool' goto valnobool + $S5 = "​:" + if $P1 goto trueval + concat $S5, "!" +trueval​: + concat $S5, $S2 + .return ($S5) +valnobool​: + if $S1 == 'Str' goto valliteral + if $S1 == 'Int' goto valnum + if $S1 == 'Num' goto valnum + die "TBD" + +valliteral​: + $S1 = $P1 + $I0 = index $S1, '>' + if $I0 != -1 goto esc_val_litteral + $I0 = index $S1, '\<' + if $I0 != -1 goto esc_val_litteral + $S6 = "​:" + $S7 = $P0 + concat $S6, $S7 + concat $S6, '\<' + $S7 = $P1 + concat $S6, $S7 + concat $S6, '>' + .return ( $S6 ) + +esc_val_litteral​: + $S1 = escape $S1 + $S1 = concat '"', $S1 + $S1 = concat $S1, '"' + $P1 = $S1 # fall-thru +valnum​: + $S6 = "​:" + $S7 = $P0 + concat $S6, $S7 + concat $S6, '(' + $S7 = $P1 + concat $S6, $S7 + concat $S6, ')' + .return ( $S6 ) + + +keyescaped​: + die "TBD" + +keyisnotstring​: + # ugly, probably not correct, certainly not yet supported + $S2 = "{ (my $p=Pair.new()), " + concat $S2, "$p[ " + $S3 = $P0.perl() + concat $S2, $S3 + concat $S2, "] = " + $S3 = $P1.perl() + concat $S2, $S3 + concat $S3, "}" +keyissnottring​: + die "TBD" +.end + + =back

=cut bash-3.2$

[p6rt]

From @jnthn

Hi,

OK, finally I have time to look through this patch. Thanks for your patience while I did $REAL_LIFE for a bit.

First a general hint for future patches​: please try and keep them at one feature per patch. This one targets a couple of distinct things as well as doing some clean-ups against some Perl 5-isms, which makes it a little harder to deal with. But I know it'd be a huge pain to get you to do that now, so I'll just work from this one as it is. :-)

Digging into the patch itself. I note you did some re-organizing of the grammar rules relating to parsing of routines and so forth. While I can see that this maybe simplifies the code, we are working towards converging on​: http://svn.pugscode.org/pugs/src/perl6/STD.pm And your changes look to me to represent a step away from that in a chunk of the Rakudo grammar that currently matches STD.pm reasonably well. Therefore, I'm going to reject those changes. It may be that STD.pm could formulate these constructs more neatly, but I think it has reasons for doing it the way it has. The changes to the colonpair rule look to to be in the same boat too - I'm not sure why the | was changed to a ||, and the \ rule allows things that are not allowable in colonpair form.

Next I went through and manually applied all of the paren clean-ups. They all looked correct to me, so they all went in as r26519.

The scoping and name fixes for the colonpair method went in as r26524. I'm not quite sure what I was smoking when I wrote those (exhaustion is a more likely culprit). It'd be nice if the postcircumfix stuff was as simple as this patch attempts, but it doesn't appear to work, so I've skipped that bit. And I'm going to redo the variable variant of it to use desigilname, rather than variable, so it's inline with STD.pm.

For the lexical self stuff, it's very much needed. However, the implementation is a little tangled up in the moving of grammar rules. I'm not sure it supports nested methods properly, though I see a comment in there that suggests it should - I just can't see how at the moment (but I'm tired, so sorry if it does and I'm missing it). If you'd be willing to have another crack at this while leaving the grammar rules intact, I'd be happy to see that patch (don't worry about nesting for now, if you like - we can resolve that later...I'm happy to have improvements rather than stuff that's perfect right off; it's not like the stuff I commit is...).

Thanks for the patch, and please don't be discouraged from working on more because I didn't apply all of this. I'm happy to answer any questions about anything I mentioned, on IRC or in mail if I can't be found there.

Take care,

Jonathan

[p6rt]

The RT System itself - Status changed from 'new' to 'open'

[p6rt]

From @jnthn

Closing this; extracted what was possible from the patch and applied it, and the ticket hasn't been replied to for a while. Any new 'self' patch can be sent as a new ticket.

[p6rt]

@jnthn - Status changed from 'open' to 'resolved'