This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Hash::Util::FieldHash: fix broken pod link
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index 92c61f0..2d8b599 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -94,7 +94,7 @@
 
 %type <opval> stmtseq fullstmt labfullstmt barestmt block mblock else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
-%type <opval> sliceme gelem
+%type <opval> sliceme kvslice gelem
 %type <opval> listexpr nexpr texpr iexpr mexpr mnexpr miexpr
 %type <opval> optlistexpr optexpr indirob listop method
 %type <opval> formname subname proto subbody cont my_scalar formblock
 %left <i_tkval> MATCHOP
 %right <i_tkval> '!' '~' UMINUS REFGEN
 %right <i_tkval> POWOP
-%nonassoc <i_tkval> PREINC PREDEC POSTINC POSTDEC
+%nonassoc <i_tkval> PREINC PREDEC POSTINC POSTDEC POSTJOIN
 %left <i_tkval> ARROW
 %nonassoc <i_tkval> ')'
 %left <i_tkval> '('
@@ -1053,6 +1053,18 @@ termunop : '-' term %prec UMINUS                       /* -$x */
                                        op_lvalue(scalar($1), OP_POSTDEC));
                          TOKEN_GETMAD($2,$$,'o');
                        }
+       |       term POSTJOIN    /* implicit join after interpolated ->@ */
+                       { $$ = convert(OP_JOIN, 0,
+                                      op_append_elem(
+                                       OP_LIST,
+                                       newSVREF(scalar(
+                                           newSVOP(OP_CONST,0,
+                                                   newSVpvs("\""))
+                                       )),
+                                       $1
+                                      ));
+                         TOKEN_GETMAD($2,$$,'o');
+                       }
        |       PREINC term                            /* ++$x */
                        { $$ = newUNOP(OP_PREINC, 0,
                                        op_lvalue(scalar($2), OP_PREINC));
@@ -1108,49 +1120,6 @@ termdo   :       DO term %prec UNIOP                     /* do $filename */
                        { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));
                          TOKEN_GETMAD($1,$$,'D');
                        }
-       |       DO subname '(' ')'                  /* do somesub() */
-                       { $$ = newUNOP(OP_ENTERSUB,
-                           OPf_SPECIAL|OPf_STACKED,
-                           op_prepend_elem(OP_LIST,
-                               scalar(newCVREF(
-                                   (OPpENTERSUB_AMPER<<8),
-                                   scalar($2)
-                               )),(OP*)NULL)); dep();
-                         TOKEN_GETMAD($1,$$,'o');
-                         TOKEN_GETMAD($3,$$,'(');
-                         TOKEN_GETMAD($4,$$,')');
-                       }
-       |       DO subname '(' expr ')'             /* do somesub(@args) */
-                       { $$ = newUNOP(OP_ENTERSUB,
-                           OPf_SPECIAL|OPf_STACKED,
-                           op_append_elem(OP_LIST,
-                               $4,
-                               scalar(newCVREF(
-                                   (OPpENTERSUB_AMPER<<8),
-                                   scalar($2)
-                               )))); dep();
-                         TOKEN_GETMAD($1,$$,'o');
-                         TOKEN_GETMAD($3,$$,'(');
-                         TOKEN_GETMAD($5,$$,')');
-                       }
-       |       DO scalar '(' ')'                /* do $subref () */
-                       { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
-                           op_prepend_elem(OP_LIST,
-                               scalar(newCVREF(0,scalar($2))), (OP*)NULL)); dep();
-                         TOKEN_GETMAD($1,$$,'o');
-                         TOKEN_GETMAD($3,$$,'(');
-                         TOKEN_GETMAD($4,$$,')');
-                       }
-       |       DO scalar '(' expr ')'           /* do $subref (@args) */
-                       { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
-                           op_prepend_elem(OP_LIST,
-                               $4,
-                               scalar(newCVREF(0,scalar($2))))); dep();
-                         TOKEN_GETMAD($1,$$,'o');
-                         TOKEN_GETMAD($3,$$,'(');
-                         TOKEN_GETMAD($5,$$,')');
-                       }
-
         ;
 
 term   :       termbinop
@@ -1208,7 +1177,7 @@ term      :       termbinop
                          TOKEN_GETMAD($2,$$,'[');
                          TOKEN_GETMAD($4,$$,']');
                        }
-       |       hsh '[' expr ']'                     /* array key/value slice */
+       |       kvslice '[' expr ']'                 /* array key/value slice */
                        { $$ = op_prepend_elem(OP_KVASLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_KVASLICE, 0,
@@ -1234,7 +1203,7 @@ term      :       termbinop
                          TOKEN_GETMAD($4,$$,';');
                          TOKEN_GETMAD($5,$$,'}');
                        }
-       |       hsh '{' expr ';' '}'                 /* %hash{@keys} */
+       |       kvslice '{' expr ';' '}'                 /* %hash{@keys} */
                        { $$ = op_prepend_elem(OP_KVHSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_KVHSLICE, 0,
@@ -1479,6 +1448,10 @@ arylen   :       DOLSHARP indirob
                        { $$ = newAVREF($2);
                          TOKEN_GETMAD($1,$$,'l');
                        }
+       |       term ARROW DOLSHARP '*'
+                       { $$ = newAVREF($1);
+                         TOKEN_GETMAD($3,$$,'l');
+                       }
        ;
 
 star   :       '*' indirob
@@ -1494,6 +1467,13 @@ sliceme  :       ary
                        }
        ;
 
+kvslice        :       hsh
+       |       term ARROW '%'
+                       { $$ = newHVREF($1);
+                         TOKEN_GETMAD($3,$$,'@');
+                       }
+       ;
+
 gelem  :       star
        |       term ARROW '*'
                        { $$ = newGVREF(0,$1);