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 / ENTITY.C < prev    next >
Text File  |  1994-07-23  |  30KB  |  1,097 lines
  1. static char rcsid[] = "$Id: entity.c,v 1.8 1993/10/15 18:48:48 libes Exp $";
  2.  
  3. /************************************************************************
  4. ** Module:    Entity
  5. ** Description:    This module is used to represent Express entity definitions.
  6. **    An entity definition consists of a name, a set of attributes, a
  7. **    collection of uniqueness sets, a specification of the entity's
  8. **    position in a class hierarchy (i.e., sub- and supertypes), and
  9. **    a list of constraints which must be satisfied by instances of
  10. **    the entity.  A uniquess set is a set of one or more attributes
  11. **    which, when taken together, uniquely identify a specific instance
  12. **    of the entity.  Thus, the uniqueness set { name, ssn } indicates
  13. **    that no two instances of the entity may share both the same
  14. **    values for both name and ssn.
  15. ** Constants:
  16. **    ENTITY_NULL    - the null entity
  17. **
  18. ************************************************************************/
  19.  
  20. /*
  21.  * This software was developed by U.S. Government employees as part of
  22.  * their official duties and is not subject to copyright.
  23.  *
  24.  * $Log: entity.c,v $
  25.  * Revision 1.8  1993/10/15  18:48:48  libes
  26.  * CADDETC certified
  27.  *
  28.  * Revision 1.6  1993/02/16  03:14:47  libes
  29.  * simplified find calls
  30.  *
  31.  * Revision 1.5  1993/01/19  22:45:07  libes
  32.  * *** empty log message ***
  33.  *
  34.  * Revision 1.4  1992/08/18  17:13:43  libes
  35.  * rm'd extraneous error messages
  36.  *
  37.  * Revision 1.3  1992/06/08  18:06:57  libes
  38.  * prettied up interface to print_objects_when_running
  39.  *
  40.  * Revision 1.2  1992/05/31  08:35:51  libes
  41.  * multiple files
  42.  *
  43.  * Revision 1.1  1992/05/28  03:55:04  libes
  44.  * Initial revision
  45.  *
  46.  * Revision 1.7  1992/05/10  06:01:29  libes
  47.  * cleaned up OBJget_symbol
  48.  *
  49.  * Revision 1.6  1992/05/05  19:51:47  libes
  50.  * final alpha
  51.  *
  52.  * Revision 1.5  1992/02/19  15:48:18  libes
  53.  * changed types to enums & flags
  54.  *
  55.  * Revision 1.4  1992/02/17  14:32:57  libes
  56.  * lazy ref/use evaluation now working
  57.  *
  58.  * Revision 1.3  1992/02/12  07:05:23  libes
  59.  * y
  60.  * do sub/supertype
  61.  *
  62.  * Revision 1.2  1992/02/09  00:49:53  libes
  63.  * does ref/use correctly
  64.  *
  65.  * Revision 1.1  1992/02/05  08:34:24  libes
  66.  * Initial revision
  67.  *
  68.  * Revision 1.0.1.1  1992/01/22  02:47:57  libes
  69.  * copied from ~pdes
  70.  *
  71.  * Revision 4.7  1991/09/20  06:20:43  libes
  72.  * fixed bug that printed out entity->attributes incorrectly
  73.  * assumed they were objects rather than strings
  74.  *
  75.  * Revision 4.6  1991/09/16  23:13:12  libes
  76.  * added print functionsalgorithm.c
  77.  *
  78.  * Revision 4.5  1991/07/18  05:07:08  libes
  79.  * added SCOPEget_use
  80.  *
  81.  * Revision 4.4  1991/07/13  05:04:17  libes
  82.  * added ENTITYget_supertype and ..get_subtype
  83.  *
  84.  * Revision 4.3  1991/01/24  22:20:36  silver
  85.  * merged changes from NIST and SCRA
  86.  * SCRA changes are due to DEC ANSI C compiler tests.
  87.  *
  88.  * Revision 4.3  91/01/08  18:55:42  pdesadmn
  89.  * Initial - Beta checkin at SCRA
  90.  * 
  91.  * Revision 4.2  90/11/23  16:33:43  clark
  92.  * Initial checkin at SCRA
  93.  * 
  94.  * Revision 4.2  90/11/23  16:33:43  clark
  95.  * initial checkin at SCRA
  96.  * 
  97.  * Revision 4.2  90/11/23  16:33:43  clark
  98.  * Fixes for better error handling on supertype lists
  99.  * 
  100.  * Revision 4.1  90/09/13  15:13:08  clark
  101.  * BPR 2.1 alpha
  102.  * 
  103.  */
  104.  
  105. #define ENTITY_C
  106. #include "entity.h"
  107. #include "express.h"
  108. #include "object.h"
  109.  
  110. /* returns true if variable is declared (or redeclared) directly by entity */
  111. int
  112. ENTITYdeclares_variable(Entity e,Variable v)
  113. {
  114.     LISTdo(e->u.entity->attributes, attr, Variable)
  115.         if (attr == v) return true;
  116.     LISTod;
  117.  
  118.     return false;
  119. }
  120.  
  121. static
  122. Entity 
  123. ENTITY_find_inherited_entity(Entity entity,char *name)
  124. {
  125.     Entity result;
  126.  
  127.     /* avoid searching scopes that we've already searched */
  128.     /* this can happen due to several things */
  129.     /* if A ref's B which ref's C, and A ref's C.  Then C */
  130.     /* can be searched twice by A.  Similar problem with */
  131.     /* sub/super inheritance. */
  132.     if (entity->search_id == __SCOPE_search_id) return NULL;
  133.     entity->search_id = __SCOPE_search_id;
  134.  
  135.     LISTdo(entity->u.entity->supertypes,super,Entity )
  136.         if (streq(super->symbol.name,name)) return super;
  137.     LISTod
  138.  
  139.     LISTdo(entity->u.entity->supertypes,super,Entity )
  140.         result = ENTITY_find_inherited_entity(super,name);
  141.         if (result) {
  142.             return result;
  143.         }
  144.     LISTod
  145.  
  146.     LISTdo(entity->u.entity->subtypes,sub,Entity )
  147.         if (streq(sub->symbol.name,name)) return sub;
  148.     LISTod
  149.  
  150.     LISTdo(entity->u.entity->subtypes,sub,Entity )
  151.         result = ENTITY_find_inherited_entity(sub,name);
  152.         if (result) {
  153.             return result;
  154.         }
  155.     LISTod;
  156.  
  157.     return 0;
  158. }
  159.  
  160. struct Scope *
  161. ENTITYfind_inherited_entity(struct Scope *entity,char *name)
  162. {
  163.     if (streq(name,entity->symbol.name)) return(entity);
  164.  
  165.     __SCOPE_search_id++;
  166.     return ENTITY_find_inherited_entity(entity,name);
  167. }
  168.  
  169. /* find a (possibly inherited) attribute */
  170. Variable
  171. ENTITY_find_inherited_attribute(Entity entity,char *name)
  172. {
  173.     Variable result;
  174.  
  175.     /* avoid searching scopes that we've already searched */
  176.     /* this can happen due to several things */
  177.     /* if A ref's B which ref's C, and A ref's C.  Then C */
  178.     /* can be searched twice by A.  Similar problem with */
  179.     /* sub/super inheritance. */
  180.     if (entity->search_id == __SCOPE_search_id) return NULL;
  181.     entity->search_id = __SCOPE_search_id;
  182.  
  183.     /* first look locally */
  184.         result = (Variable)DICTlookup(entity->symbol_table, name);
  185.         if (result) {
  186.         return result;
  187.     }
  188.  
  189.     LISTdo(entity->u.entity->supertypes,super,Entity )
  190.         result = ENTITY_find_inherited_attribute(super,name);
  191.         if (result) {
  192.             return result;
  193.         }
  194.     LISTod;
  195.  
  196. #if 0
  197.     LISTdo(entity->u.entity->subtypes,sub,Entity )
  198.         result = ENTITY_find_inherited_attribute(sub,name);
  199.         if (result) {
  200.             return result;
  201.         }
  202.     LISTod;
  203. #endif
  204.  
  205.     return 0;
  206. }
  207.  
  208. struct Variable *
  209. ENTITYfind_inherited_attribute(struct Scope *entity,char *name)
  210. {
  211.     extern struct Variable * ENTITY_find_inherited_attribute(struct Scope *,char *);
  212.     extern int __SCOPE_search_id;
  213.  
  214.     __SCOPE_search_id++;
  215.     return ENTITY_find_inherited_attribute(entity,name);
  216. }
  217.  
  218. #if 0
  219. /* find a simple object referred to be an entity */
  220. /* such as an entity, proc, etc. */
  221. Generic
  222. ENTITY_lookup(Entity entity, char * name)
  223. {
  224.     Generic    result;
  225.  
  226.     /* avoid searching scopes that we've already searched */
  227.     /* this can happen due to several things */
  228.     /* if A ref's B which ref's C, and A ref's C.  Then C */
  229.     /* can be searched twice by A.  Similar problem with */
  230.     /* sub/super inheritance. */
  231. #if 0
  232.     if (entity->last_search == __ENTITY_search_count) return NULL;
  233.     entity->last_search = __ENTITY_search_count;
  234. #endif
  235.  
  236.     /* first look locally */
  237.         result = DICTlookup(entity->symbol_table, name);
  238.         if (result != 0) {
  239.       ENTITY_type = DICT_type;
  240.           return result;
  241.         }
  242.  
  243.     /* look in the rest of the schema */
  244.     /* note that this convenient gets things LOCAL to schema, but not */
  245.     /* LOCAL to any declarations inside the schema (like a proc) or */
  246.     /* another entity's attributes */
  247.     result = DICTlookup(entity->schema->symbol_table,name);
  248.     if (result != 0) {
  249.         ENTITY_type = DICT_type;
  250.         return result;
  251.     }
  252.  
  253.         /* check if it's explicitly REFERENCE'd */
  254.         result = DICTlookup(entity->schema->referenced_objects, name);
  255.         if (result != 0) {
  256.       ENTITY_type = DICT_type;
  257.           errc = ERROR_none;
  258.           return result;
  259.         }
  260.  
  261.     /* check if it is one of the object ref'd implicitly by only a */
  262.     /* schema name */
  263.     LISTdo(entity->schema->referenced_schemas,schema,Schema *)
  264.         /* would be nice if we could prevent these referenced scopes from */
  265.         /* being looked up more than once in a single scopelookup */
  266.         result = DICTlookup(schema->symbol_table,name);
  267.         if (result) return(result);
  268.         LISTod;
  269.  
  270.     errc = ERROR_undefined_identifier;
  271.     return 0;
  272. }
  273. #endif
  274.  
  275. /*
  276. ** Procedure:    ENTITY_create/free/copy/equal
  277. ** Description:    These are the low-level defining functions for Class_Entity
  278. **
  279. ** Notes:    The attribute list of a new entity is defined as an
  280. **    empty list; all other aspects of the entity are initially
  281. **    undefined (i.e., have appropriate NULL values).
  282. */
  283.  
  284. Entity 
  285. ENTITYcreate(Symbol *sym)
  286. {
  287.     Scope s = SCOPEcreate(OBJ_ENTITY);
  288.  
  289.     s->u.entity = ENTITY_new();
  290.     s->u.entity->attributes = LISTcreate();
  291.     s->u.entity->inheritance = ENTITY_INHERITANCE_UNINITIALIZED;
  292.  
  293.     /* it's so useful to have a type hanging around for each entity */
  294.     s->u.entity->type = TYPEcreate_name(sym);
  295.     s->u.entity->type->u.type->body = TYPEBODYcreate(entity_);
  296.     s->u.entity->type->u.type->body->entity = s;
  297.     return(s);
  298. }
  299.  
  300. /* currently, this is only used by USEresolve */
  301. Entity 
  302. ENTITYcopy(Entity e)
  303. {
  304.     /* for now, do a totally shallow copy */
  305.  
  306.     Entity e2 = SCOPE_new();
  307.     *e2 = *e;
  308.     return e2;
  309. }
  310.  
  311. #if 0
  312. void
  313. ENTITY_free(Generic dummy)
  314. {
  315.     struct Entity*    entity = (struct Entity*)dummy;
  316.     Error        errc;
  317.  
  318.     OBJfree(entity->attributes, &errc);
  319.     OBJfree(entity->supertypes, &errc);
  320.     OBJfree(entity->subtypes, &errc);
  321.     OBJfree(entity->subtype_expression, &errc);
  322.     OBJfree(entity->unique, &errc);
  323.     OBJfree(entity->constraints, &errc);
  324.     OBJfree(entity->instances, &errc);
  325. }
  326.  
  327. void
  328. ENTITY_copy(Generic dummy1, Generic dummy2)
  329. {
  330.     struct Entity*    dest = (struct Entity*)dummy1;
  331.     struct Entity*    source = (struct Entity*)dummy2;
  332.     Error        errc;
  333.  
  334.     dest->supertypes = OBJcopy(source->supertypes, &errc);
  335.     dest->subtypes = OBJcopy(source->subtypes, &errc);
  336.     dest->subtype_expression = OBJcopy(source->subtype_expression, &errc);
  337.     dest->attributes = OBJcopy(source->attributes, &errc);
  338.     dest->inheritance = source->inheritance;
  339.     dest->attribute_count = source->attribute_count;
  340.     dest->unique = OBJcopy(source->unique, &errc);
  341.     dest->constraints = OBJcopy(source->constraints, &errc);
  342.     dest->instances = OBJcopy(source->instances, &errc);
  343.     dest->mark = source->mark;
  344. }
  345.  
  346. Boolean
  347. ENTITY_equal(Generic dummy1, Generic dummy2)
  348. {
  349.     struct Entity*    entity1 = (struct Entity*)dummy1;
  350.     struct Entity*    entity2 = (struct Entity*)dummy2;
  351.     Error        errc;
  352.  
  353.     return (OBJequal(entity1->attributes, entity2->attributes, &errc) &&
  354.         OBJequal(entity1->supertypes, entity2->supertypes, &errc));
  355. }
  356.  
  357. void
  358. ENTITY_print(Generic dummy)
  359. {
  360.     struct Entity*    entity = (struct Entity*)dummy;
  361.  
  362.     if (print_none(entity_print)) return;
  363.  
  364.     if (print_some(entity_print,supertypes)) {
  365.         iprint("supertypes:\n");
  366.         OBJprint(entity->supertypes);
  367.     }
  368.     if (print_some(entity_print,subtypes)) {
  369.         iprint("subtype list:\n");
  370.         OBJprint(entity->subtypes);
  371.     }
  372.     if (print_some(entity_print,subtype_expression)) {
  373.         iprint("subtype expr:\n");
  374.         OBJprint(entity->subtype_expression);
  375.     }
  376.     if (print_some(entity_print,attributes)) {
  377.         int i;
  378.  
  379.         LISTdo(entity->attributes, name, String)
  380.             iprint("attribute %d: %s\n",i++,name);
  381.         LISTod;
  382.     }
  383.     if (print_some(entity_print,inheritance)) {
  384.         iprint("inheritance: %d\n",entity->inheritance);
  385.     }
  386.     if (print_some(entity_print,attribute_count)) {
  387.         iprint("attribute_count: %d\n",entity->attribute_count);
  388.     }
  389.     if (print_some(entity_print,unique)) {
  390.         iprint("unique:\n");
  391.         OBJprint(entity->unique);
  392.     }
  393.     if (print_some(entity_print,constraints)) {
  394.         iprint("constraints:\n");
  395.         OBJprint(entity->constraints);
  396.     }
  397.     if (print_some(entity_print,instances)) {
  398.         iprint("instances:\n");
  399.         OBJprint(entity->instances);
  400.     }
  401.     if (print_some(entity_print,mark)) {
  402.         iprint("mark: %d\n",entity->mark);
  403.     }
  404.     if (print_some(entity_print,abstract)) {
  405.         iprint("abstract: %s\n",BOOLprint(entity->abstract));
  406.     }
  407. }
  408.  
  409. #endif /*0*/
  410.  
  411. /*
  412. ** Procedure:    ENTITYinitialize
  413. ** Parameters:    -- none --
  414. ** Returns:    void
  415. ** Description:    Initialize the Entity module.
  416. */
  417.  
  418. void
  419. ENTITYinitialize()
  420. {
  421.     MEMinitialize(&ENTITY_fl,sizeof(struct Entity),500,100);
  422.     OBJcreate(OBJ_ENTITY,SCOPE_get_symbol,"entity",
  423.           OBJ_ENTITY_BITS);
  424. }
  425.  
  426. #if 0
  427.  
  428. /*
  429. ** Procedure:    ENTITYput_name
  430. ** Parameters:    Entity entity - entity to modify
  431. **        String name - entity's name
  432. ** Returns:    void
  433. ** Description:    Set the name of an entity.
  434. */
  435.  
  436. /* this function is defined as a macro in entity.h */
  437.  
  438. /*
  439. ** Procedure:    ENTITYput_supertypes
  440. ** Parameters:    Entity      entity    - entity to modify
  441. **        Linked_List list    - superclass entity name Symbols
  442. ** Returns:    void
  443. ** Description:    Set the (immediate) supertype list of an entity.
  444. */
  445.  
  446. void
  447. ENTITYput_supertypes(Entity entity, Linked_List list)
  448. {
  449.     struct Entity*    data;
  450.     Error        errc;
  451.  
  452.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  453.     OBJfree(data->supertypes, &errc);
  454.     data->supertypes = OBJreference(list);
  455. }
  456.  
  457. /*
  458. ** Procedure:    ENTITYput_subtypes
  459. ** Parameters:    Entity      entity    - entity to modify
  460. **        Expression  expression    - controlling subtype expression
  461. ** Returns:    void
  462. ** Description:    Set the (immediate) subtypes of an entity.
  463. */
  464.  
  465. void
  466. ENTITYput_subtypes(Entity entity, Expression expression)
  467. {
  468.     struct Entity*    data;
  469.     Error        errc;
  470.  
  471.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  472.     OBJfree(data->subtypes, &errc);
  473.     OBJfree(data->subtype_expression, &errc);
  474.     data->subtypes = LIST_NULL;
  475.     data->subtype_expression = OBJreference(expression);
  476. }
  477.  
  478. #endif /*0*/
  479.  
  480. /*
  481. ** Procedure:    ENTITYadd_attribute
  482. ** Parameters:    Entity   entity        - entity to modify
  483. **         Variable attribute    - attribute to add
  484. ** Returns:    void
  485. ** Description:    Add an attribute to an entity.
  486. */
  487.  
  488. void
  489. ENTITYadd_attribute(Entity entity, Variable attr)
  490. {
  491.     int rc;
  492.  
  493.     if (attr->name->type->u.type->body->type != op_) {
  494.         /* simple id */
  495.         rc = DICTdefine(entity->symbol_table,attr->name->symbol.name,
  496.             (Generic)attr,&attr->name->symbol,OBJ_VARIABLE);
  497.     } else {
  498.         /* SELF\ENTITY.SIMPLE_ID */
  499.         rc = DICTdefine(entity->symbol_table,attr->name->e.op2->symbol.name,
  500.             (Generic)attr,&attr->name->symbol,OBJ_VARIABLE);
  501.     }
  502.     if (rc == 0) {
  503.         LISTadd_last(entity->u.entity->attributes,(Generic)attr);
  504.         VARput_offset(attr, entity->u.entity->attribute_count);
  505.         entity->u.entity->attribute_count++;
  506.     }
  507. }
  508.  
  509. #if 0
  510.  
  511. /*
  512. ** Procedure:    ENTITYput_uniqueness_list
  513. ** Parameters:    Entity      entity    - entity to modify
  514. **        Linked_List list    - uniqueness list of Linked_Lists
  515. ** Returns:    void
  516. ** Description:    Set the attribute uniqueness list of an entity.
  517. **
  518. ** Notes:    Each element of the uniqueness list should itself be
  519. **    a list.  The elements of these sublists are attribute names.
  520. **    The attributes in a single sublist, when taken together, must
  521. **    uniquely determine an entity instatiation.  Thus, if person_name
  522. **    has a sublist (first, last), then no two person_name entities
  523. **    may share the same first and last names.
  524. */
  525.  
  526. void
  527. ENTITYput_uniqueness_list(Entity entity, Linked_List list)
  528. {
  529.     struct Entity*    data;
  530.     Error        errc;
  531.  
  532.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  533.     OBJfree(data->unique, &errc);
  534.     data->unique = OBJreference(list);
  535. }
  536.  
  537. /*
  538. ** Procedure:    ENTITYput_constraints
  539. ** Parameters:    Entity      entity    - entity to modify
  540. **        Linked_List constraints    - list of constraints (Expressions)
  541. **                      which entity must satisfy
  542. ** Returns:    void
  543. ** Description:    Set the constraints on an entity.
  544. **
  545. ** Notes:    This is a list of constraints which must be satisfied by
  546. **        each instatiation of the entity, or by the set of all
  547. **        instantiations of the entity.
  548. */
  549.  
  550. void
  551. ENTITYput_constraints(Entity entity, Linked_List list)
  552. {
  553.     struct Entity*    data;
  554.     Error        errc;
  555.  
  556.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  557.     OBJfree(data->constraints, &errc);
  558.     data->constraints = OBJreference(list);
  559. }
  560.  
  561. #endif
  562.  
  563. /*
  564. ** Procedure:    ENTITYadd_instance
  565. ** Parameters:    Entity  entity        - entity to modify
  566. **        Generic instance    - new instance
  567. ** Returns:    void
  568. ** Description:    Add an item to the instance list of an entity.
  569. */
  570.  
  571. void
  572. ENTITYadd_instance(Entity entity, Generic instance)
  573. {
  574.     if (entity->u.entity->instances == LIST_NULL)
  575.     entity->u.entity->instances = LISTcreate();
  576.     LISTadd(entity->u.entity->instances, instance);
  577. }
  578.  
  579. #if 0
  580.  
  581. /*
  582. ** Procedure:    ENTITYdelete_instance
  583. ** Parameters:    Entity  entity        - entity to modify
  584. **        Generic instance    - instance to delete
  585. ** Returns:    void
  586. ** Description:    Remove an item from the instance list of an entity.
  587. */
  588.  
  589. void
  590. ENTITYdelete_instance(Entity entity, Generic instance)
  591. {
  592.     struct Entity*    data;
  593.     Error        errc;
  594.  
  595.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  596.     LISTdo_links(data->instances, link)
  597.     if (link->data == instance)
  598.         LISTremove(data->instances, link);
  599.     LISTod;
  600. }
  601.  
  602. /*
  603. ** Procedure:    ENTITYput_mark
  604. ** Parameters:    Entity entity - entity to modify
  605. **        int value - new mark for entity
  606. ** Returns:    void
  607. ** Description:    Set an entity's mark.
  608. */
  609.  
  610. /* this function is inlined in entity.h */
  611.  
  612. #endif
  613.  
  614. /*
  615. ** Procedure:    ENTITYhas_supertype
  616. ** Parameters:    Entity child    - entity to check parentage of
  617. **        Entity parent    - parent to check for
  618. ** Returns:    Boolean        - does child's superclass chain include parent?
  619. ** Description:    Look for a certain entity in the supertype graph of an entity.
  620. */
  621.  
  622. Boolean
  623. ENTITYhas_supertype(Entity child, Entity parent)
  624. {
  625.     LISTdo(child->u.entity->supertypes, entity, Entity)
  626.     if (entity == parent)
  627.         return true;
  628. #if 0
  629.     if (OBJis_kind_of(entity, Class_Entity) &&
  630.         ENTITYhas_supertype(entity, parent))
  631. #endif
  632.     if (ENTITYhas_supertype(entity,parent))
  633.         return true;
  634.     LISTod;
  635.     return false;
  636. }
  637.  
  638. #if 0
  639.  
  640. /*
  641. ** Procedure:    ENTITYget_supertype (by name)
  642. ** Parameters:    Entity child    - entity to check parentage of
  643. **        String supername- entity to check for
  644. ** Returns:    Boolean        - does child's superclass chain include named entity?
  645. ** Description:    Returns supertype given name and entity (or ENTITY_NULL).
  646. */
  647.  
  648. Entity
  649. ENTITYget_supertype(Entity child, String supername)
  650. {
  651.     struct Entity*    data;
  652.     Error        errc;
  653.  
  654.     data = (struct Entity*)OBJget_data(child, Class_Entity, &errc);
  655.     LISTdo(data->supertypes, super, Entity)
  656.     if (STRINGequal(supername,ENTITYget_name(super))) return(super);
  657.     if (OBJis_kind_of(super, Class_Entity))
  658.         if (ENTITY_NULL != (super = ENTITYget_supertype(super,supername)))
  659.         return(super);
  660.     LISTod;
  661.     return ENTITY_NULL;
  662. }
  663.  
  664. /*
  665. ** Procedure:    ENTITYget_subtype (by name)
  666. ** Parameters:    Entity child    - entity to check parentage of
  667. **        String subname    - entity to check for
  668. ** Returns:    Boolean        - does child's subclass chain include named entity?
  669. ** Description:    Returns subtype given name and entity (or ENTITY_NULL).
  670. */
  671.  
  672. Entity
  673. ENTITYget_subtype(Entity child, String subname)
  674. {
  675.     struct Entity*    data;
  676.     Error        errc;
  677.  
  678.     data = (struct Entity*)OBJget_data(child, Class_Entity, &errc);
  679.     LISTdo(data->subtypes, sub, Entity)
  680.     if (STRINGequal(subname,ENTITYget_name(sub))) return(sub);
  681.     if (ENTITY_NULL != (sub = ENTITYget_subtype(sub,subname)))
  682.         return(sub);
  683.     LISTod;
  684.     return ENTITY_NULL;
  685. }
  686.  
  687. /*
  688. ** Procedure:    ENTITYhas_subtype
  689. ** Parameters:    Entity parent    - entity to check descendants of
  690. **        Entity child    - child to check for
  691. ** Returns:    Boolean        - does parent's subclass tree include child?
  692. ** Description:    Look for a certain entity in the subtype graph of an entity.
  693. */
  694.  
  695. Boolean
  696. ENTITYhas_subtype(Entity parent, Entity child)
  697. {
  698.     struct Entity*    data;
  699.     Error        errc;
  700.  
  701.     data = (struct Entity*)OBJget_data(parent, Class_Entity, &errc);
  702.     LISTdo(data->subtypes, entity, Entity)
  703.     if (OBJequal(entity, child, &errc))
  704.         return true;
  705.     if (ENTITYhas_subtype(entity, child))
  706.         return true;
  707.     LISTod;
  708.     return false;
  709. }
  710.  
  711. /*
  712. ** Procedure:    ENTITYhas_immediate_supertype
  713. ** Parameters:    Entity child    - entity to check parentage of
  714. **        Entity parent    - parent to check for
  715. ** Returns:    Boolean        - is parent a direct supertype of child?
  716. ** Description:    Check whether an entity has a specific immediate superclass.
  717. */
  718.  
  719. #endif
  720.  
  721. Boolean
  722. ENTITYhas_immediate_supertype(Entity child, Entity parent)
  723. {
  724.     LISTdo(child->u.entity->supertypes, entity,Entity )
  725.     if (entity == parent) return true;
  726.     LISTod;
  727.     return false;
  728. }
  729.  
  730. #if 0
  731.  
  732. /*
  733. ** Procedure:    ENTITYhas_immediate_subtype
  734. ** Parameters:    Entity parent    - entity to check children of
  735. **        Entity child    - child to check for
  736. ** Returns:    Boolean        - is child a direct subtype of parent?
  737. ** Description:    Check whether an entity has a specific immediate subclass.
  738. */
  739.  
  740. Boolean
  741. ENTITYhas_immediate_subtype(Entity parent, Entity child)
  742. {
  743.     LISTdo(parent->u.entity->subtypes, entity, Entity )
  744.     if (entity == child) return true;
  745.     LISTod;
  746.     return false;
  747. }
  748.  
  749. Boolean
  750. ENTITYhas_immediate_subtype(Entity parent, Entity child)
  751. {
  752.     struct Entity*    data;
  753.     Error        errc;
  754.  
  755.     data = (struct Entity*)OBJget_data(parent, Class_Entity, &errc);
  756.     LISTdo(data->subtypes, entity, Entity)
  757.     if (OBJequal(entity, child, &errc))
  758.         return true;
  759.     LISTod;
  760.     return false;
  761. }
  762.  
  763. /*
  764. ** Procedure:    ENTITYget_name
  765. ** Parameters:    Entity entity    - entity to examine
  766. ** Returns:    String        - entity name
  767. ** Description:    Retrieve the name of an entity.
  768. */
  769.  
  770. /* this function is defined as a macro in entity.h */
  771.  
  772. /*
  773. ** Procedure:    ENTITYget_supertypes
  774. ** Parameters:    Entity      entity    - entity to examine
  775. ** Returns:    Linked_List of Entity    - immediate supertypes of this entity
  776. ** Description:    Retrieve a list of an entity's immediate supertypes.
  777. */
  778.  
  779. /* this function is defined as a macro in entity.h */
  780.  
  781. /*
  782. ** Procedure:    ENTITYget_subtypes
  783. ** Parameters:    Entity      entity    - entity to examine
  784. ** Returns:    Linked_List of Entity    - immediate subtypes of this entity
  785. ** Description:    Retrieve a list of an entity's immediate subtypes.
  786. */
  787.  
  788. Linked_List
  789. ENTITYget_subtypes(Entity entity)
  790. {
  791.     struct Entity*    data;
  792.     Error        errc;
  793.  
  794.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  795.     return OBJreference(data->subtypes);
  796. }
  797.  
  798. /*
  799. ** Procedure:    ENTITY{get,put}_abstract
  800. ** Parameters:    Entity      entity    - entity to examine
  801. **        Boolean        abstract    - is entity abstract?
  802. ** Returns:    Boolean            - is entity abstract?
  803. ** Description:    Retrieve/Set whether an entity is abstract.
  804. */
  805.  
  806. Boolean
  807. ENTITYget_abstract(Entity entity)
  808. {
  809.     struct Entity*    data;
  810.     Error        errc;
  811.  
  812.     data = (struct Entity*)OBJget_data(entity,Class_Entity,&errc);
  813.     return data->abstract;
  814. }
  815.  
  816. void
  817. ENTITYput_abstract(Entity entity, Boolean abstract)
  818. {
  819.     struct Entity*    data;
  820.     Error        errc;
  821.  
  822.     data = (struct Entity*)OBJget_data(entity,Class_Entity,&errc);
  823.     data->abstract = abstract;
  824. }
  825.  
  826. /*
  827. ** Procedure:    ENTITYget_subtype_expression
  828. ** Parameters:    Entity     entity    - entity to examine
  829. ** Returns:    Expression        - immediate subtype expression
  830. ** Description:    Retrieve the controlling expression for an entity's
  831. **    immediate subtype list.
  832. */
  833.  
  834. Expression
  835. ENTITYget_subtype_expression(Entity entity)
  836. {
  837.     struct Entity*    data;
  838.     Error        errc;
  839.  
  840.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  841.     return OBJreference(data->subtype_expression);
  842. }
  843.  
  844. #endif
  845.  
  846. /*
  847. ** Procedure:    ENTITYget_all_attributes
  848. ** Parameters:    Entity      entity    - entity to examine
  849. ** Returns:    Linked_List of Variable    - all attributes of this entity
  850. ** Description:    Retrieve the attribute list of an entity.
  851. **
  852. ** Notes:    If an entity has neither defines nor inherits any
  853. **        attributes, this call returns an empty list.  Note
  854. **        that this is distinct from the constant LIST_NULL.
  855. */
  856.  
  857. static
  858. void
  859. ENTITY_get_all_attributes(Entity entity, Linked_List result)
  860. {
  861.     LISTdo(entity->u.entity->supertypes, super, Entity )
  862. /*    if (OBJis_kind_of(super, Class_Entity))*/
  863.         ENTITY_get_all_attributes(super, result);
  864.     LISTod;
  865. /* Gee, aren't they resolved by this time? */
  866. #if 0
  867.     LISTdo(entity->attributes, name, char *)
  868.     LISTadd_last(result,
  869.              (Generic)SCOPElookup(entity, name, false, &errc));
  870. #endif
  871.     LISTdo(entity->u.entity->attributes,attr,Generic)
  872.         LISTadd_last(result,attr);
  873.     LISTod;
  874. }
  875.  
  876. Linked_List
  877. ENTITYget_all_attributes(Entity entity)
  878. {
  879.     Linked_List result = LISTcreate();
  880.  
  881.     ENTITY_get_all_attributes(entity, result);
  882.     return result;
  883. }
  884.  
  885. /*
  886. ** Procedure:    ENTITYget_named_attribute
  887. ** Parameters:    Entity  entity    - entity to examine
  888. **        String    name    - name of attribute to retrieve
  889. ** Returns:    Variable    - the named attribute of this entity
  890. ** Description:    Retrieve an entity attribute by name.
  891. **
  892. ** Notes:    If the entity has no attribute with the given name,
  893. **    VARIABLE_NULL is returned.
  894. */
  895.  
  896. Variable
  897. ENTITYget_named_attribute(Entity entity, char *name)
  898. {
  899.     Variable attribute;
  900.  
  901.     LISTdo(entity->u.entity->attributes, attr, Variable)
  902.     if (streq(VARget_simple_name(attr), name))
  903.         return attr;
  904.     LISTod;
  905.  
  906.     LISTdo(entity->u.entity->supertypes, super, Entity )
  907. /*    if (OBJis_kind_of(super, Class_Entity) && */
  908.     if (0 != (attribute = ENTITYget_named_attribute(super,name)))
  909.         return attribute;
  910.     LISTod;
  911.     return 0;
  912. }
  913.  
  914. /*
  915. ** Procedure:    ENTITYget_attribute_offset
  916. ** Parameters:    Entity   entity        - entity to examine
  917. **        Variable attribute    - attribute to retrieve offset for
  918. ** Returns:    int            - offset to given attribute
  919. ** Description:    Retrieve offset to an entity attribute.
  920. **
  921. ** Notes:    If the entity does not include the attribute, -1
  922. **    is returned.
  923. */
  924.  
  925. int
  926. ENTITYget_attribute_offset(Entity entity, Variable attribute)
  927. {
  928.     int            offset, value;
  929.  
  930.     LISTdo(entity->u.entity->attributes, attr, Variable)
  931.     if (attr == attribute)
  932.         return entity->u.entity->inheritance + VARget_offset(attribute);
  933.     LISTod;
  934.     offset = 0;
  935.     LISTdo(entity->u.entity->supertypes, super, Entity )
  936. /*    if (OBJis_kind_of(super, Class_Entity)) {*/
  937.         if ((value = ENTITYget_attribute_offset(super, attribute)) != -1)
  938.         return value + offset;
  939.         offset += ENTITYget_initial_offset(super);
  940. /*    }*/
  941.     LISTod;
  942.     return -1;
  943. }
  944.  
  945. /*
  946. ** Procedure:    ENTITYget_named_attribute_offset
  947. ** Parameters:    Entity  entity    - entity to examine
  948. **        String    name    - name of attribute to retrieve
  949. ** Returns:    int        - offset to named attribute of this entity
  950. ** Description:    Retrieve offset to an entity attribute by name.
  951. **
  952. ** Notes:    If the entity has no attribute with the given name,
  953. **        -1 is returned.
  954. */
  955.  
  956. int
  957. ENTITYget_named_attribute_offset(Entity entity, String name)
  958. {
  959.     int            offset, value;
  960.  
  961.     LISTdo(entity->u.entity->attributes, attr, Variable)
  962.     if (STRINGequal(VARget_simple_name(attr), name))
  963.         return entity->u.entity->inheritance +
  964. /*           VARget_offset(SCOPElookup(entity, name, false));*/
  965.            VARget_offset(ENTITY_find_inherited_attribute(entity,name));
  966.     LISTod;
  967.     offset = 0;
  968.     LISTdo(entity->u.entity->supertypes, super, Entity )
  969. /*    if (OBJis_kind_of(super, Class_Entity)) {*/
  970.         if ((value = ENTITYget_named_attribute_offset(super, name)) != -1)
  971.         return value + offset;
  972.         offset += ENTITYget_initial_offset(super);
  973. /*    }*/
  974.     LISTod;
  975.     return -1;
  976. }
  977.  
  978. /*
  979. ** Procedure:    ENTITYget_initial_offset
  980. ** Parameters:    Entity entity    - entity to examine
  981. ** Returns:    int        - number of inherited attributes
  982. ** Description:    Retrieve the initial offset to an entity's local frame.
  983. */
  984.  
  985. int
  986. ENTITYget_initial_offset(Entity entity)
  987. {
  988.     return entity->u.entity->inheritance;
  989. }
  990.  
  991. /*
  992. ** Procedure:    ENTITYget_size
  993. ** Parameters:    Entity entity    - entity to examine
  994. ** Returns:    int        - storage size of instantiated entity
  995. ** Description:    Compute the storage size of an entity instance.
  996. **
  997. ** Notes:    The size is computed in units of Object.
  998. */
  999.  
  1000. /* macroized in entity.h */
  1001.  
  1002. #if 0
  1003.  
  1004. /*
  1005. ** Procedure:    ENTITYget_uniqueness_list
  1006. ** Parameters:    Entity      entity        - entity to examine
  1007. ** Returns:    Linked_List of Linked_List    - this entity's uniqueness sets
  1008. ** Description:    Retrieve an entity's uniqueness list.
  1009. **
  1010. ** Notes:    For a description of the uniqueness list, see the notes to
  1011. **        ENTITYput_uniqueness_list.
  1012. */
  1013.  
  1014. Linked_List
  1015. ENTITYget_uniqueness_list(Entity entity)
  1016. {
  1017.     struct Entity*    data;
  1018.     Error        errc;
  1019.  
  1020.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  1021.     return OBJreference(data->unique);
  1022. }
  1023.  
  1024. /*
  1025. ** Procedure:    ENTITYget_constraints
  1026. ** Parameters:    Entity      entity        - entity to examine
  1027. ** Returns:    Linked_List of Expression    - this entity's constraints
  1028. ** Description:    Retrieve the list of constraints on an entity.
  1029. */
  1030.  
  1031. Linked_List
  1032. ENTITYget_constraints(Entity entity)
  1033. {
  1034.     struct Entity*    data;
  1035.     Error        errc;
  1036.  
  1037.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  1038.     return OBJreference(data->constraints);
  1039. }
  1040.  
  1041. /*
  1042. ** Procedure:    ENTITYget_instances
  1043. ** Parameters:    Entity entity    - entity to examine
  1044. ** Returns:    Linked_List    - list of instances
  1045. ** Description:    Retrieve a list of instances of an entity.
  1046. */
  1047.  
  1048. Linked_List
  1049. ENTITYget_instances(Entity entity)
  1050. {
  1051.     struct Entity*    data;
  1052.     Error        errc;
  1053.  
  1054.     data = (struct Entity*)OBJget_data(entity, Class_Entity, &errc);
  1055.     return OBJreference(data->instances);
  1056. }
  1057.  
  1058. /*
  1059. ** Procedure:    ENTITYput_resolved
  1060. ** Parameters:    Entity entity    - entity to modify
  1061. ** Returns:    void
  1062. ** Description:    Set the 'resolved' flag for an entity.
  1063. **
  1064. ** Notes:    This should be called only when the entity has indeed
  1065. **        been resolved.
  1066. */
  1067.  
  1068. /* this function is defined as a macro in entity.h */
  1069.  
  1070. /*
  1071. ** Procedure:    ENTITYget_resolved
  1072. ** Parameters:    Entity entity    - entity to examine
  1073. ** Returns:    Boolean        - has entity been resolved?
  1074. ** Description:    Checks whether references within an entity have been resolved.
  1075. */
  1076.  
  1077. /* this function is defined as a macro in entity.h */
  1078.  
  1079. /*
  1080. ** Procedure:    ENTITYput_inheritance_count
  1081. ** Parameters:    Entity entity    - entity to modify
  1082. **        int    count    - number of inherited attributes
  1083. ** Returns:    void
  1084. ** Description:    Set the count of attributes inherited by an entity.
  1085. **
  1086. ** Notes:    This should be computed automatically (perhaps only when
  1087. **        needed), and this call removed.  The count is currently
  1088. **        computed by ENTITYresolve().
  1089. */
  1090.  
  1091. void
  1092. ENTITYput_inheritance_count(Entity e, int count)
  1093. {
  1094.     e->u.entity->inheritance = count;
  1095. }
  1096. #endif
  1097.