S_intuit_more: 'use strict' allows much better handling

Most code these days runs under 'use strict'.  That allows us to resolve
ambiguity without resorting to heuristics in far more cases than before.

This commit adds a parameter to intuit_more() that gives the context it
is being called from.  And when that call is to resolve what $foo[...]
is supposed to mean, we can look up foo to see if it is an array or a
scalar.  If the former, the "..." must be a subscript; if a scalar, it
must be a charclass.

Only if there is both a $foo and an @foo is there ambiguity.  If so, we
drop down to using the heuristics

Author: khwilliamson

embed.fnc

@@ -6082,7 +6082,8 @@ S	|int	|intuit_method	|NN char *s				\
 				|NULLOK SV *ioname			\
 				|NULLOK NOCHECK CV *cv
 S	|int	|intuit_more	|NN char *s				\
-				|NN char *e
+				|NN char *e				\
+				|U8 caller_context
 S	|Size_t |is_existing_identifier 				\
 				|NN char *s				\
 				|NN char *e				\

embed.h

@@ -1684,7 +1684,7 @@
 #     define get_and_check_backslash_N_name_wrapper(a,b) S_get_and_check_backslash_N_name_wrapper(aTHX_ a,b)
 #     define incline(a,b)                       S_incline(aTHX_ a,b)
 #     define intuit_method(a,b,c)               S_intuit_method(aTHX_ a,b,c)
-#     define intuit_more(a,b)                   S_intuit_more(aTHX_ a,b)
+#     define intuit_more(a,b,c)                 S_intuit_more(aTHX_ a,b,c)
 #     define is_existing_identifier(a,b,c,d)    S_is_existing_identifier(aTHX_ a,b,c,d)
 #     define lop(a,b,c,d)                       S_lop(aTHX_ a,b,c,d)
 #     define missingterm(a,b)                   S_missingterm(aTHX_ a,b)

proto.h

@@ -101,6 +101,12 @@ static const char ident_var_zero_multi_digit[] = "Numeric variables with more th
 #define XFAKEEOF   0x40
 #define XFAKEBRACK 0x80
 
+#define FROM_DOLLAR             1
+#define FROM_SNAIL              2
+#define FROM_PERCENT            3
+#define FROM_IDENT              4
+#define FROM_INTERDEPENDMAYBE   5
+
 #ifdef USE_UTF8_SCRIPTS
 #   define UTF cBOOL(!IN_BYTES)
 #else
@@ -4547,7 +4553,7 @@ S_is_existing_identifier(pTHX_ char *s, char *e, char sigil, bool is_utf8)
 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
 
 STATIC int
-S_intuit_more(pTHX_ char *s, char *e)
+S_intuit_more(pTHX_ char *s, char *e, U8 caller_context)
 {
     PERL_ARGS_ASSERT_INTUIT_MORE;
 
@@ -4608,23 +4614,47 @@ S_intuit_more(pTHX_ char *s, char *e)
     if (s[0] == ']' || s[0] == '^')
         return FALSE;
 
-    /* khw: If the context of this call is $foo[...], we may be able to avoid
-     * the heuristics below.  The possibilities are:
-     *  strict    @foo    $foo
-     *   vars?   exists   exists
-     *    y         n       n      This is an error; return false now
-     *    y         n       y      must be a a charclass
-     *    y         y       n      must be a a subscript
-     *    y         y       y      ambiguous; do heuristics below
-     *    n         n       n      ambiguous; do heuristics below
-     *    n         n       y      ambiguous; do heuristics below, but I
-     *                             wonder if the initial bias should be a
-     *                             little towards charclass
-     *    n         y       n      ambiguous; do heuristics below, but I
-     *                             wonder if the initial bias should be a
-     *                             little towards subscript
-     *    n         y       y      ambiguous; do heuristics below
-     */
+
+    /* If the input is of the form '$foo[...', and there is a $foo scalar and
+     * no @foo array, then '...' is more likely to be a character class.
+     * (Under 'strict vars', we know at compile time all the accessible
+     * variables, so in that case it MUST be a character class.)  If the
+     * situation is reversed, it is more likely or must be a subscript */
+    if (    caller_context == FROM_DOLLAR
+        || (caller_context == FROM_INTERDEPENDMAYBE && PL_tokenbuf[0] == '@'))
+    {
+        char * e = PL_tokenbuf + sizeof(PL_tokenbuf) + 1;
+
+        /* See if there is a known scalar for what our caller is asking about.
+         * */
+        bool has_scalar = is_existing_identifier(PL_tokenbuf, e, '$', UTF);
+
+        /* Repeat to see if there is a known array of the given name */
+        bool has_array = is_existing_identifier(PL_tokenbuf, e, '@', UTF);
+
+        unsigned int count = has_scalar + has_array;
+
+        /* Under strict, we need some variable to be declared. */
+        if (PL_hints & HINT_STRICT_VARS) {
+
+            /* If none are, is an error, return false to stop useless further
+             * parsing. */
+            if (count == 0) {
+                return false;
+            }
+
+            /* When just one variable is declared, the construct has to match
+             * what the variable is.  If it is an array, this must be a
+             * subscript which needs further processing; otherwise it is a
+             * character class needing nothing further. */
+            if (count == 1) {
+                return has_array;
+            }
+
+            /* Here have both an array and a scalar with the same name.  Drop
+             * down to use the heuristics to try to intuit which is meant */
+        }
+    }
 
     /* Find matching ']'.  khw: Actually it finds the next ']' and assumes it
      * matches the '['.  In order to account for the possibility of the ']'
@@ -5585,7 +5615,7 @@ yyl_dollar(pTHX_ char *s)
             s = skipspace(s);
 
         if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
-            && intuit_more(s, PL_bufend)) {
+            && intuit_more(s, PL_bufend, FROM_DOLLAR)) {
             if (*s == '[') {
                 PL_tokenbuf[0] = '@';
                 if (ckWARN(WARN_SYNTAX)) {
@@ -6288,7 +6318,7 @@ yyl_percent(pTHX_ char *s)
         PREREF(PERLY_PERCENT_SIGN);
     }
     if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
-        && intuit_more(s, PL_bufend)) {
+        && intuit_more(s, PL_bufend, FROM_PERCENT)) {
         if (*s == '[')
             PL_tokenbuf[0] = '@';
     }
@@ -6910,7 +6940,7 @@ yyl_snail(pTHX_ char *s)
     if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
         s = skipspace(s);
     if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
-        && intuit_more(s, PL_bufend))
+        && intuit_more(s, PL_bufend, FROM_SNAIL))
     {
         if (*s == '{')
             PL_tokenbuf[0] = '%';
@@ -9993,7 +10023,7 @@ Perl_yylex(pTHX)
         return yylex();
 
     case LEX_INTERPENDMAYBE:
-        if (intuit_more(PL_bufptr, PL_bufend)) {
+        if (intuit_more(PL_bufptr, PL_bufend, FROM_INTERDEPENDMAYBE)) {
             PL_lex_state = LEX_INTERPNORMAL;	/* false alarm, more expr */
             break;
         }
@@ -10807,7 +10837,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
     }
     else if (   PL_lex_state == LEX_INTERPNORMAL
              && !PL_lex_brackets
-             && !intuit_more(s, PL_bufend))
+             && !intuit_more(s, PL_bufend, FROM_IDENT))
         PL_lex_state = LEX_INTERPEND;
     return s;
 }