Support my method and ->&meth syntax

perly.y

@@ -105,7 +105,7 @@
 %type <opval> empty
 %type <opval> sliceme kvslice gelem
 %type <opval> listexpr nexpr texpr iexpr mexpr mnexpr
-%type <opval> optlistexpr optexpr optrepl indirob listop methodname
+%type <opval> optlistexpr optexpr optrepl indirob listop methodname lexsubref
 %type <opval> formname subname proto cont my_scalar my_var
 %type <opval> list_of_scalars my_list_of_scalars refgen_topic formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
@@ -776,6 +776,16 @@ subname	:	BAREWORD
 	|	PRIVATEREF
 	;
 
+/* Lexical sub reference - must be lexical. BAREWORD case detects references
+ * to subs that are not lexical (i.e. package). */
+lexsubref :     PRIVATEREF
+          |     BAREWORD
+                        {
+                            SV *bareword = cSVOPx($BAREWORD)->op_sv;
+                            croak("Expected a lexical subroutine reference, found %" SVf_QUOTEDPREFIX,
+                                SVfARG(bareword));
+                        }
+
 /* Subroutine prototype */
 proto
 	:	empty
@@ -1006,6 +1016,18 @@ listop	:	LSTOP indirob listexpr /* map {...} @args or print $fh @args */
 				op_append_elem(OP_LIST, scalar($term),
 				    newMETHOP(OP_METHOD, 0, $methodname)));
 			}
+	|       term ARROW PERLY_AMPERSAND lexsubref[method] PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* $foo->&bar(list) */
+			{ $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
+				op_append_elem(OP_LIST,
+				    op_prepend_elem(OP_LIST, scalar($term), $optexpr),
+				    newCVREF(0, $method)));
+			}
+	|       term ARROW PERLY_AMPERSAND lexsubref[method] /* $foo->&bar */
+			{ $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
+				op_append_elem(OP_LIST,
+				    scalar($term),
+				    newCVREF(0, $method)));
+			}
 	|	METHCALL0 indirob optlistexpr           /* new Class @args */
 			{ $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED,
 				op_append_elem(OP_LIST,

pod/perlclass.pod

@@ -185,6 +185,28 @@ Just like regular subroutines, methods I<can> be anonymous:
         }
     }
 
+Methods can also be declared as lexical subroutines, using the C<my> prefix.
+This creates a subroutine that is lexically visible within the current scope,
+but does not appear in the symbol table.  The effect is that of a I<private>
+method; one that can be called from within the class's own code, but not from
+outside.
+
+To invoke these lexical subroutines as methods, it is best to use the
+C<< ->& >> operator.  This bypasses method lookup by name, and directly
+invokes a lexical subroutine as if it was a method.
+
+    class LexicalMethod {
+        my method abc ($x, $y) {
+            say "Internal method abc invoked with x=$x y=$y";
+        }
+
+        method xyz {
+            $self->&abc("x", "y");
+        }
+    }
+
+    # The `abc` method is not visible from here
+
 =head1 ATTRIBUTES
 
 Specific aspects of the keywords mentioned above are managed using

pod/perldelta.pod

@@ -27,6 +27,21 @@ here, but most should go in the L</Performance Enhancements> section.
 
 [ List each enhancement as a =head2 entry ]
 
+=head2 Lexical method declaration using C<my method>
+
+Like C<sub> since Perl version 5.18, C<method> can now be prefixed with the
+C<my> keyword.  This declares a subroutine that has lexical, rather than
+package visibility.  See L<perlclass> for more detail.
+
+=head2 Lexical method invocation operator C<< ->& >>
+
+Along with the ability to declare methods lexically, this release also permits
+invoking a lexical subroutine as if it were a method, bypassing the usual
+name-based method resolution by name.
+
+Combined with lexical method declaration, these two new abilities create the
+effect of having private methods.
+
 =head1 Security
 
 XXX Any security-related notices go here. In particular, any security

pod/perldiag.pod

@@ -2471,6 +2471,13 @@ as a return, a goto, or a loop control statement.
 match the sigil of the preceding name, or the value was not a reference at
 all. 
 
+=item Expected a lexical subroutine reference, found "%s"
+
+(F) An attempt was made to use the C<< ->& >> lexical method invocation
+operator on a subroutine that is not declared lexically.  Remember that
+subroutines used as methods for this operator must be declared with the C<my>
+keyword to make them lexical.
+
 =item Expecting close bracket in regex; marked by S<<-- HERE> in m/%s/
 
 (F) You wrote something like

pod/perlop.pod

@@ -236,6 +236,13 @@ and (if it is a method name) the left side must be either an object (a
 blessed reference) or a class name (that is, a package name).  See
 L<perlobj>.
 
+The right side may also be the name of a lexical subroutine, prefixed
+with the C<&> sigil.  This creates what looks like a lexical method
+invocation, where the method subroutine is resolved lexically instead of
+by name by a search within the packages of the object's class.  This
+resolution happens entirely at compile-time, and performs the same as a
+regular lexical subroutine call at runtime.
+
 The dereferencing cases (as opposed to method-calling cases) are
 somewhat extended by the C<postderef> feature.  For the
 details of that feature, consult L<perlref/Postfix Dereference Syntax>.

t/class/method.t

@@ -89,4 +89,36 @@ no warnings 'experimental::class';
     is(Testcase6->new->forwarded, "OK", 'forward-declared method works');
 }
 
+# methods can be declared lexically
+{
+    class Testcase7 {
+        my method priv {
+            return "private-result";
+        }
+
+        method m { return priv($self); }
+    }
+
+    is(Testcase7->new->m, "private-result", 'lexical method can be declared and called');
+    ok(!Testcase7->can("priv"), 'lexical method does not appear in the symbol table');
+}
+
+# ->& operator can invoke lexical methods
+{
+    class Testcase8 {
+        my method priv {
+            return "private-result";
+        }
+
+        method notpriv {
+        }
+
+        method m_paren { return $self->&priv(); }
+        method m_plain { return $self->&priv; }
+    }
+
+    is(Testcase8->new->m_paren, "private-result", 'lexical method can be invoked with ->&m()');
+    is(Testcase8->new->m_plain, "private-result", 'lexical method can be invoked with ->&m');
+}
+
 done_testing;

t/lib/croak/op

@@ -342,3 +342,15 @@ all length, qw( a b c )
 EXPECT
 syntax error at - line 4, near "all length"
 Execution of - aborted due to compilation errors.
+########
+sub not_lexical { }
+my $obj;
+$obj->&not_lexical();
+EXPECT
+Expected a lexical subroutine reference, found "not_lexical" at - line 3.
+########
+sub not_lexical { }
+my $obj;
+$obj->&not_lexical;
+EXPECT
+Expected a lexical subroutine reference, found "not_lexical" at - line 3.

toke.c

@@ -5959,6 +5959,8 @@ yyl_hyphen(pTHX_ char *s)
             }
             else if (*s == '$')
                 OPERATOR(ARROW);
+            else if (*s == '&')
+                OPERATOR(ARROW);
             else
                 TERM(ARROW);
         }
@@ -7191,7 +7193,11 @@ yyl_my(pTHX_ char *s, I32 my)
         STRLEN len;
         s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
         if (memEQs(PL_tokenbuf, len, "sub"))
+            /* my sub ... */
             return yyl_sub(aTHX_ s, my);
+        if (memEQs(PL_tokenbuf, len, "method"))
+            /* my method ... */
+            return yyl_sub(aTHX_ s, KEY_method);
         PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);
         if (!PL_in_my_stash) {
             char tmpbuf[1024];