Centralize yacc interface names remapping (yyparse, yylex, yyerror, etc)
[external/binutils.git] / gdb / d-exp.y
1 /* YACC parser for D expressions, for GDB.
2
3    Copyright (C) 2014-2016 Free Software Foundation, Inc.
4
5    This file is part of GDB.
6
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19
20 /* This file is derived from c-exp.y, jv-exp.y.  */
21
22 /* Parse a D expression from text in a string,
23    and return the result as a struct expression pointer.
24    That structure contains arithmetic operations in reverse polish,
25    with constants represented by operations that are followed by special data.
26    See expression.h for the details of the format.
27    What is important here is that it can be built up sequentially
28    during the process of parsing; the lower levels of the tree always
29    come first in the result.
30
31    Note that malloc's and realloc's in this file are transformed to
32    xmalloc and xrealloc respectively by the same sed command in the
33    makefile that remaps any other malloc/realloc inserted by the parser
34    generator.  Doing this with #defines and trying to control the interaction
35    with include files (<malloc.h> and <stdlib.h> for example) just became
36    too messy, particularly when such includes can be inserted at random
37    times by the parser generator.  */
38
39 %{
40
41 #include "defs.h"
42 #include <ctype.h>
43 #include "expression.h"
44 #include "value.h"
45 #include "parser-defs.h"
46 #include "language.h"
47 #include "c-lang.h"
48 #include "d-lang.h"
49 #include "bfd.h" /* Required by objfiles.h.  */
50 #include "symfile.h" /* Required by objfiles.h.  */
51 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
52 #include "charset.h"
53 #include "block.h"
54
55 #define parse_type(ps) builtin_type (parse_gdbarch (ps))
56 #define parse_d_type(ps) builtin_d_type (parse_gdbarch (ps))
57
58 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
59    etc).  */
60 #define GDB_YY_REMAP_PREFIX d_
61 #include "yy-remap.h"
62
63 /* The state of the parser, used internally when we are parsing the
64    expression.  */
65
66 static struct parser_state *pstate = NULL;
67
68 int yyparse (void);
69
70 static int yylex (void);
71
72 void yyerror (char *);
73
74 static int type_aggregate_p (struct type *);
75
76 %}
77
78 /* Although the yacc "value" of an expression is not used,
79    since the result is stored in the structure being created,
80    other node types do have values.  */
81
82 %union
83   {
84     struct {
85       LONGEST val;
86       struct type *type;
87     } typed_val_int;
88     struct {
89       DOUBLEST dval;
90       struct type *type;
91     } typed_val_float;
92     struct symbol *sym;
93     struct type *tval;
94     struct typed_stoken tsval;
95     struct stoken sval;
96     struct ttype tsym;
97     struct symtoken ssym;
98     int ival;
99     int voidval;
100     struct block *bval;
101     enum exp_opcode opcode;
102     struct stoken_vector svec;
103   }
104
105 %{
106 /* YYSTYPE gets defined by %union */
107 static int parse_number (struct parser_state *, const char *,
108                          int, int, YYSTYPE *);
109 %}
110
111 %token <sval> IDENTIFIER UNKNOWN_NAME
112 %token <tsym> TYPENAME
113 %token <voidval> COMPLETE
114
115 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
116    but which would parse as a valid number in the current input radix.
117    E.g. "c" when input_radix==16.  Depending on the parse, it will be
118    turned into a name or into a number.  */
119
120 %token <sval> NAME_OR_INT
121
122 %token <typed_val_int> INTEGER_LITERAL
123 %token <typed_val_float> FLOAT_LITERAL
124 %token <tsval> CHARACTER_LITERAL
125 %token <tsval> STRING_LITERAL
126
127 %type <svec> StringExp
128 %type <tval> BasicType TypeExp
129 %type <sval> IdentifierExp
130 %type <ival> ArrayLiteral
131
132 %token ENTRY
133 %token ERROR
134
135 /* Keywords that have a constant value.  */
136 %token TRUE_KEYWORD FALSE_KEYWORD NULL_KEYWORD
137 /* Class 'super' accessor.  */
138 %token SUPER_KEYWORD
139 /* Properties.  */
140 %token CAST_KEYWORD SIZEOF_KEYWORD
141 %token TYPEOF_KEYWORD TYPEID_KEYWORD
142 %token INIT_KEYWORD
143 /* Comparison keywords.  */
144 /* Type storage classes.  */
145 %token IMMUTABLE_KEYWORD CONST_KEYWORD SHARED_KEYWORD
146 /* Non-scalar type keywords.  */
147 %token STRUCT_KEYWORD UNION_KEYWORD
148 %token CLASS_KEYWORD INTERFACE_KEYWORD
149 %token ENUM_KEYWORD TEMPLATE_KEYWORD
150 %token DELEGATE_KEYWORD FUNCTION_KEYWORD
151
152 %token <sval> DOLLAR_VARIABLE
153
154 %token <opcode> ASSIGN_MODIFY
155
156 %left ','
157 %right '=' ASSIGN_MODIFY
158 %right '?'
159 %left OROR
160 %left ANDAND
161 %left '|'
162 %left '^'
163 %left '&'
164 %left EQUAL NOTEQUAL '<' '>' LEQ GEQ
165 %right LSH RSH
166 %left '+' '-'
167 %left '*' '/' '%'
168 %right HATHAT
169 %left IDENTITY NOTIDENTITY
170 %right INCREMENT DECREMENT
171 %right '.' '[' '('
172 %token DOTDOT
173
174 \f
175 %%
176
177 start   :
178         Expression
179 |       TypeExp
180 ;
181
182 /* Expressions, including the comma operator.  */
183
184 Expression:
185         CommaExpression
186 ;
187
188 CommaExpression:
189         AssignExpression
190 |       AssignExpression ',' CommaExpression
191                 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
192 ;
193
194 AssignExpression:
195         ConditionalExpression
196 |       ConditionalExpression '=' AssignExpression
197                 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
198 |       ConditionalExpression ASSIGN_MODIFY AssignExpression
199                 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
200                   write_exp_elt_opcode (pstate, $2);
201                   write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
202 ;
203
204 ConditionalExpression:
205         OrOrExpression
206 |       OrOrExpression '?' Expression ':' ConditionalExpression
207                 { write_exp_elt_opcode (pstate, TERNOP_COND); }
208 ;
209
210 OrOrExpression:
211         AndAndExpression
212 |       OrOrExpression OROR AndAndExpression
213                 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
214 ;
215
216 AndAndExpression:
217         OrExpression
218 |       AndAndExpression ANDAND OrExpression
219                 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
220 ;
221
222 OrExpression:
223         XorExpression
224 |       OrExpression '|' XorExpression
225                 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
226 ;
227
228 XorExpression:
229         AndExpression
230 |       XorExpression '^' AndExpression
231                 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
232 ;
233
234 AndExpression:
235         CmpExpression
236 |       AndExpression '&' CmpExpression
237                 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
238 ;
239
240 CmpExpression:
241         ShiftExpression
242 |       EqualExpression
243 |       IdentityExpression
244 |       RelExpression
245 ;
246
247 EqualExpression:
248         ShiftExpression EQUAL ShiftExpression
249                 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
250 |       ShiftExpression NOTEQUAL ShiftExpression
251                 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
252 ;
253
254 IdentityExpression:
255         ShiftExpression IDENTITY ShiftExpression
256                 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
257 |       ShiftExpression NOTIDENTITY ShiftExpression
258                 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
259 ;
260
261 RelExpression:
262         ShiftExpression '<' ShiftExpression
263                 { write_exp_elt_opcode (pstate, BINOP_LESS); }
264 |       ShiftExpression LEQ ShiftExpression
265                 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
266 |       ShiftExpression '>' ShiftExpression
267                 { write_exp_elt_opcode (pstate, BINOP_GTR); }
268 |       ShiftExpression GEQ ShiftExpression
269                 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
270 ;
271
272 ShiftExpression:
273         AddExpression
274 |       ShiftExpression LSH AddExpression
275                 { write_exp_elt_opcode (pstate, BINOP_LSH); }
276 |       ShiftExpression RSH AddExpression
277                 { write_exp_elt_opcode (pstate, BINOP_RSH); }
278 ;
279
280 AddExpression:
281         MulExpression
282 |       AddExpression '+' MulExpression
283                 { write_exp_elt_opcode (pstate, BINOP_ADD); }
284 |       AddExpression '-' MulExpression
285                 { write_exp_elt_opcode (pstate, BINOP_SUB); }
286 |       AddExpression '~' MulExpression
287                 { write_exp_elt_opcode (pstate, BINOP_CONCAT); }
288 ;
289
290 MulExpression:
291         UnaryExpression
292 |       MulExpression '*' UnaryExpression
293                 { write_exp_elt_opcode (pstate, BINOP_MUL); }
294 |       MulExpression '/' UnaryExpression
295                 { write_exp_elt_opcode (pstate, BINOP_DIV); }
296 |       MulExpression '%' UnaryExpression
297                 { write_exp_elt_opcode (pstate, BINOP_REM); }
298
299 UnaryExpression:
300         '&' UnaryExpression
301                 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
302 |       INCREMENT UnaryExpression
303                 { write_exp_elt_opcode (pstate, UNOP_PREINCREMENT); }
304 |       DECREMENT UnaryExpression
305                 { write_exp_elt_opcode (pstate, UNOP_PREDECREMENT); }
306 |       '*' UnaryExpression
307                 { write_exp_elt_opcode (pstate, UNOP_IND); }
308 |       '-' UnaryExpression
309                 { write_exp_elt_opcode (pstate, UNOP_NEG); }
310 |       '+' UnaryExpression
311                 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
312 |       '!' UnaryExpression
313                 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
314 |       '~' UnaryExpression
315                 { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
316 |       TypeExp '.' SIZEOF_KEYWORD
317                 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
318 |       CastExpression
319 |       PowExpression
320 ;
321
322 CastExpression:
323         CAST_KEYWORD '(' TypeExp ')' UnaryExpression
324                 { write_exp_elt_opcode (pstate, UNOP_CAST);
325                   write_exp_elt_type (pstate, $3);
326                   write_exp_elt_opcode (pstate, UNOP_CAST); }
327         /* C style cast is illegal D, but is still recognised in
328            the grammar, so we keep this around for convenience.  */
329 |       '(' TypeExp ')' UnaryExpression
330                 { write_exp_elt_opcode (pstate, UNOP_CAST);
331                   write_exp_elt_type (pstate, $2);
332                   write_exp_elt_opcode (pstate, UNOP_CAST); }
333 ;
334
335 PowExpression:
336         PostfixExpression
337 |       PostfixExpression HATHAT UnaryExpression
338                 { write_exp_elt_opcode (pstate, BINOP_EXP); }
339 ;
340
341 PostfixExpression:
342         PrimaryExpression
343 |       PostfixExpression '.' COMPLETE
344                 { struct stoken s;
345                   mark_struct_expression (pstate);
346                   write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
347                   s.ptr = "";
348                   s.length = 0;
349                   write_exp_string (pstate, s);
350                   write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
351 |       PostfixExpression '.' IDENTIFIER
352                 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
353                   write_exp_string (pstate, $3);
354                   write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
355 |       PostfixExpression '.' IDENTIFIER COMPLETE
356                 { mark_struct_expression (pstate);
357                   write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
358                   write_exp_string (pstate, $3);
359                   write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
360 |       PostfixExpression '.' SIZEOF_KEYWORD
361                 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
362 |       PostfixExpression INCREMENT
363                 { write_exp_elt_opcode (pstate, UNOP_POSTINCREMENT); }
364 |       PostfixExpression DECREMENT
365                 { write_exp_elt_opcode (pstate, UNOP_POSTDECREMENT); }
366 |       CallExpression
367 |       IndexExpression
368 |       SliceExpression
369 ;
370
371 ArgumentList:
372         AssignExpression
373                 { arglist_len = 1; }
374 |       ArgumentList ',' AssignExpression
375                 { arglist_len++; }
376 ;
377
378 ArgumentList_opt:
379         /* EMPTY */
380                 { arglist_len = 0; }
381 |       ArgumentList
382 ;
383
384 CallExpression:
385         PostfixExpression '('
386                 { start_arglist (); }
387         ArgumentList_opt ')'
388                 { write_exp_elt_opcode (pstate, OP_FUNCALL);
389                   write_exp_elt_longcst (pstate, (LONGEST) end_arglist ());
390                   write_exp_elt_opcode (pstate, OP_FUNCALL); }
391 ;
392
393 IndexExpression:
394         PostfixExpression '[' ArgumentList ']'
395                 { if (arglist_len > 0)
396                     {
397                       write_exp_elt_opcode (pstate, MULTI_SUBSCRIPT);
398                       write_exp_elt_longcst (pstate, (LONGEST) arglist_len);
399                       write_exp_elt_opcode (pstate, MULTI_SUBSCRIPT);
400                     }
401                   else
402                     write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT);
403                 }
404 ;
405
406 SliceExpression:
407         PostfixExpression '[' ']'
408                 { /* Do nothing.  */ }
409 |       PostfixExpression '[' AssignExpression DOTDOT AssignExpression ']'
410                 { write_exp_elt_opcode (pstate, TERNOP_SLICE); }
411 ;
412
413 PrimaryExpression:
414         '(' Expression ')'
415                 { /* Do nothing.  */ }
416 |       IdentifierExp
417                 { struct bound_minimal_symbol msymbol;
418                   char *copy = copy_name ($1);
419                   struct field_of_this_result is_a_field_of_this;
420                   struct block_symbol sym;
421
422                   /* Handle VAR, which could be local or global.  */
423                   sym = lookup_symbol (copy, expression_context_block, VAR_DOMAIN,
424                                        &is_a_field_of_this);
425                   if (sym.symbol && SYMBOL_CLASS (sym.symbol) != LOC_TYPEDEF)
426                     {
427                       if (symbol_read_needs_frame (sym.symbol))
428                         {
429                           if (innermost_block == 0
430                               || contained_in (sym.block, innermost_block))
431                             innermost_block = sym.block;
432                         }
433
434                       write_exp_elt_opcode (pstate, OP_VAR_VALUE);
435                       write_exp_elt_block (pstate, sym.block);
436                       write_exp_elt_sym (pstate, sym.symbol);
437                       write_exp_elt_opcode (pstate, OP_VAR_VALUE);
438                     }
439                   else if (is_a_field_of_this.type != NULL)
440                      {
441                       /* It hangs off of `this'.  Must not inadvertently convert from a
442                          method call to data ref.  */
443                       if (innermost_block == 0
444                           || contained_in (sym.block, innermost_block))
445                         innermost_block = sym.block;
446                       write_exp_elt_opcode (pstate, OP_THIS);
447                       write_exp_elt_opcode (pstate, OP_THIS);
448                       write_exp_elt_opcode (pstate, STRUCTOP_PTR);
449                       write_exp_string (pstate, $1);
450                       write_exp_elt_opcode (pstate, STRUCTOP_PTR);
451                     }
452                   else
453                     {
454                       /* Lookup foreign name in global static symbols.  */
455                       msymbol = lookup_bound_minimal_symbol (copy);
456                       if (msymbol.minsym != NULL)
457                         write_exp_msymbol (pstate, msymbol);
458                       else if (!have_full_symbols () && !have_partial_symbols ())
459                         error (_("No symbol table is loaded.  Use the \"file\" command"));
460                       else
461                         error (_("No symbol \"%s\" in current context."), copy);
462                     }
463                   }
464 |       TypeExp '.' IdentifierExp
465                         { struct type *type = check_typedef ($1);
466
467                           /* Check if the qualified name is in the global
468                              context.  However if the symbol has not already
469                              been resolved, it's not likely to be found.  */
470                           if (TYPE_CODE (type) == TYPE_CODE_MODULE)
471                             {
472                               struct bound_minimal_symbol msymbol;
473                               struct block_symbol sym;
474                               const char *type_name = TYPE_SAFE_NAME (type);
475                               int type_name_len = strlen (type_name);
476                               char *name;
477
478                               name = xstrprintf ("%.*s.%.*s",
479                                                  type_name_len, type_name,
480                                                  $3.length, $3.ptr);
481                               make_cleanup (xfree, name);
482
483                               sym =
484                                 lookup_symbol (name, (const struct block *) NULL,
485                                                VAR_DOMAIN, NULL);
486                               if (sym.symbol)
487                                 {
488                                   write_exp_elt_opcode (pstate, OP_VAR_VALUE);
489                                   write_exp_elt_block (pstate, sym.block);
490                                   write_exp_elt_sym (pstate, sym.symbol);
491                                   write_exp_elt_opcode (pstate, OP_VAR_VALUE);
492                                   break;
493                                 }
494
495                               msymbol = lookup_bound_minimal_symbol (name);
496                               if (msymbol.minsym != NULL)
497                                 write_exp_msymbol (pstate, msymbol);
498                               else if (!have_full_symbols () && !have_partial_symbols ())
499                                 error (_("No symbol table is loaded.  Use the \"file\" command."));
500                               else
501                                 error (_("No symbol \"%s\" in current context."), name);
502                             }
503
504                           /* Check if the qualified name resolves as a member
505                              of an aggregate or an enum type.  */
506                           if (!type_aggregate_p (type))
507                             error (_("`%s' is not defined as an aggregate type."),
508                                    TYPE_SAFE_NAME (type));
509
510                           write_exp_elt_opcode (pstate, OP_SCOPE);
511                           write_exp_elt_type (pstate, type);
512                           write_exp_string (pstate, $3);
513                           write_exp_elt_opcode (pstate, OP_SCOPE);
514                         }
515 |       DOLLAR_VARIABLE
516                 { write_dollar_variable (pstate, $1); }
517 |       NAME_OR_INT
518                 { YYSTYPE val;
519                   parse_number (pstate, $1.ptr, $1.length, 0, &val);
520                   write_exp_elt_opcode (pstate, OP_LONG);
521                   write_exp_elt_type (pstate, val.typed_val_int.type);
522                   write_exp_elt_longcst (pstate,
523                                          (LONGEST) val.typed_val_int.val);
524                   write_exp_elt_opcode (pstate, OP_LONG); }
525 |       NULL_KEYWORD
526                 { struct type *type = parse_d_type (pstate)->builtin_void;
527                   type = lookup_pointer_type (type);
528                   write_exp_elt_opcode (pstate, OP_LONG);
529                   write_exp_elt_type (pstate, type);
530                   write_exp_elt_longcst (pstate, (LONGEST) 0);
531                   write_exp_elt_opcode (pstate, OP_LONG); }
532 |       TRUE_KEYWORD
533                 { write_exp_elt_opcode (pstate, OP_BOOL);
534                   write_exp_elt_longcst (pstate, (LONGEST) 1);
535                   write_exp_elt_opcode (pstate, OP_BOOL); }
536 |       FALSE_KEYWORD
537                 { write_exp_elt_opcode (pstate, OP_BOOL);
538                   write_exp_elt_longcst (pstate, (LONGEST) 0);
539                   write_exp_elt_opcode (pstate, OP_BOOL); }
540 |       INTEGER_LITERAL
541                 { write_exp_elt_opcode (pstate, OP_LONG);
542                   write_exp_elt_type (pstate, $1.type);
543                   write_exp_elt_longcst (pstate, (LONGEST)($1.val));
544                   write_exp_elt_opcode (pstate, OP_LONG); }
545 |       FLOAT_LITERAL
546                 { write_exp_elt_opcode (pstate, OP_DOUBLE);
547                   write_exp_elt_type (pstate, $1.type);
548                   write_exp_elt_dblcst (pstate, $1.dval);
549                   write_exp_elt_opcode (pstate, OP_DOUBLE); }
550 |       CHARACTER_LITERAL
551                 { struct stoken_vector vec;
552                   vec.len = 1;
553                   vec.tokens = &$1;
554                   write_exp_string_vector (pstate, $1.type, &vec); }
555 |       StringExp
556                 { int i;
557                   write_exp_string_vector (pstate, 0, &$1);
558                   for (i = 0; i < $1.len; ++i)
559                     free ($1.tokens[i].ptr);
560                   free ($1.tokens); }
561 |       ArrayLiteral
562                 { write_exp_elt_opcode (pstate, OP_ARRAY);
563                   write_exp_elt_longcst (pstate, (LONGEST) 0);
564                   write_exp_elt_longcst (pstate, (LONGEST) $1 - 1);
565                   write_exp_elt_opcode (pstate, OP_ARRAY); }
566 |       TYPEOF_KEYWORD '(' Expression ')'
567                 { write_exp_elt_opcode (pstate, OP_TYPEOF); }
568 ;
569
570 ArrayLiteral:
571         '[' ArgumentList_opt ']'
572                 { $$ = arglist_len; }
573 ;
574
575 IdentifierExp:
576         IDENTIFIER
577 ;
578
579 StringExp:
580         STRING_LITERAL
581                 { /* We copy the string here, and not in the
582                      lexer, to guarantee that we do not leak a
583                      string.  Note that we follow the
584                      NUL-termination convention of the
585                      lexer.  */
586                   struct typed_stoken *vec = XNEW (struct typed_stoken);
587                   $$.len = 1;
588                   $$.tokens = vec;
589
590                   vec->type = $1.type;
591                   vec->length = $1.length;
592                   vec->ptr = (char *) malloc ($1.length + 1);
593                   memcpy (vec->ptr, $1.ptr, $1.length + 1);
594                 }
595 |       StringExp STRING_LITERAL
596                 { /* Note that we NUL-terminate here, but just
597                      for convenience.  */
598                   char *p;
599                   ++$$.len;
600                   $$.tokens
601                     = XRESIZEVEC (struct typed_stoken, $$.tokens, $$.len);
602
603                   p = (char *) malloc ($2.length + 1);
604                   memcpy (p, $2.ptr, $2.length + 1);
605
606                   $$.tokens[$$.len - 1].type = $2.type;
607                   $$.tokens[$$.len - 1].length = $2.length;
608                   $$.tokens[$$.len - 1].ptr = p;
609                 }
610 ;
611
612 TypeExp:
613         '(' TypeExp ')'
614                 { /* Do nothing.  */ }
615 |       BasicType
616                 { write_exp_elt_opcode (pstate, OP_TYPE);
617                   write_exp_elt_type (pstate, $1);
618                   write_exp_elt_opcode (pstate, OP_TYPE); }
619 |       BasicType BasicType2
620                 { $$ = follow_types ($1);
621                   write_exp_elt_opcode (pstate, OP_TYPE);
622                   write_exp_elt_type (pstate, $$);
623                   write_exp_elt_opcode (pstate, OP_TYPE);
624                 }
625 ;
626
627 BasicType2:
628         '*'
629                 { push_type (tp_pointer); }
630 |       '*' BasicType2
631                 { push_type (tp_pointer); }
632 |       '[' INTEGER_LITERAL ']'
633                 { push_type_int ($2.val);
634                   push_type (tp_array); }
635 |       '[' INTEGER_LITERAL ']' BasicType2
636                 { push_type_int ($2.val);
637                   push_type (tp_array); }
638 ;
639
640 BasicType:
641         TYPENAME
642                 { $$ = $1.type; }
643 ;
644
645 %%
646
647 /* Return true if the type is aggregate-like.  */
648
649 static int
650 type_aggregate_p (struct type *type)
651 {
652   return (TYPE_CODE (type) == TYPE_CODE_STRUCT
653           || TYPE_CODE (type) == TYPE_CODE_UNION
654           || (TYPE_CODE (type) == TYPE_CODE_ENUM
655               && TYPE_DECLARED_CLASS (type)));
656 }
657
658 /* Take care of parsing a number (anything that starts with a digit).
659    Set yylval and return the token type; update lexptr.
660    LEN is the number of characters in it.  */
661
662 /*** Needs some error checking for the float case ***/
663
664 static int
665 parse_number (struct parser_state *ps, const char *p,
666               int len, int parsed_float, YYSTYPE *putithere)
667 {
668   ULONGEST n = 0;
669   ULONGEST prevn = 0;
670   ULONGEST un;
671
672   int i = 0;
673   int c;
674   int base = input_radix;
675   int unsigned_p = 0;
676   int long_p = 0;
677
678   /* We have found a "L" or "U" suffix.  */
679   int found_suffix = 0;
680
681   ULONGEST high_bit;
682   struct type *signed_type;
683   struct type *unsigned_type;
684
685   if (parsed_float)
686     {
687       const struct builtin_d_type *builtin_d_types;
688       const char *suffix;
689       int suffix_len;
690       char *s, *sp;
691
692       /* Strip out all embedded '_' before passing to parse_float.  */
693       s = (char *) alloca (len + 1);
694       sp = s;
695       while (len-- > 0)
696         {
697           if (*p != '_')
698             *sp++ = *p;
699           p++;
700         }
701       *sp = '\0';
702       len = strlen (s);
703
704       if (! parse_float (s, len, &putithere->typed_val_float.dval, &suffix))
705         return ERROR;
706
707       suffix_len = s + len - suffix;
708
709       if (suffix_len == 0)
710         {
711           putithere->typed_val_float.type
712             = parse_d_type (ps)->builtin_double;
713         }
714       else if (suffix_len == 1)
715         {
716           /* Check suffix for `f', `l', or `i' (float, real, or idouble).  */
717           if (tolower (*suffix) == 'f')
718             {
719               putithere->typed_val_float.type
720                 = parse_d_type (ps)->builtin_float;
721             }
722           else if (tolower (*suffix) == 'l')
723             {
724               putithere->typed_val_float.type
725                 = parse_d_type (ps)->builtin_real;
726             }
727           else if (tolower (*suffix) == 'i')
728             {
729               putithere->typed_val_float.type
730                 = parse_d_type (ps)->builtin_idouble;
731             }
732           else
733             return ERROR;
734         }
735       else if (suffix_len == 2)
736         {
737           /* Check suffix for `fi' or `li' (ifloat or ireal).  */
738           if (tolower (suffix[0]) == 'f' && tolower (suffix[1] == 'i'))
739             {
740               putithere->typed_val_float.type
741                 = parse_d_type (ps)->builtin_ifloat;
742             }
743           else if (tolower (suffix[0]) == 'l' && tolower (suffix[1] == 'i'))
744             {
745               putithere->typed_val_float.type
746                 = parse_d_type (ps)->builtin_ireal;
747             }
748           else
749             return ERROR;
750         }
751       else
752         return ERROR;
753
754       return FLOAT_LITERAL;
755     }
756
757   /* Handle base-switching prefixes 0x, 0b, 0 */
758   if (p[0] == '0')
759     switch (p[1])
760       {
761       case 'x':
762       case 'X':
763         if (len >= 3)
764           {
765             p += 2;
766             base = 16;
767             len -= 2;
768           }
769         break;
770
771       case 'b':
772       case 'B':
773         if (len >= 3)
774           {
775             p += 2;
776             base = 2;
777             len -= 2;
778           }
779         break;
780
781       default:
782         base = 8;
783         break;
784       }
785
786   while (len-- > 0)
787     {
788       c = *p++;
789       if (c == '_')
790         continue;       /* Ignore embedded '_'.  */
791       if (c >= 'A' && c <= 'Z')
792         c += 'a' - 'A';
793       if (c != 'l' && c != 'u')
794         n *= base;
795       if (c >= '0' && c <= '9')
796         {
797           if (found_suffix)
798             return ERROR;
799           n += i = c - '0';
800         }
801       else
802         {
803           if (base > 10 && c >= 'a' && c <= 'f')
804             {
805               if (found_suffix)
806                 return ERROR;
807               n += i = c - 'a' + 10;
808             }
809           else if (c == 'l' && long_p == 0)
810             {
811               long_p = 1;
812               found_suffix = 1;
813             }
814           else if (c == 'u' && unsigned_p == 0)
815             {
816               unsigned_p = 1;
817               found_suffix = 1;
818             }
819           else
820             return ERROR;       /* Char not a digit */
821         }
822       if (i >= base)
823         return ERROR;           /* Invalid digit in this base.  */
824       /* Portably test for integer overflow.  */
825       if (c != 'l' && c != 'u')
826         {
827           ULONGEST n2 = prevn * base;
828           if ((n2 / base != prevn) || (n2 + i < prevn))
829             error (_("Numeric constant too large."));
830         }
831       prevn = n;
832     }
833
834   /* An integer constant is an int or a long.  An L suffix forces it to
835      be long, and a U suffix forces it to be unsigned.  To figure out
836      whether it fits, we shift it right and see whether anything remains.
837      Note that we can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or
838      more in one operation, because many compilers will warn about such a
839      shift (which always produces a zero result).  To deal with the case
840      where it is we just always shift the value more than once, with fewer
841      bits each time.  */
842   un = (ULONGEST) n >> 2;
843   if (long_p == 0 && (un >> 30) == 0)
844     {
845       high_bit = ((ULONGEST) 1) << 31;
846       signed_type = parse_d_type (ps)->builtin_int;
847       /* For decimal notation, keep the sign of the worked out type.  */
848       if (base == 10 && !unsigned_p)
849         unsigned_type = parse_d_type (ps)->builtin_long;
850       else
851         unsigned_type = parse_d_type (ps)->builtin_uint;
852     }
853   else
854     {
855       int shift;
856       if (sizeof (ULONGEST) * HOST_CHAR_BIT < 64)
857         /* A long long does not fit in a LONGEST.  */
858         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
859       else
860         shift = 63;
861       high_bit = (ULONGEST) 1 << shift;
862       signed_type = parse_d_type (ps)->builtin_long;
863       unsigned_type = parse_d_type (ps)->builtin_ulong;
864     }
865
866   putithere->typed_val_int.val = n;
867
868   /* If the high bit of the worked out type is set then this number
869      has to be unsigned_type.  */
870   if (unsigned_p || (n & high_bit))
871     putithere->typed_val_int.type = unsigned_type;
872   else
873     putithere->typed_val_int.type = signed_type;
874
875   return INTEGER_LITERAL;
876 }
877
878 /* Temporary obstack used for holding strings.  */
879 static struct obstack tempbuf;
880 static int tempbuf_init;
881
882 /* Parse a string or character literal from TOKPTR.  The string or
883    character may be wide or unicode.  *OUTPTR is set to just after the
884    end of the literal in the input string.  The resulting token is
885    stored in VALUE.  This returns a token value, either STRING or
886    CHAR, depending on what was parsed.  *HOST_CHARS is set to the
887    number of host characters in the literal.  */
888
889 static int
890 parse_string_or_char (const char *tokptr, const char **outptr,
891                       struct typed_stoken *value, int *host_chars)
892 {
893   int quote;
894
895   /* Build the gdb internal form of the input string in tempbuf.  Note
896      that the buffer is null byte terminated *only* for the
897      convenience of debugging gdb itself and printing the buffer
898      contents when the buffer contains no embedded nulls.  Gdb does
899      not depend upon the buffer being null byte terminated, it uses
900      the length string instead.  This allows gdb to handle C strings
901      (as well as strings in other languages) with embedded null
902      bytes */
903
904   if (!tempbuf_init)
905     tempbuf_init = 1;
906   else
907     obstack_free (&tempbuf, NULL);
908   obstack_init (&tempbuf);
909
910   /* Skip the quote.  */
911   quote = *tokptr;
912   ++tokptr;
913
914   *host_chars = 0;
915
916   while (*tokptr)
917     {
918       char c = *tokptr;
919       if (c == '\\')
920         {
921            ++tokptr;
922            *host_chars += c_parse_escape (&tokptr, &tempbuf);
923         }
924       else if (c == quote)
925         break;
926       else
927         {
928           obstack_1grow (&tempbuf, c);
929           ++tokptr;
930           /* FIXME: this does the wrong thing with multi-byte host
931              characters.  We could use mbrlen here, but that would
932              make "set host-charset" a bit less useful.  */
933           ++*host_chars;
934         }
935     }
936
937   if (*tokptr != quote)
938     {
939       if (quote == '"' || quote == '`')
940         error (_("Unterminated string in expression."));
941       else
942         error (_("Unmatched single quote."));
943     }
944   ++tokptr;
945
946   /* FIXME: should instead use own language string_type enum
947      and handle D-specific string suffixes here. */
948   if (quote == '\'')
949     value->type = C_CHAR;
950   else
951     value->type = C_STRING;
952
953   value->ptr = (char *) obstack_base (&tempbuf);
954   value->length = obstack_object_size (&tempbuf);
955
956   *outptr = tokptr;
957
958   return quote == '\'' ? CHARACTER_LITERAL : STRING_LITERAL;
959 }
960
961 struct token
962 {
963   char *oper;
964   int token;
965   enum exp_opcode opcode;
966 };
967
968 static const struct token tokentab3[] =
969   {
970     {"^^=", ASSIGN_MODIFY, BINOP_EXP},
971     {"<<=", ASSIGN_MODIFY, BINOP_LSH},
972     {">>=", ASSIGN_MODIFY, BINOP_RSH},
973   };
974
975 static const struct token tokentab2[] =
976   {
977     {"+=", ASSIGN_MODIFY, BINOP_ADD},
978     {"-=", ASSIGN_MODIFY, BINOP_SUB},
979     {"*=", ASSIGN_MODIFY, BINOP_MUL},
980     {"/=", ASSIGN_MODIFY, BINOP_DIV},
981     {"%=", ASSIGN_MODIFY, BINOP_REM},
982     {"|=", ASSIGN_MODIFY, BINOP_BITWISE_IOR},
983     {"&=", ASSIGN_MODIFY, BINOP_BITWISE_AND},
984     {"^=", ASSIGN_MODIFY, BINOP_BITWISE_XOR},
985     {"++", INCREMENT, BINOP_END},
986     {"--", DECREMENT, BINOP_END},
987     {"&&", ANDAND, BINOP_END},
988     {"||", OROR, BINOP_END},
989     {"^^", HATHAT, BINOP_END},
990     {"<<", LSH, BINOP_END},
991     {">>", RSH, BINOP_END},
992     {"==", EQUAL, BINOP_END},
993     {"!=", NOTEQUAL, BINOP_END},
994     {"<=", LEQ, BINOP_END},
995     {">=", GEQ, BINOP_END},
996     {"..", DOTDOT, BINOP_END},
997   };
998
999 /* Identifier-like tokens.  */
1000 static const struct token ident_tokens[] =
1001   {
1002     {"is", IDENTITY, BINOP_END},
1003     {"!is", NOTIDENTITY, BINOP_END},
1004
1005     {"cast", CAST_KEYWORD, OP_NULL},
1006     {"const", CONST_KEYWORD, OP_NULL},
1007     {"immutable", IMMUTABLE_KEYWORD, OP_NULL},
1008     {"shared", SHARED_KEYWORD, OP_NULL},
1009     {"super", SUPER_KEYWORD, OP_NULL},
1010
1011     {"null", NULL_KEYWORD, OP_NULL},
1012     {"true", TRUE_KEYWORD, OP_NULL},
1013     {"false", FALSE_KEYWORD, OP_NULL},
1014
1015     {"init", INIT_KEYWORD, OP_NULL},
1016     {"sizeof", SIZEOF_KEYWORD, OP_NULL},
1017     {"typeof", TYPEOF_KEYWORD, OP_NULL},
1018     {"typeid", TYPEID_KEYWORD, OP_NULL},
1019
1020     {"delegate", DELEGATE_KEYWORD, OP_NULL},
1021     {"function", FUNCTION_KEYWORD, OP_NULL},
1022     {"struct", STRUCT_KEYWORD, OP_NULL},
1023     {"union", UNION_KEYWORD, OP_NULL},
1024     {"class", CLASS_KEYWORD, OP_NULL},
1025     {"interface", INTERFACE_KEYWORD, OP_NULL},
1026     {"enum", ENUM_KEYWORD, OP_NULL},
1027     {"template", TEMPLATE_KEYWORD, OP_NULL},
1028   };
1029
1030 /* This is set if a NAME token appeared at the very end of the input
1031    string, with no whitespace separating the name from the EOF.  This
1032    is used only when parsing to do field name completion.  */
1033 static int saw_name_at_eof;
1034
1035 /* This is set if the previously-returned token was a structure operator.
1036    This is used only when parsing to do field name completion.  */
1037 static int last_was_structop;
1038
1039 /* Read one token, getting characters through lexptr.  */
1040
1041 static int
1042 lex_one_token (struct parser_state *par_state)
1043 {
1044   int c;
1045   int namelen;
1046   unsigned int i;
1047   const char *tokstart;
1048   int saw_structop = last_was_structop;
1049   char *copy;
1050
1051   last_was_structop = 0;
1052
1053  retry:
1054
1055   prev_lexptr = lexptr;
1056
1057   tokstart = lexptr;
1058   /* See if it is a special token of length 3.  */
1059   for (i = 0; i < sizeof tokentab3 / sizeof tokentab3[0]; i++)
1060     if (strncmp (tokstart, tokentab3[i].oper, 3) == 0)
1061       {
1062         lexptr += 3;
1063         yylval.opcode = tokentab3[i].opcode;
1064         return tokentab3[i].token;
1065       }
1066
1067   /* See if it is a special token of length 2.  */
1068   for (i = 0; i < sizeof tokentab2 / sizeof tokentab2[0]; i++)
1069     if (strncmp (tokstart, tokentab2[i].oper, 2) == 0)
1070       {
1071         lexptr += 2;
1072         yylval.opcode = tokentab2[i].opcode;
1073         return tokentab2[i].token;
1074       }
1075
1076   switch (c = *tokstart)
1077     {
1078     case 0:
1079       /* If we're parsing for field name completion, and the previous
1080          token allows such completion, return a COMPLETE token.
1081          Otherwise, we were already scanning the original text, and
1082          we're really done.  */
1083       if (saw_name_at_eof)
1084         {
1085           saw_name_at_eof = 0;
1086           return COMPLETE;
1087         }
1088       else if (saw_structop)
1089         return COMPLETE;
1090       else
1091         return 0;
1092
1093     case ' ':
1094     case '\t':
1095     case '\n':
1096       lexptr++;
1097       goto retry;
1098
1099     case '[':
1100     case '(':
1101       paren_depth++;
1102       lexptr++;
1103       return c;
1104
1105     case ']':
1106     case ')':
1107       if (paren_depth == 0)
1108         return 0;
1109       paren_depth--;
1110       lexptr++;
1111       return c;
1112
1113     case ',':
1114       if (comma_terminates && paren_depth == 0)
1115         return 0;
1116       lexptr++;
1117       return c;
1118
1119     case '.':
1120       /* Might be a floating point number.  */
1121       if (lexptr[1] < '0' || lexptr[1] > '9')
1122         {
1123           if (parse_completion)
1124             last_was_structop = 1;
1125           goto symbol;          /* Nope, must be a symbol.  */
1126         }
1127       /* FALL THRU into number case.  */
1128
1129     case '0':
1130     case '1':
1131     case '2':
1132     case '3':
1133     case '4':
1134     case '5':
1135     case '6':
1136     case '7':
1137     case '8':
1138     case '9':
1139       {
1140         /* It's a number.  */
1141         int got_dot = 0, got_e = 0, toktype;
1142         const char *p = tokstart;
1143         int hex = input_radix > 10;
1144
1145         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1146           {
1147             p += 2;
1148             hex = 1;
1149           }
1150
1151         for (;; ++p)
1152           {
1153             /* Hex exponents start with 'p', because 'e' is a valid hex
1154                digit and thus does not indicate a floating point number
1155                when the radix is hex.  */
1156             if ((!hex && !got_e && tolower (p[0]) == 'e')
1157                 || (hex && !got_e && tolower (p[0] == 'p')))
1158               got_dot = got_e = 1;
1159             /* A '.' always indicates a decimal floating point number
1160                regardless of the radix.  If we have a '..' then its the
1161                end of the number and the beginning of a slice.  */
1162             else if (!got_dot && (p[0] == '.' && p[1] != '.'))
1163                 got_dot = 1;
1164             /* This is the sign of the exponent, not the end of the number.  */
1165             else if (got_e && (tolower (p[-1]) == 'e' || tolower (p[-1]) == 'p')
1166                      && (*p == '-' || *p == '+'))
1167               continue;
1168             /* We will take any letters or digits, ignoring any embedded '_'.
1169                parse_number will complain if past the radix, or if L or U are
1170                not final.  */
1171             else if ((*p < '0' || *p > '9') && (*p != '_')
1172                      && ((*p < 'a' || *p > 'z') && (*p < 'A' || *p > 'Z')))
1173               break;
1174           }
1175
1176         toktype = parse_number (par_state, tokstart, p - tokstart,
1177                                 got_dot|got_e, &yylval);
1178         if (toktype == ERROR)
1179           {
1180             char *err_copy = (char *) alloca (p - tokstart + 1);
1181
1182             memcpy (err_copy, tokstart, p - tokstart);
1183             err_copy[p - tokstart] = 0;
1184             error (_("Invalid number \"%s\"."), err_copy);
1185           }
1186         lexptr = p;
1187         return toktype;
1188       }
1189
1190     case '@':
1191       {
1192         const char *p = &tokstart[1];
1193         size_t len = strlen ("entry");
1194
1195         while (isspace (*p))
1196           p++;
1197         if (strncmp (p, "entry", len) == 0 && !isalnum (p[len])
1198             && p[len] != '_')
1199           {
1200             lexptr = &p[len];
1201             return ENTRY;
1202           }
1203       }
1204       /* FALLTHRU */
1205     case '+':
1206     case '-':
1207     case '*':
1208     case '/':
1209     case '%':
1210     case '|':
1211     case '&':
1212     case '^':
1213     case '~':
1214     case '!':
1215     case '<':
1216     case '>':
1217     case '?':
1218     case ':':
1219     case '=':
1220     case '{':
1221     case '}':
1222     symbol:
1223       lexptr++;
1224       return c;
1225
1226     case '\'':
1227     case '"':
1228     case '`':
1229       {
1230         int host_len;
1231         int result = parse_string_or_char (tokstart, &lexptr, &yylval.tsval,
1232                                            &host_len);
1233         if (result == CHARACTER_LITERAL)
1234           {
1235             if (host_len == 0)
1236               error (_("Empty character constant."));
1237             else if (host_len > 2 && c == '\'')
1238               {
1239                 ++tokstart;
1240                 namelen = lexptr - tokstart - 1;
1241                 goto tryname;
1242               }
1243             else if (host_len > 1)
1244               error (_("Invalid character constant."));
1245           }
1246         return result;
1247       }
1248     }
1249
1250   if (!(c == '_' || c == '$'
1251         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1252     /* We must have come across a bad character (e.g. ';').  */
1253     error (_("Invalid character '%c' in expression"), c);
1254
1255   /* It's a name.  See how long it is.  */
1256   namelen = 0;
1257   for (c = tokstart[namelen];
1258        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1259         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));)
1260     c = tokstart[++namelen];
1261
1262   /* The token "if" terminates the expression and is NOT
1263      removed from the input stream.  */
1264   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1265     return 0;
1266
1267   /* For the same reason (breakpoint conditions), "thread N"
1268      terminates the expression.  "thread" could be an identifier, but
1269      an identifier is never followed by a number without intervening
1270      punctuation.  "task" is similar.  Handle abbreviations of these,
1271      similarly to breakpoint.c:find_condition_and_thread.  */
1272   if (namelen >= 1
1273       && (strncmp (tokstart, "thread", namelen) == 0
1274           || strncmp (tokstart, "task", namelen) == 0)
1275       && (tokstart[namelen] == ' ' || tokstart[namelen] == '\t'))
1276     {
1277       const char *p = tokstart + namelen + 1;
1278
1279       while (*p == ' ' || *p == '\t')
1280         p++;
1281       if (*p >= '0' && *p <= '9')
1282         return 0;
1283     }
1284
1285   lexptr += namelen;
1286
1287  tryname:
1288
1289   yylval.sval.ptr = tokstart;
1290   yylval.sval.length = namelen;
1291
1292   /* Catch specific keywords.  */
1293   copy = copy_name (yylval.sval);
1294   for (i = 0; i < sizeof ident_tokens / sizeof ident_tokens[0]; i++)
1295     if (strcmp (copy, ident_tokens[i].oper) == 0)
1296       {
1297         /* It is ok to always set this, even though we don't always
1298            strictly need to.  */
1299         yylval.opcode = ident_tokens[i].opcode;
1300         return ident_tokens[i].token;
1301       }
1302
1303   if (*tokstart == '$')
1304     return DOLLAR_VARIABLE;
1305
1306   yylval.tsym.type
1307     = language_lookup_primitive_type (parse_language (par_state),
1308                                       parse_gdbarch (par_state), copy);
1309   if (yylval.tsym.type != NULL)
1310     return TYPENAME;
1311
1312   /* Input names that aren't symbols but ARE valid hex numbers,
1313      when the input radix permits them, can be names or numbers
1314      depending on the parse.  Note we support radixes > 16 here.  */
1315   if ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1316       || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10))
1317     {
1318       YYSTYPE newlval;  /* Its value is ignored.  */
1319       int hextype = parse_number (par_state, tokstart, namelen, 0, &newlval);
1320       if (hextype == INTEGER_LITERAL)
1321         return NAME_OR_INT;
1322     }
1323
1324   if (parse_completion && *lexptr == '\0')
1325     saw_name_at_eof = 1;
1326
1327   return IDENTIFIER;
1328 }
1329
1330 /* An object of this type is pushed on a FIFO by the "outer" lexer.  */
1331 typedef struct
1332 {
1333   int token;
1334   YYSTYPE value;
1335 } token_and_value;
1336
1337 DEF_VEC_O (token_and_value);
1338
1339 /* A FIFO of tokens that have been read but not yet returned to the
1340    parser.  */
1341 static VEC (token_and_value) *token_fifo;
1342
1343 /* Non-zero if the lexer should return tokens from the FIFO.  */
1344 static int popping;
1345
1346 /* Temporary storage for yylex; this holds symbol names as they are
1347    built up.  */
1348 static struct obstack name_obstack;
1349
1350 /* Classify an IDENTIFIER token.  The contents of the token are in `yylval'.
1351    Updates yylval and returns the new token type.  BLOCK is the block
1352    in which lookups start; this can be NULL to mean the global scope.  */
1353
1354 static int
1355 classify_name (struct parser_state *par_state, const struct block *block)
1356 {
1357   struct block_symbol sym;
1358   char *copy;
1359   struct field_of_this_result is_a_field_of_this;
1360
1361   copy = copy_name (yylval.sval);
1362
1363   sym = lookup_symbol (copy, block, VAR_DOMAIN, &is_a_field_of_this);
1364   if (sym.symbol && SYMBOL_CLASS (sym.symbol) == LOC_TYPEDEF)
1365     {
1366       yylval.tsym.type = SYMBOL_TYPE (sym.symbol);
1367       return TYPENAME;
1368     }
1369   else if (sym.symbol == NULL)
1370     {
1371       /* Look-up first for a module name, then a type.  */
1372       sym = lookup_symbol (copy, block, MODULE_DOMAIN, NULL);
1373       if (sym.symbol == NULL)
1374         sym = lookup_symbol (copy, block, STRUCT_DOMAIN, NULL);
1375
1376       if (sym.symbol != NULL)
1377         {
1378           yylval.tsym.type = SYMBOL_TYPE (sym.symbol);
1379           return TYPENAME;
1380         }
1381
1382       return UNKNOWN_NAME;
1383     }
1384
1385   return IDENTIFIER;
1386 }
1387
1388 /* Like classify_name, but used by the inner loop of the lexer, when a
1389    name might have already been seen.  CONTEXT is the context type, or
1390    NULL if this is the first component of a name.  */
1391
1392 static int
1393 classify_inner_name (struct parser_state *par_state,
1394                      const struct block *block, struct type *context)
1395 {
1396   struct type *type;
1397   char *copy;
1398
1399   if (context == NULL)
1400     return classify_name (par_state, block);
1401
1402   type = check_typedef (context);
1403   if (!type_aggregate_p (type))
1404     return ERROR;
1405
1406   copy = copy_name (yylval.ssym.stoken);
1407   yylval.ssym.sym = d_lookup_nested_symbol (type, copy, block);
1408
1409   if (yylval.ssym.sym.symbol == NULL)
1410     return ERROR;
1411
1412   if (SYMBOL_CLASS (yylval.ssym.sym.symbol) == LOC_TYPEDEF)
1413     {
1414       yylval.tsym.type = SYMBOL_TYPE (yylval.ssym.sym.symbol);
1415       return TYPENAME;
1416     }
1417
1418   return IDENTIFIER;
1419 }
1420
1421 /* The outer level of a two-level lexer.  This calls the inner lexer
1422    to return tokens.  It then either returns these tokens, or
1423    aggregates them into a larger token.  This lets us work around a
1424    problem in our parsing approach, where the parser could not
1425    distinguish between qualified names and qualified types at the
1426    right point.  */
1427
1428 static int
1429 yylex (void)
1430 {
1431   token_and_value current;
1432   int last_was_dot;
1433   struct type *context_type = NULL;
1434   int last_to_examine, next_to_examine, checkpoint;
1435   const struct block *search_block;
1436
1437   if (popping && !VEC_empty (token_and_value, token_fifo))
1438     goto do_pop;
1439   popping = 0;
1440
1441   /* Read the first token and decide what to do.  */
1442   current.token = lex_one_token (pstate);
1443   if (current.token != IDENTIFIER && current.token != '.')
1444     return current.token;
1445
1446   /* Read any sequence of alternating "." and identifier tokens into
1447      the token FIFO.  */
1448   current.value = yylval;
1449   VEC_safe_push (token_and_value, token_fifo, &current);
1450   last_was_dot = current.token == '.';
1451
1452   while (1)
1453     {
1454       current.token = lex_one_token (pstate);
1455       current.value = yylval;
1456       VEC_safe_push (token_and_value, token_fifo, &current);
1457
1458       if ((last_was_dot && current.token != IDENTIFIER)
1459           || (!last_was_dot && current.token != '.'))
1460         break;
1461
1462       last_was_dot = !last_was_dot;
1463     }
1464   popping = 1;
1465
1466   /* We always read one extra token, so compute the number of tokens
1467      to examine accordingly.  */
1468   last_to_examine = VEC_length (token_and_value, token_fifo) - 2;
1469   next_to_examine = 0;
1470
1471   current = *VEC_index (token_and_value, token_fifo, next_to_examine);
1472   ++next_to_examine;
1473
1474   /* If we are not dealing with a typename, now is the time to find out.  */
1475   if (current.token == IDENTIFIER)
1476     {
1477       yylval = current.value;
1478       current.token = classify_name (pstate, expression_context_block);
1479       current.value = yylval;
1480     }
1481
1482   /* If the IDENTIFIER is not known, it could be a package symbol,
1483      first try building up a name until we find the qualified module.  */
1484   if (current.token == UNKNOWN_NAME)
1485     {
1486       obstack_free (&name_obstack, obstack_base (&name_obstack));
1487       obstack_grow (&name_obstack, current.value.sval.ptr,
1488                     current.value.sval.length);
1489
1490       last_was_dot = 0;
1491
1492       while (next_to_examine <= last_to_examine)
1493         {
1494           token_and_value *next;
1495
1496           next = VEC_index (token_and_value, token_fifo, next_to_examine);
1497           ++next_to_examine;
1498
1499           if (next->token == IDENTIFIER && last_was_dot)
1500             {
1501               /* Update the partial name we are constructing.  */
1502               obstack_grow_str (&name_obstack, ".");
1503               obstack_grow (&name_obstack, next->value.sval.ptr,
1504                             next->value.sval.length);
1505
1506               yylval.sval.ptr = (char *) obstack_base (&name_obstack);
1507               yylval.sval.length = obstack_object_size (&name_obstack);
1508
1509               current.token = classify_name (pstate, expression_context_block);
1510               current.value = yylval;
1511
1512               /* We keep going until we find a TYPENAME.  */
1513               if (current.token == TYPENAME)
1514                 {
1515                   /* Install it as the first token in the FIFO.  */
1516                   VEC_replace (token_and_value, token_fifo, 0, &current);
1517                   VEC_block_remove (token_and_value, token_fifo, 1,
1518                                     next_to_examine - 1);
1519                   break;
1520                 }
1521             }
1522           else if (next->token == '.' && !last_was_dot)
1523             last_was_dot = 1;
1524           else
1525             {
1526               /* We've reached the end of the name.  */
1527               break;
1528             }
1529         }
1530
1531       /* Reset our current token back to the start, if we found nothing
1532          this means that we will just jump to do pop.  */
1533       current = *VEC_index (token_and_value, token_fifo, 0);
1534       next_to_examine = 1;
1535     }
1536   if (current.token != TYPENAME && current.token != '.')
1537     goto do_pop;
1538
1539   obstack_free (&name_obstack, obstack_base (&name_obstack));
1540   checkpoint = 0;
1541   if (current.token == '.')
1542     search_block = NULL;
1543   else
1544     {
1545       gdb_assert (current.token == TYPENAME);
1546       search_block = expression_context_block;
1547       obstack_grow (&name_obstack, current.value.sval.ptr,
1548                     current.value.sval.length);
1549       context_type = current.value.tsym.type;
1550       checkpoint = 1;
1551     }
1552
1553   last_was_dot = current.token == '.';
1554
1555   while (next_to_examine <= last_to_examine)
1556     {
1557       token_and_value *next;
1558
1559       next = VEC_index (token_and_value, token_fifo, next_to_examine);
1560       ++next_to_examine;
1561
1562       if (next->token == IDENTIFIER && last_was_dot)
1563         {
1564           int classification;
1565
1566           yylval = next->value;
1567           classification = classify_inner_name (pstate, search_block,
1568                                                 context_type);
1569           /* We keep going until we either run out of names, or until
1570              we have a qualified name which is not a type.  */
1571           if (classification != TYPENAME && classification != IDENTIFIER)
1572             break;
1573
1574           /* Accept up to this token.  */
1575           checkpoint = next_to_examine;
1576
1577           /* Update the partial name we are constructing.  */
1578           if (context_type != NULL)
1579             {
1580               /* We don't want to put a leading "." into the name.  */
1581               obstack_grow_str (&name_obstack, ".");
1582             }
1583           obstack_grow (&name_obstack, next->value.sval.ptr,
1584                         next->value.sval.length);
1585
1586           yylval.sval.ptr = (char *) obstack_base (&name_obstack);
1587           yylval.sval.length = obstack_object_size (&name_obstack);
1588           current.value = yylval;
1589           current.token = classification;
1590
1591           last_was_dot = 0;
1592
1593           if (classification == IDENTIFIER)
1594             break;
1595
1596           context_type = yylval.tsym.type;
1597         }
1598       else if (next->token == '.' && !last_was_dot)
1599         last_was_dot = 1;
1600       else
1601         {
1602           /* We've reached the end of the name.  */
1603           break;
1604         }
1605     }
1606
1607   /* If we have a replacement token, install it as the first token in
1608      the FIFO, and delete the other constituent tokens.  */
1609   if (checkpoint > 0)
1610     {
1611       VEC_replace (token_and_value, token_fifo, 0, &current);
1612       if (checkpoint > 1)
1613         VEC_block_remove (token_and_value, token_fifo, 1, checkpoint - 1);
1614     }
1615
1616  do_pop:
1617   current = *VEC_index (token_and_value, token_fifo, 0);
1618   VEC_ordered_remove (token_and_value, token_fifo, 0);
1619   yylval = current.value;
1620   return current.token;
1621 }
1622
1623 int
1624 d_parse (struct parser_state *par_state)
1625 {
1626   int result;
1627   struct cleanup *back_to;
1628
1629   /* Setting up the parser state.  */
1630   gdb_assert (par_state != NULL);
1631   pstate = par_state;
1632
1633   back_to = make_cleanup (null_cleanup, NULL);
1634
1635   make_cleanup_restore_integer (&yydebug);
1636   make_cleanup_clear_parser_state (&pstate);
1637   yydebug = parser_debug;
1638
1639   /* Initialize some state used by the lexer.  */
1640   last_was_structop = 0;
1641   saw_name_at_eof = 0;
1642
1643   VEC_free (token_and_value, token_fifo);
1644   popping = 0;
1645   obstack_init (&name_obstack);
1646   make_cleanup_obstack_free (&name_obstack);
1647
1648   result = yyparse ();
1649   do_cleanups (back_to);
1650   return result;
1651 }
1652
1653 void
1654 yyerror (char *msg)
1655 {
1656   if (prev_lexptr)
1657     lexptr = prev_lexptr;
1658
1659   error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
1660 }
1661