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 / EXPR.C < prev    next >
C/C++ Source or Header  |  1994-07-23  |  38KB  |  1,328 lines
  1. static char rcsid[] = "$Id: expr.c,v 1.3 1994/06/02 14:56:06 libes Exp $";
  2.  
  3. /************************************************************************
  4. ** Module:    Expression
  5. ** Description:    This module implements the Expression abstraction.  Several
  6. **    types of expressions are supported: identifiers, literals,
  7. **    operations (arithmetic, logical, array indexing, etc.), and
  8. **    function calls.  Every expression is marked with a type.
  9. ** Constants:
  10. **    EXPRESSION_NULL        - the null expression
  11. **    LITERAL_E        - a real literal with the value 2.7182...
  12. **    LITERAL_EMPTY_SET    - a set literal representing the empty set
  13. **    LITERAL_INFINITY    - a numeric literal representing infinity
  14. **    LITERAL_PI        - a real literal with the value 3.1415...
  15. **    LITERAL_ZERO        - an integer literal representing 0
  16. **
  17. ************************************************************************/
  18.  
  19. /*
  20.  * This software was developed by U.S. Government employees as part of
  21.  * their official duties and is not subject to copyright.
  22.  *
  23.  * $Log: expr.c,v $
  24.  * Revision 1.3  1994/06/02  14:56:06  libes
  25.  * made plus-like ops check both args
  26.  *
  27.  * Revision 1.2  1993/10/15  18:48:48  libes
  28.  * CADDETC certified
  29.  *
  30.  * Revision 1.9  1993/02/22  21:46:00  libes
  31.  * ANSI compat fixes
  32.  *
  33.  * Revision 1.8  1993/02/16  03:21:31  libes
  34.  * fixed numerous confusions of type with return type
  35.  * fixed implicit loop variable type declarations
  36.  * improved errors
  37.  *
  38.  * Revision 1.7  1993/01/19  22:44:17  libes
  39.  * *** empty log message ***
  40.  *
  41.  * Revision 1.6  1992/09/16  18:20:40  libes
  42.  * made expression resolution routines search through references
  43.  *
  44.  * Revision 1.5  1992/08/18  17:13:43  libes
  45.  * rm'd extraneous error messages
  46.  *
  47.  * Revision 1.4  1992/06/08  18:06:57  libes
  48.  * prettied up interface to print_objects_when_running
  49.  *
  50.  * Revision 1.3  1992/05/31  23:32:26  libes
  51.  * implemented ALIAS resolution
  52.  *
  53.  * Revision 1.2  1992/05/31  08:35:51  libes
  54.  * multiple files
  55.  *
  56.  * Revision 1.1  1992/05/28  03:55:04  libes
  57.  * Initial revision
  58.  *
  59.  * Revision 4.1  90/09/13  15:12:48  clark
  60.  * BPR 2.1 alpha
  61.  * 
  62.  */
  63.  
  64. #define EXPR_C
  65. #include "expr.h"
  66. #include "resolve.h"
  67.  
  68. void EXPop_init();
  69. static Error ERROR_internal_unrecognized_op_in_EXPresolve;
  70.         /* following two could probably be combined */
  71. static Error ERROR_attribute_reference_on_aggregate;
  72. static Error ERROR_attribute_ref_from_nonentity;
  73. static Error ERROR_indexing_illegal;
  74. static Error ERROR_enum_no_such_item;
  75. static Error ERROR_group_ref_no_such_entity;
  76. static Error ERROR_group_ref_unexpected_type;
  77. int OPget_number_of_operands(Op_Code op);
  78.  
  79. Expression 
  80. EXPcreate(Type type)
  81. {
  82.     Expression e;
  83.     e = EXP_new();
  84.     SYMBOLset(e);
  85.     e->type = type;
  86.     e->return_type = Type_Unknown;
  87.     return(e);
  88. }
  89.  
  90. /* use this when the return_type is the same as the type */
  91. /* For example, for constant integers */
  92. Expression 
  93. EXPcreate_simple(Type type)
  94. {
  95.     Expression e;
  96.     e = EXP_new();
  97.     SYMBOLset(e);
  98.     e->type = e->return_type = type;
  99.     return(e);
  100. }
  101.  
  102. Expression 
  103. EXPcreate_from_symbol(Type type, Symbol *symbol)
  104. {
  105.     Expression e;
  106.     e = EXP_new();
  107.     e->type = type;
  108.     e->return_type = Type_Unknown;
  109.     e->symbol = *symbol;
  110.     return e;
  111. }
  112.  
  113. Symbol *
  114. EXP_get_symbol(Generic e)
  115. {
  116.     return(&((Expression )e)->symbol);
  117. }
  118.  
  119. /*
  120. ** Procedure:    EXPinitialize
  121. ** Parameters:    -- none --
  122. ** Returns:    void
  123. ** Description:    Initialize the Expression module.
  124. */
  125.  
  126. void
  127. EXPinitialize(void)
  128. {
  129.     MEMinitialize(&EXP_fl,sizeof(struct Expression),500,200);
  130.     MEMinitialize(&OP_fl,sizeof(struct Op_Subexpression),500,100);
  131.     MEMinitialize(&QUERY_fl,sizeof(struct Query),50,10);
  132.     MEMinitialize(&QUAL_ATTR_fl,sizeof(struct Query),20,10);
  133.     OBJcreate(OBJ_EXPRESSION,EXP_get_symbol,"expression",OBJ_EXPRESSION_BITS);
  134.     OBJcreate(OBJ_AMBIG_ENUM,EXP_get_symbol,"ambiguous enumeration",OBJ_UNUSED_BITS);
  135.  
  136. #ifdef does_not_appear_to_be_necessary_or_even_make_sense
  137.     LITERAL_EMPTY_SET = EXPcreate_simple(Type_Set);
  138.     LITERAL_EMPTY_SET->u.list = LISTcreate();
  139.     resolved_all(LITERAL_EMPTY_SET);
  140. #endif
  141.  
  142. /* E and PI might come out of math.h */
  143.  
  144.     LITERAL_E = EXPcreate_simple(Type_Real);
  145. #ifndef M_E
  146. #define    M_E        2.7182818284590452354
  147. #endif
  148.     LITERAL_E->u.real = M_E;
  149.     resolved_all(LITERAL_E);
  150.  
  151.     LITERAL_PI = EXPcreate_simple(Type_Real);
  152. #ifndef M_PI
  153. #define    M_PI    3.14159265358979323846
  154. #endif
  155.     LITERAL_PI->u.real = M_PI;
  156.     resolved_all(LITERAL_PI);
  157.  
  158.     LITERAL_INFINITY = EXPcreate_simple(Type_Integer);
  159.     LITERAL_INFINITY->u.integer = MAXINT;
  160.     resolved_all(LITERAL_INFINITY);
  161.  
  162.     LITERAL_ZERO = EXPcreate_simple(Type_Integer);
  163.     LITERAL_ZERO->u.integer = 0;
  164.     resolved_all(LITERAL_ZERO);
  165.  
  166.     LITERAL_ONE = EXPcreate_simple(Type_Integer);
  167.     LITERAL_ONE->u.integer = 1;
  168.     resolved_all(LITERAL_ONE);
  169.  
  170.     ERROR_integer_expression_expected =    ERRORcreate(
  171. "Integer expression expected", SEVERITY_WARNING);
  172.     ERROR_internal_unrecognized_op_in_EXPresolve = ERRORcreate(
  173. "Opcode unrecognized while trying to resolve expression",
  174.         SEVERITY_ERROR);
  175.     ERROR_attribute_reference_on_aggregate = ERRORcreate(
  176. "Attribute %s cannot be referenced from an aggregate",SEVERITY_ERROR);
  177.     ERROR_attribute_ref_from_nonentity = ERRORcreate(
  178. "Attribute %s cannot be referenced from a non-entity",SEVERITY_ERROR);
  179.     ERROR_indexing_illegal = ERRORcreate(
  180. "Indexing is only permitted on aggregates",SEVERITY_ERROR);
  181.     ERROR_enum_no_such_item = ERRORcreate(
  182. "Enumeration type %s does not contain item %s",SEVERITY_ERROR);
  183.     ERROR_group_ref_no_such_entity = ERRORcreate(
  184. "Group reference failed to find entity %s",SEVERITY_ERROR);
  185.     ERROR_group_ref_unexpected_type = ERRORcreate(
  186. "Group reference of unusual expression %s",SEVERITY_ERROR);
  187.  
  188.     EXPop_init();
  189. }
  190.  
  191. Type
  192. EXPresolve_op_dot(Expression expr,Scope scope)
  193. {
  194.     Expression op1 = expr->e.op1;
  195.     Expression op2 = expr->e.op2;
  196.     Variable v;
  197.     Expression item;
  198. /*    enum type_enum type;*/
  199.     Type op1type;
  200.  
  201.     /* op1 is entity expression, op2 is attribute */
  202.     /* could be very impossible to determine except */
  203.     /* at run-time, .... */
  204.     EXPresolve(op1,scope,Type_Dont_Care);
  205.     if (is_resolve_failed(op1)) {
  206.         resolve_failed(expr);
  207.         return(Type_Bad);
  208.     }
  209.     op1type = op1->return_type;
  210.  
  211.     switch (op1type->u.type->body->type) {
  212.     case generic_:
  213.     case select_:
  214.     case runtime_:
  215.         /* defer */
  216.         return(Type_Runtime);
  217.     case op_:    /* (op1).op2 */
  218.         v = VARfind(op1type->u.type->body->entity,op2->symbol.name,1);
  219. /*        v = VARfind(op1->return_type->entity,op2->symbol.name,1);*/
  220.         if (!v) {
  221.             ERRORreport_with_symbol(ERROR_undefined_attribute,
  222.                 &expr->symbol,op2->symbol.name);
  223.             resolve_failed(expr);
  224.             return(Type_Bad);
  225.         }
  226.         if (DICT_type != OBJ_VARIABLE) {
  227.             printf("EXPresolved_op_dot: attribute not an attribute? - press ^C now to trap to debugger\n");
  228.             getchar();
  229.         }
  230.         op2->u.variable = v;
  231.         op2->return_type = v->type;
  232. /*        op2->type = Type_Attribute;*/
  233.         resolved_all(expr);
  234.         return(v->type);
  235.     case attribute_:
  236.         v = VARfind(op1->u.variable->type->u.type->body->entity,op2->symbol.name,1);
  237.         if (!v) {
  238.             ERRORreport_with_symbol(ERROR_undefined_attribute,
  239.                 &expr->symbol,op2->symbol.name);
  240.             resolve_failed(expr);
  241.             return(Type_Bad);
  242.         }
  243.         if (DICT_type != OBJ_VARIABLE) {
  244.             printf("EXPresolved_op_dot: attribute not an attribute?\n");
  245.             ERRORabort(0);
  246.         }
  247.         op2->u.variable = v;
  248.         op2->return_type = v->type;
  249.         resolved_all(expr);
  250.         return(v->type);
  251.     case entity_:
  252.         v = VARfind(op1type->u.type->body->entity,op2->symbol.name,1);
  253. /*        v = VARfind(op1->return_type->entity,op2->symbol.name,1);*/
  254.         if (!v) {
  255.             ERRORreport_with_symbol(ERROR_undefined_attribute,
  256.                 &expr->symbol,op2->symbol.name);
  257.             resolve_failed(expr);
  258.             return(Type_Bad);
  259.         }
  260.         if (DICT_type != OBJ_VARIABLE) {
  261.             printf("EXPresolved_op_dot: attribute not an attribute? - press ^C now to trap to debugger\n");
  262.             getchar();
  263.         }
  264.         op2->u.variable = v;
  265.         /* changed to set return_type */
  266.         op2->return_type = op2->u.variable->type;
  267.         resolved_all(expr);
  268.         return(op2->return_type);
  269.     case enumeration_:
  270.         item = (Expression )DICTlookup(TYPEget_enum_tags(op1type),op2->symbol.name);
  271. /*        item = (Expression )DICTlookup(TYPEget_enum_tags(op1->return_type),op2->symbol.name);*/
  272.         if (!item) {
  273.             ERRORreport_with_symbol(ERROR_enum_no_such_item,&op2->symbol,op1type->symbol.name,op2->symbol.name);
  274. /*            ERRORreport_with_symbol(ERROR_enum_no_such_item,&op2->symbol,op1->return_type->symbol.name,op2->symbol.name);*/
  275.             resolve_failed(expr);
  276.             return(Type_Bad);
  277.  
  278.         }
  279.         op2->u.expression = item;
  280.         op2->return_type = item->type;
  281.         resolved_all(expr);
  282.         return(item->type);
  283.     case aggregate_:
  284.     case array_:
  285.     case bag_:
  286.     case list_:
  287.     case set_:
  288.         ERRORreport_with_symbol(ERROR_attribute_reference_on_aggregate,
  289.             &op2->symbol,op2->symbol.name);
  290.         /*FALLTHRU*/
  291.     case unknown_:    /* unable to resolved operand */
  292.         /* presumably error has already been reported */
  293.         resolve_failed(expr);
  294.         return(Type_Bad);
  295.     default:
  296.         ERRORreport_with_symbol(ERROR_attribute_ref_from_nonentity,
  297.             &op2->symbol,op2->symbol.name);
  298.         resolve_failed(expr);
  299.         return(Type_Bad);
  300.     }
  301. }
  302.  
  303. Type
  304. EXPresolve_op_group(Expression expr,Scope scope)
  305. {
  306.     Expression op1 = expr->e.op1;
  307.     Expression op2 = expr->e.op2;
  308.     Entity ent_ref;
  309.     Type op1type;
  310.  
  311.     /* op1 is entity expression, op2 is entity */
  312.     /* could be very impossible to determine except */
  313.     /* at run-time, .... */
  314.     EXPresolve(op1,scope,Type_Dont_Care);
  315.     if (is_resolve_failed(op1)) {
  316.         resolve_failed(expr);
  317.         return(Type_Bad);
  318.     }
  319.     op1type = op1->return_type;
  320.  
  321.     switch (op1type->u.type->body->type) {
  322.     case generic_:
  323.     case select_:
  324.     case runtime_:
  325.     case op_:
  326.     case aggregate_:
  327.     case array_:
  328.     case bag_:
  329.     case list_:
  330.     case set_:
  331.         /* All these cases are very painful to do right */
  332.         /* "Generic" and sometimes others require runtime evaluation */
  333.         op2->return_type = Type_Runtime;
  334.         return(Type_Runtime);
  335.     case self_:
  336.     case entity_:
  337.         /* Get entity denoted by "X\" */
  338.         ent_ref = ((op1type->u.type->body->type == self_)?scope:op1type->u.type->body->entity);
  339.  
  340.         /* Now get entity denoted by "X\Y" */
  341.         ent_ref = (Entity)ENTITYfind_inherited_entity(ent_ref,op2->symbol.name);
  342.         if (!ent_ref) {
  343.             ERRORreport_with_symbol(ERROR_group_ref_no_such_entity,&op2->symbol,op2->symbol.name);
  344.             resolve_failed(expr);
  345.             return(Type_Bad);
  346.         }
  347.         op2->u.entity = ent_ref;
  348.         op2->return_type = ent_ref->u.entity->type;
  349.         resolved_all(expr);
  350.         return(op2->return_type);
  351.     case unknown_:    /* unable to resolved operand */
  352.         /* presumably error has already been reported */
  353.         resolve_failed(expr);
  354.         return(Type_Bad);
  355.     default:
  356.         ERRORreport_with_symbol(ERROR_group_ref_unexpected_type,
  357.             &op1->symbol);
  358.         return(Type_Bad);
  359.     }
  360. }
  361.  
  362. Type
  363. EXPresolve_op_relational(Expression e, Scope s)
  364. {
  365.     Type t = 0;
  366.     int failed = 0;
  367.     Type op1type;
  368.  
  369.     /* Prevent op1 from complaining if it fails */
  370.  
  371.     EXPresolve(e->e.op1,s,Type_Unknown);
  372.     failed = is_resolve_failed(e->e.op1);
  373.     op1type = e->e.op1->return_type;
  374.  
  375.     /* now, either op1 was resolved in which case, we use its return type */
  376.     /* for typechecking, OR, it wasn't resolved in which case we resolve */
  377.     /* op2 in such a way that it complains if it fails to resolved */
  378.  
  379.     if (op1type == Type_Unknown) t = Type_Dont_Care;
  380.     else t = op1type;
  381.  
  382.     EXPresolve(e->e.op2,s,t);
  383.     if (is_resolve_failed(e->e.op2)) failed = 1;
  384.  
  385.     /* If op1 wasn't successfully resolved, retry it now with new information */
  386.  
  387.     if ((failed == 0) && !is_resolved(e->e.op1)) {
  388.         EXPresolve(e->e.op1,s,e->e.op2->return_type);
  389.         if (is_resolve_failed(e->e.op1)) failed = 1;
  390.     }
  391.  
  392.     if (failed) resolve_failed(e);
  393.     else resolved_all(e);
  394.     return(Type_Logical);
  395. }    
  396.  
  397. void
  398. EXPresolve_op_default(Expression e, Scope s)
  399. {
  400.     int failed = 0;
  401.  
  402.     switch (OPget_number_of_operands(e->e.op_code)) {
  403.     case 3: EXPresolve(e->e.op3,s,Type_Dont_Care);
  404.         failed = is_resolve_failed(e->e.op3);
  405.     case 2: EXPresolve(e->e.op2,s,Type_Dont_Care);
  406.         failed |= is_resolve_failed(e->e.op2);
  407.     }
  408.     EXPresolve(e->e.op1, s,Type_Dont_Care);
  409.     if (failed || is_resolve_failed(e->e.op1)) resolve_failed(e);
  410.     else resolved_all(e);
  411. }
  412.  
  413. /*ARGSUSED*/
  414. Type
  415. EXPresolve_op_unknown(Expression e, Scope s)
  416. {
  417.     ERRORreport(ERROR_internal_unrecognized_op_in_EXPresolve);
  418.     return Type_Bad;
  419. }
  420.  
  421. typedef Type Resolve_expr_func PROTO((Expression ,Scope));
  422.  
  423. Type
  424. EXPresolve_op_logical(Expression e,Scope s)
  425. {
  426.     EXPresolve_op_default(e,s);
  427.     return(Type_Logical);
  428. }
  429.  
  430. Type
  431. EXPresolve_op_array_like(Expression e, Scope s)
  432. {
  433.     Type op1type;
  434.  
  435.     EXPresolve_op_default(e,s);
  436.     op1type = e->e.op1->return_type;
  437.  
  438.     if (TYPEis_aggregate(op1type)) {
  439.         return(op1type->u.type->body->base);
  440.     } else if (TYPEis_string(op1type)) {
  441.         return(op1type);
  442.     } else if (op1type == Type_Runtime) {
  443.         return(Type_Runtime);
  444.     } else {
  445.         ERRORreport_with_symbol(ERROR_indexing_illegal,&e->symbol);
  446.         return(Type_Unknown);
  447.     }
  448. }
  449.  
  450. Type
  451. EXPresolve_op_entity_constructor(Expression e, Scope s)
  452. {
  453.     EXPresolve_op_default(e,s);
  454.     /* perhaps should return Type_Runtime? */
  455.     return Type_Entity;
  456. }
  457.  
  458. Type
  459. EXPresolve_op_int_div_like(Expression e, Scope s)
  460. {
  461.     EXPresolve_op_default(e,s);
  462.     return Type_Integer;
  463. }
  464.  
  465. Type
  466. EXPresolve_op_plus_like(Expression e, Scope s)
  467. {
  468.     /* i.e., Integer or Real */
  469.     EXPresolve_op_default(e,s);
  470.     if (is_resolve_failed(e)) {
  471.         resolve_failed(e);
  472.         return(Type_Unknown);
  473.     }
  474.  
  475.     /* could produce better results with a lot of pain but the EXPRESS */
  476.     /* spec is a little confused so what's the point.  For example */
  477.     /* it says bag+set=bag */
  478.     /*     and set+bag=set */
  479.     /*     and set+list=set */
  480.     /*     and list+set=? */
  481.  
  482.     /* crude but sufficient */
  483.     if ((TYPEis_aggregate(e->e.op1->return_type)) ||
  484.         (TYPEis_aggregate(e->e.op2->return_type))) {
  485.         return Type_Aggregate;
  486.     }
  487.  
  488.     /* crude but sufficient */
  489.     if ((e->e.op1->return_type->u.type->body->type == real_) ||
  490.         (e->e.op2->return_type->u.type->body->type == real_))
  491.             return(Type_Real);
  492.     return Type_Integer;
  493. }
  494.  
  495. Type
  496. EXPresolve_op_unary_minus(Expression e, Scope s)
  497. {
  498.     EXPresolve_op_default(e,s);
  499.     return e->e.op1->return_type;
  500. }
  501.  
  502. /*
  503. resolve_func:    resolves an expression of this type
  504. type_func:    returns final type of expression of this type
  505.         avoids resolution if possible
  506. */
  507. void
  508. EXPop_create(int token_number,char *string,Resolve_expr_func *resolve_func) {
  509.     EXPop_table[token_number].token = string;
  510.     EXPop_table[token_number].resolve = resolve_func;
  511. }
  512.  
  513. void EXPop_init() {
  514.     EXPop_create(OP_AND,"AND",        EXPresolve_op_logical);
  515.     EXPop_create(OP_ANDOR,"ANDOR",        EXPresolve_op_logical);
  516.     EXPop_create(OP_ARRAY_ELEMENT,"[array element]",EXPresolve_op_array_like);
  517.     EXPop_create(OP_CONCAT,"||",        EXPresolve_op_entity_constructor);
  518.     EXPop_create(OP_DIV,"/ (INTEGER)",    EXPresolve_op_int_div_like);
  519.     EXPop_create(OP_DOT,".",        EXPresolve_op_dot);
  520.     EXPop_create(OP_EQUAL,"=",        EXPresolve_op_relational);
  521.     EXPop_create(OP_EXP,"**",        EXPresolve_op_plus_like);
  522.     EXPop_create(OP_GREATER_EQUAL,">=",    EXPresolve_op_relational);
  523.     EXPop_create(OP_GREATER_THAN,">",    EXPresolve_op_relational);
  524.     EXPop_create(OP_GROUP,"\\",        EXPresolve_op_group);
  525.     EXPop_create(OP_IN,"IN",        EXPresolve_op_relational);
  526.     EXPop_create(OP_INST_EQUAL,":=:",    EXPresolve_op_relational);
  527.     EXPop_create(OP_INST_NOT_EQUAL,":<>:",    EXPresolve_op_relational);
  528.     EXPop_create(OP_LESS_EQUAL,"<=",    EXPresolve_op_relational);
  529.     EXPop_create(OP_LESS_THAN,"<",        EXPresolve_op_relational);
  530.     EXPop_create(OP_LIKE,"LIKE",        EXPresolve_op_relational);
  531.     EXPop_create(OP_MINUS,"- (MINUS)",    EXPresolve_op_plus_like);
  532.     EXPop_create(OP_MOD,"MOD",        EXPresolve_op_int_div_like);
  533.     EXPop_create(OP_NEGATE,"- (NEGATE)",    EXPresolve_op_unary_minus);
  534.     EXPop_create(OP_NOT,"NOT",        EXPresolve_op_logical);
  535.     EXPop_create(OP_NOT_EQUAL,"<>",        EXPresolve_op_relational);
  536.     EXPop_create(OP_OR,"OR",        EXPresolve_op_logical);
  537.     EXPop_create(OP_PLUS,"+",        EXPresolve_op_plus_like);
  538.     EXPop_create(OP_REAL_DIV,"/ (REAL)",    EXPresolve_op_plus_like);
  539.     EXPop_create(OP_SUBCOMPONENT,"[:]",    EXPresolve_op_array_like);
  540.     EXPop_create(OP_TIMES,"*",        EXPresolve_op_plus_like);
  541.     EXPop_create(OP_XOR,"XOR",        EXPresolve_op_logical);
  542.     EXPop_create(OP_UNKNOWN,"UNKNOWN OP",    EXPresolve_op_unknown);
  543. }
  544.  
  545. #if 0
  546.  
  547. /*
  548. ** Procedure:    EXPput_type
  549. ** Parameters:    Expression expression    - expression to modify
  550. **        Type       type        - the new type for the expression
  551. ** Returns:    void
  552. ** Description:    Set the type of an expression.
  553. **
  554. ** Notes:    This call should actually be unnecessary: the type of
  555. **    an expression should be uniquely determined by its definition.
  556. **    While this is currently true in the case of literals, there are
  557. **    no rules in place for deriving the type from, for example, the
  558. **    return type of a function or an operator together with its
  559. **    operands.
  560. */
  561.  
  562. void
  563. EXPput_type(Expression expression, Type type)
  564. {
  565.     Type    data;
  566.     Error    errc;
  567.  
  568.     data = (Type)OBJget_data(expression, Class_Expression, &errc);
  569.     OBJfree(*data, &errc);
  570.     *data = OBJreference(type);
  571. }
  572.  
  573. /*
  574. ** Procedure:    EXPget_type
  575. ** Parameters:    Expression expression    - expression to examine
  576. ** Returns:    Type            - the type of the expression
  577. ** Description:    Retrieve the type of an expression.
  578. */
  579.  
  580. Type
  581. EXPget_type(Expression expression)
  582. {
  583.     Type    data;
  584.     Error    errc;
  585.  
  586.     data = (Type)OBJget_data(expression, Class_Expression, &errc);
  587.     return OBJreference(*data);
  588. }
  589.  
  590.  
  591. /*
  592. ** Procedure:    EXPresolve_qualification
  593. ** Parameters:    Expression expression    - qualified identifier to resolve
  594. **        Scope      scope    - scope in which to resolve
  595. **        Error*     errc        - buffer for error code
  596. ** Returns:    Symbol            - the symbol referenced by the expression
  597. ** Description:    Retrieves the symbol definition referenced by a (possibly
  598. **    qualified) identifier.
  599. */
  600.  
  601. Symbol
  602. EXPresolve_qualification(Expression expression, Scope scope, Error* errc)
  603. {
  604.     String    name;
  605.  
  606.     if (expression == EXPRESSION_NULL)
  607.     return SYMBOL_NULL;
  608.     if (OBJis_kind_of(expression, Class_Identifier)) {
  609.     name = SYMBOLget_name(IDENTget_identifier(expression));
  610.     return SCOPElookup(scope, name, true, errc);
  611.     } else if (OBJis_kind_of(expression, Class_Binary_Expression) &&
  612.            (BIN_EXPget_operator(expression) == OP_DOT)) {
  613.     scope =
  614.         (Scope)EXPresolve_qualification(BIN_EXPget_first_operand(expression),
  615.                         scope, errc);
  616.     if (*errc != ERROR_none)
  617.         return SYMBOL_NULL;
  618.     return EXPresolve_qualification(BIN_EXPget_second_operand(expression),
  619.                     scope, errc);
  620.     } else {
  621.     *errc = ERROR_bad_qualification;
  622.     return SYMBOL_NULL;
  623.     }
  624. }
  625.  
  626. #endif
  627.  
  628. /*
  629. ** Procedure:    TERN_EXPcreate
  630. ** Parameters:    Op_Code       op        - operation
  631. **        Expression operand1    - first operand
  632. **        Expression operand2    - second operand
  633. **        Expression operand3    - third operand
  634. **        Error*     errc        - buffer for error code
  635. ** Returns:    Ternary_Expression    - the expression created
  636. ** Description:    Create a ternary operation Expression.
  637. */
  638.  
  639. Expression 
  640. TERN_EXPcreate(Op_Code op, Expression operand1, Expression operand2, Expression operand3)
  641. {
  642.     Expression e = EXPcreate(Type_Expression);
  643.  
  644.     e->e.op_code = op;
  645.     e->e.op1 = operand1;
  646.     e->e.op2 = operand2;
  647.     e->e.op3 = operand3;
  648.     return e;
  649. }
  650. #if 0
  651.  
  652. /*
  653. ** Procedure:    TERN_EXPget_second/third_operand
  654. ** Parameters:    Ternary_Expression expression    - expression to examine
  655. ** Returns:    Expression            - the second/third operand
  656. ** Description:    Retrieve the second/third operand from a binary expression.
  657. */
  658.  
  659. Expression
  660. TERN_EXPget_second_operand(Ternary_Expression expression)
  661. {
  662.     struct Ternary_Expression*    data;
  663.     Error    errc;
  664.  
  665.     data = (struct Ternary_Expression )OBJget_data(expression, Class_Binary_Expression, &errc);
  666.     return OBJreference(data->op2);
  667. }
  668.  
  669. Expression
  670. TERN_EXPget_third_operand(Ternary_Expression expression)
  671. {
  672.     struct Ternary_Expression*    data;
  673.     Error    errc;
  674.  
  675.     data = (struct Ternary_Expression )OBJget_data(expression, Class_Binary_Expression, &errc);
  676.     return OBJreference(data->op3);
  677. }
  678.  
  679. #endif /*0*/
  680.  
  681. /*
  682. ** Procedure:    BIN_EXPcreate
  683. ** Parameters:    Op_Code       op        - operation
  684. **        Expression operand1    - first operand
  685. **        Expression operand2    - second operand
  686. **        Error*     errc        - buffer for error code
  687. ** Returns:    Binary_Expression    - the expression created
  688. ** Description:    Create a binary operation Expression.
  689. */
  690.  
  691. Expression 
  692. BIN_EXPcreate(Op_Code op, Expression operand1, Expression operand2)
  693. {
  694.     Expression e = EXPcreate(Type_Expression);
  695.  
  696.     e->e.op_code = op;
  697.     e->e.op1 = operand1;
  698.     e->e.op2 = operand2;
  699.     return e;
  700. }
  701.  
  702. #if 0
  703.  
  704. /*
  705. ** Procedure:    BIN_EXPget_second_operand
  706. ** Parameters:    Binary_Expression expression    - expression to examine
  707. ** Returns:    Expression            - the second operand
  708. ** Description:    Retrieve the second operand from a binary expression.
  709. */
  710.  
  711. Expression
  712. BIN_EXPget_second_operand(Binary_Expression expression)
  713. {
  714.     Expression*    data;
  715.     Error    errc;
  716.  
  717.     data = (Expression*)OBJget_data(expression, Class_Binary_Expression, &errc);
  718.     return OBJreference(*data);
  719. }
  720.  
  721. #endif /*0*/
  722. /*
  723. ** Procedure:    UN_EXPcreate
  724. ** Parameters:    Op_Code       op        - operation
  725. **        Expression operand    - operand
  726. **        Error*     errc        - buffer for error code
  727. ** Returns:    Unary_Expression    - the expression created
  728. ** Description:    Create a unary operation Expression.
  729. */
  730.  
  731. Expression 
  732. UN_EXPcreate(Op_Code op, Expression operand)
  733. {
  734.     Expression e = EXPcreate(Type_Expression);
  735.  
  736.     e->e.op_code = op;
  737.     e->e.op1 = operand;
  738.     return e;
  739. }
  740.  
  741. #if 0
  742.  
  743. /*
  744. ** Procedure:    ONEOFcreate
  745. ** Parameters:    Linked_List selections    - list of selections for oneof()
  746. **        Error*      errc    - buffer for error code
  747. ** Returns:    One_Of_Expression    - the oneof expression created
  748. ** Description:    Create a oneof() Expression.
  749. */
  750.  
  751. One_Of_Expression
  752. ONEOFcreate(Linked_List selections, Error* errc)
  753. {
  754.     One_Of_Expression    result;
  755.     Linked_List    data;
  756.  
  757.     *errc = ERROR_none;
  758.     result = OBJcreate(Class_One_Of_Expression, errc);
  759.     data = (Linked_List)OBJget_data(result, Class_One_Of_Expression, errc);
  760.     *data = OBJreference(selections);
  761.     return result;
  762. }
  763.  
  764. /*
  765. ** Procedure:    ONEOFput_selections
  766. ** Parameters:    One_Of_Expression expression    - expression to modify
  767. **        Linked_List       selections    - list of selection Expressions
  768. ** Returns:    void
  769. ** Description:    Set the selections for a oneof() expression.
  770. */
  771.  
  772. void
  773. ONEOFput_selections(One_Of_Expression expression, Linked_List selections)
  774. {
  775.     Linked_List    data;
  776.     Error        errc;
  777.  
  778.     data = (Linked_List)OBJget_data(expression, Class_One_Of_Expression, &errc);
  779.     OBJfree(*data, &errc);
  780.     *data = OBJreference(selections);
  781. }
  782.  
  783. /*
  784. ** Procedure:    ONEOFget_selections
  785. ** Parameters:    One_Of_Expression expression    - expression to modify
  786. ** Returns:    Linked_List            - list of selection Expressions
  787. ** Description:    Retrieve the selections from a oneof() expression.
  788. */
  789.  
  790. Linked_List
  791. ONEOFget_selections(One_Of_Expression expression)
  792. {
  793.     Linked_List    data;
  794.     Error        errc;
  795.  
  796.     data = (Linked_List)OBJget_data(expression, Class_One_Of_Expression, &errc);
  797.     return *data;
  798. }
  799.  
  800. /*
  801. ** Procedure:    FCALLcreate
  802. ** Parameters:    Function    function    - function called by expression
  803. **        Linked_List parameters    - parameters to function call
  804. **        Error*      errc    - buffer for error code
  805. ** Returns:    Function_Call        - the function call created
  806. ** Description:    Create a function call Expression.
  807. */
  808.  
  809. Function_Call
  810. FCALLcreate(Function function, Linked_List parameters, Error* errc)
  811. {
  812.     Function_Call    result;
  813.     Algorithm*        data;
  814.  
  815.     *errc = ERROR_none;
  816.     result = OBJcreate(Class_Function_Call, errc);
  817.     data = (Algorithm*)OBJget_data(result, Class_Function_Call, errc);
  818.     *data = OBJreference(function);
  819.     ONEOFput_selections(result, parameters);
  820.     return result;
  821. }
  822.  
  823. /*
  824. ** Procedure:    FCALLput_algorithm
  825. ** Parameters:    Function_Call expression - expression to modify
  826. **        Function      function     - function called by expression
  827. ** Returns:    void
  828. ** Description:    Set the algorithm for a function call expression.
  829. */
  830.  
  831. void
  832. FCALLput_algorithm(Function_Call expression, Function function)
  833. {
  834.     Algorithm*    data;
  835.     Error    errc;
  836.  
  837.     data = (Algorithm*)OBJget_data(expression, Class_Function_Call, &errc);
  838.     if (*data == ALGORITHM_NULL)
  839.     *data = OBJreference(function);
  840.     else
  841.     OBJbecome(*data, function, &errc);
  842. }
  843.  
  844. /*
  845. ** Procedure:    FCALLput_parameters
  846. ** Parameters:    Function_Call expression - expression to modify
  847. **        Linked_List   parameters - list of actual parameter Expressions.
  848. ** Returns:    void
  849. ** Description:    Set the actual parameters to a function call expression.
  850. **
  851. ** Notes:    The actual parameter list is not verified against the
  852. **        formal parameters list of the called algorithm.
  853. */
  854.  
  855. /* this function is implemented as a macro in expression.h */
  856.  
  857. /*
  858. ** Procedure:    FCALLget_algorithm
  859. ** Parameters:    Function_Call expression    - function call to examine
  860. ** Returns:    Function            - the algorithm called in the
  861. **                          expression
  862. ** Description:    Retrieve the algorithm called by a function call expression.
  863. */
  864.  
  865. Function
  866. FCALLget_algorithm(Function_Call expression)
  867. {
  868.     Algorithm*    data;
  869.     Error    errc;
  870.  
  871.     data = (Algorithm*)OBJget_data(expression, Class_Function_Call, &errc);
  872.     return OBJreference(*data);
  873. }
  874.  
  875. /*
  876. ** Procedure:    FCALLget_parameters
  877. ** Parameters:    Function_Call  expression    - expression to examine
  878. ** Returns:    Linked_List of Expression    - list of actual parameters
  879. ** Description:    Retrieve the actual parameters from a function call expression.
  880. */
  881.  
  882. /* this function is defined as a macro in expression.h */
  883.  
  884. /*
  885. ** Procedure:    IDENTcreate
  886. ** Parameters:    Symbol ident    - identifier referenced by expression
  887. **        Error* errc    - buffer for error code
  888. ** Returns:    Identifier    - the identifier expression created
  889. ** Description:    Create a simple identifier Expression.
  890. */
  891.  
  892. Identifier
  893. IDENTcreate(Symbol ident, Error* errc)
  894. {
  895.     Identifier    result;
  896.     Variable    data;
  897.  
  898.     *errc = ERROR_none;
  899.     result = OBJcreate(Class_Identifier, errc);
  900.     data = (Variable)OBJget_data(result, Class_Identifier, errc);
  901.     *data = OBJreference(ident);
  902.     return result;
  903. }
  904.  
  905. /*
  906. ** Procedure:    IDENTput_identifier
  907. ** Parameters:    Identifier expression    - expression to modify
  908. **        Symbol     identifier    - the name of the identifier
  909. ** Returns:    void
  910. ** Description:    Set the name of an identifier expression.
  911. */
  912.  
  913. void
  914. IDENTput_identifier(Identifier expression, Symbol identifier)
  915. {
  916.     Variable    data;
  917.     Error    errc;
  918.  
  919.     data = (Variable)OBJget_data(expression, Class_Identifier, &errc);
  920.     OBJfree(*data, &errc);
  921.     *data = OBJreference(identifier);
  922. }
  923.  
  924. /*
  925. ** Procedure:    IDENTget_identifier
  926. ** Parameters:    Identifier expression    - expression to examine
  927. ** Returns:    Symbol            - the identifier represented by
  928. **                      the expression
  929. ** Description:    Retrieve the identifier of an identifier expression.
  930. */
  931.  
  932. Symbol
  933. IDENTget_identifier(Identifier expression)
  934. {
  935.     Variable    data;
  936.     Error    errc;
  937.  
  938.     data = (Variable)OBJget_data(expression, Class_Identifier, &errc);
  939.     return OBJreference(*data);
  940. }
  941.  
  942. /*
  943. ** Procedure:    AGGR_LITcreate
  944. ** Parameters:    Type        type    - type of aggregate literal
  945. **        Linked_List value    - value of aggregate literal
  946. **        Error*      errc    - buffer for error code
  947. ** Returns:    Aggregate_Literal    - the literal created
  948. ** Description:    Create an aggregate literal Expression.
  949. */
  950.  
  951. Aggregate_Literal
  952. AGGR_LITcreate(Type type, Linked_List value, Error* errc)
  953. {
  954.     Aggregate_Literal    result;
  955.     Linked_List    data;
  956.  
  957.     *errc = ERROR_none;
  958.     result = OBJcreate(Class_Aggregate_Literal, errc);
  959.     EXPput_type(result, OBJreference(type));
  960.     data = (Linked_List)OBJget_data(result, Class_Aggregate_Literal, errc);
  961.     *data = OBJreference(value);
  962.     return result;
  963. }
  964.  
  965. /*
  966. ** Procedure:    INT_LITcreate
  967. ** Parameters:    Integer value    - value of integer literal
  968. **        Error*  errc    - buffer for error code
  969. ** Returns:    Integer_Literal    - the literal created
  970. ** Description:    Create an integer literal Expression.
  971. */
  972.  
  973. Integer_Literal
  974. INT_LITcreate(Integer value, Error* errc)
  975. {
  976.     Integer_Literal    result;
  977.     Integer*        data;
  978.  
  979.     *errc = ERROR_none;
  980.     result = OBJcreate(Class_Integer_Literal, errc);
  981.     EXPput_type(result, OBJreference(TYPE_INTEGER));
  982.     data = (Integer*)OBJget_data(result, Class_Integer_Literal, errc);
  983.     *data = value;
  984.     return result;
  985. }
  986.  
  987. /*
  988. ** Procedure:    LOG_LITcreate
  989. ** Parameters:    Logical value    - value of logical literal
  990. **        Error*  errc    - buffer for error code
  991. ** Returns:    Logical_Literal    - the literal created
  992. ** Description:    Create a logical literal Expression.
  993. */
  994.  
  995. Logical_Literal
  996. LOG_LITcreate(Logical value, Error* errc)
  997. {
  998.     Logical_Literal    result;
  999.     Logical*        data;
  1000.  
  1001.     *errc = ERROR_none;
  1002.     result = OBJcreate(Class_Logical_Literal, errc);
  1003.     EXPput_type(result, OBJreference(TYPE_LOGICAL));
  1004.     data = (Logical*)OBJget_data(result, Class_Logical_Literal, errc);
  1005.     *data = value;
  1006.     return result;
  1007. }
  1008.  
  1009. /*
  1010. ** Procedure:    REAL_LITcreate
  1011. ** Parameters:    Real    value    - value of real literal
  1012. **        Error*  errc    - buffer for error code
  1013. ** Returns:    Real_Literal    - the literal created
  1014. ** Description:    Create a real literal Expression.
  1015. */
  1016.  
  1017. Real_Literal
  1018. REAL_LITcreate(Real value, Error* errc)
  1019. {
  1020.     Real_Literal    result;
  1021.     Real*        data;
  1022.  
  1023.     *errc = ERROR_none;
  1024.     result = OBJcreate(Class_Real_Literal, errc);
  1025.     EXPput_type(result, OBJreference(TYPE_REAL));
  1026.     data = (Real*)OBJget_data(result, Class_Real_Literal, errc);
  1027.     *data = value;
  1028.     return result;
  1029. }
  1030.  
  1031. /*
  1032. ** Procedure:    STR_LITcreate
  1033. ** Parameters:    String value    - value of string literal
  1034. **        Error* errc    - buffer for error code
  1035. ** Returns:    String_Literal    - the literal created
  1036. ** Description:    Create a string literal Expression.
  1037. */
  1038.  
  1039. String_Literal
  1040. STR_LITcreate(String value, Error* errc)
  1041. {
  1042.     String_Literal    result;
  1043.     String*        data;
  1044.  
  1045.     *errc = ERROR_none;
  1046.     result = OBJcreate(Class_String_Literal, errc);
  1047.     EXPput_type(result, OBJreference(TYPE_STRING));
  1048.     data = (String*)OBJget_data(result, Class_String_Literal, errc);
  1049.     *data = STRINGcopy(value);
  1050.     return result;
  1051. }
  1052. /*
  1053. ** Procedure:    BIN_LITcreate
  1054. ** Parameters:    Binary value    - value of binary literal
  1055. **        Error* errc    - buffer for error code
  1056. ** Returns:    Binary_Literal    - the literal created
  1057. ** Description:    Create a string literal Expression.
  1058. */
  1059.  
  1060. Binary_Literal
  1061. BIN_LITcreate(Binary value, Error* errc)
  1062. {
  1063.     Binary_Literal    result;
  1064.     Binary*        data;
  1065.  
  1066.     *errc = ERROR_none;
  1067.     result = OBJcreate(Class_Binary_Literal, errc);
  1068.     EXPput_type(result, OBJreference(TYPE_BINARY));
  1069.     data = (Binary*)OBJget_data(result, Class_Binary_Literal, errc);
  1070.     *data = STRINGcopy(value);
  1071.     return result;
  1072. }
  1073.  
  1074. /*
  1075. ** Procedure:    AGGR_LITget_value
  1076. ** Parameters:    Aggregate_Literal literal    - literal to examine
  1077. **        Error*            errc        - buffer for error code
  1078. ** Returns:    Linked_List            - the literal's value
  1079. ** Description:    Retrieve the value of an aggregate literal.
  1080. */
  1081.  
  1082. Linked_List
  1083. AGGR_LITget_value(Aggregate_Literal literal, Error* errc)
  1084. {
  1085.     Linked_List    data;
  1086.  
  1087.     data = (Linked_List)OBJget_data(literal, Class_Aggregate_Literal, errc);
  1088.     return OBJcopy(*data, errc);
  1089. }
  1090.  
  1091. /*
  1092. ** Procedure:    INT_LITget_value
  1093. ** Parameters:    Integer_Literal literal    - literal to examine
  1094. **        Error*          errc    - buffer for error code
  1095. ** Returns:    Integer            - the literal's value
  1096. ** Description:    Retrieve the value of an integer literal.
  1097. */
  1098.  
  1099. Integer
  1100. INT_LITget_value(Integer_Literal literal, Error* errc)
  1101. {
  1102.     Integer*    data;
  1103.  
  1104.     data = (Integer*)OBJget_data(literal, Class_Integer_Literal, errc);
  1105.     return *data;
  1106. }
  1107.  
  1108. /*
  1109. ** Procedure:    LOG_LITget_value
  1110. ** Parameters:    Logical_Literal literal    - literal to examine
  1111. **        Error*          errc    - buffer for error code
  1112. ** Returns:    Logical            - the literal's value
  1113. ** Description:    Retrieve the value of a logical literal.
  1114. */
  1115.  
  1116. Logical
  1117. LOG_LITget_value(Logical_Literal literal, Error* errc)
  1118. {
  1119.     Logical*    data;
  1120.  
  1121.     data = (Logical*)OBJget_data(literal, Class_Logical_Literal, errc);
  1122.     return *data;
  1123. }
  1124.  
  1125. /*
  1126. ** Procedure:    REAL_LITget_value
  1127. ** Parameters:    Real_Literal literal    - literal to examine
  1128. **        Error*       errc    - buffer for error code
  1129. ** Returns:    Real            - the literal's value
  1130. ** Description:    Retrieve the value of a real literal.
  1131. */
  1132.  
  1133. Real
  1134. REAL_LITget_value(Real_Literal literal, Error* errc)
  1135. {
  1136.     Real*    data;
  1137.  
  1138.     data = (Real*)OBJget_data(literal, Class_Real_Literal, errc);
  1139.     return *data;
  1140. }
  1141.  
  1142. /*
  1143. ** Procedure:    STR_LITget_value
  1144. ** Parameters:    String_Literal literal    - literal to examine
  1145. **        Error*       errc    - buffer for error code
  1146. ** Returns:    String            - the literal's value
  1147. ** Description:    Retrieve the value of a string literal.
  1148. */
  1149.  
  1150. String
  1151. STR_LITget_value(String_Literal literal, Error* errc)
  1152. {
  1153.     String*    data;
  1154.  
  1155.     data = (String*)OBJget_data(literal, Class_String_Literal, errc);
  1156.     return STRINGcopy(*data);
  1157. }
  1158.  
  1159. /*
  1160. ** Procedure:    BIN_LITget_value
  1161. ** Parameters:    Binary_Literal literal    - literal to examine
  1162. **        Error*       errc    - buffer for error code
  1163. ** Returns:    Binary            - the literal's value
  1164. ** Description:    Retrieve the value of a binary literal.
  1165. */
  1166.  
  1167. Binary
  1168. BIN_LITget_value(Binary_Literal literal, Error* errc)
  1169. {
  1170.     String*    data;
  1171.  
  1172.     data = (String*)OBJget_data(literal, Class_Binary_Literal, errc);
  1173.     return STRINGcopy(*data);
  1174. }
  1175.  
  1176. #endif
  1177.  
  1178. /*
  1179. ** Procedure:    QUERYcreate
  1180. ** Parameters:    String     ident    - local identifier for source elements
  1181. **        Expression source    - source aggregate to query
  1182. **        Expression discriminant    - discriminating expression for query
  1183. **        Error*     errc        - buffer for error code
  1184. ** Returns:    Query            - the query expression created
  1185. ** Description:    Create a query Expression.
  1186. */
  1187.  
  1188. Expression 
  1189. QUERYcreate(Symbol *local, Expression aggregate)
  1190. {
  1191.     Expression e = EXPcreate_from_symbol(Type_Query,local);
  1192.     Scope s = SCOPEcreate_tiny(OBJ_QUERY);
  1193.     Expression e2 = EXPcreate_from_symbol(Type_Attribute,local);
  1194.  
  1195.     Variable v = VARcreate(e2,Type_Attribute);
  1196.  
  1197.     DICTdefine(s->symbol_table,local->name,(Generic)v,&e2->symbol,OBJ_VARIABLE);
  1198.     e->u.query = QUERY_new();
  1199.     e->u.query->scope = s;
  1200.     e->u.query->local = v;
  1201.     e->u.query->aggregate = aggregate;
  1202.     return e;
  1203. }
  1204.  
  1205. #if 0
  1206.  
  1207. /*
  1208. ** Procedure:    QUERYget_variable
  1209. ** Parameters:    Query expression    - query expression to examine
  1210. ** Returns:    Variable        - the local variable for the query
  1211. ** Description:    Retrieve the variable used locally within the query to
  1212. **    iterate over the contents of the source aggregate.
  1213. */
  1214.  
  1215. Variable
  1216. QUERYget_variable(Query expression)
  1217. {
  1218.     struct Query*    data;
  1219.     Error        errc;
  1220.  
  1221.     data = (struct Query*)OBJget_data(expression, Class_Query, &errc);
  1222.     return OBJreference(data->identifier);
  1223. }
  1224.  
  1225. /*
  1226. ** Procedure:    QUERYget_source
  1227. ** Parameters:    Query expression    - query expression to examine
  1228. ** Returns:    Expression        - the source set for the query
  1229. ** Description:    Retrieve the aggregate examined by a query expression.
  1230. */
  1231.  
  1232. Expression
  1233. QUERYget_source(Query expression)
  1234. {
  1235.     struct Query*    data;
  1236.     Error        errc;
  1237.  
  1238.     data = (struct Query*)OBJget_data(expression, Class_Query, &errc);
  1239.     return OBJreference(data->fromSet);
  1240. }
  1241.  
  1242. /*
  1243. ** Procedure:    QUERYget_discriminant
  1244. ** Parameters:    Query expression    - query expression to examine
  1245. ** Returns:    Expression        - the discriminant for the query
  1246. ** Description:    Retrieve a query's discriminant expression.
  1247. */
  1248.  
  1249. Expression
  1250. QUERYget_discriminant(Query expression)
  1251. {
  1252.     struct Query*    data;
  1253.     Error        errc;
  1254.  
  1255.     data = (struct Query*)OBJget_data(expression, Class_Query, &errc);
  1256.     return OBJreference(data->discriminant);
  1257. }
  1258.  
  1259. /*
  1260. ** Procedure:    OPget_number_of_operands
  1261. ** Parameters:    Op_Code    operation    - the opcode to query
  1262. ** Returns:    int            - number of operands required
  1263. ** Description:    Determine the number of operands required by an operator.
  1264. */
  1265.  
  1266. /* this function is inlined in expression.h */
  1267.  
  1268. #endif
  1269.  
  1270. /*
  1271. ** Procedure:    EXPget_integer_value
  1272. ** Parameters:    Expression  expression    - expression to evaluate
  1273. **        Error*      errc    - buffer for error code
  1274. ** Returns:    int            - value of expression
  1275. ** Description:    Compute the value of an integer expression.
  1276. */
  1277.  
  1278. int
  1279. EXPget_integer_value(Expression expression)
  1280. {
  1281.     errc = ERROR_none;
  1282.     if (expression == EXPRESSION_NULL)
  1283.     return 0;
  1284.     if (expression->return_type->u.type->body->type == integer_) {
  1285.     return INT_LITget_value(expression);
  1286.     } else {
  1287.     errc = ERROR_integer_expression_expected;
  1288.     return 0;
  1289.     }
  1290. }
  1291.  
  1292. char *
  1293. opcode_print(Op_Code o)
  1294. {
  1295.     switch (o) {
  1296.     case OP_AND: return("OP_AND");
  1297.     case OP_ANDOR: return("OP_ANDOR");
  1298.     case OP_ARRAY_ELEMENT: return("OP_ARRAY_ELEMENT");
  1299.     case OP_CONCAT: return("OP_CONCAT");
  1300.     case OP_DIV: return("OP_DIV");
  1301.     case OP_DOT: return("OP_DOT");
  1302.     case OP_EQUAL: return("OP_EQUAL");
  1303.     case OP_EXP: return("OP_EXP");
  1304.     case OP_GREATER_EQUAL: return("OP_GREATER_EQUAL");
  1305.     case OP_GREATER_THAN: return("OP_GREATER_THAN");
  1306.     case OP_GROUP: return("OP_GROUP");
  1307.     case OP_IN: return("OP_IN");
  1308.     case OP_INST_EQUAL: return("OP_INST_EQUAL");
  1309.     case OP_INST_NOT_EQUAL: return("OP_INST_NOT_EQUAL");
  1310.     case OP_LESS_EQUAL: return("OP_LESS_EQUAL");
  1311.     case OP_LESS_THAN: return("OP_LESS_THAN");
  1312.     case OP_LIKE: return("OP_LIKE");
  1313.     case OP_MINUS: return("OP_MINUS");
  1314.     case OP_MOD: return("OP_MOD");
  1315.     case OP_NEGATE: return("OP_NEGATE");
  1316.     case OP_NOT: return("OP_NOT");
  1317.     case OP_NOT_EQUAL: return("OP_NOT_EQUAL");
  1318.     case OP_OR: return("OP_OR");
  1319.     case OP_PLUS: return("OP_PLUS");
  1320.     case OP_REAL_DIV: return("OP_REAL_DIV");
  1321.     case OP_SUBCOMPONENT: return("OP_SUBCOMPONENT");
  1322.     case OP_TIMES: return("OP_TIMES");
  1323.     case OP_XOR: return("OP_XOR");
  1324.     case OP_UNKNOWN: return("OP_UNKNOWN");
  1325.     default: return("no such op");
  1326.     }
  1327. }
  1328.