home *** CD-ROM | disk | FTP | other *** search
/ ftptest.leeds.ac.uk / 2015.02.ftptest.leeds.ac.uk.tar / ftptest.leeds.ac.uk / bionet / CAE-GROUP / SCL-WIN3x / FED_PLUS.EXE / RESOLVE.C < prev    next >
C/C++ Source or Header  |  1994-07-23  |  46KB  |  1,560 lines
  1. static char rcsid[] = "$Id: resolve.c,v 1.7 1994/05/11 19:51:24 libes Exp $";
  2.  
  3. /*
  4.  * This software was developed by U.S. Government employees as part of
  5.  * their official duties and is not subject to copyright.
  6.  *
  7.  * $Log: resolve.c,v $
  8.  * Revision 1.7  1994/05/11  19:51:24  libes
  9.  * numerous fixes
  10.  *
  11.  * Revision 1.6  1993/10/15  18:48:48  libes
  12.  * CADDETC certified
  13.  *
  14.  * Revision 1.4  1993/02/16  03:24:37  libes
  15.  * fixed numerous type botches (see comment in expparse.y)
  16.  * fixed statement handling botches
  17.  * completed implicit sub/supertypes
  18.  * misc other fixeds
  19.  *
  20.  * Revision 1.3  1993/01/19  22:17:27  libes
  21.  * *** empty log message ***
  22.  *
  23.  * Revision 1.2  1992/09/16  18:23:08  libes
  24.  * fixed bug in TYPEresolve connecting reference types back to using types
  25.  *
  26.  * Revision 1.1  1992/08/18  17:13:43  libes
  27.  * Initial revision
  28.  *
  29.  * Revision 1.4  1992/06/08  18:06:57  libes
  30.  * prettied up interface to print_objects_when_running
  31.  *
  32.  */
  33.  
  34. #define RESOLVE_C
  35. #include "resolve.h"
  36. #include "expr.h"
  37. #include "stack.h"
  38. #include "schema.h"
  39. #include "express.h"
  40. #include "error.h"
  41. #include <stdlib.h>
  42.  
  43. static void ENTITYresolve_subtypes PROTO((Schema));
  44. static void ENTITYresolve_supertypes PROTO((Entity));
  45. static void TYPEresolve_expressions PROTO((Type,Scope));
  46. static_inline Boolean ERRORis_enabled(Error error);
  47. static Error ERROR_wrong_arg_count;
  48. static Error ERROR_supertype_resolve;
  49. static Error ERROR_subtype_resolve;
  50. static Error ERROR_unknown_attr_in_entity;
  51. static Error ERROR_not_a_type;
  52. static Error ERROR_funcall_not_a_function;
  53. static Error ERROR_undefined_func;
  54. static Error ERROR_undefined;
  55. static Error ERROR_expected_proc;
  56. static Error ERROR_no_such_procedure;
  57. static Error ERROR_query_requires_aggregate;
  58. static Error ERROR_self_is_unknown;
  59. static Error ERROR_inverse_bad_attribute;
  60. static Error ERROR_inverse_bad_entity;
  61. static Error ERROR_subsuper_loop;
  62. static Error ERROR_subsuper_continuation;
  63. static Error ERROR_type_is_entity;
  64.  
  65. static Type self = 0;    /* always points to current value of SELF */
  66.             /* or 0 if none */
  67.  
  68. /***********************/
  69. /* function prototypes */
  70. /***********************/
  71.  
  72. static void WHEREresolve PROTO((Linked_List,Scope));
  73. extern void VAR_resolve_expressions PROTO((Variable,Entity));  
  74. extern void VAR_resolve_types PROTO((Variable,Entity));  
  75.  
  76. /*
  77. ** Procedure:    RESOLVEinitialize
  78. ** Parameters:    -- none --
  79. ** Returns:    void
  80. ** Description:    Initialize the Fed-X second pass.
  81. */
  82.  
  83. void
  84. RESOLVEinitialize(void)
  85. {
  86.     ERROR_undefined = ERRORcreate(
  87. "Reference to undefined object %s.",SEVERITY_ERROR);
  88.     ERROR_undefined_attribute = ERRORcreate(
  89. "Reference to undefined attribute %s.",SEVERITY_ERROR);
  90.     ERROR_undefined_type = ERRORcreate(
  91. "Reference to undefined type %s.", SEVERITY_ERROR);
  92.     ERROR_undefined_schema = ERRORcreate(
  93. "Reference to undefined schema %s.", SEVERITY_ERROR);
  94.     ERROR_unknown_subtype = ERRORcreate(
  95. "Unknown subtype %s for entity %s.", SEVERITY_EXIT);
  96. /*"Unknown subtype %s for entity %s.", SEVERITY_WARNING);*/
  97.     ERROR_unknown_supertype = ERRORcreate(
  98. "Unknown supertype %s for entity %s.", SEVERITY_ERROR);
  99.    ERROR_circular_reference = ERRORcreate(
  100. "Circularity: definition of %s references itself.",SEVERITY_ERROR);
  101. /*"Circular definition: schema %s referenced schema %s.",SEVERITY_ERROR);*/
  102.    ERROR_subsuper_loop = ERRORcreate(
  103. "Entity %s is a subtype of itself",SEVERITY_ERROR);
  104.    ERROR_subsuper_continuation = ERRORcreate(
  105. "via supertype entity %s",SEVERITY_ERROR);
  106.    ERROR_supertype_resolve = ERRORcreate(
  107. "Supertype %s is not an entity (line %d).",SEVERITY_ERROR);
  108.    ERROR_subtype_resolve = ERRORcreate(
  109. "Subtype %s resolves to non-entity %s on line %d.",SEVERITY_ERROR);
  110.    ERROR_unknown_attr_in_entity = ERRORcreate(
  111. "Unknown attribute %s in entity %s.", SEVERITY_ERROR);
  112.    ERROR_not_a_type = ERRORcreate(
  113. "Expected a type (or entity) but %s is %s.",SEVERITY_ERROR);
  114.     ERROR_funcall_not_a_function = ERRORcreate(
  115. "Function call of %s which is not a function.",SEVERITY_ERROR);
  116.     ERROR_undefined_func = ERRORcreate(
  117. "Function %s undefined.",SEVERITY_ERROR);
  118.     ERROR_expected_proc = ERRORcreate(
  119. "%s is used as a procedure call but is not defined as one (line %d).",SEVERITY_ERROR);
  120.     ERROR_no_such_procedure = ERRORcreate(
  121. "No such procedure as %s.",SEVERITY_ERROR);
  122.     ERROR_wrong_arg_count = ERRORcreate(
  123. "Call to %s uses %d arguments, but expected %d.",SEVERITY_WARNING);
  124.     ERROR_query_requires_aggregate = ERRORcreate(
  125. "Query expression source must be an aggregate.",SEVERITY_ERROR);
  126.     ERROR_self_is_unknown = ERRORcreate(
  127. "SELF is not within an entity declaration",SEVERITY_ERROR);
  128.     ERROR_inverse_bad_entity = ERRORcreate(
  129. "Attribute %s is referenced from non-entity-inheriting type.",SEVERITY_ERROR);
  130.     ERROR_inverse_bad_attribute = ERRORcreate(
  131. "Unknown attribute %s in entity %s in inverse.", SEVERITY_ERROR);
  132.     ERROR_type_is_entity = ERRORcreate(
  133. "An entity (%s) is not acceptable as an underlying type",SEVERITY_ERROR);
  134.  
  135.     ERRORcreate_warning("circular_subtype",ERROR_subsuper_loop);
  136.     ERRORcreate_warning("entity_as_type",ERROR_type_is_entity);
  137.  
  138. #if 0
  139.  
  140.    ERROR_undefined_object = ERRORcreate(
  141. "Reference to undefined object %s.", SEVERITY_ERROR);
  142.    ERROR_undefined_entity = ERRORcreate(
  143. "Reference to undefined entity %s.", SEVERITY_ERROR);
  144.     ERROR_inappropriate_use = ERRORcreate(
  145. "Inappropriate use of symbol %s.", SEVERITY_ERROR);
  146.    ERROR_overshadowed_reference = ERRORcreate(
  147. "Referenced item %s already exists on line %d.", SEVERITY_WARNING);
  148.    ERROR_overloaded_reference  = ERRORcreate(
  149. "Referenced item %s already referenced on line %d.", SEVERITY_WARNING);
  150.     ERROR_missing_subtype = ERRORcreate(
  151. "Entity %s missing from subtype list for supertype %s.", SEVERITY_WARNING);
  152.     ERROR_missing_supertype = ERRORcreate(
  153. "Entity %s missing from supertype list for subtype %s.", SEVERITY_ERROR);
  154.     ERROR_overloaded_attribute = ERRORcreate(
  155. "Attribute %s previously defined in supertype %s.", SEVERITY_ERROR);
  156.     ERROR_shadow_decl = ERRORcreate(
  157. "Declaration of %s shadows previous declaration on line %d.", SEVERITY_WARNING);
  158.     ERROR_group_reference_syntax = ERRORcreate(
  159. "Bad syntax in group reference syntax.  Should be entity\\supertype",SEVERITY_EXIT);
  160.  
  161. #endif
  162. }
  163.  
  164. /*
  165. ** Procedure:    EXPresolve
  166. ** Parameters:    Expression expression    - expression to resolve
  167. **        Boolean       group_qualified - true if attribute reference that
  168. **                    will later be group qualified
  169. **        Scope      scope    - scope in which to resolve
  170. ** Returns:    void
  171. ** Description:    Resolve all references in an expression.
  172. */
  173.  
  174. void
  175. EXP_resolve(Expression expr, Scope scope,Type typecheck)
  176. {
  177.     Function f;
  178.     Symbol *sym;
  179.     Generic x;
  180.     Entity e;
  181.     Type t;
  182.     int func_args_checked = false;
  183.  
  184. /*    if (expr == EXPRESSION_NULL)
  185.         return;
  186. */
  187.     switch (expr->type->u.type->body->type) {
  188.     case funcall_:
  189.         /* functions with no arguments get handled elsewhere */
  190.         /* because the parser sees them just like attributes */
  191.  
  192.         x = SCOPEfind(scope,expr->symbol.name,
  193.                 SCOPE_FIND_FUNCTION|SCOPE_FIND_ENTITY);
  194.         if (!x) {
  195.             ERRORreport_with_symbol(ERROR_undefined_func,
  196.                 &expr->symbol,expr->symbol.name);
  197.             resolve_failed(expr);
  198.             break;
  199.         }
  200.         if ((DICT_type != OBJ_FUNCTION) && (DICT_type != OBJ_ENTITY)) {
  201.             sym = OBJget_symbol(x,DICT_type);
  202.             ERRORreport_with_symbol(ERROR_funcall_not_a_function,
  203.                 &expr->symbol,sym->name);
  204.             resolve_failed(expr);
  205.             break;
  206.         }
  207.         /* original code accepted rules, too? */
  208.  
  209.         /* entities are treated like implicit constructor functions */
  210.         if (DICT_type == OBJ_ENTITY) {
  211.             Type self_old = self; /* save previous in the */
  212.                 /* unlikely but possible case that SELF */
  213.                 /* is in a derived initialization of an */
  214.                 /* entity */
  215.             e = (Entity)x;
  216.             self = e->u.entity->type;
  217. /* skip parameter resolution for now */
  218. /*            ARGresolve();*/
  219.             expr->return_type = e->u.entity->type;
  220.             self = self_old;    /* restore old SELF */
  221.         } else {
  222.             f = (Function)x;
  223.             expr->return_type = f->u.func->return_type;
  224.  
  225.             /* do argument typechecking here if requested */
  226.             /* currently, we just check arg count; necesary */
  227.             /* to NVL code later which assumes args are present */
  228.             if (LISTget_length(expr->u.funcall.list) != 
  229.                     f->u.func->pcount) {
  230.                 ERRORreport_with_symbol(ERROR_wrong_arg_count,
  231.                     &expr->symbol,expr->symbol.name,
  232.                     LISTget_length(expr->u.funcall.list),
  233.                     f->u.func->pcount);
  234.             }
  235.  
  236. #if future_work
  237.             if (EXPRESS_lint) {
  238.                 /* verify parameters match function call */
  239.             }
  240. #endif
  241.  
  242.             /* should make this data-driven! */
  243.             if (f == FUNC_NVL) {
  244.                 EXPresolve((Expression)LISTget_first(expr->u.funcall.list),scope,typecheck);
  245.                 EXPresolve((Expression)LISTget_second(expr->u.funcall.list),scope,typecheck);
  246.                 func_args_checked = true;
  247.             }
  248.  
  249.             if (f == FUNC_USEDIN) {
  250.                 expr->return_type = Type_Set_Of_Generic;
  251.             }
  252.         }
  253.         if (!func_args_checked) {
  254.             LISTdo (expr->u.funcall.list, param, Expression )
  255.                 EXPresolve(param,scope,Type_Dont_Care);
  256.                 if (is_resolve_failed(param)) {
  257.                     resolve_failed(expr);
  258.                     break;
  259.                 }
  260.             LISTod;
  261.         }
  262.  
  263. #if 0
  264.         /* add function or entity as first element of list */
  265.         LISTadd_first(expr->u.list,x);
  266. #endif
  267.         expr->u.funcall.function = x;
  268.  
  269.         resolved_all(expr);
  270.         break;
  271.     case aggregate_:
  272.         LISTdo (expr->u.list,elt, Expression )
  273.             EXPresolve(elt,scope,Type_Dont_Care);
  274.             if (is_resolve_failed(elt)) {
  275.                 resolve_failed(expr);
  276.                 break;
  277.             }
  278.         LISTod;
  279.  
  280.         /* may have to do more work here! */
  281.         expr->return_type = expr->type;
  282.         resolved_all(expr);
  283.         break;
  284.     case identifier_:
  285.  
  286.         /* if this must match an enumeration, try first looking */
  287.         /* in the enumeration tag scope */
  288.         x = 0;
  289.         if (typecheck->u.type->body->type == enumeration_) {
  290.             x = DICTlookup(TYPEget_enum_tags(typecheck),expr->symbol.name);
  291.         }
  292.         /* if not an enumeration tag, assume it's an attribute */
  293.         if (!x) x = (Generic)VARfind(scope,expr->symbol.name,0);
  294.         /* if not found as attribute, try as function, etc ... */
  295.         if (!x) x = SCOPEfind(scope,expr->symbol.name,
  296.                 SCOPE_FIND_ANYTHING);
  297.         if (!x) {
  298.             if (typecheck == Type_Unknown) return;
  299.             else {
  300.                 ERRORreport_with_symbol(ERROR_undefined,
  301.                     &expr->symbol,expr->symbol.name);
  302.                 resolve_failed(expr);
  303.                 break;
  304.             }
  305.         }
  306.         switch (DICT_type) {
  307.         case OBJ_VARIABLE:
  308.             expr->u.variable = (Variable)x;
  309. #if 0
  310. /* gee, I don't see what variables have to go through this right here */
  311.             VARresolve_expressions(expr->u.variable,scope);
  312.             if (is_resolve_failed(expr->u.variable->name)) {
  313.                 resolve_failed(expr);
  314.                 break;
  315.             }
  316. #endif
  317.             /* Geez, don't wipe out original type! */
  318.             expr->return_type = expr->u.variable->type;
  319.             resolved_all(expr);
  320.             break;
  321.         case OBJ_ENTITY:
  322.             expr->return_type = expr->type = ((Entity)x)->u.entity->type;
  323.             /* entity may not actually be resolved by now */
  324.             /* but I don't think that's a problem */
  325.             resolved_all(expr);
  326.             break;
  327.         case OBJ_EXPRESSION:
  328.             /* so far only enumerations get returned this way */
  329.             expr->u.expression = (Expression )x;
  330.             expr->type = expr->return_type = ((Expression )x)->type;
  331.             resolved_all(expr);
  332.             break;
  333.         case OBJ_FUNCTION:
  334.             /* functions with no args end up here because the */
  335.             /* parser doesn't know any better */
  336.             expr->u.list = LISTcreate();
  337.             LISTadd(expr->u.list,x);
  338.             expr->type = Type_Funcall;
  339.             expr->return_type = ((Function)x)->u.func->return_type;
  340.             /* function may not actually be resolved by now */
  341.             /* but I don't think that's a problem */
  342.  
  343.             if (((Function)x)->u.func->pcount != 0) {
  344.                 ERRORreport_with_symbol(ERROR_wrong_arg_count,
  345.                     &expr->symbol,expr->symbol.name,0,
  346.                     f->u.func->pcount);
  347.                 resolve_failed(expr);
  348.             } else {
  349.                 resolved_all(expr);
  350.             }
  351.             break;                
  352.         case OBJ_TYPE:
  353.             /* enumerations can appear here, I don't know about others */
  354.             expr->type = (Type)x;
  355.             expr->return_type = (Type)x;
  356.             expr->symbol.resolved = expr->type->symbol.resolved;
  357.             break;
  358.         default:
  359.             printf("unexpected type in EXPresolve.  Press ^C now to trap to debugger\n");
  360.             getchar();
  361.             break;
  362.         }
  363.         break;
  364.     case op_:
  365.         expr->return_type = (*EXPop_table[expr->e.op_code].resolve)(expr,scope);
  366.         break;
  367.     case entity_:            /* only 'self' is seen this way */
  368.     case self_:
  369.         if (self) {
  370.             expr->return_type = self;
  371.             /* we can't really call ourselves resolved, but we */
  372.             /* will be by the time we return, and besides, */
  373.             /* there's no way this will be accessed if the true */
  374.             /* entity fails resolution */
  375.             resolved_all(expr);
  376.         } else {
  377.             ERRORreport_with_symbol(ERROR_self_is_unknown,&scope->symbol);
  378.             resolve_failed(expr);
  379.         }
  380.         break;
  381.     case query_:
  382.         EXPresolve(expr->u.query->aggregate,expr->u.query->scope,Type_Dont_Care);
  383.         expr->return_type = expr->u.query->aggregate->return_type;
  384.  
  385.         /* verify that it's an aggregate */
  386.         if (is_resolve_failed(expr->u.query->aggregate)) {
  387.             resolve_failed(expr);
  388.             break;
  389.         }
  390.         if (TYPEis_aggregate(expr->return_type)) {
  391.             t = expr->u.query->aggregate->return_type->u.type->body->base;
  392.         } else if (TYPEis_runtime(expr->return_type)) {
  393.             t = Type_Runtime;
  394.         } else {
  395.             ERRORreport_with_symbol(ERROR_query_requires_aggregate,&expr->u.query->aggregate->symbol);
  396.             resolve_failed(expr);
  397.             break;
  398.         }
  399.         expr->u.query->local->type = t;
  400.         expr->u.query->local->name->return_type = t;
  401.         EXPresolve(expr->u.query->expression,expr->u.query->scope,Type_Dont_Care);
  402.         expr->symbol.resolved = expr->u.query->expression->symbol.resolved;
  403.         break;
  404.     case integer_:
  405.     case real_:
  406.     case string_:
  407.     case binary_:
  408.     case boolean_:
  409.     case logical_:
  410.     case number_:
  411.     case attribute_:
  412.         expr->return_type = expr->type;
  413.         resolved_all(expr);
  414.         break;
  415.     default:
  416.         printf("unexpected type in EXPresolve.  Press ^C now to trap to debugger\n");
  417.         exit(0);
  418.     }
  419. }
  420.  
  421. int
  422. ENTITYresolve_subtype_expression(Expression expr, Entity ent/*was scope*/, Linked_List *flat)
  423. {
  424.     Entity ent_ref;
  425.     int i = UNRESOLVED;
  426.  
  427.     if (!expr) {
  428.     return (RESOLVED);
  429.     } else if (TYPEis_expression(expr->type)) {
  430.     i = ENTITYresolve_subtype_expression(expr->e.op1,ent,flat);
  431.     i |= ENTITYresolve_subtype_expression(expr->e.op2,ent,flat);
  432.     } else if (TYPEis_oneof(expr->type)) {
  433.     LISTdo(expr->u.list, sel, Expression )
  434.         i |= ENTITYresolve_subtype_expression(sel, ent, flat);
  435.     LISTod;
  436.     } else {
  437.     /* must be a simple entity reference */
  438.     ent_ref = (Entity)SCOPEfind(ent->superscope,expr->symbol.name,SCOPE_FIND_ENTITY);
  439.     if (!ent_ref) {
  440.         ERRORreport_with_symbol(ERROR_unknown_subtype,&ent->symbol,
  441.             expr->symbol.name,ent->symbol.name);
  442.         i = RESOLVE_FAILED;
  443.     } else if (DICT_type != OBJ_ENTITY) {
  444.         Symbol *sym = OBJget_symbol(ent_ref,DICT_type);
  445.         /* line number should really be on supertype name, */
  446.         /* but all we have easily is the entity line number */
  447.         ERRORreport_with_symbol(ERROR_subtype_resolve,&ent->symbol,
  448.                 expr->symbol.name,sym->line);
  449.         i = RESOLVE_FAILED;
  450.     } else {
  451.         int found = false;
  452.  
  453.         /* link in to flat list */
  454.         if (!*flat) *flat = LISTcreate();
  455.  
  456.         LISTdo(*flat,sub,Entity)
  457.                 if (sub == ent_ref) {
  458.                     found = true;
  459.                     break;
  460.                 }
  461.         LISTod
  462.  
  463.         if (!found) LISTadd_last(*flat, (Generic)ent_ref);
  464.  
  465.         /* link in to expression */
  466.         expr->type = ent_ref->u.entity->type;
  467.         i = RESOLVED;
  468.  
  469. #if 0
  470.         /* If the user said there was a subtype relationship but */
  471.         /* did not mentioned the reverse supertype relationship */
  472.         /* force it to be explicitly known by listing this entity */
  473.         /* in the ref'd entity's supertype list */
  474.         LISTdo(ent_ref->u.entity->supertypes,sup,Entity)
  475.             if (sup == ent) {
  476.                 found = true;
  477.                 break;
  478.             }
  479.         LISTod
  480.         if (!found) {
  481.             if (!ent_ref->u.entity->supertypes)
  482.                 ent_ref->u.entity->supertypes = LISTcreate();
  483.             LISTadd_last(ent_ref->u.entity->supertypes,(Generic)ent);
  484.         }
  485. #endif
  486.     }
  487.     }
  488.     return(i);
  489. }
  490.  
  491. /*
  492. ** Procedure:    TYPEresolve
  493. ** Parameters:    Type  type    - type to resolve
  494. **        Scope scope    - scope in which to resolve
  495. ** Returns:    returns true type
  496. ** Description:    Resolve all references in a type.
  497. */
  498.  
  499. void
  500. TYPE_resolve(Type *typeaddr /*, Scope scope*/)
  501. {
  502.     Type type = *typeaddr;
  503.     Type ref_type;
  504.     TypeBody body = type->u.type->body;
  505.     Scope scope = type->superscope;
  506.  
  507.     if (body) {
  508.         /* complex type definition such as aggregates, enums, ... */
  509.  
  510.         resolve_in_progress(type);
  511.  
  512.         if (TYPEis_aggregate(type)) {
  513.             TYPEresolve(&body->base, scope);
  514.             /* only really critical failure point for future use */
  515.             /* of this type is the base type, ignore others (above) */
  516.             type->symbol.resolved = body->base->symbol.resolved;
  517.         } else if (TYPEis_select(type)) {
  518.             LISTdo_links(body->list,link)
  519.             TYPEresolve((Type *)&link->data,scope);
  520.             if (is_resolve_failed((Type)link->data)) {
  521.                 resolve_failed(type);
  522.                 break;
  523.             }
  524.             LISTod;
  525.         }
  526.     } else if (type->u.type->head) {
  527.         /* simple type definition such as "TYPE T = U" */
  528.         resolve_in_progress(type);
  529.  
  530.         TYPEresolve(&type->u.type->head,scope);
  531.  
  532.         if (!is_resolve_failed(type->u.type->head)) {
  533.             if (ERRORis_enabled(ERROR_type_is_entity)) {
  534.                 if (TYPEis_entity(type->u.type->head)) {
  535.                     ERRORreport_with_symbol(ERROR_type_is_entity,&type->symbol,type->u.type->head->u.type->body->entity->symbol.name);
  536.                     resolve_failed(type);
  537.                 }
  538.             }
  539.             /* allow type ref's to be bypassed by caching true type */
  540.             type->u.type->body = type->u.type->head->u.type->body;
  541.         }
  542.     } else {
  543.         /* simple type reference such as "T" */
  544.  
  545.         ref_type = (Type)SCOPEfind(scope, type->symbol.name,
  546.                 SCOPE_FIND_TYPE | SCOPE_FIND_ENTITY);
  547.         if (!ref_type) {
  548.             ERRORreport_with_symbol(ERROR_undefined_type,&type->symbol,type->symbol.name);
  549.             *typeaddr = Type_Bad; /* just in case */
  550.             resolve_failed(type);
  551.         } else if (DICT_type == OBJ_TYPE) {
  552.             /* due to declarations of multiple attributes off of a */
  553.             /* single type ref, we have to use reference counts */
  554.             /* to safely deallocate the TypeHead.  It's trivial to do */
  555.             /* but gaining back the memory isn't worth the CPU time. */
  556.             /* if (type->refcount--) TYPE_destroy(type); */
  557.  
  558.             type = *typeaddr = ref_type;
  559.             TYPEresolve(typeaddr,scope);  /* addr doesn't matter here */
  560.                         /* it will not be written through */
  561.         } else if (DICT_type == OBJ_ENTITY) {
  562.             /* if (type->refcount--) TYPE_destroy(type); see above */
  563.  
  564.             type = *typeaddr = ((Entity)ref_type)->u.entity->type;
  565.         } else {
  566.             ERRORreport_with_symbol(ERROR_not_a_type,&type->symbol,type->symbol.name,
  567.                 OBJget_type(DICT_type));
  568.             resolve_failed(type);
  569.         }
  570.     }
  571.  
  572.     if (!is_resolve_failed(type)) resolved_all(type);
  573.     return;
  574. }
  575.  
  576. /*
  577. ** Procedure:    VARresolve
  578. ** Parameters:    Variable variable    - variable to resolve
  579. **        Scope    scope        - scope in which to resolve
  580. ** Returns:    void
  581. ** Description:    Resolve all references in a variable definition.
  582. */
  583.  
  584. void
  585. VAR_resolve_expressions(Variable v, Entity entity /* was scope */)
  586. {
  587.     EXPresolve(v->name,entity,Type_Dont_Care);    /* new!! */
  588.  
  589.     if (v->initializer) {
  590.         EXPresolve(v->initializer, entity,v->type);
  591.  
  592.         if (is_resolve_failed(v->initializer)) {
  593.         resolve_failed(v->name);
  594.         }
  595.     }
  596. }
  597.  
  598. void
  599. VAR_resolve_types(Variable v, Entity entity /* was scope */)
  600. {
  601.     int failed = 0;
  602.  
  603.     TYPEresolve(&v->type,entity);
  604.     failed = is_resolve_failed(v->type);
  605.  
  606.     if (v->inverse_symbol && (!v->inverse_attribute)) {
  607.         /* resolve inverse */
  608.         Variable attr;
  609.         Type type = v->type;
  610.  
  611.         if (TYPEis_aggregate(type)) {
  612.             /* pull entity out of aggregate type defn for ... */
  613.             /* inverse var: set (or bag) of entity for ...; */
  614.             type = type->u.type->body->base;
  615.         }
  616.         if (type->u.type->body->type != entity_) {
  617.             ERRORreport_with_symbol(ERROR_inverse_bad_entity,
  618.             &v->name->symbol,v->inverse_symbol->name);
  619.         } else {
  620.             attr = VARfind(type->u.type->body->entity,v->inverse_symbol->name,1);
  621.             if (attr) {
  622.                 v->inverse_attribute = attr;
  623.                 failed |= is_resolve_failed(attr->name);
  624.             } else {
  625.                 ERRORreport_with_symbol(ERROR_inverse_bad_attribute,
  626.                 v->inverse_symbol,v->inverse_symbol->name,type->u.type->body->entity->symbol.name);
  627.             }
  628.         }
  629.         /* symbol is no longer used here and could be gc'd */
  630.         /* but keep around anyway for ease in later reconstruction */
  631.     }
  632.  
  633.     if (failed) resolve_failed(v->name);
  634.  
  635.     /* note: cannot set resolved bit since it has to be resolved again */
  636.     /* by VAR_resolve_expressions later on */
  637. #if 0
  638.     else resolved_all(v->name);
  639. #endif
  640. }
  641.  
  642. /*
  643. ** Procedure:    STMTresolve
  644. ** Parameters:    Statement statement    - statement to resolve
  645. **        Scope     scope        - scope in which to resolve
  646. ** Returns:    void
  647. ** Description:    Resolve all references in a statement.
  648. */
  649.  
  650. void STMTresolve(Statement statement, Scope scope);
  651.  
  652. void
  653. STMTlist_resolve(Linked_List list,Scope scope)
  654. {
  655.     LISTdo(list, s, Statement)
  656.         STMTresolve(s, scope);
  657.     LISTod;
  658. }
  659.  
  660. /*
  661. ** Procedure:    CASE_ITresolve
  662. ** Parameters:    Case_Item   item    - case item to resolve
  663. **        Scope       scope    - scope in which to resolve
  664. ** Returns:    void
  665. ** Description:    Resolve all references in a case item
  666. */
  667.  
  668. void
  669. CASE_ITresolve(Case_Item item, Scope scope, Type type)
  670. {
  671.     LISTdo(item->labels, e, Expression )
  672.     EXPresolve(e, scope, type);
  673.     LISTod;
  674.     STMTresolve(item->action,scope);
  675. }
  676.  
  677. void
  678. STMTresolve(Statement statement, Scope scope)
  679. {
  680.     Type type;
  681.     Scope proc;
  682.  
  683.     if (!statement) return;        /* could be null statement */
  684.  
  685.     switch (statement->type) {
  686.     case STMT_ALIAS:
  687.         EXPresolve(statement->u.alias->variable->initializer,scope,Type_Dont_Care);
  688.         statement->u.alias->variable->type =
  689.                 statement->u.alias->variable->initializer->type;
  690.         if (!is_resolve_failed(statement->u.alias->variable->initializer))
  691.             STMTlist_resolve(statement->u.alias->statements,statement->u.alias->scope);
  692.         break;
  693.     case STMT_ASSIGN:
  694.         EXPresolve(statement->u.assign->lhs, scope,Type_Dont_Care);
  695.         EXPresolve(statement->u.assign->rhs, scope,statement->u.assign->lhs->type);
  696.         break;
  697.     case STMT_CASE:
  698.         EXPresolve(statement->u.Case->selector,scope,Type_Dont_Care);
  699.         type = statement->u.Case->selector->return_type;
  700.         LISTdo(statement->u.Case->cases, c, Case_Item)
  701.             CASE_ITresolve(c, scope, type);
  702.         LISTod;
  703.         break;
  704.     case STMT_COMPOUND:
  705.         STMTlist_resolve(statement->u.compound->statements,scope);
  706.         break;
  707.     case STMT_COND:
  708.         EXPresolve(statement->u.cond->test,scope,Type_Dont_Care);
  709.         STMTlist_resolve(statement->u.cond->code, scope);
  710.         if (statement->u.cond->otherwise)
  711.             STMTlist_resolve(statement->u.cond->otherwise, scope);
  712.         break;
  713.     case STMT_PCALL:
  714. #define proc_name statement->symbol.name
  715.         proc = (Scope)SCOPEfind(scope, proc_name,
  716.                         SCOPE_FIND_PROCEDURE);
  717.         if (proc) {
  718.             if (DICT_type != OBJ_PROCEDURE) {
  719.             Symbol *newsym = OBJget_symbol(proc,DICT_type);
  720.             ERRORreport_with_symbol(ERROR_expected_proc,&statement->symbol,proc_name,newsym->line);
  721.             } else {
  722.             statement->u.proc->procedure = proc;
  723.             }
  724.         } else {
  725.             ERRORreport_with_symbol(ERROR_no_such_procedure,&statement->symbol,proc_name);
  726.         }
  727.         LISTdo(statement->u.proc->parameters, e, Expression )
  728.             EXPresolve(e, scope,Type_Dont_Care);
  729.         LISTod;
  730.         break;
  731.     case STMT_LOOP:
  732.         if (statement->u.loop->scope) {
  733.             /* resolve increment with old scope */
  734.             EXPresolve(statement->u.loop->scope->u.incr->init,scope,Type_Dont_Care);
  735.             EXPresolve(statement->u.loop->scope->u.incr->end,scope,Type_Dont_Care);
  736.             EXPresolve(statement->u.loop->scope->u.incr->increment,scope,Type_Dont_Care);
  737.             /* resolve others with new scope! */
  738.             scope = statement->u.loop->scope;
  739.         }
  740.         if (statement->u.loop->while_expr)
  741.             EXPresolve(statement->u.loop->while_expr,scope,Type_Dont_Care);
  742.  
  743.         if (statement->u.loop->until_expr)
  744.             EXPresolve(statement->u.loop->until_expr,scope,Type_Dont_Care);
  745.  
  746.         STMTlist_resolve(statement->u.loop->statements,scope);
  747.         break;
  748.     case STMT_RETURN:
  749.         if (statement->u.ret->value)
  750.              EXPresolve(statement->u.ret->value,scope,Type_Dont_Care);
  751.         break;
  752.     case STMT_SKIP:
  753.     case STMT_ESCAPE:
  754.         /* do nothing */
  755.         ;
  756.     }
  757. }
  758.  
  759. void
  760. ALGresolve_expressions_statements(Scope s,Linked_List statements)
  761. {
  762.     int status = 0;
  763.  
  764.     if (print_objects_while_running & OBJ_ALGORITHM_BITS &
  765.         OBJget_bits(s->type)) {
  766.         fprintf(stdout,"pass %d: %s (%s)\n",EXPRESSpass,
  767.             s->symbol.name,OBJget_type(s->type));
  768.     }
  769.  
  770.     SCOPEresolve_expressions_statements(s);
  771.     STMTlist_resolve(statements,s);
  772.  
  773.     s->symbol.resolved = status;
  774. }
  775.  
  776. void
  777. ENTITYresolve_expressions(Entity e)
  778. {
  779.     Variable v;
  780.     int status = 0;
  781.     DictionaryEntry de;
  782.  
  783.     if (print_objects_while_running & OBJ_ENTITY_BITS) {
  784.         fprintf(stdout,"pass %d: %s (entity)\n",EXPRESSpass,
  785.             e->symbol.name);
  786.     }
  787.  
  788.     self = e->u.entity->type;
  789.  
  790.     LISTdo(e->u.entity->attributes, attr, Variable)
  791. #if 0
  792.         /* resolve in the context of the superscope to allow "X : X;" */
  793.         TYPEresolve(&attr->type,e->superscope);
  794.         status |= is_resolve_failed(attr->type);
  795. #else
  796.         VARresolve_expressions(attr,e);
  797.         status |= is_resolve_failed(attr->name);
  798. #endif
  799.     LISTod;
  800.  
  801.     DICTdo_type_init(e->symbol_table,&de,OBJ_VARIABLE);
  802.     while (0 != (v = (Variable)DICTdo(&de))) {
  803.         if (!is_resolve_failed(v->name)) {
  804.             TYPEresolve_expressions(v->type,e);
  805.             if (v->initializer) {
  806.                 EXPresolve(v->initializer,e,v->type);
  807.                 status |= is_resolve_failed(v->initializer);
  808.             }
  809.         } else status = RESOLVE_FAILED;
  810.     }
  811.  
  812.     WHEREresolve(e->where,e);
  813.  
  814.     self = 0;
  815.  
  816.     e->symbol.resolved = status;
  817. }
  818.  
  819. #if 0
  820. /*
  821. ** Procedure:    ENTITYresolve
  822. ** Parameters:    Entity entity    - entity to resolve
  823. ** Returns:    void
  824. ** Description:    Resolve all references in an entity definition.
  825. */
  826.  
  827. void
  828. ENTITYresolve_pass1(Entity entity)
  829. {
  830.  
  831. static depth = 0;
  832.  
  833.  
  834.     Entity ref_entity;
  835.     Qualified_Attr *ref;
  836.     Symbol *sym;
  837.     int i;
  838.     Generic attr;    /* really an attribute, but easier to type it this way */
  839.  
  840.     if (is_not_resolvable(entity)) return;
  841.     if (is_resolved_pass1(entity)) return;
  842.  
  843.     /* prevent things like our supertype trying to resolve us */
  844.     /* when we resolve our subtypes */
  845.     resolve_in_progress(entity);
  846.  
  847. /*printf("ENTITYresolve_pass1 (%s): depth = %d\n",entity->symbol.name,++depth);*/
  848.  
  849.     if (print_entities_while_running) {
  850.         fprintf(stdout,"pass1: %s\n",entity->symbol.name);
  851.     }
  852.  
  853.     /*
  854.      * for each supertype, find the entity it refs to
  855.      */
  856.  
  857.     /* for convenience, parser leaves these as symbols */
  858.     /* convert to entities */
  859.     LISTdo_links(entity->u.entity->supertypes, link)
  860.     sym = (Symbol *)link->data;
  861.     ref_entity = (Entity)SCOPEfind(entity->superscope,sym->name);
  862.     if (!ref_entity) {
  863.         ERRORreport_with_symbol(ERROR_unknown_supertype,sym,sym->name,entity->symbol.name);
  864.         resolve_failed(entity);
  865.     } else if (DICT_type != OBJ_ENTITY) {
  866.         Symbol *newsym = OBJget_symbol(ref_entity,DICT_type);
  867.         ERRORreport_with_symbol(ERROR_supertype_resolve,sym,sym->name,newsym->line);
  868.         resolve_failed(entity);
  869.     } else {
  870.         /* replace symbol with true entity */
  871.         link->data = (Generic)ref_entity;
  872.     }
  873.     LISTod;
  874.  
  875. #if 0
  876.     /*
  877.      * for each subtype, find the entity it refs to.
  878.      * this is a little more complicated than for supertypes, because
  879.      * of the subtype expression jazz.
  880.      */
  881. /*printf("EXPresolve_subtype_expression(%s)\n",entity->symbol.name);*/
  882.  
  883.     i = EXPresolve_subtype_expression(entity->u.entity->subtype_expression,entity,&entity->u.entity->subtypes);
  884.     if (i & RESOLVE_FAILED) resolve_failed(entity);
  885. #endif
  886.  
  887.  
  888.     /* at this point we need the sub/supertypes to continue, so give up */
  889.     /* if we had earlier problems */
  890.  
  891.     if (is_resolve_failed(entity)) {
  892.         printf("ENTITYresolve_pass1 (middle): return from depth = %d\n",depth--);
  893.         return;
  894.     }
  895.  
  896.     /*
  897.      * resolve all local attributes of this entity
  898.      */
  899.     LISTdo(entity->u.entity->attributes, attr, Variable)
  900. /*printf("VARresolve(%s)\n",attr->name->symbol.name);*/
  901.     VARresolve(attr, entity);
  902.     LISTod;
  903.  
  904.     /*
  905.      * resolve the 'unique' list
  906.      */
  907.  
  908.     /* these are lists of lists */
  909.     /* the sublists are: label, ref'd_attr, ref'd attr, ref'd attr, etc. */
  910.     /* where ref'd_attrs are either simple ids or SELF\entity.attr */
  911.     /* where "entity" represents a supertype (only, I believe) */
  912.  
  913.     LISTdo(entity->u.entity->unique, unique, Linked_List)
  914.     i = 0;
  915.     LISTdo_links(unique, reflink)
  916.         /* skip first which is always the label (or NULL if no label) */
  917.         i++;
  918.         if (i == 1) continue;
  919.         ref = (Qualified_Attr *)reflink->data;
  920.  
  921. /* following code should be abstracted out into something like GROUP_REFresolve */
  922.  
  923.  
  924.         if (ref->entity) {
  925.             /* use entity provided in group reference */
  926.  
  927.             ref_entity = ENTITYfind_inherited_attribute(entity,ref->entity->name);
  928.             if (!ref_entity) {
  929.                 ERRORreport_with_symbol(ERROR_unknown_supertype,ref->entity,
  930.                     ref->entity->name,entity->symbol.name);
  931.                 resolve_failed(entity);
  932.                 continue;
  933.             }
  934.             attr = DICTlookup(ref_entity->symbol_table,ref->attribute->name);
  935.             if (!attr) {
  936.                 ERRORreport_with_symbol(ERROR_unknown_attr_in_entity,ref->attribute->line,
  937.                     ref->attribute->name,ref_entity->symbol.name);
  938.                     resolve_failed(entity);
  939.             }
  940.         } else {
  941.             /* no entity provided, look through sub/super chain */
  942.             attr = (Generic)ENTITYfind_attribute(entity,entity->symbol.name);
  943.             if (!ref_entity) {
  944.                 ERRORreport_with_symbol(ERROR_unknown_attr_in_entity,ref->entity->line,
  945.                     ref->attribute->name,entity->symbol.name);
  946.                 resolve_failed(entity);
  947.             }
  948.         }
  949.         QUAL_ATTR_destroy(ref);
  950.         reflink->data = attr;
  951.     LISTod;
  952.     LISTod;
  953.  
  954. /*    printf("ENTITYresolve_pass1 (bottom): return from depth = %d\n",depth--);*/
  955.     if (!is_resolve_failed(entity)) resolved_pass1(entity);
  956.     return;
  957. }
  958.  
  959. void
  960. ENTITYresolve_pass2(Entity e)
  961. {
  962.     int count;
  963.     char *attr_name;
  964.  
  965. /*    if (is_resolved_pass2(e)) return;*/
  966.     if (is_not_resolvable(e)) return;
  967.  
  968.     if (print_entities_while_running) {
  969.         fprintf(stdout,"pass2: %s\n",e->symbol.name);
  970.     }
  971.  
  972.     count = 0;
  973.     LISTdo(e->u.entity->supertypes, sup, Entity)
  974. /*    if (OBJget_class(sup) == Class_Entity) {*/
  975.         ENTITYresolve_pass2(sup);
  976.         count += ENTITYget_size(sup);
  977. #if no_longer_necessary
  978.         if (!ENTITYhas_immediate_subtype(sup, e)) {
  979.         ERRORreport_with_symbol(ERROR_missing_subtype,
  980.                       sup->symbol.line,
  981.                       e->symbol.name,
  982.                     sup->symbol.name);
  983.         }
  984.     /* supertypes are no longer treated as superscopes, but are */
  985.     /* searched directly by scopefind */
  986.         SCOPEadd_superscope(e, sup);
  987. #endif
  988.     LISTod;
  989.     ENTITYput_inheritance_count(e, count);
  990.  
  991.     LISTdo(e->u.entity->subtypes, sub, Entity)
  992.         if (!ENTITYhas_immediate_supertype(sub, e)) {
  993.         ERRORreport_with_symbol(ERROR_missing_supertype,
  994.                     sub->symbol.line,
  995.                     e->symbol.name,
  996.                     sub->symbol.name);
  997.         }
  998.     LISTod;
  999. }
  1000.  
  1001.     LISTdo(e->u.entity->attributes, attr, Variable)
  1002.     attr_name = attr->name->symbol.name;
  1003.     LISTdo(e->u.entity->supertypes, sup, Entity)
  1004.         if (ENTITYget_named_attribute(sup, attr_name)) {
  1005.             ERRORreport_with_symbol(ERROR_overloaded_attribute,
  1006.                       attr->name->symbol.line,
  1007.                       attr_name,
  1008.                       sup->symbol.name);
  1009.         }
  1010.     LISTod;
  1011.     LISTod;
  1012.  
  1013.     resolved_all(e);
  1014. }
  1015. #endif
  1016.  
  1017. /* calculate number of attributes inheritance, following up superclass chain */
  1018. void ENTITYcalculate_inheritance(Entity e)
  1019. {
  1020.     e->u.entity->inheritance = 0;
  1021.  
  1022.     LISTdo(e->u.entity->supertypes,super,Entity)
  1023.         if (super->u.entity->inheritance == ENTITY_INHERITANCE_UNINITIALIZED) {
  1024.             ENTITYcalculate_inheritance(super);
  1025.         }
  1026.         e->u.entity->inheritance += ENTITYget_size(super);
  1027.     LISTod
  1028. }
  1029.  
  1030. /* returns 1 if entity is involved in circularity, else 0 */
  1031. int
  1032. ENTITY_check_subsuper_cyclicity(Entity e,Entity enew)
  1033. {
  1034.     /* just check subtypes - this implicitly checks supertypes */
  1035.     /* as well */
  1036.     LISTdo(enew->u.entity->subtypes,sub,Entity)
  1037.         if (e == sub) {
  1038.             ERRORreport_with_symbol(ERROR_subsuper_loop,&sub->symbol,e->symbol.name);
  1039.             return 1;
  1040.         }
  1041.         if (sub->search_id == __SCOPE_search_id) return 0;
  1042.         sub->search_id = __SCOPE_search_id;
  1043.         if (ENTITY_check_subsuper_cyclicity(e,sub)) {
  1044.             ERRORreport_with_symbol(ERROR_subsuper_continuation,&sub->symbol,sub->symbol.name);
  1045.             return 1;
  1046.         }
  1047.     LISTod;
  1048.     return 0;
  1049. }
  1050.  
  1051. void ENTITYcheck_subsuper_cyclicity(Entity e)
  1052. {
  1053.     __SCOPE_search_id++;
  1054.     (void) ENTITY_check_subsuper_cyclicity(e,e);
  1055. }
  1056.  
  1057. void ENTITYresolve_types(Entity e);
  1058.  
  1059. /* also resolves inheritance counts */
  1060. void
  1061. SCOPEresolve_types(Scope s)
  1062. {
  1063.     Variable var;
  1064.     Type type;
  1065.     DictionaryEntry de;
  1066.     Generic x;
  1067.  
  1068.     if (print_objects_while_running & OBJ_SCOPE_BITS &
  1069.         OBJget_bits(s->type)) {
  1070.         fprintf(stdout,"pass %d: %s (%s)\n",EXPRESSpass,
  1071.             s->symbol.name,OBJget_type(s->type));
  1072.     }
  1073.  
  1074.     DICTdo_init(s->symbol_table,&de);
  1075.     while (0 != (x = DICTdo(&de))) {
  1076.         switch (DICT_type) {
  1077.         case OBJ_TYPE:
  1078.             break;
  1079.         case OBJ_VARIABLE:    /* really constants */
  1080.             var = (Variable)x;
  1081.             /* before OBJ_BITS hack, we looked in s->superscope */
  1082.             TYPEresolve(&var->type,s);
  1083.             if (is_resolve_failed(var->type)) {
  1084.                 resolve_failed(var->name);
  1085.                 resolve_failed(s);
  1086.             }
  1087.             break;
  1088.         case OBJ_ENTITY:
  1089.             ENTITYresolve_types((Entity)x);
  1090.             ENTITYcalculate_inheritance((Entity)x);
  1091.             if (ERRORis_enabled(ERROR_subsuper_loop)) {
  1092.                 ENTITYcheck_subsuper_cyclicity((Entity)x);
  1093.             }
  1094.             if (is_resolve_failed((Entity)x)) resolve_failed(s);
  1095.             break;
  1096.         case OBJ_SCHEMA:
  1097.             if (is_not_resolvable((Schema)x)) break;
  1098.             /*FALLTHRU*/
  1099.         case OBJ_PROCEDURE:
  1100.         case OBJ_RULE:
  1101.         case OBJ_FUNCTION:
  1102.             SCOPEresolve_types((Scope)x);
  1103.             if (is_resolve_failed((Scope)x)) resolve_failed(s);
  1104.             break;
  1105.         default:
  1106.             break;
  1107.         }
  1108.     }
  1109.     if (s->type == OBJ_FUNCTION) {
  1110.         TYPEresolve(&s->u.func->return_type,s->superscope);
  1111.     }
  1112. }
  1113.  
  1114. #if 0
  1115. static
  1116. int
  1117. SCHEMAresolve_pass1(Schema *schema/*, Dictionary schemas*/)
  1118. {
  1119.     DictionaryEntry de;
  1120.     Entity e;
  1121.  
  1122. /*printf("USE/REFresolve(%s)\n",schema->symbol.name);*/
  1123.  
  1124.     resolve_in_progress(schema);
  1125.  
  1126.     /* old way built a list of entities, diddled with it, and then */
  1127.     /* destroyed the list.  New way is to read the dictionary while */
  1128.     /* we diddle, thus avoiding building the list */
  1129.     DICTdo_type_init(schema->symbol_table,&de,OBJ_ENTITY);
  1130.     while (0 != (e = (Entity)DICTdo(&de))) {
  1131.         ENTITYresolve_pass1(e);
  1132.         if (is_resolve_failed(e)) resolve_failed(schema);
  1133.     }
  1134.  
  1135.     resolved_pass1(schema);
  1136.     return(schema->symbol.resolved);
  1137. };
  1138.  
  1139. void
  1140. SCHEMAresolve_pass2(Schema *schema)
  1141. {
  1142.     DictionaryEntry    de;
  1143.     Generic previous;
  1144.     Type t;
  1145.     Scope scope;
  1146.  
  1147. #if 0
  1148.     /* Don't think this can happen anymore - at least not at the schema level */
  1149.     if (ERRORis_enabled(ERROR_shadow_decl)) {
  1150.     Generic obj;
  1151.  
  1152.     DICTdo_init(schema->symbol_table,&de);
  1153.     while (0 != (obj = DICTdo(&de))) {
  1154.         Symbol *sym = OBJget_symbol(obj,DICT_type), *sym2;
  1155.         if (0 != (previous = SCHEMA_lookup(schema, SYMBOLget_name(sym),
  1156.                         true, false))) {
  1157.         sym2 = OBJget_symbol(previous,DICT_type);
  1158.         ERRORreport_with_symbol(ERROR_shadow_decl,
  1159.                       SYMBOLget_line_number(sym),
  1160.                       SYMBOLget_name(sym),
  1161.                       SYMBOLget_line_number(sym2));
  1162.         }
  1163.     }
  1164.     }
  1165. #endif
  1166. #endif
  1167.  
  1168.  
  1169. /********************************new****************************************/
  1170.  
  1171. void
  1172. SCOPEresolve_subsupers(Scope scope)
  1173. {
  1174.     DictionaryEntry de;
  1175.     Generic x;
  1176.     char type;
  1177.     Symbol *sym;
  1178.     Type t;
  1179.  
  1180.     if (print_objects_while_running & OBJ_SCOPE_BITS &
  1181.         OBJget_bits(scope->type)) {
  1182.         fprintf(stdout,"pass %d: %s (%s)\n",EXPRESSpass,
  1183.             scope->symbol.name,OBJget_type(scope->type));
  1184.     }
  1185.  
  1186.     DICTdo_init(scope->symbol_table,&de);
  1187.     while (0 != (x = DICTdo(&de))) {
  1188.         switch (type = DICT_type) {
  1189.         case OBJ_ENTITY:
  1190.             ENTITYresolve_supertypes((Entity)x);
  1191.             ENTITYresolve_subtypes((Entity)x);
  1192.             break;
  1193.         case OBJ_FUNCTION:
  1194.         case OBJ_PROCEDURE:
  1195.         case OBJ_RULE:
  1196.             SCOPEresolve_subsupers((Scope)x);
  1197.             break;
  1198.         case OBJ_TYPE:
  1199.             t = (Type)x;
  1200.             TYPEresolve(&t,scope);
  1201.             break;
  1202.         default:
  1203.             /* ignored everything else */
  1204.             break;
  1205.         }
  1206.         sym = OBJget_symbol(x,type);
  1207.         if (is_resolve_failed_raw(sym)) resolve_failed(scope);
  1208.     }
  1209. }
  1210.  
  1211. /* for each supertype, find the entity it refs to */
  1212. static
  1213. void
  1214. ENTITYresolve_supertypes(Entity e)
  1215. {
  1216.     Entity ref_entity;
  1217.  
  1218.     if (print_objects_while_running & OBJ_ENTITY_BITS) {
  1219.         fprintf(stdout,"pass %d: %s (entity)\n",EXPRESSpass,
  1220.             e->symbol.name);
  1221.     }
  1222.  
  1223.     if (e->u.entity->supertype_symbols)
  1224.         e->u.entity->supertypes = LISTcreate();
  1225. #if 0
  1226.     if (e->u.entity->supertype_symbols && !e->u.entity->supertypes)
  1227.         e->u.entity->supertypes = LISTcreate();
  1228. #endif
  1229.  
  1230.     LISTdo(e->u.entity->supertype_symbols,sym,Symbol *)
  1231.         ref_entity = (Entity)SCOPEfind(e->superscope,sym->name,SCOPE_FIND_ENTITY);
  1232.         if (!ref_entity) {
  1233.             ERRORreport_with_symbol(ERROR_unknown_supertype,sym,sym->name,e->symbol.name);
  1234. /*            ENTITY_resolve_failed = 1;*/
  1235.             resolve_failed(e);
  1236.         } else if (DICT_type != OBJ_ENTITY) {
  1237.             Symbol *newsym = OBJget_symbol(ref_entity,DICT_type);
  1238.             ERRORreport_with_symbol(ERROR_supertype_resolve,sym,sym->name,newsym->line);
  1239. /*            ENTITY_resolve_failed = 1;*/
  1240.             resolve_failed(e);
  1241.         } else {
  1242.             int found = false;
  1243.  
  1244.             LISTadd(e->u.entity->supertypes,(Generic)ref_entity);
  1245.             if (is_resolve_failed(ref_entity)) {
  1246.                 resolve_failed(e);
  1247.             }
  1248.  
  1249.         /* If the user said there was a supertype relationship but */
  1250.         /* did not mentioned the reverse subtype relationship */
  1251.         /* force it to be explicitly known by listing this entity */
  1252.         /* in the ref'd entity's subtype list */
  1253.  
  1254.             LISTdo(ref_entity->u.entity->subtypes,sub,Entity)
  1255.                 if (sub == e) {
  1256.                     found = true;
  1257.                     break;
  1258.                 }
  1259.             LISTod
  1260.             if (!found) {
  1261.                 if (!ref_entity->u.entity->subtypes)
  1262.                     ref_entity->u.entity->subtypes = LISTcreate();
  1263.                 LISTadd_last(ref_entity->u.entity->subtypes,(Generic)e);
  1264.             }
  1265.         }
  1266.     LISTod;
  1267. }
  1268.         
  1269. static void
  1270. ENTITYresolve_subtypes(Entity e)
  1271. {
  1272.     int i;
  1273.  
  1274.     if (print_objects_while_running & OBJ_ENTITY_BITS) {
  1275.         fprintf(stdout,"pass %d: %s (entity)\n",EXPRESSpass,
  1276.             e->symbol.name);
  1277.     }
  1278.  
  1279.     i = ENTITYresolve_subtype_expression(e->u.entity->subtype_expression,e,&e->u.entity->subtypes);
  1280.     if (i & RESOLVE_FAILED) resolve_failed(e);
  1281. }
  1282.  
  1283. void
  1284. ENTITYresolve_types(Entity e)
  1285. {
  1286.     Entity ref_entity;
  1287.     int i;
  1288.     Qualified_Attr *ref;
  1289.     Variable attr;
  1290.     int failed = 0;
  1291.  
  1292.     if (print_objects_while_running & OBJ_ENTITY_BITS) {
  1293.         fprintf(stdout,"pass %d: %s (entity)\n",EXPRESSpass,
  1294.             e->symbol.name);
  1295.     }
  1296.  
  1297.     LISTdo(e->u.entity->attributes, attr, Variable)
  1298.         /* resolve in context of superscope to allow "X : X;" */
  1299.         VARresolve_types(attr,e);
  1300.         failed |= is_resolve_failed(attr->name);
  1301.     LISTod;
  1302.  
  1303.     /*
  1304.      * resolve the 'unique' list
  1305.      */
  1306.  
  1307.     /* these are lists of lists */
  1308.     /* the sublists are: label, ref'd_attr, ref'd attr, ref'd attr, etc. */
  1309.     /* where ref'd_attrs are either simple ids or SELF\entity.attr */
  1310.     /* where "entity" represents a supertype (only, I believe) */
  1311.  
  1312.     LISTdo(e->u.entity->unique, unique, Linked_List)
  1313.     i = 0;
  1314.     LISTdo_links(unique, reflink)
  1315.         /* skip first which is always the label (or NULL if no label) */
  1316.         i++;
  1317.         if (i == 1) continue;
  1318.         ref = (Qualified_Attr *)reflink->data;
  1319.  
  1320. /* following code should be abstracted out into something like GROUP_REFresolve */
  1321.         if (ref->entity) {
  1322.             /* use entity provided in group reference */
  1323.             ref_entity = ENTITYfind_inherited_entity(e,ref->entity->name);
  1324.             if (!ref_entity) {
  1325.                 ERRORreport_with_symbol(ERROR_unknown_supertype,ref->entity,ref->entity->name,e->symbol.name);
  1326.                 failed = RESOLVE_FAILED;
  1327.                 continue;
  1328.             }
  1329.             attr = (Variable)DICTlookup(ref_entity->symbol_table,ref->attribute->name);
  1330.             if (!attr) {
  1331.                 ERRORreport_with_symbol(ERROR_unknown_attr_in_entity,ref->attribute,ref->attribute->name,ref_entity->symbol.name);
  1332.                     failed = RESOLVE_FAILED;
  1333.                     resolve_failed(e);
  1334.             }
  1335.         } else {
  1336.             /* no entity provided, look through sub/super chain */
  1337.             attr = ENTITYfind_inherited_attribute(e,ref->attribute->name);
  1338.             if (!attr /* was ref_entity? */) {
  1339.                 ERRORreport_with_symbol(ERROR_unknown_attr_in_entity,ref->attribute,ref->attribute->name,e->symbol.name);
  1340.                 failed = RESOLVE_FAILED;
  1341.             }
  1342.         }
  1343.         QUAL_ATTR_destroy(ref);
  1344.         reflink->data = (Generic)attr;
  1345.  
  1346.         if (ENTITYdeclares_variable(e,attr)) {
  1347.             attr->flags.unique = 1;
  1348.         }
  1349.  
  1350.     LISTod;
  1351.     LISTod;
  1352.  
  1353.     /* don't wipe out any previous failure stat */
  1354.     e->symbol.resolved |= failed;
  1355. }
  1356.  
  1357. /* resolve all expressions in type definitions */
  1358. static
  1359. void
  1360. TYPEresolve_expressions(Type t,Scope s)
  1361. {
  1362.     TypeBody body;
  1363.  
  1364.     /* meaning of self in a type declaration refers to the type itself, so */
  1365.     /* temporary redirect "self" to ourselves to allow this */
  1366.     Type self_old = self;
  1367.     self = t;
  1368.  
  1369.     /* recurse through base types */
  1370.     for (;;t = body->base) {
  1371.         if (t->where) WHEREresolve(t->where,s);
  1372.  
  1373.         /* reached an indirect type definition, resolved elsewhere */
  1374.         if (t->u.type->head) break;
  1375.  
  1376.         if (!TYPEis_aggregate(t)) break;
  1377.  
  1378.         body = t->u.type->body;
  1379.         if (body->upper) EXPresolve(body->upper,s,Type_Dont_Care);
  1380.         if (body->lower) EXPresolve(body->lower,s,Type_Dont_Care);
  1381.         if (body->precision) EXPresolve(body->precision,s,Type_Dont_Care);
  1382.     }
  1383.  
  1384.     self = self_old;
  1385. }
  1386.  
  1387. void
  1388. SCOPEresolve_expressions_statements(Scope s)
  1389. {
  1390.     DictionaryEntry de;
  1391.     Generic x;
  1392.     Variable v;
  1393.  
  1394.     if (print_objects_while_running & OBJ_SCOPE_BITS &
  1395.         OBJget_bits(s->type)) {
  1396.         fprintf(stdout,"pass %d: %s (%s)\n",EXPRESSpass,
  1397.             s->symbol.name,OBJget_type(s->type));
  1398.     }
  1399.  
  1400.     DICTdo_init(s->symbol_table,&de);
  1401.     while (0 != (x = DICTdo(&de))) {
  1402.         switch (DICT_type) {
  1403.         case OBJ_SCHEMA:
  1404.             if (is_not_resolvable((Schema)x)) break;
  1405.             SCOPEresolve_expressions_statements((Scope)x);
  1406.             break;
  1407.         case OBJ_ENTITY:
  1408.             ENTITYresolve_expressions((Entity)x);
  1409.             break;
  1410.         case OBJ_FUNCTION:
  1411.             ALGresolve_expressions_statements((Scope)x,((Scope)x)->u.func->body);
  1412.             break;
  1413.         case OBJ_PROCEDURE:
  1414.             ALGresolve_expressions_statements((Scope)x,((Scope)x)->u.proc->body);
  1415.             break;
  1416.         case OBJ_RULE:
  1417.             ALGresolve_expressions_statements((Scope)x,((Scope)x)->u.rule->body);
  1418.  
  1419.             WHEREresolve(RULEget_where((Scope)x),(Scope)x);
  1420.             break;
  1421.         case OBJ_VARIABLE:
  1422.             v = (Variable)x;
  1423.             TYPEresolve_expressions(v->type,s);
  1424.             if (v->initializer) {
  1425.                 EXPresolve(v->initializer,s,v->type);
  1426.             }
  1427.             break;
  1428.         case OBJ_TYPE:
  1429.             TYPEresolve_expressions((Type)x,s);
  1430.             break;
  1431.         default:
  1432.             /* ignored everything else */
  1433.             break;
  1434.         }
  1435.     }
  1436. }
  1437.  
  1438. static void
  1439. WHEREresolve(Linked_List list, Scope scope)
  1440. {
  1441.     LISTdo (list, w, Where )
  1442.         EXPresolve(w->expr,scope,Type_Dont_Care);
  1443.     LISTod
  1444. }
  1445.  
  1446. static Type
  1447. TAGget_type(struct tag *tags,char *name)
  1448. {
  1449.     while (1) {
  1450.         if (streq(tags->name,name)) return(tags->type);
  1451.     }
  1452. }
  1453.  
  1454. /* should only be called on types known to be tagged! */
  1455. static char *
  1456. TYPEget_tagname(Type type) {
  1457.     for (;type;type = type->u.type->body->base) {
  1458.         if (type->u.type->body->tag) return type->u.type->body->tag->symbol.name;
  1459.     }
  1460.     /* can't happen */
  1461.     return 0;
  1462. }
  1463.         
  1464. struct tag *
  1465. TAGcreate_tags() {
  1466.     extern tag_count;
  1467.  
  1468.     return((struct tag *)calloc(tag_count,sizeof(struct tag)));
  1469. }
  1470.  
  1471. /* typecheck represents a possible type, such as from */
  1472. /*       known_type = FUNC(?,?,?) */
  1473.  
  1474. #if 0
  1475. PARAM_LISTresolve(Linked_List reals, Linked_List formals,
  1476.         Scope real_scope, Type return_type,int tag_count)
  1477. {
  1478.     Link f, r;
  1479.     Expression real;
  1480.     Type formal_type;
  1481.  
  1482.     int some_types_unresolved = 0;
  1483.  
  1484.     if (tag_count) {
  1485.         /* need to keep track of different mappings of type to */
  1486.         /* tags to each invocation because of the possibility */
  1487.         /* of a call like func(tag1:type1,func(tag1:type2,.):tag1)); */
  1488.         /* Ugh!!!!! */
  1489.  
  1490.         tags = TAGcreate_tags(tag_count,formal_scope);
  1491.         /* assert(tags) */
  1492.  
  1493.         /* if the return type is usable, use it */
  1494.         if (is_resolved(return_type) && TYPEhas_tag(return_type))
  1495.             TAGset(tags,TYPEtag_name(return_type),TYPEtag_type(return_type));
  1496.     }
  1497.  
  1498.     f = formals->mark->next;
  1499.     r =   reals->mark->next;
  1500.     for (;f != formals->mark;f = f->next, r = r->next) {
  1501.         Type formal_tag;
  1502.  
  1503.         formal_type = ((Expression) f->data)->type;
  1504.         real   = (Expression) f->data;
  1505.         formal_tag = TYPEget_tag(formal_type);
  1506.         if (!formal_tag) {
  1507.             /* no tag, do normal resolution */
  1508.             EXPresolve(real,real_scope,formal_type);
  1509.         } else {
  1510.             /* note t might be embedded in an aggregate */
  1511.             /* EXPresolve might need to be */
  1512.             /* changed to accomodate this */
  1513.             EXPresolve(real,real_scope,tags[]);
  1514.             if (formal_tag->type == unknown_) {
  1515.                 if (is_resolved(real)) {
  1516.                     TAGset_type(tags,TYPEget_tag(formal_type),t,real->type);
  1517.                 } else some_types_unresolved = 1;
  1518.             }
  1519.         }
  1520.     }
  1521.  
  1522.     /* if some types were not resolved, but we got new tag info */
  1523.     /* then retry the whole mess with our new info */
  1524.  
  1525.     if (!(some_types_unresolved || 
  1526.          (return_type->type == unknown_ && TYPEhas_tag(return_type)))) {
  1527.         return;
  1528.     }
  1529.  
  1530.     /* force tags that were not resolved to fail next time */
  1531.     /* through EXPresolve... */
  1532.     for (i=0;i<tagcount;i++) {
  1533.         if (tags[i]->type->type == unknown_)
  1534.             tags[i]->type = Type_Bad;
  1535.     }
  1536.  
  1537.     /* do return type if necessary */
  1538.     if (return_type && TYPEhas_tag(func->u.function->return_type)) {
  1539.         return_type = TAGsearch(TYPEtag(func->u.function->return_type));
  1540.         if (typecheck->type == unknown && TYPEhas_tag(typecheck)) {
  1541.     }
  1542.  
  1543.     /* what is this??? */    
  1544.     for (;;) {
  1545.         if (TYPEhas_tag(f)) && is_resolvable(r)) {
  1546.             t = TAGsearch(tags,TYPEtag(f));
  1547.             EXPresolve(r,alg,t);
  1548.             status |= r->symbol.resolved;
  1549.         }
  1550.     }
  1551. }  
  1552. /*static_inline
  1553. Boolean
  1554. ERRORis_enabled(Error error)
  1555. {
  1556.     return error->enabled;
  1557. } */
  1558. #endif
  1559.  
  1560.