⟦aedf96838⟧

TextFile

/*
 * Copyright (C) 1986   Alan Kent
 *
 * Permission is granted to freely distribute part or
 * all of this code as long as it is not for profit
 * and this message is retained in the code.
 *
 * No resposibility is taken for any damage or incorect
 * results this program generates.
 * 
 */


#include <stdio.h>
#include "graph.h"
#include "y.tab.h"
#include "math.h"


extern double eval ();
extern table_st *eval_tab ();
extern double min_fun ();
extern double max_fun ();
extern double sum_fun ();
extern double count_fun ();
extern double average_fun ();


#define MIN_FUN		((attr_st *)2)
#define MAX_FUN		((attr_st *)3)
#define SUM_FUN		((attr_st *)4)
#define COUNT_FUN	((attr_st *)5)
#define AVERAGE_FUN	((attr_st *)6)
#define LOG_FUN		((attr_st *)7)
#define LN_FUN		((attr_st *)8)
#define EXP_FUN		((attr_st *)9)
#define POWER_FUN	((attr_st *)10)
#define SQRT_FUN	((attr_st *)11)
#define FLOOR_FUN	((attr_st *)12)
#define CEIL_FUN	((attr_st *)13)
#define ABS_FUN		((attr_st *)14)
#define SIN_FUN		((attr_st *)15)
#define COS_FUN		((attr_st *)16)
#define ASIN_FUN	((attr_st *)17)
#define ACOS_FUN	((attr_st *)18)
#define ATAN_FUN	((attr_st *)19)
#define ATAN2_FUN	((attr_st *)20)
#define SINH_FUN	((attr_st *)21)
#define COSH_FUN	((attr_st *)22)
#define TANH_FUN	((attr_st *)23)
#define HYPOT_FUN	((attr_st *)24)
#define J0_FUN		((attr_st *)26)
#define J1_FUN		((attr_st *)27)
#define JN_FUN		((attr_st *)28)
#define Y0_FUN		((attr_st *)29)
#define Y1_FUN		((attr_st *)30)
#define YN_FUN		((attr_st *)31)


#define MAX_DEC		50


static struct declare_st {
    char *name;
    parm_st *parm_list;
    attr_st *expr;
    tnode_st *tab_expr;
} dec [ MAX_DEC ];

static int num_dec;



pdef_fun ()
{
    static parm_st ptab;
    static parm_st pexpr1 , pexpr2;

    ptab.parm_type = TABLE;
    ptab.ident = "";
    ptab.next = NULL;

    pexpr1.parm_type = VALUE;
    pexpr1.ident = "";
    pexpr1.next = NULL;

    pexpr2.parm_type = VALUE;
    pexpr2.ident = "";
    pexpr2.next = &pexpr1;

    fun_declare ( "min" , &ptab , MIN_FUN , NULL );
    fun_declare ( "max" , &ptab , MAX_FUN , NULL );
    fun_declare ( "sum" , &ptab , SUM_FUN , NULL );
    fun_declare ( "count" , &ptab , COUNT_FUN , NULL );
    fun_declare ( "average" , &ptab , AVERAGE_FUN , NULL );

    fun_declare ( "sqrt" , &pexpr1 , SQRT_FUN , NULL );
    fun_declare ( "log" , &pexpr1 , LOG_FUN , NULL );
    fun_declare ( "ln" , &pexpr1 , LN_FUN , NULL );
    fun_declare ( "exp" , &pexpr1 , EXP_FUN , NULL );
    fun_declare ( "pow" , &pexpr2 , POWER_FUN , NULL );
    fun_declare ( "floor" , &pexpr1 , FLOOR_FUN , NULL );
    fun_declare ( "ceil" , &pexpr1 , CEIL_FUN , NULL );
    fun_declare ( "abs" , &pexpr1 , ABS_FUN , NULL );

    fun_declare ( "sin" , &pexpr1 , SIN_FUN , NULL );
    fun_declare ( "cos" , &pexpr1 , COS_FUN , NULL );
    fun_declare ( "asin" , &pexpr1 , ASIN_FUN , NULL );
    fun_declare ( "acos" , &pexpr1 , ACOS_FUN , NULL );
    fun_declare ( "atan" , &pexpr1 , ATAN_FUN , NULL );
    fun_declare ( "atan2" , &pexpr2 , ATAN2_FUN , NULL );
    fun_declare ( "sinh" , &pexpr1 , SINH_FUN , NULL );
    fun_declare ( "cosh" , &pexpr1 , COSH_FUN , NULL );
    fun_declare ( "tanh" , &pexpr1 , TANH_FUN , NULL );

    fun_declare ( "hypot" , &pexpr2 , HYPOT_FUN , NULL );

    fun_declare ( "j0" , &pexpr1 , J0_FUN , NULL );
    fun_declare ( "j1" , &pexpr1 , J1_FUN , NULL );
    fun_declare ( "jn" , &pexpr2 , JN_FUN , NULL );
    fun_declare ( "y0" , &pexpr1 , Y0_FUN , NULL );
    fun_declare ( "y1" , &pexpr1 , Y1_FUN , NULL );
    fun_declare ( "yn" , &pexpr2 , YN_FUN , NULL );
}


