This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Distinguish C- and perly- literals - PERLY_PERCENT_SIGN
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 944e9d3..26f763f 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -238,7 +238,7 @@ static const char* const lex_state_names[] = {
 #define BOop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)BITOROP))
 #define BAop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)BITANDOP))
 #define BCop(f) return pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr = s, \
-                      REPORT('~')
+                      REPORT(PERLY_TILDE)
 #define SHop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)SHIFTOP))
 #define PWop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)POWOP))
 #define PMop(f)  return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
@@ -386,9 +386,23 @@ static struct debug_tokens {
     { OROP,            TOKENTYPE_IVAL,         "OROP" },
     { OROR,            TOKENTYPE_NONE,         "OROR" },
     { PACKAGE,         TOKENTYPE_NONE,         "PACKAGE" },
+    DEBUG_TOKEN (IVAL, PERLY_AMPERSAND),
     DEBUG_TOKEN (IVAL, PERLY_BRACE_CLOSE),
     DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN),
+    DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE),
     DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN),
+    DEBUG_TOKEN (IVAL, PERLY_COLON),
+    DEBUG_TOKEN (IVAL, PERLY_COMMA),
+    DEBUG_TOKEN (IVAL, PERLY_DOT),
+    DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN),
+    DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK),
+    DEBUG_TOKEN (IVAL, PERLY_MINUS),
+    DEBUG_TOKEN (IVAL, PERLY_PERCENT_SIGN),
+    DEBUG_TOKEN (IVAL, PERLY_PLUS),
+    DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK),
+    DEBUG_TOKEN (IVAL, PERLY_SEMICOLON),
+    DEBUG_TOKEN (IVAL, PERLY_SNAIL),
+    DEBUG_TOKEN (IVAL, PERLY_TILDE),
     { PLUGEXPR,                TOKENTYPE_OPVAL,        "PLUGEXPR" },
     { PLUGSTMT,                TOKENTYPE_OPVAL,        "PLUGSTMT" },
     { PMFUNC,          TOKENTYPE_OPVAL,        "PMFUNC" },
@@ -2035,20 +2049,25 @@ S_force_next(pTHX_ I32 type)
 static int
 S_postderef(pTHX_ int const funny, char const next)
 {
-    assert(funny == DOLSHARP || memCHRs("$@%&*", funny));
+    assert(funny == DOLSHARP
+        || memCHRs("$@%&*", funny)
+        || funny == PERLY_SNAIL
+        || funny == PERLY_PERCENT_SIGN
+        || funny == PERLY_AMPERSAND
+    );
     if (next == '*') {
        PL_expect = XOPERATOR;
        if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
-           assert('@' == funny || '$' == funny || DOLSHARP == funny);
+           assert(PERLY_SNAIL == funny || '$' == funny || DOLSHARP == funny);
            PL_lex_state = LEX_INTERPEND;
-           if ('@' == funny)
+           if (PERLY_SNAIL == funny)
                force_next(POSTJOIN);
        }
        force_next(next);
        PL_bufptr+=2;
     }
     else {
-       if ('@' == funny && PL_lex_state == LEX_INTERPNORMAL
+       if (PERLY_SNAIL == funny && PL_lex_state == LEX_INTERPNORMAL
         && !PL_lex_brackets)
            PL_lex_dojoin = 2;
        PL_expect = XOPERATOR;
@@ -2176,8 +2195,8 @@ S_force_ident(pTHX_ const char *s, int kind)
                              (PL_in_eval ? GV_ADDMULTI
                              : GV_ADD) | ( UTF ? SVf_UTF8 : 0 ),
                              kind == '$' ? SVt_PV :
-                             kind == '@' ? SVt_PVAV :
-                             kind == '%' ? SVt_PVHV :
+                             kind == PERLY_SNAIL ? SVt_PVAV :
+                             kind == PERLY_PERCENT_SIGN ? SVt_PVHV :
                              SVt_PVGV
                              );
        }
