Automatic date update in version.in
[binutils-gdb/blckswan.git] / gdb / ada-lex.l
blob33a08eaa93b8cb1b30a1915da5e82feeda5f815f
1 /* FLEX lexer for Ada expressions, for GDB. -*- c++ -*-
2    Copyright (C) 1994-2022 Free Software Foundation, Inc.
4    This file is part of GDB.
6    This program is free software; you can redistribute it and/or modify
7    it under the terms of the GNU General Public License as published by
8    the Free Software Foundation; either version 3 of the License, or
9    (at your option) any later version.
11    This program is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14    GNU General Public License for more details.
16    You should have received a copy of the GNU General Public License
17    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 /*----------------------------------------------------------------------*/
21 /* The converted version of this file is to be included in ada-exp.y, */
22 /* the Ada parser for gdb.  The function yylex obtains characters from */
23 /* the global pointer lexptr.  It returns a syntactic category for */
24 /* each successive token and places a semantic value into yylval */
25 /* (ada-lval), defined by the parser.   */
27 DIG     [0-9]
28 NUM10   ({DIG}({DIG}|_)*)
29 HEXDIG  [0-9a-f]
30 NUM16   ({HEXDIG}({HEXDIG}|_)*)
31 OCTDIG  [0-7]
32 LETTER  [a-z_]
33 ID      ({LETTER}({LETTER}|{DIG}|[\x80-\xff])*|"<"{LETTER}({LETTER}|{DIG})*">")
34 WHITE   [ \t\n]
35 TICK    ("'"{WHITE}*)
36 GRAPHIC [a-z0-9 #&'()*+,-./:;<>=_|!$%?@\[\]\\^`{}~]
37 OPER    ([-+*/=<>&]|"<="|">="|"**"|"/="|"and"|"or"|"xor"|"not"|"mod"|"rem"|"abs")
39 EXP     (e[+-]{NUM10})
40 POSEXP  (e"+"?{NUM10})
42 /* This must agree with COMPLETION_CHAR below.  See the comment there
43    for the explanation.  */
44 COMPLETE "\001"
45 NOT_COMPLETE [^\001]
49 #include "diagnostics.h"
51 /* Some old versions of flex generate code that uses the "register" keyword,
52    which clang warns about.  This was observed for example with flex 2.5.35,
53    as shipped with macOS 10.12.  The same happens with flex 2.5.37 and g++ 11
54    which defaults to ISO C++17, that does not allow register storage class
55    specifiers.  */
56 DIAGNOSTIC_PUSH
57 DIAGNOSTIC_IGNORE_DEPRECATED_REGISTER
59 #define NUMERAL_WIDTH 256
60 #define LONGEST_SIGN ((ULONGEST) 1 << (sizeof(LONGEST) * HOST_CHAR_BIT - 1))
62 /* Temporary staging for numeric literals.  */
63 static char numbuf[NUMERAL_WIDTH];
64  static void canonicalizeNumeral (char *s1, const char *);
65 static struct stoken processString (const char*, int);
66 static int processInt (struct parser_state *, const char *, const char *,
67                        const char *);
68 static int processReal (struct parser_state *, const char *);
69 static struct stoken processId (const char *, int);
70 static int processAttribute (const char *);
71 static int find_dot_all (const char *);
72 static void rewind_to_char (int);
74 #undef YY_DECL
75 #define YY_DECL static int yylex ( void )
77 /* Flex generates a static function "input" which is not used.
78    Defining YY_NO_INPUT comments it out.  */
79 #define YY_NO_INPUT
81 /* When completing, we'll return a special character at the end of the
82    input, to signal the completion position to the lexer.  This is
83    done because flex does not have a generally useful way to detect
84    EOF in a pattern.  This variable records whether the special
85    character has been emitted.  */
86 static bool returned_complete = false;
88 /* The character we use to represent the completion point.  */
89 #define COMPLETE_CHAR '\001'
91 #undef YY_INPUT
92 #define YY_INPUT(BUF, RESULT, MAX_SIZE)                                 \
93   if ( *pstate->lexptr == '\000' )                                      \
94     {                                                                   \
95       if (pstate->parse_completion && !returned_complete)               \
96         {                                                               \
97           returned_complete = true;                                     \
98           *(BUF) = COMPLETE_CHAR;                                       \
99           (RESULT) = 1;                                                 \
100         }                                                               \
101       else                                                              \
102         (RESULT) = YY_NULL;                                             \
103     }                                                                   \
104   else                                                                  \
105     {                                                                   \
106       *(BUF) = *pstate->lexptr == COMPLETE_CHAR ? ' ' : *pstate->lexptr; \
107       (RESULT) = 1;                                                     \
108       pstate->lexptr += 1;                                              \
109     }
111 /* Depth of parentheses.  */
112 static int paren_depth;
116 %option case-insensitive interactive nodefault noyywrap
118 %s BEFORE_QUAL_QUOTE
122 {WHITE}          { }
124 "--".*           { yyterminate(); }
126 {NUM10}{POSEXP}  {
127                    canonicalizeNumeral (numbuf, yytext);
128                    char *e_ptr = strrchr (numbuf, 'e');
129                    *e_ptr = '\0';
130                    return processInt (pstate, nullptr, numbuf, e_ptr + 1);
131                  }
133 {NUM10}          {
134                    canonicalizeNumeral (numbuf, yytext);
135                    return processInt (pstate, NULL, numbuf, NULL);
136                  }
138 {NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#"{POSEXP} {
139                    canonicalizeNumeral (numbuf, yytext);
140                    char *e_ptr = strrchr (numbuf, 'e');
141                    *e_ptr = '\0';
142                    return processInt (pstate, numbuf,
143                                       strchr (numbuf, '#') + 1,
144                                       e_ptr + 1);
145                  }
147         /* The "llf" is a gdb extension to allow a floating-point
148            constant to be written in some other base.  The
149            floating-point number is formed by reinterpreting the
150            bytes, allowing direct control over the bits.  */
151 {NUM10}(l{0,2}f)?"#"{HEXDIG}({HEXDIG}|_)*"#" {
152                    canonicalizeNumeral (numbuf, yytext);
153                    return processInt (pstate, numbuf, strchr (numbuf, '#') + 1,
154                                       NULL);
155                  }
157 "0x"{HEXDIG}+   {
158                   canonicalizeNumeral (numbuf, yytext+2);
159                   return processInt (pstate, "16#", numbuf, NULL);
160                 }
163 {NUM10}"."{NUM10}{EXP} {
164                    canonicalizeNumeral (numbuf, yytext);
165                    return processReal (pstate, numbuf);
166                 }
168 {NUM10}"."{NUM10} {
169                    canonicalizeNumeral (numbuf, yytext);
170                    return processReal (pstate, numbuf);
171                 }
173 {NUM10}"#"{NUM16}"."{NUM16}"#"{EXP} {
174                    error (_("Based real literals not implemented yet."));
175                 }
177 {NUM10}"#"{NUM16}"."{NUM16}"#" {
178                    error (_("Based real literals not implemented yet."));
179                 }
181 <INITIAL>"'"({GRAPHIC}|\")"'" {
182                    yylval.typed_val.val = yytext[1];
183                    yylval.typed_val.type = type_for_char (pstate, yytext[1]);
184                    return CHARLIT;
185                 }
187 <INITIAL>"'[\""{HEXDIG}{2,}"\"]'"   {
188                    ULONGEST v = strtoulst (yytext+3, nullptr, 16);
189                    yylval.typed_val.val = v;
190                    yylval.typed_val.type = type_for_char (pstate, v);
191                    return CHARLIT;
192                 }
194         /* Note that we don't handle bracket sequences of more than 2
195            digits here.  Currently there's no support for wide or
196            wide-wide strings.  */
197 \"({GRAPHIC}|"[\""({HEXDIG}{2,}|\")"\"]")*\"   {
198                    yylval.sval = processString (yytext+1, yyleng-2);
199                    return STRING;
200                 }
202 \"              {
203                    error (_("ill-formed or non-terminated string literal"));
204                 }
207 if              {
208                   rewind_to_char ('i');
209                   return 0;
210                 }
212 task            {
213                   rewind_to_char ('t');
214                   return 0;
215                 }
217 thread{WHITE}+{DIG} {
218                   /* This keyword signals the end of the expression and
219                      will be processed separately.  */
220                   rewind_to_char ('t');
221                   return 0;
222                 }
224         /* ADA KEYWORDS */
226 abs             { return ABS; }
227 and             { return _AND_; }
228 else            { return ELSE; }
229 in              { return IN; }
230 mod             { return MOD; }
231 new             { return NEW; }
232 not             { return NOT; }
233 null            { return NULL_PTR; }
234 or              { return OR; }
235 others          { return OTHERS; }
236 rem             { return REM; }
237 then            { return THEN; }
238 xor             { return XOR; }
240         /* BOOLEAN "KEYWORDS" */
242  /* True and False are not keywords in Ada, but rather enumeration constants.
243     However, the boolean type is no longer represented as an enum, so True
244     and False are no longer defined in symbol tables.  We compromise by
245     making them keywords (when bare). */
247 true            { return TRUEKEYWORD; }
248 false           { return FALSEKEYWORD; }
250         /* ATTRIBUTES */
252 {TICK}([a-z][a-z_]*)?{COMPLETE}? { BEGIN INITIAL; return processAttribute (yytext); }
254         /* PUNCTUATION */
256 "=>"            { return ARROW; }
257 ".."            { return DOTDOT; }
258 "**"            { return STARSTAR; }
259 ":="            { return ASSIGN; }
260 "/="            { return NOTEQUAL; }
261 "<="            { return LEQ; }
262 ">="            { return GEQ; }
264 <BEFORE_QUAL_QUOTE>"'"/{NOT_COMPLETE} { BEGIN INITIAL; return '\''; }
266 [-&*+{}@/:<>=|;\[\]] { return yytext[0]; }
268 ","             { if (paren_depth == 0 && pstate->comma_terminates)
269                     {
270                       rewind_to_char (',');
271                       return 0;
272                     }
273                   else
274                     return ',';
275                 }
277 "("             { paren_depth += 1; return '('; }
278 ")"             { if (paren_depth == 0)
279                     {
280                       rewind_to_char (')');
281                       return 0;
282                     }
283                   else
284                     {
285                       paren_depth -= 1;
286                       return ')';
287                     }
288                 }
290 "."{WHITE}*{ID}{COMPLETE}? {
291                   yylval.sval = processId (yytext+1, yyleng-1);
292                   if (yytext[yyleng - 1] == COMPLETE_CHAR)
293                     return DOT_COMPLETE;
294                   return DOT_ID;
295                 }
297 "."{WHITE}*{COMPLETE} {
298                   yylval.sval.ptr = "";
299                   yylval.sval.length = 0;
300                   return DOT_COMPLETE;
301                 }
303 {ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*(" "*"'"|{COMPLETE})?  {
304                   int all_posn = find_dot_all (yytext);
306                   if (all_posn == -1 && yytext[yyleng-1] == '\'')
307                     {
308                       BEGIN BEFORE_QUAL_QUOTE;
309                       yyless (yyleng-1);
310                     }
311                   else if (all_posn >= 0)
312                     yyless (all_posn);
313                   bool is_completion = yytext[yyleng - 1] == COMPLETE_CHAR;
314                   yylval.sval = processId (yytext, yyleng);
315                   return is_completion ? NAME_COMPLETE : NAME;
316                }
319         /* GDB EXPRESSION CONSTRUCTS  */
321 "'"[^']+"'"{WHITE}*:: {
322                   yyless (yyleng - 2);
323                   yylval.sval = processId (yytext, yyleng);
324                   return NAME;
325                 }
327 "::"            { return COLONCOLON; }
329         /* REGISTERS AND GDB CONVENIENCE VARIABLES */
331 "$"({LETTER}|{DIG}|"$")*  {
332                   yylval.sval.ptr = yytext;
333                   yylval.sval.length = yyleng;
334                   return DOLLAR_VARIABLE;
335                 }
337         /* CATCH-ALL ERROR CASE */
339 .               { error (_("Invalid character '%s' in expression."), yytext); }
342 #include <ctype.h>
343 /* Initialize the lexer for processing new expression. */
345 static void
346 lexer_init (FILE *inp)
348   BEGIN INITIAL;
349   paren_depth = 0;
350   returned_complete = false;
351   yyrestart (inp);
355 /* Copy S2 to S1, removing all underscores, and downcasing all letters.  */
357 static void
358 canonicalizeNumeral (char *s1, const char *s2)
360   for (; *s2 != '\000'; s2 += 1)
361     {
362       if (*s2 != '_')
363         {
364           *s1 = tolower(*s2);
365           s1 += 1;
366         }
367     }
368   s1[0] = '\000';
371 /* Interprets the prefix of NUM that consists of digits of the given BASE
372    as an integer of that BASE, with the string EXP as an exponent.
373    Puts value in yylval, and returns INT, if the string is valid.  Causes
374    an error if the number is improperly formated.   BASE, if NULL, defaults
375    to "10", and EXP to "1".  The EXP does not contain a leading 'e' or 'E'.
376  */
378 static int
379 processInt (struct parser_state *par_state, const char *base0,
380             const char *num0, const char *exp0)
382   long exp;
383   int base;
384   /* For the based literal with an "f" prefix, we'll return a
385      floating-point number.  This counts the the number of "l"s seen,
386      to decide the width of the floating-point number to return.  -1
387      means no "f".  */
388   int floating_point_l_count = -1;
390   if (base0 == NULL)
391     base = 10;
392   else
393     {
394       char *end_of_base;
395       base = strtol (base0, &end_of_base, 10);
396       if (base < 2 || base > 16)
397         error (_("Invalid base: %d."), base);
398       while (*end_of_base == 'l')
399         {
400           ++floating_point_l_count;
401           ++end_of_base;
402         }
403       /* This assertion is ensured by the pattern.  */
404       gdb_assert (floating_point_l_count == -1 || *end_of_base == 'f');
405       if (*end_of_base == 'f')
406         {
407           ++end_of_base;
408           ++floating_point_l_count;
409         }
410       /* This assertion is ensured by the pattern.  */
411       gdb_assert (*end_of_base == '#');
412     }
414   if (exp0 == NULL)
415     exp = 0;
416   else
417     exp = strtol(exp0, (char **) NULL, 10);
419   gdb_mpz result;
420   while (isxdigit (*num0))
421     {
422       int dig = fromhex (*num0);
423       if (dig >= base)
424         error (_("Invalid digit `%c' in based literal"), *num0);
425       mpz_mul_ui (result.val, result.val, base);
426       mpz_add_ui (result.val, result.val, dig);
427       ++num0;
428     }
430   while (exp > 0)
431     {
432       mpz_mul_ui (result.val, result.val, base);
433       exp -= 1;
434     }
436   if (floating_point_l_count > -1)
437     {
438       struct type *fp_type;
439       if (floating_point_l_count == 0)
440         fp_type = language_lookup_primitive_type (par_state->language (),
441                                                   par_state->gdbarch (),
442                                                   "float");
443       else if (floating_point_l_count == 1)
444         fp_type = language_lookup_primitive_type (par_state->language (),
445                                                   par_state->gdbarch (),
446                                                   "long_float");
447       else
448         {
449           /* This assertion is ensured by the pattern.  */
450           gdb_assert (floating_point_l_count == 2);
451           fp_type = language_lookup_primitive_type (par_state->language (),
452                                                     par_state->gdbarch (),
453                                                     "long_long_float");
454         }
456       yylval.typed_val_float.type = fp_type;
457       result.write (gdb::make_array_view (yylval.typed_val_float.val,
458                                           TYPE_LENGTH (fp_type)),
459                     type_byte_order (fp_type),
460                     true);
462       return FLOAT;
463     }
465   gdb_mpz maxval (ULONGEST_MAX);
466   if (mpz_cmp (result.val, maxval.val) > 0)
467     error (_("Integer literal out of range"));
469   ULONGEST value = result.as_integer<ULONGEST> ();
470   if ((value >> (gdbarch_int_bit (par_state->gdbarch ())-1)) == 0)
471     yylval.typed_val.type = type_int (par_state);
472   else if ((value >> (gdbarch_long_bit (par_state->gdbarch ())-1)) == 0)
473     yylval.typed_val.type = type_long (par_state);
474   else if (((value >> (gdbarch_long_bit (par_state->gdbarch ())-1)) >> 1) == 0)
475     {
476       /* We have a number representable as an unsigned integer quantity.
477          For consistency with the C treatment, we will treat it as an
478          anonymous modular (unsigned) quantity.  Alas, the types are such
479          that we need to store .val as a signed quantity.  Sorry
480          for the mess, but C doesn't officially guarantee that a simple
481          assignment does the trick (no, it doesn't; read the reference manual).
482        */
483       yylval.typed_val.type
484         = builtin_type (par_state->gdbarch ())->builtin_unsigned_long;
485       if (value & LONGEST_SIGN)
486         yylval.typed_val.val =
487           (LONGEST) (value & ~LONGEST_SIGN)
488           - (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
489       else
490         yylval.typed_val.val = (LONGEST) value;
491       return INT;
492     }
493   else
494     yylval.typed_val.type = type_long_long (par_state);
496   yylval.typed_val.val = value;
497   return INT;
500 static int
501 processReal (struct parser_state *par_state, const char *num0)
503   yylval.typed_val_float.type = type_long_double (par_state);
505   bool parsed = parse_float (num0, strlen (num0),
506                              yylval.typed_val_float.type,
507                              yylval.typed_val_float.val);
508   gdb_assert (parsed);
509   return FLOAT;
513 /* Store a canonicalized version of NAME0[0..LEN-1] in yylval.ssym.  The
514    resulting string is valid until the next call to ada_parse.  If
515    NAME0 contains the substring "___", it is assumed to be already
516    encoded and the resulting name is equal to it.  Similarly, if the name
517    starts with '<', it is copied verbatim.  Otherwise, it differs
518    from NAME0 in that:
519     + Characters between '...' are transfered verbatim to yylval.ssym.
520     + Trailing "'" characters in quoted sequences are removed (a leading quote is
521       preserved to indicate that the name is not to be GNAT-encoded).
522     + Unquoted whitespace is removed.
523     + Unquoted alphabetic characters are mapped to lower case.
524    Result is returned as a struct stoken, but for convenience, the string
525    is also null-terminated.  Result string valid until the next call of
526    ada_parse.
527  */
528 static struct stoken
529 processId (const char *name0, int len)
531   char *name = (char *) obstack_alloc (&temp_parse_space, len + 11);
532   int i0, i;
533   struct stoken result;
535   result.ptr = name;
536   while (len > 0 && isspace (name0[len-1]))
537     len -= 1;
539   if (name0[0] == '<' || strstr (name0, "___") != NULL)
540     {
541       strncpy (name, name0, len);
542       name[len] = '\000';
543       result.length = len;
544       return result;
545     }
547   bool in_quotes = false;
548   i = i0 = 0;
549   while (i0 < len)
550     {
551       if (name0[i0] == COMPLETE_CHAR)
552         {
553           /* Just ignore.  */
554           ++i0;
555         }
556       else if (in_quotes)
557         name[i++] = name0[i0++];
558       else if (isalnum (name0[i0]))
559         {
560           name[i] = tolower (name0[i0]);
561           i += 1; i0 += 1;
562         }
563       else if (isspace (name0[i0]))
564         i0 += 1;
565       else if (name0[i0] == '\'')
566         {
567           /* Copy the starting quote, but not the ending quote.  */
568           if (!in_quotes)
569             name[i++] = name0[i0++];
570           in_quotes = !in_quotes;
571         }
572       else
573         name[i++] = name0[i0++];
574     }
575   name[i] = '\000';
577   result.length = i;
578   return result;
581 /* Return TEXT[0..LEN-1], a string literal without surrounding quotes,
582    with special hex character notations replaced with characters. 
583    Result valid until the next call to ada_parse.  */
585 static struct stoken
586 processString (const char *text, int len)
588   const char *p;
589   char *q;
590   const char *lim = text + len;
591   struct stoken result;
593   q = (char *) obstack_alloc (&temp_parse_space, len);
594   result.ptr = q;
595   p = text;
596   while (p < lim)
597     {
598       if (p[0] == '[' && p[1] == '"' && p+2 < lim)
599          {
600            if (p[2] == '"')  /* "...["""]... */
601              {
602                *q = '"';
603                p += 4;
604              }
605            else
606              {
607                const char *end;
608                ULONGEST chr = strtoulst (p + 2, &end, 16);
609                if (chr > 0xff)
610                  error (_("wide strings are not yet supported"));
611                *q = (char) chr;
612                p = end + 1;
613              }
614          }
615        else
616          *q = *p;
617        q += 1;
618        p += 1;
619      }
620   result.length = q - result.ptr;
621   return result;
624 /* Returns the position within STR of the '.' in a
625    '.{WHITE}*all' component of a dotted name, or -1 if there is none.
626    Note: we actually don't need this routine, since 'all' can never be an
627    Ada identifier.  Thus, looking up foo.all or foo.all.x as a name
628    must fail, and will eventually be interpreted as (foo).all or
629    (foo).all.x.  However, this does avoid an extraneous lookup. */
631 static int
632 find_dot_all (const char *str)
634   int i;
636   for (i = 0; str[i] != '\000'; i++)
637     if (str[i] == '.')
638       {
639         int i0 = i;
641         do
642           i += 1;
643         while (isspace (str[i]));
645         if (strncasecmp (str + i, "all", 3) == 0
646             && !isalnum (str[i + 3]) && str[i + 3] != '_')
647           return i0;
648       }
649   return -1;
652 /* Returns non-zero iff string SUBSEQ matches a subsequence of STR, ignoring
653    case.  */
655 static int
656 subseqMatch (const char *subseq, const char *str)
658   if (subseq[0] == '\0')
659     return 1;
660   else if (str[0] == '\0')
661     return 0;
662   else if (tolower (subseq[0]) == tolower (str[0]))
663     return subseqMatch (subseq+1, str+1) || subseqMatch (subseq, str+1);
664   else
665     return subseqMatch (subseq, str+1);
669 static struct { const char *name; int code; }
670 attributes[] = {
671   { "address", TICK_ADDRESS },
672   { "unchecked_access", TICK_ACCESS },
673   { "unrestricted_access", TICK_ACCESS },
674   { "access", TICK_ACCESS },
675   { "first", TICK_FIRST },
676   { "last", TICK_LAST },
677   { "length", TICK_LENGTH },
678   { "max", TICK_MAX },
679   { "min", TICK_MIN },
680   { "modulus", TICK_MODULUS },
681   { "pos", TICK_POS },
682   { "range", TICK_RANGE },
683   { "size", TICK_SIZE },
684   { "tag", TICK_TAG },
685   { "val", TICK_VAL },
688 /* Return the syntactic code corresponding to the attribute name or
689    abbreviation STR.  */
691 static int
692 processAttribute (const char *str)
694   gdb_assert (*str == '\'');
695   ++str;
696   while (isspace (*str))
697     ++str;
699   int len = strlen (str);
700   if (len > 0 && str[len - 1] == COMPLETE_CHAR)
701     {
702       /* This is enforced by YY_INPUT.  */
703       gdb_assert (pstate->parse_completion);
704       yylval.sval.ptr = obstack_strndup (&temp_parse_space, str, len - 1);
705       yylval.sval.length = len - 1;
706       return TICK_COMPLETE;
707     }
709   for (const auto &item : attributes)
710     if (strcasecmp (str, item.name) == 0)
711       return item.code;
713   gdb::optional<int> found;
714   for (const auto &item : attributes)
715     if (subseqMatch (str, item.name))
716       {
717         if (!found.has_value ())
718           found = item.code;
719         else
720           error (_("ambiguous attribute name: `%s'"), str);
721       }
722   if (!found.has_value ())
723     error (_("unrecognized attribute: `%s'"), str);
725   return *found;
728 bool
729 ada_tick_completer::complete (struct expression *exp,
730                               completion_tracker &tracker)
732   completion_list output;
733   for (const auto &item : attributes)
734     {
735       if (strncasecmp (item.name, m_name.c_str (), m_name.length ()) == 0)
736         output.emplace_back (xstrdup (item.name));
737     }
738   tracker.add_completions (std::move (output));
739   return true;
742 /* Back up lexptr by yyleng and then to the rightmost occurrence of
743    character CH, case-folded (there must be one).  WARNING: since
744    lexptr points to the next input character that Flex has not yet
745    transferred to its internal buffer, the use of this function
746    depends on the assumption that Flex calls YY_INPUT only when it is
747    logically necessary to do so (thus, there is no reading ahead
748    farther than needed to identify the next token.)  */
750 static void
751 rewind_to_char (int ch)
753   pstate->lexptr -= yyleng;
754   while (toupper (*pstate->lexptr) != toupper (ch))
755     pstate->lexptr -= 1;
756   yyrestart (NULL);
759 /* Dummy definition to suppress warnings about unused static definitions. */
760 typedef void (*dummy_function) ();
761 dummy_function ada_flex_use[] = 
763   (dummy_function) yyunput
766 DIAGNOSTIC_POP