fun_declare ( name , parm_list , expr , tab_expr )
char *name;
parm_st *parm_list;
attr_st *expr;
tnode_st *tab_expr;
{
    int i;

    for ( i = 0; i < num_dec; i++ ) {
	if ( strcmp ( name , dec[i].name ) == 0 ) {
	    abort ( "cannot redeclare functions: '%s'" , name );
	    return;
	}
    }
    if ( num_dec >= MAX_DEC )
	abort ( "Internal array overflow - too many functions declared" );
    dec[num_dec].name = name;
    dec[num_dec].parm_list = parm_list;
    dec[num_dec].expr = expr;
    dec[num_dec].tab_expr = tab_expr;
    num_dec++;
}


double
call_var_fun ( name , parm_list , table , row )
char *name;
parm_st *parm_list;
table_st *table;
int row;
{
    int i;
    double value;
    parm_st *p1 , *p2;
#define MAX_TAB 3
#define MAX_VAR 3
    table_st *tab_parm[ MAX_TAB ];
    double var_parm[ MAX_VAR ];
    int tab_num , var_num;

    for ( i = 0; i < num_dec; i++ ) {
	if ( strcmp ( dec[i].name , name ) == 0 ) {

	    if ( dec[i].expr == NULL )
		abort ( "value function with no expression found" );

	    p1 = parm_list;
	    p2 = dec[i].parm_list;
	    var_num = 0;
	    tab_num = 0;
	    while ( p1 != NULL  &&  p2 != NULL ) {

		if ( p1->parm_type != p2->parm_type )
		    abort ( "type mismatch for parameter to function '%s'" , name );

		if ( p1->parm_type == TABLE ) {
		    tab_parm[ tab_num ] = eval_tab ( p1->tab_expr );
		    tab_declare ( p2->ident , tab_parm[ tab_num ] );
		    if ( tab_num + 1 < MAX_TAB )
			tab_num++;
		}
		else {
		    var_parm[ var_num ] = eval ( table , row , p1->expr );
		    var_declare ( p2->ident , var_parm[ var_num ] );
		    if ( var_num + 1 < MAX_VAR )
			var_num++;
		}
		p1 = p1->next;
		p2 = p2->next;
	    }
	    if ( p1 != NULL  ||  p2 != NULL )
		abort ( "illegal parameter list for function '%s'" , name );

	    switch ( dec[i].expr ) {

	    case MIN_FUN :
		value = min_fun ( tab_parm[0] , 0 , tab_parm[0]->size );
		break;

	    case MAX_FUN :
		value = max_fun ( tab_parm[0] , 0 , tab_parm[0]->size );
		break;

	    case SUM_FUN :
		value = sum_fun ( tab_parm[0] , 0 , tab_parm[0]->size );
		break;

	    case COUNT_FUN :
		value = count_fun ( tab_parm[0] , 0 , tab_parm[0]->size );
		break;

	    case AVERAGE_FUN :
		value = average_fun ( tab_parm[0] , 0 , tab_parm[0]->size );
		break;

	    case LOG_FUN :
		value = log10 ( var_parm[0] );
		break;
	    
	    case LN_FUN :
		value = log ( var_parm[0] );
		break;

	    case EXP_FUN :
		value = exp ( var_parm[0] );
		break;
	    
	    case POWER_FUN :
		value = pow ( var_parm[0] , var_parm[1] );
		break;
	    
	    case SQRT_FUN :
		value = sqrt ( var_parm[0] );
		break;
	    
	    case FLOOR_FUN :
		value = floor ( var_parm[0] );
		break;
	    
	    case CEIL_FUN :
		value = ceil ( var_parm[0] );
		break;
	    
	    case ABS_FUN :
		value = fabs ( var_parm[0] );
		break;
	    
	    case SIN_FUN :
		value = sin ( var_parm[0] );
		break;

	    case COS_FUN :
		value = cos ( var_parm[0] );
		break;

	    case ASIN_FUN :
		value = asin ( var_parm[0] );
		break;

	    case ACOS_FUN :
		value = acos ( var_parm[0] );
		break;

	    case ATAN_FUN :
		value = atan ( var_parm[0] );
		break;

	    case ATAN2_FUN :
		value = atan2 ( var_parm[0] , var_parm[1] );
		break;

	    case SINH_FUN :
		value = sinh ( var_parm[0] );
		break;

	    case COSH_FUN :
		value = cosh ( var_parm[0] );
		break;

	    case TANH_FUN :
		value = tanh ( var_parm[0] );
		break;

	    case HYPOT_FUN :
		value = hypot ( var_parm[0] , var_parm[1] );
		break;

	    case J0_FUN :
		value = sin ( var_parm[0] );
		break;

	    case J1_FUN :
		value = j1 ( var_parm[0] );
		break;

	    case JN_FUN :
		value = jn ( var_parm[0] );
		break;

	    case Y0_FUN :
		value = y0 ( var_parm[0] );
		break;

	    case Y1_FUN :
		value = y1 ( var_parm[0] );
		break;

	    case YN_FUN :
		value = yn ( var_parm[0] );
		break;

	    default :
		value = eval ( table , row , dec[i].expr );
		break;
	    }
	    return ( value );
	}
    }
    abort ( "Undefined function '%s' referenced" , name );
}