@@ -4986,7 +5005,12 @@ yyl_sigvar(pTHX_ char *s)
         break;
     }
 
-    TOKEN(sigil);
+    switch (sigil) {
+        case ',': TOKEN (PERLY_COMMA);
+        case '@': TOKEN (PERLY_SNAIL);
+        case '%': TOKEN (PERLY_PERCENT_SIGN);
+        default:  TOKEN (sigil);
+    }
 }
 
 static int
@@ -5395,7 +5419,7 @@ yyl_interpcasemod(pTHX_ char *s)
             PL_lex_starts = 0;
             /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
             if (PL_lex_casemods == 1 && PL_lex_inpat)
-                TOKEN(',');
+                TOKEN(PERLY_COMMA);
             else
                 AopNOASSIGN(OP_CONCAT);
         }
@@ -5536,7 +5560,7 @@ yyl_hyphen(pTHX_ char *s)
         if (memBEGINs(s, (STRLEN) (PL_bufend - s), "=>")) {
             s = force_word(PL_bufptr,BAREWORD,FALSE,FALSE);
             DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } );
-            OPERATOR('-');              /* unary minus */
+            OPERATOR(PERLY_MINUS);              /* unary minus */
         }
         switch (tmp) {
         case 'r': ftst = OP_FTEREAD;    break;
@@ -5637,7 +5661,7 @@ yyl_hyphen(pTHX_ char *s)
         else {
             if (isSPACE(*s) || !isSPACE(*PL_bufptr))
                 check_uni();
-            OPERATOR('-');              /* unary minus */
+            OPERATOR(PERLY_MINUS);              /* unary minus */
         }
     }
 }
@@ -5666,7 +5690,7 @@ yyl_plus(pTHX_ char *s)
     else {
         if (isSPACE(*s) || !isSPACE(*PL_bufptr))
             check_uni();
-        OPERATOR('+');
+        OPERATOR(PERLY_PLUS);
     }
 }
 
@@ -5722,13 +5746,13 @@ yyl_percent(pTHX_ char *s)
         Mop(OP_MODULO);
     }
     else if (PL_expect == XPOSTDEREF)
-        POSTDEREF('%');
+        POSTDEREF(PERLY_PERCENT_SIGN);
 
     PL_tokenbuf[0] = '%';
     s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
     pl_yylval.ival = 0;
     if (!PL_tokenbuf[1]) {
-        PREREF('%');
+        PREREF(PERLY_PERCENT_SIGN);
     }
     if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
         && intuit_more(s, PL_bufend)) {
@@ -5737,7 +5761,7 @@ yyl_percent(pTHX_ char *s)
     }
     PL_expect = XOPERATOR;
     force_ident_maybe_lex('%');
-    TERM('%');
+    TERM(PERLY_PERCENT_SIGN);
 }
 
 static int
@@ -5899,7 +5923,7 @@ yyl_colon(pTHX_ char *s)
                       : "Unterminated attribute list" ) );
             if (attrs)
                 op_free(attrs);
-            OPERATOR(':');
+            OPERATOR(PERLY_COLON);
         }
 
     got_attrs:
@@ -5924,7 +5948,7 @@ yyl_colon(pTHX_ char *s)
     }
 
     PL_lex_allbrackets--;
-    OPERATOR(':');
+    OPERATOR(PERLY_COLON);
 }
 
 static int
@@ -6017,7 +6041,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack)
                 const char minus = (PL_tokenbuf[0] == '-');
                 s = force_word(s + minus, BAREWORD, FALSE, TRUE);
                 if (minus)
-                    force_next('-');
+                    force_next(PERLY_MINUS);
             }
         }
         /* FALLTHROUGH */
@@ -6183,7 +6207,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack)
 
     pl_yylval.ival = CopLINE(PL_curcop);
     PL_copline = NOLINE;   /* invalidate current command line number */
