diff --git a/include/express/object.h b/include/express/object.h index cfd2504d..e2e02a17 100644 --- a/include/express/object.h +++ b/include/express/object.h @@ -104,11 +104,7 @@ GLOBAL SCL_EXPRESS_EXPORT struct Object * OBJ; #define OBJtype_is_oneof(_type_,class) (OBJ[(int)_type_].bits & (class)) #define OBJget_name(obj,type) (OBJget_symbol(obj,type)->name) -/* for backwards compatibility */ -#define OBJequal(x,y) ((x) == (y)) -#define OBJfree(x) -#define OBJreference(x) (x) -#define OBJget_data(obj,type,err) (obj) +/* removed #define statements for obsolete fn macros OBJequal OBJfree OBJreference OBJget_data */ /***********************/ /* function prototypes */ diff --git a/src/express/expr.c b/src/express/expr.c index 6c2b82b9..869b4bca 100644 --- a/src/express/expr.c +++ b/src/express/expr.c @@ -816,87 +816,6 @@ void EXPop_init() { EXPop_create( OP_UNKNOWN, "UNKNOWN OP", EXPresolve_op_unknown ); } -#if 0 - -/* -** Procedure: EXPput_type -** Parameters: Expression expression - expression to modify -** Type type - the new type for the expression -** Returns: void -** Description: Set the type of an expression. -** -** Notes: This call should actually be unnecessary: the type of -** an expression should be uniquely determined by its definition. -** While this is currently true in the case of literals, there are -** no rules in place for deriving the type from, for example, the -** return type of a function or an operator together with its -** operands. -*/ - -void -EXPput_type( Expression expression, Type type ) { - Type data; - Error experrc; - - data = ( Type )OBJget_data( expression, Class_Expression, &experrc ); - OBJfree( *data, &experrc ); - *data = OBJreference( type ); -} - -/* -** Procedure: EXPget_type -** Parameters: Expression expression - expression to examine -** Returns: Type - the type of the expression -** Description: Retrieve the type of an expression. -*/ - -Type -EXPget_type( Expression expression ) { - Type data; - Error experrc; - - data = ( Type )OBJget_data( expression, Class_Expression, &experrc ); - return OBJreference( *data ); -} - - -/* -** Procedure: EXPresolve_qualification -** Parameters: Expression expression - qualified identifier to resolve -** Scope scope - scope in which to resolve -** Error* experrc - buffer for error code -** Returns: Symbol - the symbol referenced by the expression -** Description: Retrieves the symbol definition referenced by a (possibly -** qualified) identifier. -*/ - -Symbol -EXPresolve_qualification( Expression expression, Scope scope, Error * experrc ) { - String name; - - if( expression == EXPRESSION_NULL ) { - return SYMBOL_NULL; - } - if( OBJis_kind_of( expression, Class_Identifier ) ) { - name = SYMBOLget_name( IDENTget_identifier( expression ) ); - return SCOPElookup( scope, name, true, experrc ); - } else if( OBJis_kind_of( expression, Class_Binary_Expression ) && - ( BIN_EXPget_operator( expression ) == OP_DOT ) ) { - scope = - ( Scope )EXPresolve_qualification( BIN_EXPget_first_operand( expression ), - scope, experrc ); - if( *experrc != ERROR_none ) { - return SYMBOL_NULL; - } - return EXPresolve_qualification( BIN_EXPget_second_operand( expression ), - scope, experrc ); - } else { - *experrc = ERROR_bad_qualification; - return SYMBOL_NULL; - } -} - -#endif /** \fn TERN_EXPcreate ** \param op operation @@ -915,34 +834,6 @@ Expression TERN_EXPcreate( Op_Code op, Expression operand1, Expression operand2, e->e.op3 = operand3; return e; } -#if 0 - -/* -** Procedure: TERN_EXPget_second/third_operand -** Parameters: Ternary_Expression expression - expression to examine -** Returns: Expression - the second/third operand -** Description: Retrieve the second/third operand from a binary expression. -*/ - -Expression -TERN_EXPget_second_operand( Ternary_Expression expression ) { - struct Ternary_Expression * data; - Error experrc; - - data = ( struct Ternary_Expression )OBJget_data( expression, Class_Binary_Expression, &experrc ); - return OBJreference( data->op2 ); -} - -Expression -TERN_EXPget_third_operand( Ternary_Expression expression ) { - struct Ternary_Expression * data; - Error experrc; - - data = ( struct Ternary_Expression )OBJget_data( expression, Class_Binary_Expression, &experrc ); - return OBJreference( data->op3 ); -} - -#endif /*0*/ /** ** \fn BIN_EXPcreate @@ -961,25 +852,6 @@ Expression BIN_EXPcreate( Op_Code op, Expression operand1, Expression operand2 ) return e; } -#if 0 - -/* -** Procedure: BIN_EXPget_second_operand -** Parameters: Binary_Expression expression - expression to examine -** Returns: Expression - the second operand -** Description: Retrieve the second operand from a binary expression. -*/ - -Expression -BIN_EXPget_second_operand( Binary_Expression expression ) { - Expression * data; - Error experrc; - - data = ( Expression * )OBJget_data( expression, Class_Binary_Expression, &experrc ); - return OBJreference( *data ); -} - -#endif /*0*/ /** \fn UN_EXPcreate ** \param op operation ** \param operand operand @@ -994,423 +866,6 @@ Expression UN_EXPcreate( Op_Code op, Expression operand ) { return e; } -#if 0 - -/* -** Procedure: ONEOFcreate -** Parameters: Linked_List selections - list of selections for oneof() -** Error* experrc - buffer for error code -** Returns: One_Of_Expression - the oneof expression created -** Description: Create a oneof() Expression. -*/ - -One_Of_Expression -ONEOFcreate( Linked_List selections, Error * experrc ) { - One_Of_Expression result; - Linked_List data; - - *experrc = ERROR_none; - result = OBJcreate( Class_One_Of_Expression, experrc ); - data = ( Linked_List )OBJget_data( result, Class_One_Of_Expression, experrc ); - *data = OBJreference( selections ); - return result; -} - -/* -** Procedure: ONEOFput_selections -** Parameters: One_Of_Expression expression - expression to modify -** Linked_List selections - list of selection Expressions -** Returns: void -** Description: Set the selections for a oneof() expression. -*/ - -void -ONEOFput_selections( One_Of_Expression expression, Linked_List selections ) { - Linked_List data; - Error experrc; - - data = ( Linked_List )OBJget_data( expression, Class_One_Of_Expression, &experrc ); - OBJfree( *data, &experrc ); - *data = OBJreference( selections ); -} - -/* -** Procedure: ONEOFget_selections -** Parameters: One_Of_Expression expression - expression to modify -** Returns: Linked_List - list of selection Expressions -** Description: Retrieve the selections from a oneof() expression. -*/ - -Linked_List -ONEOFget_selections( One_Of_Expression expression ) { - Linked_List data; - Error experrc; - - data = ( Linked_List )OBJget_data( expression, Class_One_Of_Expression, &experrc ); - return *data; -} - -/* -** Procedure: FCALLcreate -** Parameters: Function function - function called by expression -** Linked_List parameters - parameters to function call -** Error* experrc - buffer for error code -** Returns: Function_Call - the function call created -** Description: Create a function call Expression. -*/ - -Function_Call -FCALLcreate( Function function, Linked_List parameters, Error * experrc ) { - Function_Call result; - Algorithm * data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Function_Call, experrc ); - data = ( Algorithm * )OBJget_data( result, Class_Function_Call, experrc ); - *data = OBJreference( function ); - ONEOFput_selections( result, parameters ); - return result; -} - -/* -** Procedure: FCALLput_algorithm -** Parameters: Function_Call expression - expression to modify -** Function function - function called by expression -** Returns: void -** Description: Set the algorithm for a function call expression. -*/ - -void -FCALLput_algorithm( Function_Call expression, Function function ) { - Algorithm * data; - Error experrc; - - data = ( Algorithm * )OBJget_data( expression, Class_Function_Call, &experrc ); - if( *data == ALGORITHM_NULL ) { - *data = OBJreference( function ); - } else { - OBJbecome( *data, function, &experrc ); - } -} - -/* -** Procedure: FCALLput_parameters -** Parameters: Function_Call expression - expression to modify -** Linked_List parameters - list of actual parameter Expressions. -** Returns: void -** Description: Set the actual parameters to a function call expression. -** -** Notes: The actual parameter list is not verified against the -** formal parameters list of the called algorithm. -*/ - -/* this function is implemented as a macro in expression.h */ - -/* -** Procedure: FCALLget_algorithm -** Parameters: Function_Call expression - function call to examine -** Returns: Function - the algorithm called in the -** expression -** Description: Retrieve the algorithm called by a function call expression. -*/ - -Function -FCALLget_algorithm( Function_Call expression ) { - Algorithm * data; - Error experrc; - - data = ( Algorithm * )OBJget_data( expression, Class_Function_Call, &experrc ); - return OBJreference( *data ); -} - -/* -** Procedure: FCALLget_parameters -** Parameters: Function_Call expression - expression to examine -** Returns: Linked_List of Expression - list of actual parameters -** Description: Retrieve the actual parameters from a function call expression. -*/ - -/* this function is defined as a macro in expression.h */ - -/* -** Procedure: IDENTcreate -** Parameters: Symbol ident - identifier referenced by expression -** Error* experrc - buffer for error code -** Returns: Identifier - the identifier expression created -** Description: Create a simple identifier Expression. -*/ - -Identifier -IDENTcreate( Symbol ident, Error * experrc ) { - Identifier result; - Variable data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Identifier, experrc ); - data = ( Variable )OBJget_data( result, Class_Identifier, experrc ); - *data = OBJreference( ident ); - return result; -} - -/* -** Procedure: IDENTput_identifier -** Parameters: Identifier expression - expression to modify -** Symbol identifier - the name of the identifier -** Returns: void -** Description: Set the name of an identifier expression. -*/ - -void -IDENTput_identifier( Identifier expression, Symbol identifier ) { - Variable data; - Error experrc; - - data = ( Variable )OBJget_data( expression, Class_Identifier, &experrc ); - OBJfree( *data, &experrc ); - *data = OBJreference( identifier ); -} - -/* -** Procedure: IDENTget_identifier -** Parameters: Identifier expression - expression to examine -** Returns: Symbol - the identifier represented by -** the expression -** Description: Retrieve the identifier of an identifier expression. -*/ - -Symbol -IDENTget_identifier( Identifier expression ) { - Variable data; - Error experrc; - - data = ( Variable )OBJget_data( expression, Class_Identifier, &experrc ); - return OBJreference( *data ); -} - -/* -** Procedure: AGGR_LITcreate -** Parameters: Type type - type of aggregate literal -** Linked_List value - value of aggregate literal -** Error* experrc - buffer for error code -** Returns: Aggregate_Literal - the literal created -** Description: Create an aggregate literal Expression. -*/ - -Aggregate_Literal -AGGR_LITcreate( Type type, Linked_List value, Error * experrc ) { - Aggregate_Literal result; - Linked_List data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Aggregate_Literal, experrc ); - EXPput_type( result, OBJreference( type ) ); - data = ( Linked_List )OBJget_data( result, Class_Aggregate_Literal, experrc ); - *data = OBJreference( value ); - return result; -} - -/* -** Procedure: INT_LITcreate -** Parameters: Integer value - value of integer literal -** Error* experrc - buffer for error code -** Returns: Integer_Literal - the literal created -** Description: Create an integer literal Expression. -*/ - -Integer_Literal -INT_LITcreate( Integer value, Error * experrc ) { - Integer_Literal result; - Integer * data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Integer_Literal, experrc ); - EXPput_type( result, OBJreference( TYPE_INTEGER ) ); - data = ( Integer * )OBJget_data( result, Class_Integer_Literal, experrc ); - *data = value; - return result; -} - -/* -** Procedure: LOG_LITcreate -** Parameters: Logical value - value of logical literal -** Error* experrc - buffer for error code -** Returns: Logical_Literal - the literal created -** Description: Create a logical literal Expression. -*/ - -Logical_Literal -LOG_LITcreate( Logical value, Error * experrc ) { - Logical_Literal result; - Logical * data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Logical_Literal, experrc ); - EXPput_type( result, OBJreference( TYPE_LOGICAL ) ); - data = ( Logical * )OBJget_data( result, Class_Logical_Literal, experrc ); - *data = value; - return result; -} - -/* -** Procedure: REAL_LITcreate -** Parameters: Real value - value of real literal -** Error* experrc - buffer for error code -** Returns: Real_Literal - the literal created -** Description: Create a real literal Expression. -*/ - -Real_Literal -REAL_LITcreate( Real value, Error * experrc ) { - Real_Literal result; - Real * data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Real_Literal, experrc ); - EXPput_type( result, OBJreference( TYPE_REAL ) ); - data = ( Real * )OBJget_data( result, Class_Real_Literal, experrc ); - *data = value; - return result; -} - -/* -** Procedure: STR_LITcreate -** Parameters: String value - value of string literal -** Error* experrc - buffer for error code -** Returns: String_Literal - the literal created -** Description: Create a string literal Expression. -*/ - -String_Literal -STR_LITcreate( String value, Error * experrc ) { - String_Literal result; - String * data; - - *experrc = ERROR_none; - result = OBJcreate( Class_String_Literal, experrc ); - EXPput_type( result, OBJreference( TYPE_STRING ) ); - data = ( String * )OBJget_data( result, Class_String_Literal, experrc ); - *data = STRINGcopy( value ); - return result; -} -/* -** Procedure: BIN_LITcreate -** Parameters: Binary value - value of binary literal -** Error* experrc - buffer for error code -** Returns: Binary_Literal - the literal created -** Description: Create a string literal Expression. -*/ - -Binary_Literal -BIN_LITcreate( Binary value, Error * experrc ) { - Binary_Literal result; - Binary * data; - - *experrc = ERROR_none; - result = OBJcreate( Class_Binary_Literal, experrc ); - EXPput_type( result, OBJreference( TYPE_BINARY ) ); - data = ( Binary * )OBJget_data( result, Class_Binary_Literal, experrc ); - *data = STRINGcopy( value ); - return result; -} - -/* -** Procedure: AGGR_LITget_value -** Parameters: Aggregate_Literal literal - literal to examine -** Error* experrc - buffer for error code -** Returns: Linked_List - the literal's value -** Description: Retrieve the value of an aggregate literal. -*/ - -Linked_List -AGGR_LITget_value( Aggregate_Literal literal, Error * experrc ) { - Linked_List data; - - data = ( Linked_List )OBJget_data( literal, Class_Aggregate_Literal, experrc ); - return OBJcopy( *data, experrc ); -} - -/* -** Procedure: INT_LITget_value -** Parameters: Integer_Literal literal - literal to examine -** Error* experrc - buffer for error code -** Returns: Integer - the literal's value -** Description: Retrieve the value of an integer literal. -*/ - -Integer -INT_LITget_value( Integer_Literal literal, Error * experrc ) { - Integer * data; - - data = ( Integer * )OBJget_data( literal, Class_Integer_Literal, experrc ); - return *data; -} - -/* -** Procedure: LOG_LITget_value -** Parameters: Logical_Literal literal - literal to examine -** Error* experrc - buffer for error code -** Returns: Logical - the literal's value -** Description: Retrieve the value of a logical literal. -*/ - -Logical -LOG_LITget_value( Logical_Literal literal, Error * experrc ) { - Logical * data; - - data = ( Logical * )OBJget_data( literal, Class_Logical_Literal, experrc ); - return *data; -} - -/* -** Procedure: REAL_LITget_value -** Parameters: Real_Literal literal - literal to examine -** Error* experrc - buffer for error code -** Returns: Real - the literal's value -** Description: Retrieve the value of a real literal. -*/ - -Real -REAL_LITget_value( Real_Literal literal, Error * experrc ) { - Real * data; - - data = ( Real * )OBJget_data( literal, Class_Real_Literal, experrc ); - return *data; -} - -/* -** Procedure: STR_LITget_value -** Parameters: String_Literal literal - literal to examine -** Error* experrc - buffer for error code -** Returns: String - the literal's value -** Description: Retrieve the value of a string literal. -*/ - -String -STR_LITget_value( String_Literal literal, Error * experrc ) { - String * data; - - data = ( String * )OBJget_data( literal, Class_String_Literal, experrc ); - return STRINGcopy( *data ); -} - -/* -** Procedure: BIN_LITget_value -** Parameters: Binary_Literal literal - literal to examine -** Error* experrc - buffer for error code -** Returns: Binary - the literal's value -** Description: Retrieve the value of a binary literal. -*/ - -Binary -BIN_LITget_value( Binary_Literal literal, Error * experrc ) { - String * data; - - data = ( String * )OBJget_data( literal, Class_Binary_Literal, experrc ); - return STRINGcopy( *data ); -} - -#endif - /** \fn QUERYcreate ** \param local local identifier for source elements ** \param aggregate source aggregate to query @@ -1433,68 +888,6 @@ Expression QUERYcreate( Symbol * local, Expression aggregate ) { return e; } -#if 0 - -/* -** Procedure: QUERYget_variable -** Parameters: Query expression - query expression to examine -** Returns: Variable - the local variable for the query -** Description: Retrieve the variable used locally within the query to -** iterate over the contents of the source aggregate. -*/ - -Variable -QUERYget_variable( Query expression ) { - struct Query * data; - Error experrc; - - data = ( struct Query * )OBJget_data( expression, Class_Query, &experrc ); - return OBJreference( data->identifier ); -} - -/* -** Procedure: QUERYget_source -** Parameters: Query expression - query expression to examine -** Returns: Expression - the source set for the query -** Description: Retrieve the aggregate examined by a query expression. -*/ - -Expression -QUERYget_source( Query expression ) { - struct Query * data; - Error experrc; - - data = ( struct Query * )OBJget_data( expression, Class_Query, &experrc ); - return OBJreference( data->fromSet ); -} - -/* -** Procedure: QUERYget_discriminant -** Parameters: Query expression - query expression to examine -** Returns: Expression - the discriminant for the query -** Description: Retrieve a query's discriminant expression. -*/ - -Expression -QUERYget_discriminant( Query expression ) { - struct Query * data; - Error experrc; - - data = ( struct Query * )OBJget_data( expression, Class_Query, &experrc ); - return OBJreference( data->discriminant ); -} - -/* -** Procedure: OPget_number_of_operands -** Parameters: Op_Code operation - the opcode to query -** Returns: int - number of operands required -** Description: Determine the number of operands required by an operator. -*/ - -/* this function is inlined in expression.h */ - -#endif - /** \fn EXPget_integer_value ** \param expression expression to evaluate ** \param experrc buffer for error code diff --git a/src/express/scope.c b/src/express/scope.c index 9095ccb1..5403cbd2 100644 --- a/src/express/scope.c +++ b/src/express/scope.c @@ -122,251 +122,6 @@ SCOPEget_entities_superclass_order( Scope scope ) { return result; } -#if 0 - -/* -** Procedure: SCOPEget_types -** Parameters: Scope scope - scope to examine -** Returns: Linked_List of Typedef - local type definitions -** Description: Retrieve a list of the types defined locally in a scope. -*/ - -Linked_List -SCOPEget_types( Scope scope ) { - struct Scope * data; - Linked_List list; - Error experrc; - Symbol s; - DictionaryEntry de; - - list = OBJcreate( Class_Linked_List, &experrc ); - DICTdo_init( scope->symbol_table, &de ); - while( s = DICTdo( &de ) ) { - if( OBJis_kind_of( s, Class_Type ) ) { - LISTadd_last( list, ( Generic )s ); - } - } - return list; -} - -/* -** Procedure: SCOPEget_variables -** Parameters: Scope scope - scope to examine -** Returns: Linked_List of Variable - variables defined locally -** Description: Retrieve a list of the variables defined locally in a scope. -*/ - -Linked_List -SCOPEget_variables( Scope scope ) { - struct Scope * data; - Linked_List list; - Error experrc; - Symbol s; - DictionaryEntry de; - - list = OBJcreate( Class_Linked_List, &experrc ); - data = ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ); - DICTdo_init( data->symbol_table, &de ); - while( s = DICTdo( &de ) ) { - if( OBJis_kind_of( s, Class_Variable ) ) { - LISTadd_last( list, ( Generic )s ); - } - } - return list; -} - -/* -** Procedure: SCOPEget_algorithms -** Parameters: Scope scope - scope to examine -** Returns: Linked_List of Algorithm - algorithms defined locally -** Description: Retrieve a list of the algorithms defined locally in a scope. -*/ - -Linked_List -SCOPEget_algorithms( Scope scope ) { - struct Scope * data; - Linked_List list; - Error experrc; - Symbol s; - DictionaryEntry de; - - list = OBJcreate( Class_Linked_List, &experrc ); - data = ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ); - DICTdo_init( data->symbol_table, &de ); - while( s = DICTdo( &de ) ) { - if( OBJis_kind_of( s, Class_Algorithm ) ) { - LISTadd_last( list, ( Generic )s ); - } - } - return list; -} - -/* -** Procedure: SCOPEget_constants -** Parameters: Scope scope - scope to examine -** Returns: Linked_List of Constant - constants defined locally -** Description: Retrieve a list of the constants defined locally in a scope. -*/ - -Linked_List -SCOPEget_constants( Scope scope ) { - struct Scope * data; - Linked_List list; - Error experrc; - Symbol s; - DictionaryEntry de; - - list = OBJcreate( Class_Linked_List, &experrc ); - data = ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ); - DICTdo_init( data->symbol_table, &de ); - while( s = DICTdo( &de ) ) { - if( OBJis_kind_of( s, Class_Constant ) ) { - LISTadd_last( list, ( Generic )s ); - } - } - return list; -} - -/* -** Procedure: SCOPEget_references -** Parameters: Scope scope - scope to examine -** Returns: Dictionary of Symbols REFERENCE'd by a schema -** Description: Retrieve a Dictionary of Symbols REFERENCE'd by a schema -*/ - -Dictionary -SCOPEget_references( Scope scope ) { - struct Scope * data; - Error experrc; - - data = ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ); - return OBJcopy( data->references, &experrc ); -} - -/* -** Procedure: SCOPEput_resolved -** Parameters: Scope scope - scope to modify -** Returns: void -** Description: Set the 'resolved' flag for a scope. -** -** Notes: This should be called only when the scope has indeed -** been resolved. -*/ - -void -SCOPEput_resolved( Scope scope ) { - struct Scope * data; - Error experrc; - - data = ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ); - data->resolved = true; -} - -/* -** Procedure: SCOPEget_resolved -** Parameters: Scope scope - scope to examine -** Returns: Boolean - has scope been resolved? -** Description: Checks whether references within a scope have been resolved. -*/ - -Boolean -SCOPEget_resolved( Scope scope ) { - struct Scope * data; - Error experrc; - - data = ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ); - return data->resolved; -} - -/* -** Procedure: SCOPEdump -** Parameters: Scope scope - scope to dump -** FILE* file - file stream to dump to -** Returns: void -** Description: Dump a schema to a file. -** -** Notes: This function is provided for debugging purposes. -*/ - -void -SCOPEdump( Scope scope, FILE * file ) { - Dictionary dict; - Linked_List list, exp_list, ref; - Error experrc; - Symbol s; - DictionaryEntry de; - - fprintf( file, "definitions:\n" ); - dict = ( ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ) )->symbol_table; - DICTdo_init( dict, &de ); - while( s = DICTdo( &de ) ) { - fprintf( file, "%s %s\n", SYMBOLget_name( s ), CLASSget_name( OBJget_class( s ) ) ); - } - - fprintf( file, "Used symbols:\n" ); - list = ( ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ) )->use; - LISTdo( list, use, Linked_List ) - fprintf( file, "From schema %s\n", SYMBOLget_name( LISTget_first( use ) ) ); - exp_list = LISTget_second( use ); - LISTdo( exp_list, exp, Expression ); - fprintf( file, " %s AS %s\n", - SYMBOLget_name( ( Symbol )BIN_EXPget_first_operand( exp ) ), - SYMBOLget_name( BIN_EXPget_second_operand( exp ) ) ); - LISTod; /* exp */ - LISTod; - - fprintf( file, "References:\n" ); - dict = ( ( struct Scope * )OBJget_data( scope, Class_Scope, &experrc ) )->references; - DICTdo_init( dict, &de ); - while( ref = DICTdo( &de ) ) { - fprintf( file, "From schema %s\n", SYMBOLget_name( LISTget_first( ref ) ) ); - exp_list = LISTget_second( ref ); - LISTdo( exp_list, exp, Expression ); - fprintf( file, " %s AS %s\n", - SYMBOLget_name( ( Symbol )BIN_EXPget_first_operand( exp ) ), - SYMBOLget_name( BIN_EXPget_second_operand( exp ) ) ); - LISTod; /* exp */ - }; /* while */ - - /* N14 Nested schemas are obsolete - list = SCOPEget_schemata(scope); - LISTdo(list, s, Schema) - SCHEMAdump(s, file); - LISTod; - OBJfree(list, &experrc); */ - -} -/* -** Procedure: SCOPE_get_ref_name -** Parameters: Linked_List ref_entry - Reference dictionary entry -** Returns: char * - Local name or schema name -** Description: Naming function for Reference dictionary -** -*/ - -char * SCOPE_get_ref_name( Linked_List ref_entry ) { - if( LISTget_second( ref_entry ) == LIST_NULL ) { - return SYMBOLget_name( LISTget_first( ref_entry ) ); - - } else { - return SYMBOLget_name( LISTget_second( ref_entry ) ); - } -} - -void -SCOPEprint( Scope scope ) { - Error experrc; - struct Scope * data; - - print_force( scope_print ); - - data = OBJget_data( scope, Class_Scope, &experrc ); - SCOPE_print( data ); - - print_unforce( scope_print ); -} -#endif - /* find an entity type, return without resolving it */ /* note that object found is not actually checked, only because */ /* caller is in a better position to describe the error with context */ @@ -460,16 +215,3 @@ SCOPE_find( Scope scope, char * name, int type ) { return 0; } - -#if 0 -/* useful for extracting true ref of SELF when you're inside of a tiny scope */ -Entity -SCOPEget_nearest_enclosing_entity( Scope s ) { - for( ; s; s = s->superscope ) { - if( s->type == OBJ_ENTITY ) { - break; - } - } - return ( s ); -} -#endif diff --git a/src/express/type.c b/src/express/type.c index e83c5beb..77d34306 100644 --- a/src/express/type.c +++ b/src/express/type.c @@ -472,62 +472,6 @@ TYPEget_size( Type type ) { } } -#if 0 - -/* -** Procedure: TYPEcompatible -** Parameters: Type lhs_type - type for left-hand-side of assignment -** Type rhs_type - type for right-hand-side of assignment -** Returns: Boolean - are the types assignment compatible? -** Description: Determine whether two types are assignment-compatible. -*/ - -Boolean -TYPEcompatible( Type lhs_type, Type rhs_type ) { - Class lhs_class; - Class rhs_class; - Entity entity; - Linked_List list; - Error experrc; - - lhs_class = OBJget_class( lhs_type ); - rhs_class = OBJget_class( rhs_type ); - if( lhs_class == Class_Aggregate_Type ) { - return ( CLASSinherits_from( rhs_class, Class_Aggregate_Type ) && - TYPEcompatible( AGGR_TYPEget_base_type( lhs_type ), - AGGR_TYPEget_base_type( rhs_type ) ) ); - } else if( CLASSinherits_from( lhs_class, Class_Aggregate_Type ) ) { - return ( ( rhs_class == lhs_class ) && - TYPEcompatible( AGGR_TYPEget_base_type( lhs_type ), - AGGR_TYPEget_base_type( rhs_type ) ) ); - } else if( lhs_class == Class_Entity_Type ) { - if( rhs_class == Class_Entity_Type ) { - entity = ENT_TYPEget_entity( lhs_type ); - list = COMP_TYPEget_items( rhs_type ); - LISTdo( list, e, Entity ) - if( !ENTITYhas_supertype( e, entity ) ) { - return false; - } - LISTod; - return true; - } else { - return false; - } - } else if( CLASSinherits_from( lhs_class, Class_Composed_Type ) ) { - return OBJequal( rhs_type, lhs_type, &experrc ); - } else if( lhs_class == Class_Number_Type ) { - return ( ( rhs_class == Class_Number_Type ) || - ( rhs_class == Class_Real_Type ) || - ( rhs_class == Class_Integer_Type ) ); - } else if( lhs_class == Class_Real_Type ) { - return ( ( rhs_class == Class_Real_Type ) || - ( rhs_class == Class_Integer_Type ) ); - } else { - return rhs_class == lhs_class; - } -} -#endif - /* ** Procedure: AGGR_TYPEget_base_type ** Parameters: Aggregate_Type type - type to examine diff --git a/src/express/variable.c b/src/express/variable.c index 0a24d6bc..50aa0ca3 100644 --- a/src/express/variable.c +++ b/src/express/variable.c @@ -88,92 +88,6 @@ #include "express/variable.h" #include "express/object.h" char * opcode_print( Op_Code o ); -/* -** Procedure: VAR_create/free/copy/equal -** Description: These are the low-level defining functions for Class_Variable -*/ - -#if 0 -void -VAR_create( Generic dummy ) { - struct Variable * var = ( struct Variable * )dummy; - - var->type = TYPE_NULL; - var->initializer = EXPRESSION_NULL; - var->reference = EXPRESSION_NULL; - /*OLD var->ref_class = REF_DYNAMIC;*/ - var->flags = 0; - var->inverse = EXPRESSION_NULL; -} - -void -VAR_free( Generic dummy ) { - struct Variable * var = ( struct Variable * )dummy; - Error experrc; - - OBJfree( var->type, &experrc ); - OBJfree( var->initializer, &experrc ); -} - -void -VAR_copy( Generic dummy1, Generic dummy2 ) { - struct Variable * dest = ( struct Variable * )dummy1; - struct Variable * source = ( struct Variable * )dummy2; - - dest->type = OBJreference( source->type ); - dest->initializer = OBJreference( source->initializer ); - dest->reference = source->reference; - /* dest->ref_class = source->ref_class;*/ - dest->offset = source->offset; - dest->flags = source->flags; -} - -Boolean -VAR_equal( Generic dummy1, Generic dummy2 ) { - struct Variable * var1 = ( struct Variable * )dummy1; - struct Variable * var2 = ( struct Variable * )dummy2; - Error experrc; - - return ( OBJequal( var1->type, var2->type, &experrc ) /* && -Deep compare or not even necessary? - DEL - (var1->ref_class == var2->ref_class)*/ ); -} - -void -VAR_print( Generic dummy ) { - struct Variable * var = ( struct Variable * )dummy; - - if( print_none( var_print ) ) { - return; - } - - if( print_some( var_print, type ) ) { - iprint( "type:\n" ); - OBJprint( var->type ); - } - if( print_some( var_print, initializer ) ) { - iprint( "initializer:\n" ); - OBJprint( var->initializer ); - } - if( print_some( var_print, reference ) ) { - iprint( "reference:\n" ); - OBJprint( var->reference ); - } - if( print_some( var_print, offset ) ) { - iprint( "offset: %d\n", var->offset ); - } - if( print_some( var_print, flags ) ) { - iprint( "optional: %s pass-by-reference %s\n", - BOOLprint( ( var->flags & VAR_OPT_MASK ) != 0 ), - BOOLprint( ( var->flags & VAR_VAR_MASK ) != 0 ) ); - } - if( print_some( var_print, inverse ) ) { - iprint( "inverse:\n" ); - OBJprint( var->inverse ); - } -} - -#endif /*0*/ Symbol * VAR_get_symbol( Generic v ) { @@ -235,304 +149,3 @@ VARcreate( Expression name, Type type ) { v->type = type; return v; } - -#if 0 - -/* -** Procedure: VARput_type -** Parameters: Variable var - variable to examine -** Type type - type for variable -** Returns: void -** Description: Set the type of a variable. -*/ - -void -VARput_type( Variable var, Type type ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - OBJfree( data->type, &experrc ); - data->type = OBJreference( type ); -} - -/* -** Procedure: VARput_initializer -** Parameters: Variable var - variable to modify -** Expression init - initializer -** Returns: void -** Description: Set the initializing expression for a variable. -** -** Notes: When a variable used to represent an attribute has an -** initializer, the represented attribute is a derived attribute. -*/ - -void -VARput_initializer( Variable var, Expression init ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - OBJfree( data->initializer, &experrc ); - data->initializer = OBJreference( init ); -} - -/* -** Procedure: VARput_derived -** Parameters: Variable var - variable to modify -** Boolean val - new value for derived flag -** Returns: void -** Description: Set the value of the 'derived' flag for a variable. -** -** Notes: This is currently redundant information, as a derived -** attribute can be identified by the fact that it has an -** initializing expression. This may not always be true, however. -*/ - -void -VARput_derived( Variable var, Boolean val ) { - return; -} - -/* -** Procedure: VARput_optional -** Parameters: Variable var - variable to modify -** Boolean val - new value for optional flag -** Returns: void -** Description: Set the value of the 'optional' flag for a variable. -*/ - -void -VARput_optional( Variable var, Boolean val ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - if( val ) { - data->flags |= VAR_OPT_MASK; - } else { - data->flags &= ~VAR_OPT_MASK; - } -} - -/* -** Procedure: VARput_variable -** Parameters: Variable var - variable to modify -** Boolean val - new value for variable flag -** Returns: void -** Description: Set the value of the 'variable' flag for a variable. -** -** Notes: This flag is intended for use in the cases when a variable -** is used to represent a formal parameter, which may be passed by -** reference (a variable parameter, in Pascal terminology). -*/ - -void -VARput_variable( Variable var, Boolean val ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - if( val ) { - data->flags |= VAR_VAR_MASK; - } else { - data->flags &= ~VAR_VAR_MASK; - } -} - -/* -** Procedure: VARput_reference -** Parameters: Variable var - variable to modify -** Expression ref - the variable's reference -** Returns: void -** Description: Set the reference class of a variable. -*/ - -void -VARput_reference( Variable var, Expression ref ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - data->reference = ref; -} - -/* -** Procedure: VARput_inverse -** Parameters: Variable var - variable to modify -** Expression ref - attr of entity related to be inverse attr -** Returns: void -** Description: Marks this as an inverse attribute and also says to which - attribute in the remove entity this relates to. -*/ - -void -VARput_inverse( Variable var, Symbol attr ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - data->inverse = attr; -} - -/* -** Procedure: VARget_inverse -** Parameters: Variable var - variable to modify -** Returns: Symbol attr - returns what was put -** Description: See VARput_inverse -*/ - -Symbol -VARget_inverse( Variable var ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - return data->inverse; -} - -/* -** Procedure: VARput_reference_class -** Parameters: Variable var - variable to modify -** Reference_Class ref - the variable's reference class -** Returns: void -** Description: Set the reference class of a variable. -*/ - -void -VARput_reference_class( Variable var, Reference_Class ref ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - data->ref_class = ref; -} - -/* -** Procedure: VARput_offset -** Parameters: Variable var - variable to modify -** int offset - offset to variable in local frame -** Returns: void -** Description: Set a variable's offset in its local frame. -*/ - -void -VARput_offset( Variable var, int offset ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - data->offset = offset; -} - -/* -** Procedure: VARget_type -** Parameters: Variable var - variable to examine -** Returns: Type - the type of the variable -** Description: Retrieve the type of a variable. -*/ - -Type -VARget_type( Variable var ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - return OBJreference( data->type ); -} - -/* -** Procedure: VARget_derived -** Parameters: Variable var - variable to examine -** Returns: Boolean - value of variable's derived flag -** Description: Retrieve the value of a variable's 'derived' flag. -*/ - -/* this function is inlined in variable.h */ - -/* -** Procedure: VARget_optional -** Parameters: Variable var - variable to examine -** Returns: Boolean - value of variable's optional flag -** Description: Retrieve the value of a variable's 'optional' flag. -*/ - -Boolean -VARget_optional( Variable var ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - return ( data->flags & VAR_OPT_MASK ) != 0; -} - -/* -** Procedure: VARget_variable -** Parameters: Variable var - variable to examine -** Returns: Boolean - value of variable's variable flag -** Description: Retrieve the value of a variable's 'variable' flag. -*/ - -Boolean -VARget_variable( Variable var ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - return ( data->flags & VAR_VAR_MASK ) != 0; -} - -/* -** Procedure: VARget_reference -** Parameters: Variable var - variable to examine -** Returns: Expression - the variable's reference -** Description: Retrieve a variable's reference -*/ - -Expression -VARget_reference_class( Variable var ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - return data->reference; -} - -/* -** Procedure: VARget_reference_class -** Parameters: Variable var - variable to examine -** Returns: Reference_Class - the variable's reference class -** Description: Retrieve a variable's reference class. -*/ - -Reference_Class -VARget_reference_class( Variable var ) { - struct Variable * data; - Error experrc; - - data = ( struct Variable * )OBJget_data( var, Class_Variable, &experrc ); - return data->ref_class; -} - -/* -** Procedure: VARget_offset -** Parameters: Variable var - variable to examine -** Returns: int - offset to variable in local frame -** Description: Retrieve the offset to a variable in it's local frame. -*/ - -/* now a macro in variable.h */ - -void -VARprint( Variable var ) { - Error experrc; - struct Var * data; - - print_force( var_print ); - - data = OBJget_data( var, Class_Variable, &experrc ); - VAR_print( data ); - - print_unforce( var_print ); -} -#endif