1 
2 
3 /** **********************************************************************
4 ** Module:  Expression \file expr.c
5 ** This module implements the Expression abstraction.  Several
6 **  types of expressions are supported: identifiers, literals,
7 **  operations (arithmetic, logical, array indexing, etc.), and
8 **  function calls.  Every expression is marked with a type.
9 ** Constants:
10 **  EXPRESSION_NULL     - the null expression
11 **  LITERAL_E       - a real literal with the value 2.7182...
12 **  LITERAL_EMPTY_SET   - a set literal representing the empty set
13 **  LITERAL_INFINITY    - a numeric literal representing infinity
14 **  LITERAL_PI      - a real literal with the value 3.1415...
15 **  LITERAL_ZERO        - an integer literal representing 0
16 **
17 ************************************************************************/
18 
19 /*
20  * This software was developed by U.S. Government employees as part of
21  * their official duties and is not subject to copyright.
22  *
23  * $Log: expr.c,v $
24  * Revision 1.6  1997/01/21 19:19:51  dar
25  * made C++ compatible
26  *
27  * Revision 1.5  1994/11/22  18:32:39  clark
28  * Part 11 IS; group reference
29  *
30  * Revision 1.4  1994/11/10  19:20:03  clark
31  * Update to IS
32  *
33  * Revision 1.3  1994/06/02  14:56:06  libes
34  * made plus-like ops check both args
35  *
36  * Revision 1.2  1993/10/15  18:48:48  libes
37  * CADDETC certified
38  *
39  * Revision 1.9  1993/02/22  21:46:00  libes
40  * ANSI compat fixes
41  *
42  * Revision 1.8  1993/02/16  03:21:31  libes
43  * fixed numerous confusions of type with return type
44  * fixed implicit loop variable type declarations
45  * improved errors
46  *
47  * Revision 1.7  1993/01/19  22:44:17  libes
48  * *** empty log message ***
49  *
50  * Revision 1.6  1992/09/16  18:20:40  libes
51  * made expression resolution routines search through references
52  *
53  * Revision 1.5  1992/08/18  17:13:43  libes
54  * rm'd extraneous error messages
55  *
56  * Revision 1.4  1992/06/08  18:06:57  libes
57  * prettied up interface to print_objects_when_running
58  *
59  * Revision 1.3  1992/05/31  23:32:26  libes
60  * implemented ALIAS resolution
61  *
62  * Revision 1.2  1992/05/31  08:35:51  libes
63  * multiple files
64  *
65  * Revision 1.1  1992/05/28  03:55:04  libes
66  * Initial revision
67  *
68  * Revision 4.1  90/09/13  15:12:48  clark
69  * BPR 2.1 alpha
70  *
71  */
72 
73 #include <sc_memmgr.h>
74 #include "express/expr.h"
75 #include "express/resolve.h"
76 
77 #include <assert.h>
78 #include <limits.h>
79 
80 struct EXPop_entry EXPop_table[OP_LAST];
81 
82 Expression  LITERAL_E = EXPRESSION_NULL;
83 Expression  LITERAL_INFINITY = EXPRESSION_NULL;
84 Expression  LITERAL_PI = EXPRESSION_NULL;
85 Expression  LITERAL_ZERO = EXPRESSION_NULL;
86 Expression  LITERAL_ONE;
87 
88 Error ERROR_bad_qualification = ERROR_none;
89 Error ERROR_integer_expression_expected = ERROR_none;
90 Error ERROR_implicit_downcast = ERROR_none;
91 Error ERROR_ambig_implicit_downcast = ERROR_none;
92 
93 struct freelist_head EXP_fl;
94 struct freelist_head OP_fl;
95 struct freelist_head QUERY_fl;
96 struct freelist_head QUAL_ATTR_fl;
97 
98 void EXPop_init();
99 static Error ERROR_internal_unrecognized_op_in_EXPresolve;
100 /* following two could probably be combined */
101 static Error ERROR_attribute_reference_on_aggregate;
102 static Error ERROR_attribute_ref_from_nonentity;
103 static Error ERROR_indexing_illegal;
104 static Error ERROR_warn_indexing_mixed;
105 static Error ERROR_enum_no_such_item;
106 static Error ERROR_group_ref_no_such_entity;
107 static Error ERROR_group_ref_unexpected_type;
108 
OPget_number_of_operands(Op_Code op)109 static_inline int OPget_number_of_operands( Op_Code op ) {
110     if( ( op == OP_NEGATE ) || ( op == OP_NOT ) ) {
111         return 1;
112     } else if( op == OP_SUBCOMPONENT ) {
113         return 3;
114     } else {
115         return 2;
116     }
117 }
118 
EXPcreate(Type type)119 Expression EXPcreate( Type type ) {
120     Expression e;
121     e = EXP_new();
122     SYMBOLset( e );
123     e->type = type;
124     e->return_type = Type_Unknown;
125     return( e );
126 }
127 
128 /**
129  * use this when the return_type is the same as the type
130  * For example, for constant integers
131  */
EXPcreate_simple(Type type)132 Expression EXPcreate_simple( Type type ) {
133     Expression e;
134     e = EXP_new();
135     SYMBOLset( e );
136     e->type = e->return_type = type;
137     return( e );
138 }
139 
EXPcreate_from_symbol(Type type,Symbol * symbol)140 Expression EXPcreate_from_symbol( Type type, Symbol * symbol ) {
141     Expression e;
142     e = EXP_new();
143     e->type = type;
144     e->return_type = Type_Unknown;
145     e->symbol = *symbol;
146     return e;
147 }
148 
EXP_get_symbol(Generic e)149 Symbol * EXP_get_symbol( Generic e ) {
150     return( &( ( Expression )e )->symbol );
151 }
152 
153 /** Description: Initialize the Expression module. */
EXPinitialize(void)154 void EXPinitialize( void ) {
155     MEMinitialize( &EXP_fl, sizeof( struct Expression_ ), 500, 200 );
156     MEMinitialize( &OP_fl, sizeof( struct Op_Subexpression ), 500, 100 );
157     MEMinitialize( &QUERY_fl, sizeof( struct Query_ ), 50, 10 );
158     MEMinitialize( &QUAL_ATTR_fl, sizeof( struct Query_ ), 20, 10 );
159     OBJcreate( OBJ_EXPRESSION, EXP_get_symbol, "expression", OBJ_EXPRESSION_BITS );
160     OBJcreate( OBJ_AMBIG_ENUM, EXP_get_symbol, "ambiguous enumeration", OBJ_UNUSED_BITS );
161 
162 #ifdef does_not_appear_to_be_necessary_or_even_make_sense
163     LITERAL_EMPTY_SET = EXPcreate_simple( Type_Set );
164     LITERAL_EMPTY_SET->u.list = LISTcreate();
165     resolved_all( LITERAL_EMPTY_SET );
166 #endif
167 
168     /* E and PI might come out of math.h */
169 
170     LITERAL_E = EXPcreate_simple( Type_Real );
171 #ifndef M_E
172 #define M_E     2.7182818284590452354
173 #endif
174     LITERAL_E->u.real = M_E;
175     resolved_all( LITERAL_E );
176 
177     LITERAL_PI = EXPcreate_simple( Type_Real );
178 #ifndef M_PI
179 #define M_PI    3.14159265358979323846
180 #endif
181     LITERAL_PI->u.real = M_PI;
182     resolved_all( LITERAL_PI );
183 
184     LITERAL_INFINITY = EXPcreate_simple( Type_Integer );
185     LITERAL_INFINITY->u.integer = INT_MAX;
186     resolved_all( LITERAL_INFINITY );
187 
188     LITERAL_ZERO = EXPcreate_simple( Type_Integer );
189     LITERAL_ZERO->u.integer = 0;
190     resolved_all( LITERAL_ZERO );
191 
192     LITERAL_ONE = EXPcreate_simple( Type_Integer );
193     LITERAL_ONE->u.integer = 1;
194     resolved_all( LITERAL_ONE );
195 
196     ERROR_integer_expression_expected = ERRORcreate(
197                                             "Integer expression expected", SEVERITY_WARNING );
198 
199     ERROR_internal_unrecognized_op_in_EXPresolve = ERRORcreate(
200                 "Opcode unrecognized while trying to resolve expression", SEVERITY_ERROR );
201 
202     ERROR_attribute_reference_on_aggregate = ERRORcreate(
203                 "Attribute %s cannot be referenced from an aggregate", SEVERITY_ERROR );
204 
205     ERROR_attribute_ref_from_nonentity = ERRORcreate(
206             "Attribute %s cannot be referenced from a non-entity", SEVERITY_ERROR );
207 
208     ERROR_indexing_illegal = ERRORcreate(
209                                  "Indexing is only permitted on aggregates", SEVERITY_ERROR );
210 
211     ERROR_warn_indexing_mixed = ERRORcreate( "Indexing upon a select (%s), with mixed base types (aggregates and "
212                                 "non-aggregates) and/or different aggregation types.", SEVERITY_WARNING );
213 
214     ERROR_enum_no_such_item = ERRORcreate(
215                                   "Enumeration type %s does not contain item %s", SEVERITY_ERROR );
216 
217     ERROR_group_ref_no_such_entity = ERRORcreate(
218                                          "Group reference failed to find entity %s", SEVERITY_ERROR );
219 
220     ERROR_group_ref_unexpected_type = ERRORcreate(
221                                           "Group reference of unusual expression %s", SEVERITY_ERROR );
222 
223     ERROR_implicit_downcast = ERRORcreate(
224                                   "Implicit downcast to %s.", SEVERITY_WARNING );
225 
226     ERROR_ambig_implicit_downcast = ERRORcreate(
227                                         "Possibly ambiguous implicit downcast (%s?).", SEVERITY_WARNING );
228 
229     ERRORcreate_warning( "downcast", ERROR_implicit_downcast );
230     ERRORcreate_warning( "downcast", ERROR_ambig_implicit_downcast );
231     ERRORcreate_warning( "indexing", ERROR_warn_indexing_mixed );
232 
233     EXPop_init();
234 }
235 
EXPcleanup(void)236 void EXPcleanup( void ) {
237     ERRORdestroy( ERROR_integer_expression_expected );
238     ERRORdestroy( ERROR_internal_unrecognized_op_in_EXPresolve );
239     ERRORdestroy( ERROR_attribute_reference_on_aggregate );
240     ERRORdestroy( ERROR_attribute_ref_from_nonentity );
241     ERRORdestroy( ERROR_indexing_illegal );
242     ERRORdestroy( ERROR_warn_indexing_mixed );
243     ERRORdestroy( ERROR_enum_no_such_item );
244     ERRORdestroy( ERROR_group_ref_no_such_entity );
245     ERRORdestroy( ERROR_group_ref_unexpected_type );
246     ERRORdestroy( ERROR_implicit_downcast );
247     ERRORdestroy( ERROR_ambig_implicit_downcast );
248 }
249 
250 /**
251  * \param selection the Type to look in (i.e. an enum)
252  * \param sref the Symbol to be found
253  * \param e set to the Expression found, when an enum is found
254  * \param v set to the Variable found, when a variable is found
255  * \param dt set to DICT_type when a match is found (use to determine whether to use e or v)
256  * \param where used by ENTITYfind_inherited_attribute, not sure of purpose
257  * \param s_id the search id, a parameter to avoid colliding with ENTITYfind...
258  * there will be no ambiguities, since we're looking at (and marking)
259  * only types, and it's marking only entities
260  */
EXP_resolve_op_dot_fuzzy(Type selection,Symbol sref,Expression * e,Variable * v,char * dt,struct Symbol_ ** where,int s_id)261 static int EXP_resolve_op_dot_fuzzy( Type selection, Symbol sref, Expression * e,
262                                      Variable * v, char * dt, struct Symbol_ ** where, int s_id ) {
263     Expression item;
264     Variable tmp;
265     int options = 0;
266     struct Symbol_ *w = NULL;
267 
268     if( selection->search_id == s_id ) {
269         return 0;
270     }
271 
272     switch( selection->u.type->body->type ) {
273         case entity_:
274             tmp = ENTITYfind_inherited_attribute( selection->u.type->body->entity,
275                                                   sref.name, &w );
276             if( tmp ) {
277                 if( w != NULL ) {
278                     *where = w;
279                 }
280                 *v = tmp;
281                 *dt = DICT_type;
282                 return 1;
283             } else {
284                 return 0;
285             }
286         case select_:
287             selection->search_id = s_id;
288             LISTdo( selection->u.type->body->list, t, Type )
289             if( EXP_resolve_op_dot_fuzzy( t, sref, e, v, dt, &w, s_id ) ) {
290                 if( w != NULL ) {
291                     *where = w;
292                 }
293                 ++options;
294             }
295             LISTod;
296             switch( options ) {
297                 case 0:
298                     return 0;
299                 case 1:
300                     return 1;
301                 default:
302                     /* found more than one, so ambiguous */
303                     *v = VARIABLE_NULL;
304                     return 1;
305             }
306         case enumeration_:
307             item = ( Expression )DICTlookup( TYPEget_enum_tags( selection ), sref.name );
308             if( item ) {
309                 *e = item;
310                 *dt = DICT_type;
311                 return 1;
312             }
313         default:
314             return 0;
315     }
316 }
317 
EXPresolve_op_dot(Expression expr,Scope scope)318 Type EXPresolve_op_dot( Expression expr, Scope scope ) {
319     Expression op1 = expr->e.op1;
320     Expression op2 = expr->e.op2;
321     Variable v;
322     Expression item;
323     Type op1type;
324     bool all_enums = true; /* used by 'case select_' */
325 
326     /* stuff for dealing with select_ */
327     int options = 0;
328     char dt;
329     struct Symbol_ *where = NULL;
330 
331     /* op1 is entity expression, op2 is attribute */
332     /* could be very impossible to determine except */
333     /* at run-time, .... */
334     EXPresolve( op1, scope, Type_Dont_Care );
335     if( is_resolve_failed( op1 ) ) {
336         resolve_failed( expr );
337         return( Type_Bad );
338     }
339     op1type = op1->return_type;
340 
341     switch( op1type->u.type->body->type ) {
342         case generic_:
343         case runtime_:
344             /* defer */
345             return( Type_Runtime );
346         case select_:
347             __SCOPE_search_id++;
348             /* don't think this actually actually catches anything on the */
349             /* first go-round, but let's be consistent */
350             op1type->search_id = __SCOPE_search_id;
351             LISTdo( op1type->u.type->body->list, t, Type ) {
352                 if( EXP_resolve_op_dot_fuzzy( t, op2->symbol, &item, &v, &dt, &where,
353                                               __SCOPE_search_id ) ) {
354                     ++options;
355                 }
356             }
357             LISTod;
358             switch( options ) {
359                 case 0:
360                     LISTdo( op1type->u.type->body->list, t, Type ) {
361                         if( t->u.type->body->type != enumeration_ ) {
362                             all_enums = false;
363                         }
364                     }
365                     LISTod;
366 
367                     if( all_enums ) {
368                         ERRORreport_with_symbol( WARNING_case_skip_label, &op2->symbol, op2->symbol.name );
369                     } else {
370                         /* no possible resolutions */
371                         ERRORreport_with_symbol( ERROR_undefined_attribute,
372                                                  &op2->symbol, op2->symbol.name );
373                     }
374                     resolve_failed( expr );
375                     return( Type_Bad );
376                 case 1:
377                     /* only one possible resolution */
378                     if( dt == OBJ_VARIABLE ) {
379                         if( where ) {
380                             ERRORreport_with_symbol( ERROR_implicit_downcast, &op2->symbol,
381                                                      where->name );
382                         }
383 
384                         op2->u.variable = v;
385                         op2->return_type = v->type;
386                         resolved_all( expr );
387                         return( v->type );
388                     } else if( dt == OBJ_ENUM ) {
389                         op2->u.expression = item;
390                         op2->return_type = item->type;
391                         resolved_all( expr );
392                         return( item->type );
393                     } else {
394                         fprintf( stderr, "EXPresolved_op_dot: attribute not an attribute?\n" );
395                         ERRORabort( 0 );
396                     }
397 
398                 default:
399                     /* compile-time ambiguous */
400                     if( where ) {
401                         ERRORreport_with_symbol( ERROR_ambig_implicit_downcast,
402                                                  &op2->symbol, where->name );
403                     }
404                     return( Type_Runtime );
405             }
406         case attribute_:
407             v = ENTITYresolve_attr_ref( op1->u.variable->type->u.type->body->entity, ( struct Symbol_ * )0, &op2->symbol );
408 
409             if( !v ) {
410                 /*      reported by ENTITYresolve_attr_ref */
411                 /*      ERRORreport_with_symbol(ERROR_undefined_attribute,*/
412                 /*              &expr->symbol,op2->symbol.name);*/
413                 resolve_failed( expr );
414                 return( Type_Bad );
415             }
416             if( DICT_type != OBJ_VARIABLE ) {
417                 fprintf( stderr, "EXPresolved_op_dot: attribute not an attribute?\n" );
418                 ERRORabort( 0 );
419             }
420 
421             op2->u.variable = v;
422             op2->return_type = v->type;
423             resolved_all( expr );
424             return( v->type );
425         case entity_:
426         case op_:   /* (op1).op2 */
427             v = ENTITYresolve_attr_ref( op1type->u.type->body->entity,
428                                         ( struct Symbol_ * )0, &op2->symbol );
429             if( !v ) {
430                 /*      reported by ENTITYresolve_attr_ref */
431                 /*      ERRORreport_with_symbol(ERROR_undefined_attribute,*/
432                 /*              &expr->symbol,op2->symbol.name);*/
433                 resolve_failed( expr );
434                 return( Type_Bad );
435             }
436             if( DICT_type != OBJ_VARIABLE ) {
437                 fprintf( stderr, "ERROR: EXPresolved_op_dot: attribute not an attribute?\n" );
438             }
439 
440             op2->u.variable = v;
441             /* changed to set return_type */
442             op2->return_type = op2->u.variable->type;
443             resolved_all( expr );
444             return( op2->return_type );
445         case enumeration_:
446             /* enumerations within a select will be handled by `case select_` above,
447              * which calls EXP_resolve_op_dot_fuzzy(). */
448             item = ( Expression )DICTlookup( TYPEget_enum_tags( op1type ), op2->symbol.name );
449             if( !item ) {
450                 ERRORreport_with_symbol( ERROR_enum_no_such_item, &op2->symbol,
451                                          op1type->symbol.name, op2->symbol.name );
452                 resolve_failed( expr );
453                 return( Type_Bad );
454             }
455 
456             op2->u.expression = item;
457             op2->return_type = item->type;
458             resolved_all( expr );
459             return( item->type );
460         case aggregate_:
461         case array_:
462         case bag_:
463         case list_:
464         case set_:
465             ERRORreport_with_symbol( ERROR_attribute_reference_on_aggregate,
466                                      &op2->symbol, op2->symbol.name );
467             /*FALLTHRU*/
468         case unknown_:  /* unable to resolved operand */
469             /* presumably error has already been reported */
470             resolve_failed( expr );
471             return( Type_Bad );
472         default:
473             ERRORreport_with_symbol( ERROR_attribute_ref_from_nonentity,
474                                      &op2->symbol, op2->symbol.name );
475             resolve_failed( expr );
476             return( Type_Bad );
477     }
478 }
479 
480 /**
481  * \param s_id the search id, a parameter to avoid colliding with ENTITYfind...
482  * there will be no ambiguities, since we're looking at (and marking)
483  * only types, and it's marking only entities
484  */
EXP_resolve_op_group_fuzzy(Type selection,Symbol sref,Entity * e,int s_id)485 static int EXP_resolve_op_group_fuzzy( Type selection, Symbol sref, Entity * e,
486                                        int s_id ) {
487     Entity tmp;
488     int options = 0;
489 
490     if( selection->search_id == s_id ) {
491         return 0;
492     }
493 
494     switch( selection->u.type->body->type ) {
495         case entity_:
496             tmp = ( Entity )ENTITYfind_inherited_entity(
497                       selection->u.type->body->entity, sref.name, 1 );
498             if( tmp ) {
499                 *e = tmp;
500                 return 1;
501             }
502 
503             return 0;
504         case select_:
505             tmp = *e;
506             selection->search_id = s_id;
507             LISTdo( selection->u.type->body->list, t, Type )
508             if( EXP_resolve_op_group_fuzzy( t, sref, e, s_id ) ) {
509                 if( *e != tmp ) {
510                     tmp = *e;
511                     ++options;
512                 }
513             }
514             LISTod;
515 
516             switch( options ) {
517                 case 0:
518                     return 0;
519                 case 1:
520                     return 1;
521                 default:
522                     /* found more than one, so ambiguous */
523                     *e = ENTITY_NULL;
524                     return 1;
525             }
526         default:
527             return 0;
528     }
529 }
530 
EXPresolve_op_group(Expression expr,Scope scope)531 Type EXPresolve_op_group( Expression expr, Scope scope ) {
532     Expression op1 = expr->e.op1;
533     Expression op2 = expr->e.op2;
534     Entity ent_ref = ENTITY_NULL;
535     Entity tmp = ENTITY_NULL;
536     Type op1type;
537 
538     /* stuff for dealing with select_ */
539     int options = 0;
540 
541     /* op1 is entity expression, op2 is entity */
542     /* could be very impossible to determine except */
543     /* at run-time, .... */
544     EXPresolve( op1, scope, Type_Dont_Care );
545     if( is_resolve_failed( op1 ) ) {
546         resolve_failed( expr );
547         return( Type_Bad );
548     }
549     op1type = op1->return_type;
550 
551     switch( op1type->u.type->body->type ) {
552         case generic_:
553         case runtime_:
554         case op_:
555             /* All these cases are very painful to do right */
556             /* "Generic" and sometimes others require runtime evaluation */
557             op2->return_type = Type_Runtime;
558             return( Type_Runtime );
559         case self_:
560         case entity_:
561             /* Get entity denoted by "X\" */
562             tmp = ( ( op1type->u.type->body->type == self_ )
563                     ? scope
564                     : op1type->u.type->body->entity );
565 
566             /* Now get entity denoted by "X\Y" */
567             ent_ref =
568                 ( Entity )ENTITYfind_inherited_entity( tmp, op2->symbol.name, 1 );
569             if( !ent_ref ) {
570                 ERRORreport_with_symbol( ERROR_group_ref_no_such_entity,
571                                          &op2->symbol, op2->symbol.name );
572                 resolve_failed( expr );
573                 return( Type_Bad );
574             }
575 
576             op2->u.entity = ent_ref;
577             op2->return_type = ent_ref->u.entity->type;
578             resolved_all( expr );
579             return( op2->return_type );
580         case select_:
581             __SCOPE_search_id++;
582             /* don't think this actually actually catches anything on the */
583             /* first go-round, but let's be consistent */
584             op1type->search_id = __SCOPE_search_id;
585             LISTdo( op1type->u.type->body->list, t, Type )
586             if( EXP_resolve_op_group_fuzzy( t, op2->symbol, &ent_ref,
587                                             __SCOPE_search_id ) ) {
588                 if( ent_ref != tmp ) {
589                     tmp = ent_ref;
590                     ++options;
591                 }
592             }
593             LISTod;
594 
595             switch( options ) {
596                 case 0:
597                     /* no possible resolutions */
598                     ERRORreport_with_symbol( ERROR_group_ref_no_such_entity,
599                                              &op2->symbol, op2->symbol.name );
600                     resolve_failed( expr );
601                     return( Type_Bad );
602                 case 1:
603                     /* only one possible resolution */
604                     op2->u.entity = ent_ref;
605                     op2->return_type = ent_ref->u.entity->type;
606                     resolved_all( expr );
607                     return( op2->return_type );
608                 default:
609                     /* compile-time ambiguous */
610                     /*      ERRORreport_with_symbol(ERROR_ambiguous_group,*/
611                     /*                  &op2->symbol, op2->symbol.name);*/
612                     return( Type_Runtime );
613             }
614         case array_:
615             if( op1->type->u.type->body->type == self_ ) {
616                 return( Type_Runtime ); /* not sure if there are other cases where Type_Runtime should be returned, or not */
617             } /*  else fallthrough */
618         case unknown_:  /* unable to resolve operand */
619             /* presumably error has already been reported */
620             resolve_failed( expr );
621             return( Type_Bad );
622         case aggregate_:
623 
624         case bag_:
625         case list_:
626         case set_:
627         default:
628             ERRORreport_with_symbol( ERROR_group_ref_unexpected_type,
629                                      &op1->symbol );
630             return( Type_Bad );
631     }
632 }
633 
EXPresolve_op_relational(Expression e,Scope s)634 Type EXPresolve_op_relational( Expression e, Scope s ) {
635     Type t = 0;
636     int failed = 0;
637     Type op1type;
638 
639     /* Prevent op1 from complaining if it fails */
640 
641     EXPresolve( e->e.op1, s, Type_Unknown );
642     failed = is_resolve_failed( e->e.op1 );
643     op1type = e->e.op1->return_type;
644 
645     /* now, either op1 was resolved in which case, we use its return type */
646     /* for typechecking, OR, it wasn't resolved in which case we resolve */
647     /* op2 in such a way that it complains if it fails to resolved */
648 
649     if( op1type == Type_Unknown ) {
650         t = Type_Dont_Care;
651     } else {
652         t = op1type;
653     }
654 
655     EXPresolve( e->e.op2, s, t );
656     if( is_resolve_failed( e->e.op2 ) ) {
657         failed = 1;
658     }
659 
660     /* If op1 wasn't successfully resolved, retry it now with new information */
661 
662     if( ( failed == 0 ) && !is_resolved( e->e.op1 ) ) {
663         EXPresolve( e->e.op1, s, e->e.op2->return_type );
664         if( is_resolve_failed( e->e.op1 ) ) {
665             failed = 1;
666         }
667     }
668 
669     if( failed ) {
670         resolve_failed( e );
671     } else {
672         resolved_all( e );
673     }
674     return( Type_Logical );
675 }
676 
EXPresolve_op_default(Expression e,Scope s)677 void EXPresolve_op_default( Expression e, Scope s ) {
678     int failed = 0;
679 
680     switch( OPget_number_of_operands( e->e.op_code ) ) {
681         case 3:
682             EXPresolve( e->e.op3, s, Type_Dont_Care );
683             failed = is_resolve_failed( e->e.op3 );
684         case 2:
685             EXPresolve( e->e.op2, s, Type_Dont_Care );
686             failed |= is_resolve_failed( e->e.op2 );
687     }
688     EXPresolve( e->e.op1, s, Type_Dont_Care );
689     if( failed || is_resolve_failed( e->e.op1 ) ) {
690         resolve_failed( e );
691     } else {
692         resolved_all( e );
693     }
694 }
695 
696 /* prototype for this func cannot change - it is passed as a fn pointer */
EXPresolve_op_unknown(Expression e,Scope s)697 Type EXPresolve_op_unknown( Expression e, Scope s ) {
698     (void) e; /* quell unused param warning */
699     (void) s;
700     ERRORreport( ERROR_internal_unrecognized_op_in_EXPresolve );
701     return Type_Bad;
702 }
703 
704 typedef Type Resolve_expr_func PROTO( ( Expression , Scope ) );
705 
EXPresolve_op_logical(Expression e,Scope s)706 Type EXPresolve_op_logical( Expression e, Scope s ) {
707     EXPresolve_op_default( e, s );
708     return( Type_Logical );
709 }
EXPresolve_op_array_like(Expression e,Scope s)710 Type EXPresolve_op_array_like( Expression e, Scope s ) {
711 
712     Type op1type;
713     EXPresolve_op_default( e, s );
714     op1type = e->e.op1->return_type;
715 
716     if( TYPEis_aggregate( op1type ) ) {
717         return( op1type->u.type->body->base );
718     } else if( TYPEis_string( op1type ) ) {
719         return( op1type );
720     } else if( op1type == Type_Runtime ) {
721         return( Type_Runtime );
722     } else if( op1type->u.type->body->type == binary_ ) {
723         ERRORreport_with_symbol( ERROR_warn_unsupported_lang_feat, &e->symbol, "indexing on a BINARY", __FILE__, __LINE__ );
724         return( Type_Binary );
725     } else if( op1type->u.type->body->type == generic_ ) {
726         return( Type_Generic );
727     } else if( TYPEis_select( op1type ) ) {
728         int numAggr = 0, numNonAggr = 0;
729         bool sameAggrType = true;
730         Type lasttype = 0;
731 
732         /* FIXME Is it possible that the base type hasn't yet been resolved?
733          * If it is possible, we should signal that we need to come back later... but how? */
734         assert( op1type->symbol.resolved == 1 );
735 
736         /* FIXME We should check for a not...or excluding non-aggregate types in the select, such as
737          * WR1: NOT('INDEX_ATTRIBUTE.COMMON_DATUM_LIST' IN TYPEOF(base)) OR (SELF\shape_aspect.of_shape = base[1]\shape_aspect.of_shape);
738          * (how?)
739          */
740 
741         /* count aggregates and non-aggregates, check aggregate types */
742         LISTdo( op1type->u.type->body->list, item, Type ) {
743             if( TYPEis_aggregate( item ) ) {
744                 numAggr++;
745                 if( lasttype == TYPE_NULL ) {
746                     lasttype = item;
747                 } else {
748                     if( lasttype->u.type->body->type != item->u.type->body->type ) {
749                         sameAggrType = false;
750                     }
751                 }
752             } else {
753                 numNonAggr++;
754             }
755         }
756         LISTod;
757 
758         /* NOTE the following code returns the same data for every case that isn't an error.
759          * It needs to be simplified or extended, depending on whether it works or not. */
760         if( sameAggrType && ( numAggr != 0 ) && ( numNonAggr == 0 ) ) {
761             /*  All are the same aggregation type */
762             return( lasttype->u.type->body->base );
763         } else if( numNonAggr == 0 ) {
764             /*  All aggregates, but different types */
765             ERRORreport_with_symbol( ERROR_warn_indexing_mixed, &e->symbol, op1type->symbol.name );
766             return( lasttype->u.type->body->base ); /*  WARNING I'm assuming that any of the types is acceptable!!! */
767         } else if( numAggr != 0 ) {
768             /*  One or more aggregates, one or more nonaggregates */
769             ERRORreport_with_symbol( ERROR_warn_indexing_mixed, &e->symbol, op1type->symbol.name );
770             return( lasttype->u.type->body->base ); /*  WARNING I'm assuming that any of the types is acceptable!!! */
771         }   /*  Else, all are nonaggregates. This is an error. */
772     }
773     ERRORreport_with_symbol( ERROR_indexing_illegal, &e->symbol );
774     return( Type_Unknown );
775 }
776 
EXPresolve_op_entity_constructor(Expression e,Scope s)777 Type EXPresolve_op_entity_constructor( Expression e, Scope s ) {
778     EXPresolve_op_default( e, s );
779     /* perhaps should return Type_Runtime? */
780     return Type_Entity;
781 }
782 
EXPresolve_op_int_div_like(Expression e,Scope s)783 Type EXPresolve_op_int_div_like( Expression e, Scope s ) {
784     EXPresolve_op_default( e, s );
785     return Type_Integer;
786 }
787 
EXPresolve_op_plus_like(Expression e,Scope s)788 Type EXPresolve_op_plus_like( Expression e, Scope s ) {
789     /* i.e., Integer or Real */
790     EXPresolve_op_default( e, s );
791     if( is_resolve_failed( e ) ) {
792         resolve_failed( e );
793         return( Type_Unknown );
794     }
795 
796     /* could produce better results with a lot of pain but the EXPRESS */
797     /* spec is a little confused so what's the point.  For example */
798     /* it says bag+set=bag */
799     /*     and set+bag=set */
800     /*     and set+list=set */
801     /*     and list+set=? */
802 
803     /* crude but sufficient */
804     if( ( TYPEis_aggregate( e->e.op1->return_type ) ) ||
805             ( TYPEis_aggregate( e->e.op2->return_type ) ) ) {
806         return Type_Aggregate;
807     }
808 
809     /* crude but sufficient */
810     if( ( e->e.op1->return_type->u.type->body->type == real_ ) ||
811             ( e->e.op2->return_type->u.type->body->type == real_ ) ) {
812         return( Type_Real );
813     }
814     return Type_Integer;
815 }
816 
EXPresolve_op_unary_minus(Expression e,Scope s)817 Type EXPresolve_op_unary_minus( Expression e, Scope s ) {
818     EXPresolve_op_default( e, s );
819     return e->e.op1->return_type;
820 }
821 
822 /** Initialize one entry in EXPop_table
823  * This table's function pointers are resolved in \sa EXP_resolve()
824  * , at approx resolve.c:520
825  * \sa EXPop_init()
826  *
827  * \param token_number operator value, usually in macro form
828  * \param string human-readable description
829  * \param resolve_func   resolves an expression of this type
830  */
EXPop_create(int token_number,char * string,Resolve_expr_func * resolve_func)831 void EXPop_create( int token_number, char * string, Resolve_expr_func * resolve_func ) {
832     EXPop_table[token_number].token = string;
833     EXPop_table[token_number].resolve = resolve_func;
834 }
835 
EXPop_init()836 void EXPop_init() {
837     EXPop_create( OP_AND, "AND",      EXPresolve_op_logical );
838     EXPop_create( OP_ANDOR, "ANDOR",      EXPresolve_op_logical );
839     EXPop_create( OP_ARRAY_ELEMENT, "[array element]", EXPresolve_op_array_like );
840     EXPop_create( OP_CONCAT, "||",        EXPresolve_op_entity_constructor );
841     EXPop_create( OP_DIV, "/ (INTEGER)",  EXPresolve_op_int_div_like );
842     EXPop_create( OP_DOT, ".",        EXPresolve_op_dot );
843     EXPop_create( OP_EQUAL, "=",      EXPresolve_op_relational );
844     EXPop_create( OP_EXP, "**",       EXPresolve_op_plus_like );
845     EXPop_create( OP_GREATER_EQUAL, ">=", EXPresolve_op_relational );
846     EXPop_create( OP_GREATER_THAN, ">",   EXPresolve_op_relational );
847     EXPop_create( OP_GROUP, "\\",     EXPresolve_op_group );
848     EXPop_create( OP_IN, "IN",        EXPresolve_op_relational );
849     EXPop_create( OP_INST_EQUAL, ":=:",   EXPresolve_op_relational );
850     EXPop_create( OP_INST_NOT_EQUAL, ":<>:",  EXPresolve_op_relational );
851     EXPop_create( OP_LESS_EQUAL, "<=",    EXPresolve_op_relational );
852     EXPop_create( OP_LESS_THAN, "<",      EXPresolve_op_relational );
853     EXPop_create( OP_LIKE, "LIKE",        EXPresolve_op_relational );
854     EXPop_create( OP_MINUS, "- (MINUS)",  EXPresolve_op_plus_like );
855     EXPop_create( OP_MOD, "MOD",      EXPresolve_op_int_div_like );
856     EXPop_create( OP_NEGATE, "- (NEGATE)",    EXPresolve_op_unary_minus );
857     EXPop_create( OP_NOT, "NOT",      EXPresolve_op_logical );
858     EXPop_create( OP_NOT_EQUAL, "<>",     EXPresolve_op_relational );
859     EXPop_create( OP_OR, "OR",        EXPresolve_op_logical );
860     EXPop_create( OP_PLUS, "+",       EXPresolve_op_plus_like );
861     EXPop_create( OP_REAL_DIV, "/ (REAL)",    EXPresolve_op_plus_like );
862     EXPop_create( OP_SUBCOMPONENT, "[:]", EXPresolve_op_array_like );
863     EXPop_create( OP_TIMES, "*",      EXPresolve_op_plus_like );
864     EXPop_create( OP_XOR, "XOR",      EXPresolve_op_logical );
865     EXPop_create( OP_UNKNOWN, "UNKNOWN OP",   EXPresolve_op_unknown );
866 }
867 
868 
869 /**
870 ** \param op operation
871 ** \param operand1 - first operand
872 ** \param operand2 - second operand
873 ** \param operand3 - third operand
874 ** \returns Ternary_Expression  - the expression created
875 ** Create a ternary operation Expression.
876 */
TERN_EXPcreate(Op_Code op,Expression operand1,Expression operand2,Expression operand3)877 Expression TERN_EXPcreate( Op_Code op, Expression operand1, Expression operand2, Expression operand3 ) {
878     Expression e = EXPcreate( Type_Expression );
879 
880     e->e.op_code = op;
881     e->e.op1 = operand1;
882     e->e.op2 = operand2;
883     e->e.op3 = operand3;
884     return e;
885 }
886 
887 /**
888 ** \fn BIN_EXPcreate
889 ** \param op       operation
890 ** \param operand1 - first operand
891 ** \param operand2 - second operand
892 ** \returns Binary_Expression   - the expression created
893 ** Create a binary operation Expression.
894 */
BIN_EXPcreate(Op_Code op,Expression operand1,Expression operand2)895 Expression BIN_EXPcreate( Op_Code op, Expression operand1, Expression operand2 ) {
896     Expression e = EXPcreate( Type_Expression );
897 
898     e->e.op_code = op;
899     e->e.op1 = operand1;
900     e->e.op2 = operand2;
901     return e;
902 }
903 
904 /**
905 ** \param op operation
906 ** \param operand  operand
907 ** \returns the expression created
908 ** Create a unary operation Expression.
909 */
UN_EXPcreate(Op_Code op,Expression operand)910 Expression UN_EXPcreate( Op_Code op, Expression operand ) {
911     Expression e = EXPcreate( Type_Expression );
912 
913     e->e.op_code = op;
914     e->e.op1 = operand;
915     return e;
916 }
917 
918 /**
919 ** \param local local identifier for source elements
920 ** \param aggregate source aggregate to query
921 ** \returns the query expression created
922 ** Create a query Expression.
923 ** NOTE Dec 2011 - MP - function description did not match actual params. Had to guess.
924 */
QUERYcreate(Symbol * local,Expression aggregate)925 Expression QUERYcreate( Symbol * local, Expression aggregate ) {
926     Expression e = EXPcreate_from_symbol( Type_Query, local );
927     Scope s = SCOPEcreate_tiny( OBJ_QUERY );
928     Expression e2 = EXPcreate_from_symbol( Type_Attribute, local );
929 
930     Variable v = VARcreate( e2, Type_Attribute );
931 
932     DICTdefine( s->symbol_table, local->name, ( Generic )v, &e2->symbol, OBJ_VARIABLE );
933     e->u.query = QUERY_new();
934     e->u.query->scope = s;
935     e->u.query->local = v;
936     e->u.query->aggregate = aggregate;
937     return e;
938 }
939 
940 /**
941 ** \param expression  expression to evaluate
942 ** \param experrc buffer for error code
943 ** \returns value of expression
944 ** Compute the value of an integer expression.
945 */
EXPget_integer_value(Expression expression)946 int EXPget_integer_value( Expression expression ) {
947     experrc = ERROR_none;
948     if( expression == EXPRESSION_NULL ) {
949         return 0;
950     }
951     if( expression->return_type->u.type->body->type == integer_ ) {
952         return INT_LITget_value( expression );
953     } else {
954         experrc = ERROR_integer_expression_expected;
955         return 0;
956     }
957 }
958 
opcode_print(Op_Code o)959 char * opcode_print( Op_Code o ) {
960     switch( o ) {
961         case OP_AND:
962             return( "OP_AND" );
963         case OP_ANDOR:
964             return( "OP_ANDOR" );
965         case OP_ARRAY_ELEMENT:
966             return( "OP_ARRAY_ELEMENT" );
967         case OP_CONCAT:
968             return( "OP_CONCAT" );
969         case OP_DIV:
970             return( "OP_DIV" );
971         case OP_DOT:
972             return( "OP_DOT" );
973         case OP_EQUAL:
974             return( "OP_EQUAL" );
975         case OP_EXP:
976             return( "OP_EXP" );
977         case OP_GREATER_EQUAL:
978             return( "OP_GREATER_EQUAL" );
979         case OP_GREATER_THAN:
980             return( "OP_GREATER_THAN" );
981         case OP_GROUP:
982             return( "OP_GROUP" );
983         case OP_IN:
984             return( "OP_IN" );
985         case OP_INST_EQUAL:
986             return( "OP_INST_EQUAL" );
987         case OP_INST_NOT_EQUAL:
988             return( "OP_INST_NOT_EQUAL" );
989         case OP_LESS_EQUAL:
990             return( "OP_LESS_EQUAL" );
991         case OP_LESS_THAN:
992             return( "OP_LESS_THAN" );
993         case OP_LIKE:
994             return( "OP_LIKE" );
995         case OP_MINUS:
996             return( "OP_MINUS" );
997         case OP_MOD:
998             return( "OP_MOD" );
999         case OP_NEGATE:
1000             return( "OP_NEGATE" );
1001         case OP_NOT:
1002             return( "OP_NOT" );
1003         case OP_NOT_EQUAL:
1004             return( "OP_NOT_EQUAL" );
1005         case OP_OR:
1006             return( "OP_OR" );
1007         case OP_PLUS:
1008             return( "OP_PLUS" );
1009         case OP_REAL_DIV:
1010             return( "OP_REAL_DIV" );
1011         case OP_SUBCOMPONENT:
1012             return( "OP_SUBCOMPONENT" );
1013         case OP_TIMES:
1014             return( "OP_TIMES" );
1015         case OP_XOR:
1016             return( "OP_XOR" );
1017         case OP_UNKNOWN:
1018             return( "OP_UNKNOWN" );
1019         default:
1020             return( "no such op" );
1021     }
1022 }
1023