-    TOKEN(formbrack ? '=' : PERLY_BRACE_OPEN);
+    TOKEN(formbrack ? PERLY_EQUAL_SIGN : PERLY_BRACE_OPEN);
 }
 
 static int
@@ -6224,21 +6248,21 @@ yyl_rightcurly(pTHX_ char *s, const U8 formbrack)
         return yylex();                /* ignore fake brackets */
     }
 
-    force_next(formbrack ? '.' : PERLY_BRACE_CLOSE);
+    force_next(formbrack ? PERLY_DOT : PERLY_BRACE_CLOSE);
     if (formbrack) LEAVE_with_name("lex_format");
     if (formbrack == 2) { /* means . where arguments were expected */
-        force_next(';');
+        force_next(PERLY_SEMICOLON);
         TOKEN(FORMRBRACK);
     }
 
-    TOKEN(';');
+    TOKEN(PERLY_SEMICOLON);
 }
 
 static int
 yyl_ampersand(pTHX_ char *s)
 {
     if (PL_expect == XPOSTDEREF)
-        POSTDEREF('&');
+        POSTDEREF(PERLY_AMPERSAND);
 
     s++;
     if (*s++ == '&') {
@@ -6284,9 +6308,9 @@ yyl_ampersand(pTHX_ char *s)
     if (PL_tokenbuf[1])
         force_ident_maybe_lex('&');
     else
-        PREREF('&');
+        PREREF(PERLY_AMPERSAND);
 
-    TERM('&');
+    TERM(PERLY_AMPERSAND);
 }
 
 static int
@@ -6353,14 +6377,14 @@ yyl_bang(pTHX_ char *s)
         PMop(OP_NOT);
 
     s--;
-    OPERATOR('!');
+    OPERATOR(PERLY_EXCLAMATION_MARK);
 }
 
 static int
 yyl_snail(pTHX_ char *s)
 {
     if (PL_expect == XPOSTDEREF)
-        POSTDEREF('@');
+        POSTDEREF(PERLY_SNAIL);
     PL_tokenbuf[0] = '@';
     s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
     if (PL_expect == XOPERATOR) {
@@ -6373,7 +6397,7 @@ yyl_snail(pTHX_ char *s)
     }
     pl_yylval.ival = 0;
     if (!PL_tokenbuf[1]) {
-        PREREF('@');
+        PREREF(PERLY_SNAIL);
     }
     if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
         s = skipspace(s);
@@ -6392,7 +6416,7 @@ yyl_snail(pTHX_ char *s)
     }
     PL_expect = XOPERATOR;
     force_ident_maybe_lex('@');
-    TERM('@');
+    TERM(PERLY_SNAIL);
 }
 
 static int
@@ -6459,7 +6483,7 @@ yyl_rightsquare(pTHX_ char *s)
                 PL_lex_state = LEX_INTERPEND;
         }
     }
-    TERM(']');
+    TERM(PERLY_BRACKET_CLOSE);
 }
 
 static int
@@ -6968,7 +6992,7 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s)
         if (!lex_next_chunk(fake_eof)) {
             CopLINE_dec(PL_curcop);
             s = PL_bufptr;
-            TOKEN(';');        /* not infinite loop because rsfp is NULL now */
+            TOKEN(PERLY_SEMICOLON);    /* not infinite loop because rsfp is NULL now */
         }
         CopLINE_dec(PL_curcop);
         s = PL_bufptr;
@@ -7209,7 +7233,7 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s)
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
         PL_lex_state = LEX_FORMLINE;
         force_next(FORMRBRACK);
-        TOKEN(';');
+        TOKEN(PERLY_SEMICOLON);
     }
 
     PL_bufptr = s;
@@ -7510,7 +7534,7 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c)
              op_free(pl_yylval.opval), force_next(PRIVATEREF);
         else op_free(c.rv2cv_op),      force_next(BAREWORD);
         pl_yylval.ival = 0;