table_st *
call_tab_fun ( name , parm_list , table , row )
char *name;
parm_st *parm_list;
table_st *table;
int row;
{
    int i;
    table_st *newtab;
    parm_st *p1 , *p2;

    for ( i = 0; i < num_dec; i++ ) {
	if ( strcmp ( dec[i].name , name ) == 0 ) {
	    if ( dec[i].tab_expr == NULL )
		abort ( "table function with no expression found" );
	    p1 = parm_list;
	    p2 = dec[i].parm_list;
	    while ( p1 != NULL  &&  p2 != NULL ) {
		if ( p1->parm_type != p2->parm_type )
		    abort ( "type mismatch for parameter to function '%s'" , name );
		if ( p1->parm_type == TABLE )
		    tab_declare ( p2->ident , eval_tab ( p1->tab_expr ) );
		else
		    var_declare ( p2->ident , eval ( table , row , p1->expr ) );
		p1 = p1->next;
		p2 = p2->next;
	    }
	    if ( p1 != NULL  ||  p2 != NULL )
		abort ( "illegal parameter list for function '%s'" , name );
	    newtab = eval_tab ( dec[i].tab_expr );
	    return ( newtab );
	}
    }
    abort ( "Undefined function '%s' referenced" , name );
}



is_fvar_ident ( name )
char *name;
{
    int i;

    for ( i = 0; i < num_dec; i++ ) {
	if ( strcmp ( dec[i].name , name ) == 0 ) {
	    return ( dec[i].expr != NULL );
	}
    }
    return ( 0 );
}



is_ftab_ident ( name )
char *name;
{
    int i;

    for ( i = 0; i < num_dec; i++ ) {
	if ( strcmp ( dec[i].name , name ) == 0 ) {
	    return ( dec[i].expr == NULL );
	}
    }
    return ( 0 );
}



check_group_fun ( name )
char *name;
{
    int i;

    for ( i = 0; i < num_dec; i++ ) {
	if ( strcmp ( dec[i].name , name ) == 0 ) {
	    if ( dec[i].expr == NULL )
		abort ( "function '%s' must return a value" , name );
	    if ( dec[i].parm_list == NULL
	    ||   dec[i].parm_list->next != NULL
	    ||   dec[i].parm_list->parm_type != TABLE )
		abort ( "function '%s' expects a single table as parameters" );
	    return;
	}
    }
}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦aedf96838⟧ TextFile

Derivation

TextFile
