Implement interpolation of method calls, array indexing and hash inde…

…xing in strings. Needs a workaround due to <after> being NYI.
rakudo · Apr 3, 2010 · 93fa3d5 · 93fa3d5
1 parent 020a6a3
commit 93fa3d5
Show file tree

Hide file tree

Showing 2 changed files with 74 additions and 9 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -2334,11 +2334,32 @@ method quote:sym<s>($/) {
 }
 
 method quote_escape:sym<$>($/) {
-    #make $<variable>.ast;
-    # my $a = 3; say "$a".WHAT # Gives Int, not Str with the above. Force
-    # stringification to fix this. This should probably be handled in nqp-rx,
-    # but work around it for now.
-    make PAST::Op.new( $<variable>.ast, :pirop('set SP') );
+    make steal_back_spaces($/, PAST::Op.new( $<EXPR>.ast, :pirop('set SP') ));
+}
+
+method quote_escape:sym<array>($/) {
+    make steal_back_spaces($/, PAST::Op.new( $<EXPR>.ast, :pirop('set SP') ));
+}
+
+method quote_escape:sym<%>($/) {
+    make steal_back_spaces($/, PAST::Op.new( $<EXPR>.ast, :pirop('set SP') ));
+}
+
+# Unfortunately, the operator precedence parser (probably correctly)
+# steals spaces after a postfixish. Thus "$a $b" would get messed up.
+# Here we take them back again. Hacky, better solutions welcome.
+sub steal_back_spaces($/, $expr) {
+    my $pos := pir::length__IS($/) - 1;
+    while pir::is_cclass__IISI(32, $/, $pos) {
+        $pos--;
+    }
+    my $nab_back := pir::substr__SSI($/, $pos + 1);
+    if $nab_back {
+        PAST::Op.new( :pasttype('call'), :name('&infix:<~>'), $expr, ~$nab_back )
+    }
+    else {
+        $expr
+    }
 }
 
 method quote_escape:sym<{ }>($/) {

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -139,6 +139,7 @@ token name {
 }
 
 token morename {
+    :my $*QSIGIL := '';
     '::' <identifier>
 }
 
@@ -243,6 +244,7 @@ token comp_unit {
     :my $*LEFTSIGIL;                           # sigil of LHS for item vs list assignment
     :my $*SCOPE := '';                         # which scope declarator we're under
     :my $*MULTINESS := '';                     # which multi declarator we're under
+    :my $*QSIGIL := '';                        # sigil of current interpolation
     :my $*TYPENAME := '';
     <.newpad>
     <.outerlex>
@@ -262,6 +264,7 @@ rule semilist {
 }
 
 token statement {
+    :my $*QSIGIL := '';
     <!before <[\])}]> | $ >
     [
     | <statement_control>
@@ -963,6 +966,7 @@ token semiarglist {
 }
 
 token arglist {
+    :my $*QSIGIL := '';
     <.ws>
     [
     | <?stdstopper>
@@ -971,7 +975,6 @@ token arglist {
     ]
 }
 
-
 token term:sym<value> { <value> }
 
 proto token value { <...> }
@@ -1095,7 +1098,24 @@ token old_rx_mods {
     }
 }
 
-token quote_escape:sym<$>   { <?[$]> <?quotemod_check('s')> <variable> }
+token quote_escape:sym<$> {
+    <?[$]>
+    :my $*QSIGIL := '$';
+    <?quotemod_check('s')> <EXPR('y=')>
+}
+
+token quote_escape:sym<array> {
+    <?[@]>
+    :my $*QSIGIL := '@';
+    <?quotemod_check('s')> <EXPR('y=')>
+}
+
+token quote_escape:sym<%> {
+    <?[%]>
+    :my $*QSIGIL := '%';
+    <?quotemod_check('s')> <EXPR('y=')>
+}
+
 token quote_escape:sym<{ }> { <?[{]> <?quotemod_check('c')> <block> }
 
 token circumfix:sym<( )> { '(' <semilist> ')' }
@@ -1142,6 +1162,26 @@ INIT {
     Perl6::Grammar.O(':prec<c=>, :assoc<left>',  '%loose_or');
 }
 
+token termish {
+    <prefixish>*
+    <term>
+    [
+    || <?{ $*QSIGIL }>
+        [
+        || <?{ $*QSIGIL eq '$' }> [ <postfixish>+! <?{ bracket_ending($<postfixish>) }> ]?
+        ||                          <postfixish>+! <?{ bracket_ending($<postfixish>) }>
+        ]
+    || <!{ $*QSIGIL }> <postfixish>*
+    ]
+}
+
+sub bracket_ending($matches) {
+    my $check := $matches[+$matches - 1];
+    my $str   := $check.Str;
+    my $last  := pir::substr($str, pir::length__IS($check) - 1, 1);
+    $last eq ')' || $last eq '}' || $last eq ']' || $last eq '>'
+}
+
 method EXPR($preclim = '') {
     # Override this so we can set $*LEFTSIGIL.
     my $*LEFTSIGIL := '';
@@ -1213,7 +1253,8 @@ regex prefix_circumfix_meta_operator:sym<reduce> {
 }
 
 token postfix_prefix_meta_operator:sym<»> {
-    [ <sym> | '>>' ] <!before '('>
+    [ <sym> | '>>' ] 
+    [ <!{ $*QSIGIL }> || <!before '('> ]
 }
 
 token prefix_postfix_meta_operator:sym<«> {
@@ -1281,12 +1322,13 @@ token methodop {
     | <longname>
     | <?before '$' | '@' | '&' > <variable>
     | <?before <[ ' " ]> >
+        [ <!{$*QSIGIL}> || <!before '"' <-["]>*? \s > ] # dwim on "$foo."
         <quote>
         [ <?before '(' | '.(' | '\\'> || <.panic: "Quoted method name requires parenthesized arguments"> ]
     ] <.unsp>?
     [
     | <?[(]> <args>
-    | ':' \s <args=.arglist>
+    | ':' \s <!{ $*QSIGIL }> <args=.arglist>
     ]?
 }
 
@@ -1295,11 +1337,13 @@ token dottyopish {
 }
 
 token postcircumfix:sym<[ ]> {
+    :my $*QSIGIL := '';
     '[' ~ ']' [ <.ws> <EXPR> ]
     <O('%methodcall')>
 }
 
 token postcircumfix:sym<{ }> {
+    :my $*QSIGIL := '';
     '{' ~ '}' [ <.ws> <EXPR> ]
     <O('%methodcall')>
 }