-        TOKEN('&');
+        TOKEN(PERLY_AMPERSAND);
     }
 
     /* If followed by var or block, call it a method (unless sub) */
@@ -8782,7 +8806,7 @@ yyl_try(pTHX_ char *s)
     case '\n': {
         const bool needs_semicolon = yyl_eol_needs_semicolon(aTHX_ &s);
         if (needs_semicolon)
-            TOKEN(';');
+            TOKEN(PERLY_SEMICOLON);
         else
             goto retry;
     }
@@ -8812,7 +8836,7 @@ yyl_try(pTHX_ char *s)
        if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
            TOKEN(0);
        s++;
-       OPERATOR(',');
+       OPERATOR(PERLY_COMMA);
     case ':':
        if (s[1] == ':')
             return yyl_just_a_word(aTHX_ s, 0, 0, no_code);
@@ -8827,7 +8851,7 @@ yyl_try(pTHX_ char *s)
        CLINE;
        s++;
        PL_expect = XSTATE;
-       TOKEN(';');
+       TOKEN(PERLY_SEMICOLON);
 
     case ')':
         return yyl_rightparen(aTHX_ s);
@@ -8876,7 +8900,7 @@ yyl_try(pTHX_ char *s)
                    s -= 2;
                    TOKEN(0);
                }
-               OPERATOR(',');
+               OPERATOR(PERLY_COMMA);
            }
            if (tmp == '~')
                PMop(OP_MATCH);
@@ -8940,7 +8964,7 @@ yyl_try(pTHX_ char *s)
        pl_yylval.ival = 0;
        OPERATOR(ASSIGNOP);
 
-    case '!':
+        case '!':
         return yyl_bang(aTHX_ s + 1);
 
     case '<':
@@ -8979,7 +9003,7 @@ yyl_try(pTHX_ char *s)
            TOKEN(0);
        }
        PL_lex_allbrackets++;
-       OPERATOR('?');
+       OPERATOR(PERLY_QUESTION_MARK);
 
     case '.':
        if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
@@ -9262,7 +9286,7 @@ Perl_yylex(pTHX)
        PL_lex_state = LEX_INTERPNORMAL;
        if (PL_lex_dojoin) {
            NEXTVAL_NEXTTOKE.ival = 0;
-           force_next(',');
+           force_next(PERLY_COMMA);
            force_ident("\"", '$');
            NEXTVAL_NEXTTOKE.ival = 0;
            force_next('$');
@@ -9285,7 +9309,7 @@ Perl_yylex(pTHX)
            s = PL_bufptr;
            /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
            if (!PL_lex_casemods && PL_lex_inpat)
-               TOKEN(',');
+               TOKEN(PERLY_COMMA);
            else
                AopNOASSIGN(OP_CONCAT);
        }
@@ -9340,7 +9364,7 @@ Perl_yylex(pTHX)
            force_next(THING);
            PL_parser->lex_shared->re_eval_start = NULL;
            PL_expect = XTERM;
-           return REPORT(',');
+           return REPORT(PERLY_COMMA);
        }
 
        /* FALLTHROUGH */
@@ -9384,7 +9408,7 @@ Perl_yylex(pTHX)
            if (PL_lex_starts++) {
                /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
                if (!PL_lex_casemods && PL_lex_inpat)
-                   TOKEN(',');
+                   TOKEN(PERLY_COMMA);
                else
                    AopNOASSIGN(OP_CONCAT);
            }
@@ -12265,7 +12289,7 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
      * processing unconditionally */
 
     if (s != NULL) {
-        if (!yychar || (yychar == ';' && !PL_rsfp))
+        if (!yychar || (yychar == PERLY_SEMICOLON && !PL_rsfp))
             sv_catpvs(where_sv, "at EOF");
         else if (   PL_oldoldbufptr
                  && PL_bufptr > PL_oldoldbufptr
Unnamed repository; edit this file 'description' to name the repository.