/* function.cc */

#include "function.h"
#include "data_classes.h"
#include "id_lookup.h"
#include "root.h"
#include <LEDA/queue.h>
#include <math.h>
#include "element.h"
#include "parser.h"
#include "data.h"

dc_data *dc_func::evaluate( void ) {
  dc_data *d = evaluate_f();
  if( d && d->type() == Real_t && isnan( ( ( dc_real * )d )->get() ) ) {
    cerr << "dc_func::evaluate -- NaN found ";
    if( owner ) cerr << " in evaluation fn of " << owner->full_type();
    cerr << " at ( " << *this << " )\n";
  }
  return d;
}

dc_const::dc_const( dc_data &d ) {
  D = nil;
  if( d.is_temporary() ) {
    D = &d;
  } else {
    D = ( dc_data * )allocate( d.sub_type() );
    set_data( *D, d );
  }
}

dc_const::~dc_const( void ) {
  if( !D->is_temporary() ) delete( D );
}

dc_data *dc_const::evaluate_f( void ) {
  dc_data *copy = ( dc_data * )allocate( D->sub_type() );
  if( set_data( *copy, *D ) ) {
    delete( copy ); 
    return nil;
  }

  return copy;
}

void dc_const::get_xtype( xtype &xt ) { 
  if( D ) D->get_xtype( xt ); 
  else xt.T = xt.subT = Undef_t;
}

dc_func *dc_const::duplicate( dc_label *, list<dc_arg *> * ) const {
  dc_data *copy = ( dc_data * )allocate( D->sub_type() );
  if( set_data( *copy, *D ) ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_const::duplicate -- failed to duplicate constant data\n";
    }
    delete( copy );
    return nil;
  }
  dc_const *dupe = new dc_const( *copy );

  return ( dc_func * )dupe;
}

static list<dc_elvalue *> elref_list;

dc_elvalue::dc_elvalue( dc_element &e, cstring Hash_Path, 
			dc_label *Hash_Origin, const bool Old = false ) {
  E = &e;
  hash_path = Hash_Path;
  hash_origin = Hash_Origin;
  old = Old;
  el_li = elref_list.append( this );
}

dc_elvalue::dc_elvalue( cstring Hash_Path, dc_label *Hash_Origin, 
			const bool Old = false ) {
  E = nil;
  hash_path = Hash_Path;
  hash_origin = Hash_Origin;
  old = Old;

  el_li = elref_list.append( this );
}

dc_elvalue::dc_elvalue( dc_element &e, const bool Old = false ) {
  E = &e;
  hash_path = string( "" );
  hash_origin = nil;
  old = Old;

  el_li = elref_list.append( this );
}

dc_elvalue::~dc_elvalue( void ) {
  elref_list.erase( el_li );
}

dc_data *dc_elvalue::evaluate_f( void ) {
  if( !E ) return nil;
  dc_data *elval = old ? E->get_previous() : E->get();

  if( !elval ) {
    run_time_error( *( ( dc_func * )this ), "dc_elvalue::evaluate" );
    return nil;
  }

  dc_data *copy = ( dc_data * )allocate( elval->sub_type() );
  set_data( *copy, *elval );
  return copy;
}

dc_type dc_elvalue::get_rtype( void ) {
  if( E ) return E->get_rtype(); else return Undef_t;
}

void dc_elvalue::get_xtype( xtype &xt ) { 
  if( E ) E->get_xtype( xt ); 
  else xt.T = xt.subT = Undef_t;
}

bool dc_elvalue::assign( dc_data *d ) {
  if( !d || !E ) return true;
  dc_type src_t = d->sub_type(),
    dest_t = E->get_rtype();
  if( src_t == dest_t ) {
    E->set( *d );
  } else if( castable( src_t, dest_t ) ) {
    dc_data *casted = cast( *d, dest_t );
    E->set( *casted );
  } else return true;
  return false;
}

bool dc_elvalue::remove_deps( const int n, const tag tags[] ) {
  if( old ) return false;
  
  tag T = E->get_tag();
  for( int i = 0 ; i < n ; i++ ) {
    if( tags[i] >= T )
      if( tags[i] == T ) return old = true;
    else return false;
  }
  return false;
}

int dc_elvalue::rehash( dep_list &dl, const tag T ) {
  if( !old && E != nil ) {
    dl.append( T ); dl.append( E->get_tag() );
  }

  return 0;
}

bool dc_elvalue::relink( void ) {
  if( hash_path.length() ) {
    dc_element *new_E = ( dc_element * )t_search( hash_path, Element_t, 
						  hash_origin );

    if( new_E == nil ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "dc_elvalue::relink -- failed to locate \"" << hash_path
	     << "\" from " << ( hash_origin ? hash_origin->full_type() : 
				string( "root" ) ) << " for eval function of "
	     << ( get_owner() ? owner->full_type() : string( "<nil>" ) ) 
	     << "\n";
      }
      if( E != nil ) {
	E = nil;
      }
      return true;
    }
    E = new_E;
  }

  return false;
}

dc_func *dc_elvalue::duplicate( dc_label *srch_origin, list<dc_arg *>* ) const {
  if( hash_path.length() ) {
    if( E ) {
      return ( dc_func * )new dc_elvalue( *E, hash_path, srch_origin, old );
    } else {
      return ( dc_func * )new dc_elvalue( hash_path, srch_origin, old );
    }
  } else {
    if( E )
      return ( dc_func * )new dc_elvalue( *E, old );
    else {
      dc_trace( TRACE_ERROR ) {
	cerr << "dc_elvalue::duplicate -- could not duplicate <nil> element "
	     << "reference without hash string\n";
      }
      return nil;
    }
  }
}

int relink_elrefs( void ) {
  dc_elvalue *e; int n = 0;
  forall( e, elref_list ) {
    dc_label *owner = e->get_owner();
    if( !( owner && owner->sub_type() == Element_t &&
	   ( ( dc_element * )owner )->is_dormant() ) ) {
      if( e->relink() ) n++;
    }
  }
  return n;
}

bool dc_base_op::set_info( int index ) {
  if( index < 0 || index >= nfns ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_base_op::set_info -- invalid index " << index << "\n";
      exit( 1 );
    }
  }
  info_index = index;
  return false;
}

void dc_base_op::clear_args( void ) { 
  list_item it;
  /* delete temporary args */
  forall_items( it, args ) {
    delete( args.inf( it ) );
  }
  
  nargs = 0; args.clear(); 
}

bool dc_base_op::remove_deps( const int n, const tag tags[] ) {
  dc_func *f;
  bool success = false;
  forall( f, args ) {
    if( f->remove_deps( n, tags ) ) success = true;
  }
  return success;
}

int dc_base_op::rehash( dep_list &dl, const tag T ) {
  op_changed = true;
  int n = 0;
  dc_func *f;
  forall( f, args ) {
    n = f->rehash( dl, T );
  }
  return n;
}

dc_op::dc_op( void ) {
  nargs = 0;
  op_changed = true;
  T = Undef_t;
  info_index = 0; /* arbitrary valid value */
}

dc_data *dc_op::evaluate_f( void ) {
  dc_data *result = fn_list[info_index].op( args );
#ifdef DC_TRACING_ON
  if( result == nil ) {
    run_time_error( *( ( dc_func * )this ), "dc_op::evaluate" );
  }
#endif
  return result;
}

void dc_op::set_bin_args( dc_func &arg1, dc_func &arg2 ) {
  clear_args();
  args.push( &arg2 );
  args.push( &arg1 );
  nargs = 2;
  op_changed = true;
  arg1.set_owner( get_owner() );
  arg2.set_owner( get_owner() );
}

void dc_op::set_arg( int index, dc_func &new_arg ) { 
  if( index >= args.length() ) {
    cerr << "dc_op::set_arg -- index " << index << " greater than length "
	 << args.length() << "\n";
    return;
  }
  
  list_item it = args.get_item( index );
  dc_func *old_arg = args.inf( it );
  if( old_arg ) delete( old_arg );
  args.assign( it, &new_arg );
  op_changed = true;
  new_arg.set_owner( get_owner() );
}

void dc_op::add_arg( dc_func &arg ) {
  args.append( &arg );
  arg.set_owner( get_owner() );
  nargs++;
  op_changed = true;
}

dc_type dc_op::get_rtype() {
  if( op_changed ) {
    T = fn_list[info_index].t_op( args );
    op_changed = false;
  }
   
  return T;
}

dc_data *dc_op::simplify( void ) {
  if( nargs ) {
    list_item li;
    bool simplified = true;
    forall_items( li, args ) {
      dc_func *f = args.inf( li );
      dc_data *d = f->simplify();
      if( d ) {
	delete( f );
	dc_func *new_fn = new dc_const( *d );
	new_fn->set_owner( get_owner() );
	args.assign( li, new_fn );
      } else simplified = false;
    }
    if( simplified ) {
      dc_data *rval = evaluate();
      return rval;
    }
  } else {
    /* want to return a default value for a given function and rtype. */
    return nil;
  }
  return nil;
}

dc_func *dc_op::duplicate( dc_label *srch_origin, 
			   list<dc_arg *> *arg_source ) const {
  dc_op *dupe = new dc_op;
  dupe->set_info( info_index );
  list_item li;
  forall_items( li, args ) {
    dc_func *arg = args.inf( li );
    dc_func *dupe_arg = arg->duplicate( srch_origin, arg_source );

    if( dupe_arg == nil ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "dc_op::duplicate -- failed to duplicate arg " << *arg << "\n";
      }
      delete( dupe );
      return nil;
    }
    
    dupe->add_arg( *dupe_arg );
  }
  return ( dc_func * )dupe;
}

dc_set_op::dc_set_op( void ) {
  set = nil;
  nargs = 0;
  hashed = false;
  op_changed = true;
  arg_type = default_type;
}

dc_set_op::~dc_set_op( void ) {
  clear_args();
}

void add_to_args( dc_label *id, void *setop ) {
  dc_func *fn = nil;

  dc_set_op *S = ( dc_set_op * )setop;
  if( id->type() == Element_t ) {
    if( !( ( ( dc_element * )id )->is_transparent() ) ) {
      dc_type el_t = ( ( dc_element * )id )->get_rtype();
      if( el_t == S->arg_type )
	fn = new dc_elvalue( *( ( dc_element * )id ) );
      else if( castable( el_t, S->arg_type ) )
	fn = new dc_fcast( *( new dc_elvalue( *( ( dc_element * )id ) ) ),
			   S->arg_type );
    }
  } else if( id->sub_type() == S->arg_type ) {
    fn = new dc_const( *( ( dc_data * )id ) );
  } else if( castable( id->sub_type(), S->arg_type ) ) {
    fn = new dc_const( *( cast( *( ( dc_data * )id ), S->arg_type ) ) );
  }
  if( fn != nil ) {
    fn->set_owner( S->get_owner() );
    S->args.append( fn );
  }
}

void dc_set_op::hash_set( void ) {
  if( !hashed ) {
    clear_args();

    if( set ) {
      set->forall_members( add_to_args, ( void * )this );
    }
    nargs = args.size();
  }

  hashed = ( nargs != 0 );
}

dc_type dc_set_op::get_rtype() {
  if( op_changed ) {
    T = fn_list[info_index].st_op( arg_type );
    op_changed = false;
  }
  
  return T;
}

bool dc_set_op::remove_deps( const int n, const tag tags[] ) {
  hash_set();

  return dc_base_op::remove_deps( n, tags );
}

dc_data *dc_tset_op::evaluate_f( void ) {
  hash_set();
  dc_data *result = fn_list[info_index].op( args );
#ifdef DC_TRACING_ON
  if( result == nil ) {
    run_time_error( *( ( dc_func * )this ), "dc_set_op::evaluate" );
  }
#endif
  return result;
}

int dc_tset_op::rehash( dep_list &dl, const tag T ) {
  op_changed = true; hashed = false;
  hash_set();

  dc_func *f;
  int n = 0;
  forall( f, args ) {
    n += f->rehash( dl, T );
  }
  return n;
}

dc_func *dc_tset_op::duplicate( dc_label *, list<dc_arg *>* ) const {
  dc_tset_op *dupe = new dc_tset_op;
  dupe->set_info( info_index );

  dupe->set_arg_type( get_arg_type() );
  if( set ) {
    dc_set *dupe_set = ( dc_set * )( set->duplicate( nil ) );
    if( dupe_set == nil ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "dc_tset_op::duplicate -- failed to duplicate set\n";
      }
      delete( dupe );
      return nil;
    }
    dupe->set_set( *dupe_set );
  }

  return ( dc_func * )dupe;
}

dc_pset_op::dc_pset_op( void ) {
  id = search_origin = nil;
}

dc_pset_op::dc_pset_op( cstring lbl, dc_label *s_o ) {
  id = search_origin = nil;
  set_set_info( lbl, s_o );
}

dc_data *dc_pset_op::evaluate_f( void ) {
  if( id == nil ) return nil;
  if( id->type() == Element_t ) {
    if( set == nil || !( ( dc_element * )id )->is_simple() ) {
      dc_set *s = ( dc_set * )( ( ( dc_element * )id )->get() );
      if( s == nil ) return nil;
      set = s;
      hashed = false;
    }
  } else { /* assume type is Set_t */
    if( set == nil ) {
      set = ( dc_set * )id;
      hashed = false;
    }
  }

  hash_set();
  dc_data *result = fn_list[info_index].op( args );
#ifdef DC_TRACING_ON
  if( result == nil ) {
    run_time_error( *( ( dc_func * )this ), "dc_set_op::evaluate" );
  }
#endif
  return result;  
}

bool find_set_crit( const dc_label *id ) {
  return ( id->type() == Element_t && 
	   ( ( dc_element * )id )->get_rtype() == Set_t ) || 
    id->type() == Set_t;
}

int dc_pset_op::rehash( dep_list &dl, const tag T ) {
  int nerrors = 0;

  op_changed = true; hashed = false;
  id = fit_search( label, find_set_crit, search_origin );
  if( id == nil ) {
    nerrors++;
  } else if( id->type() == Element_t ) {
    //dl.append( T ); dl.append( ( ( dc_element * )id )->get_tag() );
  }

  hash_set();

  dc_func *f;
  forall( f, args ) {
    nerrors += f->rehash( dl, T );
  }
  return nerrors;
}

dc_func *dc_pset_op::duplicate( dc_label *srch_origin, list<dc_arg *>* ) const {
  dc_pset_op *dupe = new dc_pset_op( label, srch_origin );

  dupe->set_info( info_index );

  dupe->set_arg_type( get_arg_type() );

  return ( dc_func * )dupe;
}

dc_func_call::dc_func_call( cstring Hash_Path, 
			    dc_label *Hash_Origin ) {
  nargs = 0; 
  max_rank = -1;
  hash_path = Hash_Path;
  hash_origin = Hash_Origin;
  E = nil;
}

dc_data *dc_func_call::evaluate_f( void ) {
  dc_data *result;
  if( E ) {
    result = E->call( args );
  } else {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_func_call::evaluate -- call of <nil> element with path \"" 
	   << hash_path << "\" failed.\n";
    }
    return nil;
  }
  if_trc( result == nil, TRACE_ERROR ) {
    cerr << "dc_func_call::evaluate -- error in call of " << E->full_type()
	 << "\n";
  }

  return result;
}

bool dc_func_call::add_arg( dc_func &f, const int rank ) {
  if( rank < max_rank ) {
    list_item li = args.first();
    for( int i = 0 ; i < rank ; i++ ) {
      li = args.succ( li );
    }
    if( args.inf( li ) != nil ) { /* trying to reset value */
      return true;
    }
    args.assign( li, &f );
  } else if( rank > max_rank ) {
    int nspaces = rank - max_rank - 1;
    for( int i = 0 ; i < nspaces ; i++ ) {
      args.append( ( dc_func * )nil );
    }
    args.append( &f );
    max_rank = rank;
  } else {
    return true;
  }
  nargs++;
  return false;
}

void dc_func_call::clear_args( void ) {
  arg_data *ad;

  forall( ad, arg_data_list ) {
    delete( ad );
  }
  
  nargs = 0; max_rank = -1;
  args.clear();
  arg_data_list.clear();
}

dc_data *dc_func_call::simplify( void ) {
  list_item li;
  forall_items( li, args ) {
    dc_func *f = args.inf( li );
    if( f ) {
      dc_data *d = f->simplify();
      if( d != nil ) {
	delete( args.inf( li ) );
	dc_func *new_fn = new dc_const( *d );
	new_fn->set_owner( get_owner() );
	args.assign( li, new_fn );
      }
    }
  }

  return nil;
}

bool dc_func_call::remove_deps( const int n, const tag tags[] ) {
  dc_func *f;
  bool success = false;
  forall( f, args ) {
    if( f->remove_deps( n, tags ) ) success = true;
  }
  return success;
}

int dc_func_call::rehash( dep_list &dl, const tag T ) {
  args.clear();
  max_rank = -1;

  E = ( dc_element * )t_search( hash_path, Element_t, hash_origin );

  if( !E ) {
    dc_trace( TRACE_ERROR ) {
      dc_label *owner = lookup( T );
      cerr << "dc_func_call::rehash -- failed to locate \"" << hash_path
	   << "\" from " << ( hash_origin ? hash_origin->full_type() : 
			      string( "root" ) ) << " for eval function of "
	   << ( owner ? owner->full_type() : string( "<nil>" ) ) << "\n";
    }
    return 1;
  }

  int nerrors = 0;

  if( E->get_nargs() < arg_data_list.length() ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_func_call::rehash -- too many args in call of " 
	   << E->full_type() << " in function of " 
	   << ( get_owner() ? get_owner()->full_type() : string( "<nil>" ) )
	   << "\n";
    }
    nerrors+=1;
  }

  int rank = 0;
  arg_data *ad;
  list_item it = arg_data_list.first();
  while( it != nil ) {
    ad = arg_data_list.inf( it );
    if( ad ) {
      int n = rank;
      if( ad->label.length() ) {
	n = E->arg_rank( ad->label );
	if( n < 0 ) {
	  dc_trace( TRACE_ERROR ) {
	    cerr << "dc_func_call::rehash -- could not match argument " 
		 << ad->label << " to any in " << E->full_type() << "\n";
	  }
	  nerrors++;
	}
      } 

      if( n >= 0 && add_arg( *( ad->f ), n ) ) {
	dc_trace( TRACE_ERROR ) {
	  cerr << "dc_func_call::rehash -- could not set " << n 
	    << ( n == 1 ? "st" : ( n == 2 ? "nd" : ( n == 3 ? "rd" : "th" ) ) ) 
	       << " argument in call of " << E->full_type() << "\n";
	}
	nerrors++;
      }
    }
    rank++;
    it = arg_data_list.succ( it );
  }

  dc_func *f;
  forall( f, args ) {
    if( f ) 
      nerrors += f->rehash( dl, T );

  }
  return nerrors;
}

void dc_func_call::get_xtype( xtype &xt ) {
  if( E ) {
    E->get_xtype( xt );
  } else {
    xt.T = xt.subT = Undef_t;
  }
}

dc_func *dc_func_call::duplicate( dc_label *srch_origin, 
				  list<dc_arg *> *arg_source ) const {
  dc_func_call *dupe = new dc_func_call( hash_path, srch_origin );

  arg_data *ad;
  forall( ad, arg_data_list ) {
    if( ad ) {
      dc_func *dupe_arg_f = ad->f->duplicate( srch_origin, arg_source );
      if( dupe_arg_f == nil ) {
	dc_trace( TRACE_ERROR ) {
	  cerr << "dc_func_call::duplicate -- failed to duplicate arg\n";
	}
	delete( dupe );
	return nil;
      }
      if( ad->label.length() != 0 ) {
	dupe->add_arg_data( ad->label, *dupe_arg_f );
      } else {
	dupe->add_arg_data( *dupe_arg_f );
      }
    } else {
      dupe->add_nil_arg_data();
    }
  }

  return ( dc_func * )dupe;
}

/* element arg functions */
dc_arg::dc_arg( cstring N, const dc_type T, dc_func *DV = nil ) {
  name = N;
  rtype = T;
  default_val = DV;
  value = nil;
}

dc_arg::dc_arg( void ) {
  rtype = Undef_t;
  default_val = value = nil;
}

dc_arg::~dc_arg( void ) {
  if( default_val ) delete( default_val );
}

dc_data *dc_arg::evaluate_f( void ) {
  if( value ) {
    return value->evaluate();
  }
  if( default_val == nil ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_arg::evaluate -- nil arg \"" << name;
      if( get_owner() ) cerr << "\" of " << get_owner()->full_type();
      else cerr << "\"";
      cerr << " without default value called\n";
    }
    run_time_error( *( ( dc_func * )this ), "dc_arg::evaluate" );
    return nil;
  }
  return default_val->evaluate();
}

void dc_arg::set_default( dc_func *DV ) {
  if( default_val )
    delete( default_val );
  default_val = DV;

  if( DV )
    DV->set_owner( get_owner() );
}

bool dc_arg::set( dc_func *f ) {
  value = f;
  return ( value == nil && default_val == nil );
}

void dc_arg::set_owner( dc_label *l ) {
  owner = l;
  if( default_val ) default_val->set_owner( l );
}

dc_data *dc_arg::simplify( void ) {
  if( default_val ) {
    dc_data *d = default_val->simplify();
    if( d ) {
      delete( default_val );
      if( d->has_units() ) {
	dc_node *origin = ( owner == nil ) ? nil : 
	  ( dc_node * ) ( ( owner->type() == Node_t ) ? owner :
			  owner->get_parent() );
	set_default_units( *( ( dc_udata * )d ), name, origin );
      }
      default_val = new dc_const( *d );
      default_val->set_owner( get_owner() );
    }
  }
  return nil;
}

bool dc_arg::remove_deps( const int n, const tag tags[] ) {
  return ( default_val != nil ) && default_val->remove_deps( n, tags );
}

int dc_arg::rehash( dep_list &dl, const tag T ) {
  if( default_val ) {
    int nerrs = default_val->rehash( dl, T );

    dc_type def_t;
    if( ( def_t = default_val->get_rtype() ) != rtype ) {
      if( castable( def_t, rtype ) ) {
	default_val = new dc_fcast( *default_val, rtype );
      } else nerrs++;
    }

    return nerrs;
  }
  return 0;
}

dc_func *dc_arg::duplicate( dc_label *srch_origin, list<dc_arg *> *arg_source ) 
  const {
  if( arg_source == nil ) {
    dc_func *dupe_default = nil;
    if( default_val ) {
      dupe_default = default_val->duplicate( srch_origin, arg_source );
      if( dupe_default == nil ) {
	dc_trace( TRACE_ERROR ) {
	  cerr << "dc_arg::duplicate -- failed to duplicate default value\n";
	}
	return nil;
      }
    }
    return new dc_arg( name, rtype, dupe_default );
  }
   
  dc_arg *arg;
  forall( arg, *arg_source ) {
    if( arg->name == name ) {
      return ( dc_func * )arg;
    }
  }
  
  dc_trace( TRACE_ERROR ) {
    cerr << "dc_arg::duplicate -- failed to locate duplicate arg \"" << name 
	 << "\"\n";
  }
  return nil;
}

dc_data *dc_fcast::evaluate_f( void ) {
  if( !f ) return nil;
  dc_data *d = f->evaluate();
  if( d ) 
    return( cast( *d, T ) ); 
  run_time_error( *( ( dc_func * )this ), "dc_fcast::evaluate" );
  return nil; 
}

dc_data *dc_fcast::simplify( void ) {
  if( !f ) return nil;
  dc_data *d = f->simplify();
  if( d ) {
    dc_data *d2 = cast( *d, T );
    if( d2 ) {
      return d2;
    } else {
      dc_trace( TRACE_WARNING ) {
	cerr << "dc_fcast::simplify -- cast failed dring simplify\n";
      }
      return d;
    }
  }
  return nil;
}

void dc_fcast::get_xtype( xtype &xt ) {
  if( f ) {
    f->get_xtype( xt );
    xt.subT = T;
    switch( T ) {
    case Distrib_t :
      xt.T = Real_t;
      break;
    case Rect_Matrix_t : case Vector_t : case Triple_t :
      xt.T = Matrix_t;
      break;
    default :
      xt.T = xt.subT = T;
    }
  } else {
    xt.T = xt.subT = Undef_t;
  }
}

bool dc_fcast::remove_deps( const int n, const tag tags[] ) {
  return f->remove_deps( n, tags );
}

dc_func *dc_fcast::duplicate( dc_label *srch_origin, 
			      list<dc_arg *> *arg_source ) const {
  if( f == nil ) return nil;
  dc_func *dupe_fn = f->duplicate( srch_origin, arg_source );
  if( dupe_fn == nil ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_fcast::duplicate -- error duplicating fn\n";
    }
    return nil;
  }
  return ( dc_func * )new dc_fcast( *dupe_fn, T );
}

dc_ucast::dc_ucast( dc_func &F, const unit_vec &UV, double Coeff = 1
		    /*, double Off = 0 */) {
  f = &F;
  F.set_owner( get_owner() );
  uv = UV;
  coeff = Coeff;
//  offset = Off;
}

dc_data *dc_ucast::evaluate_f( void ) {
  if( f == nil ) return nil;
  dc_data *d = f->evaluate();
  
  if( d && d->has_units() ) {
    ( ( dc_udata * )d )->set_units( uv );
    Real *store;
    switch( d->type() ) {
    case Real_t :
      ( ( dc_real * )d )->set( ( ( dc_real * )d )->get() * coeff );
      break;
    case Int_t :
      ( ( dc_int * )d )->set( ( long )( ( ( dc_int * )d )->get() * coeff ) );
      break;
    case Matrix_t :
      store = ( ( dc_matrix * )d )->get_store();
      for( int i = ( ( dc_matrix * )d )->get_storage() - 1 ; i >= 0 ; i-- ) {
	store[i] = store[i] * coeff;
      }
      break;
    default :;
    }
    return d;
  }
  
  run_time_error( *( ( dc_func * )this ), "dc_ucast::evaluate" );
  return nil;
}

dc_type dc_ucast::get_rtype( void ) {
  dc_type f_t = f ? f->get_rtype() : Undef_t;
  switch( f_t ) {
  case Distrib_t : case Int_t : case Matrix_t : case Real_t :
  case Rect_Matrix_t : case Triple_t : case Vector_t :
    return f_t;
    break;
  default : return Undef_t;
  }
}

void dc_ucast::get_xtype( xtype &xt ) {
  if( f ) {
    f->get_xtype( xt );
    xt.uv = uv;
  } else {
    xt.T = xt.subT = Undef_t;
  }
}

dc_data *dc_ucast::simplify( void ) {
   if( f== nil ) return nil;
   dc_data *d = f->simplify();
   if( d ) {
     ( ( dc_udata * )d )->set_units( uv );
     return d;
   }
   return nil;
}

dc_func *dc_ucast::duplicate( dc_label *srch_origin, 
			      list<dc_arg *> *arg_source ) const {
  if( f == nil ) return nil;
  dc_func *dupe_fn = f->duplicate( srch_origin, arg_source );
  if( dupe_fn == nil ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_ucast::duplicate -- error duplicating fn\n";
    }
    return nil;
  }
  return ( dc_func * )new dc_ucast( *dupe_fn, uv, coeff );
}

dc_data *dc_tquery::evaluate_f( void ) {
  dc_clock *c;
  switch( L->sub_type() ) {
  case Element_t :
    c = ( ( dc_element * )L )->get_clock();
    break;
  case Clock_t :
    c = ( dc_clock * )L;
    break;
  case Component_t : case Modification_t : case GA_t :
    c = ( ( dc_component * )L )->get_clock();
    break;
  default : 
    run_time_error( *( ( dc_func * )this ), "dc_tquery::evaluate" );
    return nil;
  }
  if( c == nil ) {
    run_time_error( *( ( dc_func * )this ), "dc_tquery::evaluate" );
    return nil;
  }
  dc_real *r;
  if( T ) {
    r = new dc_real( c->t() );
  } else {
    r = new dc_real( c->dt() );
  }
  ( r->get_units() )[uTime] = 1;
  return r;
}

void dc_tquery::get_xtype( xtype &xt ) {
  if( L ) {
    xt.T = xt.subT = Real_t;
    xt.uv.clear();
    xt.uv[uTime] = 1;
  } else {
    xt.T = xt.subT = Undef_t;
  }
}

dc_func *dc_tquery::duplicate( dc_label *, list<dc_arg *>* ) const {
  return ( dc_func * )new dc_tquery( L, T );
}

dc_iter_loop::dc_iter_loop( void ) {
  func = nil;
  set = nil;
  search_origin = nil;
  id = nil;
}

dc_iter_loop::~dc_iter_loop( void ) {
  if( func ) delete( func );
  if( set && label == "" ) delete( set );
  args.clear();
}

void dc_iter_loop::set_set( cstring lbl, dc_label *s_o ) {
  if( set && label == "" ) delete( set );
  label = lbl; 
  search_origin = s_o; 
  id = nil; set = nil; 
}

void dc_iter_loop::set_set( dc_set &S ) {
  if( set && label == "" ) delete( set );
  set = &S; 
  label = ""; 
  search_origin = id = nil;
}

void dc_iter_loop::set_owner( dc_label *l ) {
  owner = l;
  if( func ) func->set_owner( l );
  arg.set_owner( l );
  dc_func *f;
  forall( f, args ) {
    func->set_owner( l );
  }
}

dc_data *dc_iter_loop::evaluate_f( void ) {
  /* evaluate set if necessary */
  if( id ) {
    if( id->type() == Element_t ) {
      if( set == nil || !( ( dc_element * )id )->is_simple() ) {
	dc_set *s = ( dc_set * )( ( ( dc_element * )id )->get() );
	if( s == nil ) return nil;
	set = s;
	hash_set();
      }
    } else { /* assume type is Set_t */
      if( set == nil ) {
	set = ( dc_set * )id;
	hash_set();
      }
    }
  } else if( set == nil ) return nil;  

  dc_func *f;
  dc_data *result = nil;
  int step = 0;
  forall( f, args ) {
    if( result ) delete( result );
    /* substitute into arg */
    arg.set( f );
    result = f->evaluate();
    if( result == nil ) {
      run_time_error( *this, string( "dc_iter_loop::evaluate step %d", step ) );
      return nil;
    }
    step++;
  }

  return result;
}

int dc_iter_loop::rehash( dep_list &dl, const tag T ) {
  int nerrors = 0;

  if( label != "" ) {
    id = fit_search( label, find_set_crit, search_origin );
    if( id == nil ) nerrors++;
  }

  if( func ) nerrors += func->rehash( dl, T );
  nerrors += arg.rehash( dl, T );
  dc_func *f; forall( f, args ) nerrors += f->rehash( dl, T );
  return nerrors;
}

void dc_iter_loop::hash_set( void ) {
  args.clear();
  
  if( set ) {
    set->forall_members( add_to_args, ( void * )this );
  }
}

dc_func *dc_iter_loop::duplicate( dc_label *srch_origin, 
				  list<dc_arg *>*arg_source ) const {
  if( func == nil ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_iter_loop::duplicate -- tried to copy functionless loop\n"; }
    return nil;
  }

  dc_iter_loop *dupe = new dc_iter_loop;
  dupe->init_arg( arg.get_name(), arg.get_rtype_c() );

  list<dc_arg *> all_args;
  if( arg_source ) all_args.conc( *arg_source );
  all_args.push( &( dupe->arg ) );

  dc_func *dupe_fn = func->duplicate( srch_origin, &all_args );

  all_args.pop();
  if( arg_source ) arg_source->conc( all_args );

  if( dupe_fn == nil ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_iter_loop::duplicate -- error duplicating loop function\n";
    }
    delete( dupe );
    return nil;
  }
  dupe->set_func( *dupe_fn );

  if( label.length() ) {
    dupe->set_set( label, srch_origin );
  } else if( set ) {
    dc_set *S = new dc_set;
    *S = *set;
    dupe->set_set( *S );
  } else {
    dc_trace( TRACE_ERROR ) {
      cerr << "dc_iter_loop::duplicate -- error duplicating undefined loop\n";
    }
    delete( dupe );
    return nil;
  }

  return ( dc_func * )dupe;
}

#ifdef DC_TRACING_ON
void run_time_error( const dc_func &f, cstring op ) {
  dc_trace( TRACE_ERROR ) {
    cerr << op << " -- run time error in ( " << f
	 << " )";
    dc_label *l;
    if( ( l = f.get_owner() ) != nil ) {
      cerr << " of " << l->full_type();
    }
    cerr << "\n";
  }
}
#else
void run_time_error( const dc_func &, cstring ) {
  ;
}  
#endif

/* OPERATIONS ************************************************************/
inline double rmag( dc_data *d )
{ return ( ( dc_real * )d )->get(); }
inline double imag( dc_data *d )
{ return ( ( dc_int * )d )->get(); }


dc_data *sum( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    cerr << "sum -- zero args. returning <nil>\n";
    return nil;
  }

  dc_data *result = nil;
  dc_data *d;
  //  dc_function *old_f; /* kept for error checking */
  if( ( d = ( /*old_f =*/ args.inf( current ) )->evaluate() ) == nil ) return nil;
  assign( result, *d );
  current = args.succ( current );

  dc_data *temp = nil;
  while( current ) {
    dc_func *f = ( args.inf( current ) );
    if( ( d = f->evaluate() ) == nil ) {
      run_time_error( *( args.inf( current ) ), "sum" );
      delete( result );
      return nil;
    }
    if( ( temp = op_add( *result, *d ) ) == nil ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "sum -- failed to add " << *d << " of " << *f << " from "
	     << f->get_owner()->full_type() << " to " << *result << "\n";
      }
      delete( result );
      delete( d );
      return nil;
    }
    result = nil;
    assign( result, *temp );
    current = args.succ( current );
    //    old_f = f;
  }

  return result;
}

dc_data *product( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    cerr << "product -- zero args. returning <nil>\n";
    return nil;
  }

  dc_data *result = nil;
  dc_data *d = ( args.inf( current ) )->evaluate();
  if( d == nil ) return nil;
  assign( result, *d );

  dc_data *temp;
  while( ( current = args.succ( current ) ) != nil ) {
    if( ( d = ( args.inf( current ) )->evaluate() ) == nil ) {
      delete( result );
      return nil;
    }
    temp = &( *result * *d );
    result = nil;
    assign( result, *temp );
  }

  return result;
}

/* takes two args */
dc_data *dot_product( const f_list &args ) {
  if( args.size() < 2 ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "dot_product -- requires 2 args. returning <nil>\n";
    }
    return nil;
  }

  list_item arg0 = args.first();
  list_item arg1 = args.succ( arg0 );
  dc_data *d1 = args.inf( arg0 )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = args.inf( arg1 )->evaluate();
  if( d2 == nil ) return nil;

  return &( d1->dot( *d2 ) );
}

dc_data *negate( dc_data *id ) {
  if( !id )
    return nil;

  dc_data *result;
  switch( id->sub_type() ) {
  case Real_t : 
    ( ( dc_real * )id )->set( -( ( dc_real * )id )->get() );
    result = id;
    break;
  case Distrib_t :  
    result = new dc_real( -( ( dc_real * )id )->get() );
    delete( id );
    break;
  case Int_t :
    ( ( dc_int * )id )->set( -( ( dc_int * )id )->get() );
    result = id;
    break;
  case Rect_Matrix_t :
    ( ( dc_rect_matrix * )id )->set( ( ( dc_rect_matrix * )id )->get() * -1 );
    result = id;
    break;
  case Vector_t :
    ( ( dc_vector * )id )->set( ( ( dc_vector * )id )->get() * -1 );
    result = id;
    break;
  case Triple_t :
    ( ( dc_triple * )id )->set( ( ( dc_triple * )id )->get() * -1 );
    result = id;
    break;
  default : if( id->is_temporary() ) delete( id ); return nil;
  }

  return result;
}

dc_data *neg_sum( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    cerr << "neg_sum -- zero args. returning <nil>\n";
    return nil;
  }

  dc_data *result;
  if( ( result = ( args.inf( current ) )->evaluate() ) == nil ) {
    return nil;
  }
  current = args.succ( current );

  dc_data *temp = nil;
  if( current ) {
    do {
      dc_data *d;
      dc_func *f = ( args.inf( current ) );
      if( ( d = f->evaluate() ) == nil ) {
	run_time_error( *( args.inf( current ) ), "neg_sum" );
	delete( result );
	return nil;
      }
      if( ( temp = op_subtract( *result, *d ) ) == nil ) {
	cerr << "neg_sum -- failed to subtract " << *d << " of "
	     << f->get_owner()->full_type() << "\n";
	delete( result );
	delete( d );
	return nil;
      }
      result = nil;
      assign( result, *temp );
      current = args.succ( current );
    } while( current );
  } else return negate( result );
    
  return result;
}

dc_data *int_div( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    cerr << "int_div -- zero args. returning <nil>\n";
    return nil;
  }

  dc_data *result = ( args.inf( current ) )->evaluate();
  if( result == nil ) return nil;
  current = args.succ( current );

  dc_data *temp = nil;
  while( current ) {
    dc_data *d = ( args.inf( current ) )->evaluate();
    if( d == nil ) {
      delete( result );
      return nil;
    }
    temp = &( *result / *d );
    result = nil;
    assign( result, *temp );
    current = args.succ( current );
  }
    
  return result;
}

dc_data *divide( dc_data *d1, dc_data *d2 ) {
  dc_data *rVal = nil;
  switch( d1->type() ) {
  case Int_t :
    switch( d2->type() ) {
    case Int_t :
      
      rVal = new dc_real( ( ( double )( ( dc_int * )d1 )->get() ) / 
			  ( ( double )( ( dc_int * )d2 )->get() ) );
      break;
    case Real_t :
      rVal = new dc_real( ( ( dc_int * )d1 )->get() / 
			  ( ( dc_real * )d2 )->get() );
      break;
    default : ;
    }
    break;
  case Matrix_t :
    if( !d1->is_valid() ) break;
    switch( d1->sub_type() ) {
    case Rect_Matrix_t :
      switch( d2->type() ) {
      case Int_t :
	return new dc_rect_matrix( ( ( dc_rect_matrix * )d1 )->get() *
				   ( 1.0 / ( ( ( dc_int * )d2 )->get() ) ) );
	break;
      case Real_t :
	return new dc_rect_matrix( ( ( dc_rect_matrix * )d1 )->get() *
				   ( 1.0 / ( ( ( dc_real * )d2 )->get() ) ) );
	break;
      default : ;
      }
      break;
    case Vector_t :
      switch( d2->type() ) {
      case Int_t :
	return new dc_rect_matrix( ( ( dc_vector * )d1 )->get() * 
				     ( 1.0 / ( ( ( dc_int * )d2 )->get() ) ) );
	break;
      case Real_t :
	return new dc_rect_matrix( ( ( dc_vector * )d1 )->get() * 
				     ( 1.0 / ( ( ( dc_int * )d2 )->get() ) ) );
	break;
      default : ;
      }
      break;
    default : ;
    }
    break;
  case Real_t :
    switch( d2->type() ) {
    case Int_t :
      rVal = new dc_real( ( ( dc_real * )d1 )->get() / 
			  ( ( dc_int * )d2 )->get() );
      break;
    case Real_t :
      rVal = new dc_real( ( ( dc_real * )d1 )->get() / 
			  ( ( dc_real * )d2 )->get() );
      break;
    default : ;
    }
    break;
  default : ;
  }
  if( !rVal ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "divide -- operation not defined on " << d1->type_string() 
	   << " and " << d2->type_string() << "\n";
    }
    exit( 1 );
  } 
  ( ( dc_udata * )rVal )->set_units( ( ( dc_udata * )d1 )->get_units() );
  ( ( dc_udata * )rVal )->get_units() /= ( ( dc_udata * )d2 )->get_units();
  return rVal;
}

dc_data *inv_prod( const f_list &args ) {
  list_item current = args.first();
  
  if( !current ) {
    cerr << "inv_prod -- zero args. returning <nil>\n";
    return nil;
  }
  
  dc_data *result = ( args.inf( current ) )->evaluate();
  if( result == nil ) return nil;
  current = args.succ( current );
  
  dc_data *d1, *d2;
  while( current ) {
    d1 = result;
    d2 = ( args.inf( current ) )->evaluate();
    if( d2 == nil ) return nil;
    result = divide( d1, d2 );
    delete( d1 );
    delete( d2 );
    current = args.succ( current );
  }
    
  return result;
}

dc_data *magnitude( const f_list &args ) { 
  list_item arg0 = args.first();
  if( !arg0 ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "magnitude -- zero args.  returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = ( args.inf( arg0 ) )->evaluate();
  if( d == nil ) return nil;

  return &( d->mag() );
}

dc_data *mod( const f_list &args ) {
  if( args.size() < 2 ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "mod -- requires 2 args. returning <nil>\n";
    }
    return nil;
  }

  list_item arg0 = args.first();
  list_item arg1 = args.succ( arg0 );
  dc_data *d1 = args.inf( arg0 )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = args.inf( arg1 )->evaluate();
  if( d2 == nil ) return nil;
  if( d1->type() == Int_t && d2->type() == Int_t) {
    return ( dc_data * )new dc_int( ( ( ( dc_int * )d1 )->get() %
				    ( ( dc_int * )d2 )->get() ) );
  }
  
  double x, y;
  switch( d1->type() ) {
  case Real_t :
    x = rmag( d1 );
    break;
  case Int_t :
    x = imag( d1 );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "mod -- invalid argument type " << d1->type_string()
	   << ". type must be scalar. returning <nil>\n";
    }
    delete( d1 );
    return nil;
  }
  switch( d2->type() ) {
  case Real_t :
    y = rmag( d2 );
    break;
  case Int_t :
    y = imag( d2 );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "mod -- invalid argument type " << d2->type_string()
	   << ". type must be scalar. returning <nil>\n";
    }
    delete( d1 );
    delete( d2 );
    return nil;
  }
  delete( d2 );

  dc_real *result = new dc_real( fmod( x, y ) );
  result->set_units( ( ( dc_udata * )d1 )->get_units() );

  delete( d1 );

  return ( dc_data * )result;  
}

dc_data *equal( const f_list &args ) {
  list_item a1 = args.first();
  list_item a2 = args.succ( a1 );

  if( ( !a1 ) || ( !a2 ) ) { 
    cerr << "equal -- nargs < 2. failed\n";
    return nil;
  }

  dc_data *d1 = ( args.inf( a1 ) )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = ( args.inf( a2 ) )->evaluate();
  if( d2 == nil ) return nil;

  dc_data *result = &( *d1 == *d2 );
  a1 = a2;
  a2 = args.succ( a2 );

  dc_data *temp = nil;
  while( a2 ) {
    dc_data *d1 = ( args.inf( a1 ) )->evaluate();
    if( d1 == nil ) return nil;
    dc_data *d2 = ( args.inf( a2 ) )->evaluate();
    if( d2 == nil ) return nil;
    temp = &( *result && ( *d1 == *d2 ) );
    result = nil;
    assign( result, *temp );
    a1 = a2;
    a2 = args.succ( a2 );
  }

  return result;
}

dc_data *not_equal( const f_list &args ) {
  list_item a1 = args.first();
  list_item a2 = args.succ( a1 );

  if( ( !a1 ) || ( !a2 ) ) { 
    cerr << "not_equal -- nargs < 2. failed\n";
    return nil;
  }

  dc_data *d1 = ( args.inf( a1 ) )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = ( args.inf( a2 ) )->evaluate();
  if( d2 == nil ) return nil;

  dc_data *result = &( *d1 != *d2 );
  a1 = a2;
  a2 = args.succ( a2 );

  dc_data *temp = nil;
  while( a2 ) {
    dc_data *d1 = ( args.inf( a1 ) )->evaluate();
    if( d1 == nil ) return nil;
    dc_data *d2 = ( args.inf( a2 ) )->evaluate();
    if( d2 == nil ) return nil;
    temp = &( *result && ( *d1 != *d2 ) );
    result = nil;
    assign( result, *temp );
    a1 = a2;
    a2 = args.succ( a2 );
  }

  return result;
}

dc_data *less_than( const f_list &args ) { 
  list_item a1 = args.first();
  list_item a2 = args.succ( a1 );

  if( ( !a1 ) || ( !a2 ) ) {
    cerr << "less_than -- nargs < 2. returning <nil>\n";
    return nil;
  }

  dc_data *d1 = ( args.inf( a1 ) )->evaluate();
  dc_data *d2 = ( args.inf( a2 ) )->evaluate();
  if( !( d1 && d2 ) ) return nil;
  
  if( !check_units( d1, d2, "less_than" ) ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "less_than -- compare of " << *d1 << " and " << *d2 <<" failed\n";
    }
    return nil;
  }

  bool result = d1->lessthan( *d2 );

  a1 = a2;
  a2 = args.succ( a2 );
  
  while( result && a2 ) {
    d1 = ( args.inf( a1 ) )->evaluate();
    d2 = ( args.inf( a2 ) )->evaluate();
    if( !( d1 && d2 ) ) return nil;
    if( !check_units( d1, d2, "less_than" ) ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "less_than -- compare of " << *d1 << " and " << *d2 
	     << "failed\n";
      }
      return nil;
    }
    result = d1->lessthan( *d2 );

    a1 = a2;
    a2 = args.succ( a2 );
  }

  return new dc_boolean( result );
}

dc_data *greater_than( const f_list &args ) { 
  list_item a1 = args.first();
  list_item a2 = args.succ( a1 );

  if( ( !a1 ) || ( !a2 ) ) {
    cerr << "greater_than -- nargs < 2. returning <nil>\n";
    return nil;
  }

  dc_data *d1 = ( args.inf( a2 ) )->evaluate();
  dc_data *d2 = ( args.inf( a1 ) )->evaluate();
  if( !( d1 && d2 ) ) return nil;

  if( !check_units( d1, d2, "less_than" ) ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "greater_than -- compare of " << *d1 << " and " << *d2 
	   << "failed\n";
    }
    return nil;
  }
  
  bool result = d1->lessthan( *d2 );
  a1 = a2;
  a2 = args.succ( a2 );
  
  while( result && a2 ) {
    d1 = ( args.inf( a2 ) )->evaluate();
    d2 = ( args.inf( a1 ) )->evaluate();
    if( !( d1 && d2 ) ) return nil;
    if( !check_units( d1, d2, "less_than" ) ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "greater_than -- compare of " << *d1 << " and " << *d2 
	     << "failed\n";
      }
      return nil;
    }

    result = result && d1->lessthan( *d2 );  

    a1 = a2;
    a2 = args.succ( a2 );
  }

  return new dc_boolean( result );
}

dc_data *less_equal( const f_list &args ) {
  list_item a1 = args.first();
  list_item a2 = args.succ( a1 );

  if( ( !a1 ) || ( !a2 ) ) {
    cerr << "less_equal -- nargs < 2. returning <nil>\n";
    return nil;
  }

  dc_data *d1 = ( args.inf( a2 ) )->evaluate();
  dc_data *d2 = ( args.inf( a1 ) )->evaluate();
  if( !( d1 && d2 ) ) return nil;
  if( !check_units( d1, d2, "less_than" ) ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "less_equal -- compare of " << *d1 << " and " << *d2 
	   << "failed\n";
    }
    return nil;
  }
  
  bool result = d1->lessthan( *d2 );
  a1 = a2;
  a2 = args.succ( a2 );
  
  while( result && a2 ) {
    d1 = ( args.inf( a2 ) )->evaluate();
    d2 = ( args.inf( a1 ) )->evaluate();
    if( !( d1 && d2 ) ) return nil;
    if( !check_units( d1, d2, "less_than" ) ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "less_equal -- compare of " << *d1 << " and " << *d2 
	     << "failed\n";
      }
      return nil;
    }

    result = result && d1->lessthan( *d2 );
    a1 = a2;
    a2 = args.succ( a2 );
  }

  return new dc_boolean( !result );
}

dc_data *greater_equal( const f_list &args ) {
  list_item a1 = args.first();
  list_item a2 = args.succ( a1 );

  if( ( !a1 ) || ( !a2 ) ) {
    cerr << "greater_equal -- nargs < 2. returning <nil>\n";
    return nil;
  }

  dc_data *d1 = ( args.inf( a1 ) )->evaluate();
  dc_data *d2 = ( args.inf( a2 ) )->evaluate();
  if( !( d1 && d2 ) ) return nil;
  if( !check_units( d1, d2, "less_than" ) ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "greater_equal -- compare of " << *d1 << " and " << *d2 
	   << "failed\n";
    }
    return nil;
  }
  
  bool result = d1->lessthan( *d2 );
  a1 = a2;
  a2 = args.succ( a2 );
  
  while( result && a2 ) {
    d1 = ( args.inf( a1 ) )->evaluate();
    d2 = ( args.inf( a2 ) )->evaluate();
    if( !( d1 && d2 ) ) return nil;
    if( !check_units( d1, d2, "less_than" ) ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "greater_equal -- compare of " << *d1 << " and " << *d2 
	     << "failed\n";
      }
      return nil;
    }

    result = result && d1->lessthan( *d2 );
    a1 = a2;
    a2 = args.succ( a2 );
  }

  return new dc_boolean( !result );
}

dc_data *not( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    return nil;
  }
  
  dc_boolean *b = ( dc_boolean * )args.inf( arg0 )->evaluate();
  if( b == nil || b->sub_type() != Boolean_t ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "not -- illegal arg to not\n";
    }
    return nil;
  }

  b->set( !b->get() );
  return b;
}

dc_data *conditional( const f_list &args ) {
  list_item if_arg = args.first();
  if( if_arg == nil ) {
    cerr << "conditional -- zero args. exiting\n";
    exit( 1 );
  }

  list_item then;
  while( if_arg ) {
    then = args.succ( if_arg );
    dc_data *d = ( args.inf( if_arg ) )->evaluate();
    if( then == nil )
      return d;
    if( d == nil || d->sub_type() != Boolean_t ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "conditional -- wrong type " 
	     << ( d ? d->full_type() : string( "<nil>" ) )
	     << ". Boolean expected.  returning <nil>\n";
      }
      return nil;
    }
    if( ( ( dc_boolean * )d )->get() ) {
      return ( args.inf( then ) )->evaluate();
    }
    if_arg = args.succ( then );
  }
  return ( args.inf( then ) )->evaluate();
}

dc_data *and( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "and -- zero args. returning <nil>\n";
    }
    return nil;
  }

  while( 1 ) {
    dc_data *inf = ( args.inf( current ) )->evaluate();
    if( inf == nil || inf->type() != Boolean_t ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "and -- non_boolean arg.  returning <nil>\n";
      }
      return nil;
    }
    if( !( ( ( dc_boolean * )inf )->get() ) ) {
      return inf;
    }

    current = args.succ( current );
    if( current ) 
      delete( inf );
    else
      return inf;
  }
}

dc_data *or( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "or -- zero args. returning <nil>\n";
    }
    return nil;
  }

  while( 1 ) {
    dc_data *inf = ( args.inf( current ) )->evaluate();
    if( inf == nil || inf->type() != Boolean_t ) {
      dc_trace( TRACE_ERROR ) {
	cerr << "or -- non_boolean arg.  returning <nil>\n";
      }
      return nil;
    }
    if( ( ( dc_boolean * )inf )->get() ) {
      return inf;
    }

    current = args.succ( current );
    if( current ) 
      delete( inf );
    else
      return inf;
  }
}

bool is_angle( const dc_data &d ) {
  if( d.has_units() ) {
    unit_vec *uv = &( ( ( dc_udata * )&d )->get_units() );
    int i;
    for( i = 0 ; i < uAngle ; i++ ) {
      if( ( *uv )[i] ) return false;
    }
    int angle_pwr = ( *uv )[i++];
    if( angle_pwr < 0 || angle_pwr > 1 ) 
      return false;
    for( ; i < num_basic_units ; i++ ) {
      if( ( *uv )[i] ) return false;
    }
    return true;
  }
  return false;
}

bool is_unitless( dc_data *d ) {
  if( d->has_units() ) {
    unit_vec *uv = &( ( ( dc_udata * )d )->get_units() );
    for( int i = 0 ; i < num_basic_units ; i++ ) {
      if( ( *uv )[i] ) return false;
    }
  }
  return true;
}

/* trig functions take 1 argument */
dc_data *Sin( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "sin -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  if( !is_angle( *d ) ) { delete( d ); return nil; }
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "sin -- invalid argument type " << d->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( sin( n ) );
}

dc_data *Cos( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "cos -- zero args. returning <nil>\n";
    }
    return nil;
  }

  dc_data *d = args.inf( arg0 )->evaluate();  
  if( d == nil ) {
    return nil;
  }
  if( !is_angle( *d ) ) { 
    dc_trace( TRACE_ERROR ) {
      cerr << "cos -- value passed was not an angle.  was " << *d << "\n";
    }
    delete( d );
    return nil; 
  }
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_ERROR ) {
      cerr << "cos -- invalid argument type " << d->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( cos( n ) );
}

dc_data *Tan( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "tan -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  if( !is_angle( *d ) ) { 
    dc_trace( TRACE_ERROR ) {
      cerr << "tan -- tried to take tangent of non angle " << *d << "\n";
    }
    delete( d ); return nil; 
  }
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "tan -- invalid argument type " << d->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( tan( n ) );
}

dc_data *Asin( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "asin -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  if( !is_unitless( d ) ) { delete( d ); return nil; }
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "asin -- invalid argument type " << d->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  dc_real *R = new dc_real( asin( n ) );
  ( R->get_units() )[uAngle] = 1;
  return ( dc_data * )R;
}

dc_data *Acos( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "acos -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  if( !is_unitless( d ) ) { delete( d ); return nil; }  
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "acos -- invalid argument type " << d->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  dc_real *R = new dc_real( acos( n ) );
  ( R->get_units() )[uAngle] = 1;
  return ( dc_data * )R;
}

dc_data *Atan( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "atan -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  if( !is_unitless( d ) ) { delete( d ); return nil; }
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "atan -- invalid argument type " << d->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  dc_real *R = new dc_real( atan( n ) );
  ( R->get_units() )[uAngle] = 1;
  return ( dc_data * )R;
}

/* takes two args */
dc_data *Atan2( const f_list &args ) {
  if( args.size() < 2 ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "atan2 -- requires 2 args. returning <nil>\n";
    }
    return nil;
  }

  list_item arg0 = args.first();
  list_item arg1 = args.succ( arg0 );
  dc_data *d1 = args.inf( arg0 )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = args.inf( arg1 )->evaluate();
  if( d2 == nil ) return nil;

  if( !equiv_units( d1, d2 ) ) { delete( d1 ); delete( d2 ); return nil; }  
  double x, y;
  switch( d1->type() ) {
  case Real_t :
    x = rmag( d1 );
    break;
  case Int_t :
    x = imag( d1 );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "atan2 -- invalid argument type " << d1->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d1 );
    return nil;
  }
  delete( d1 );
  switch( d2->type() ) {
  case Real_t :
    y = rmag( d2 );
    break;
  case Int_t :
    y = imag( d2 );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "atan2 -- invalid argument type " << d2->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d2 );
    return nil;
  }
  delete( d2 );

  dc_real *R = new dc_real( atan2( x, y ) );
  ( R->get_units() )[uAngle] = 1;
  return ( dc_data * )R;
}

dc_data *Hypot( const f_list &args ) {
  if( args.size() < 2 ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "hypot -- requires 2 args. returning <nil>\n";
    }
    return nil;
  }

  list_item arg0 = args.first();
  list_item arg1 = args.succ( arg0 );
  dc_data *d1 = args.inf( arg0 )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = args.inf( arg1 )->evaluate();
  if( d2 == nil ) return nil;

  if( !equiv_units( d1, d2 ) ) { delete( d1 ); delete( d2 ); return nil; } 
  double x, y;
  switch( d1->type() ) {
  case Real_t :
    x = ( ( dc_real * )d1 )->get();
    break;
  case Int_t :
    x = ( ( dc_int * )d1 )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "hypot -- invalid argument type " << d1->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d1 );
    return nil;
  }
  delete( d1 );
  switch( d2->type() ) {
  case Real_t :
    y = ( ( dc_real * )d2 )->get();
    break;
  case Int_t :
    y = ( ( dc_int * )d2 )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "hypot -- invalid argument type " << d2->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d2 );
    return nil;
  }
  delete( d2 );

  dc_real *r = new dc_real( hypot( x, y ) );
  r->set_units( ( ( dc_udata * )d1 )->get_units() );

  return ( dc_data * )r;
}

dc_data *Min( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    cerr << "min -- zero args. returning <nil>\n";
    return nil;
  }

  /* assume type of first */
  dc_data *result = args.inf( current )->evaluate();
  if( result == nil ) return nil;
  dc_data *c;

  while( 1 ) {
    current = args.succ( current );
    if( !current ) break;
    c = args.inf( current )->evaluate();
    if( c == nil ) return nil;
    switch( result->type() ) {
    case Int_t :
      switch( c->type() ) {
      case Int_t :
	if( imag( c ) < imag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      case Real_t :
	if( rmag( c ) < imag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      default:
	dc_trace( TRACE_ERROR ) {
	  cerr << "min -- all args must be int or real. returning <nil>.\n";
	}
	delete( c );
	return nil;
      }
      break;
    case Real_t :
      switch( c->type() ) {
      case Int_t :
	if( imag( c ) < rmag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      case Real_t :
	if( rmag( c ) < rmag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      default :
	dc_trace( TRACE_ERROR ) {
	  cerr << "min -- all args must be int or real. returning <nil>.\n";
	}
	delete( c );
	return nil;
      }
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "min -- all args must be int or real. returning <nil>.\n";
      }
      delete( c );
      return nil;
    }
  }

  return result;
}

dc_data *Max( const f_list &args ) {
  list_item current = args.first();

  if( !current ) {
    cerr << "max -- zero args. returning <nil>\n";
    return nil;
  }

  /* assume type of first */
  dc_data *result = args.inf( current )->evaluate();
  if( result == nil ) return nil;
  dc_data *c;

  while( 1 ) {
    current = args.succ( current );
    if( !current ) break;
    c = args.inf( current )->evaluate();
    if( c == nil ) return nil;
    switch( result->type() ) {
    case Int_t :
      switch( c->type() ) {
      case Int_t :
	if( imag( c ) > imag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      case Real_t :
	if( rmag( c ) > imag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      default :
	dc_trace( TRACE_ERROR ) {
	  cerr << "max -- all args must be int or real. returning <nil>.\n";
	}
	return nil;
      }
      break;
    case Real_t :
      switch( c->type() ) {
      case Int_t :
	if( imag( c ) > rmag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      case Real_t :
	if( rmag( c ) > rmag( result ) ) {
	  delete( result );
	  result = c;
	} else {
	  delete( c );
	}
	break;
      default :
	dc_trace( TRACE_ERROR ) {
	  cerr << "max -- all args must be int or real. returning <nil>.\n";
	}
	delete( c );
	return nil;
      }
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "max -- all args must be int or real. returning <nil>.\n";
      }
      delete( c );
      return nil;
    }
  }

  return result;
}

dc_data *avg( const f_list &args ) { 
  dc_data *total = sum( args );
  dc_data *n = count( args );
  if( total == nil ) return nil;
  if( n == nil ) {
    delete( total );
    return nil;
  }
  dc_data *avg = divide( total, n );
  delete( total );
  delete( n );
  return avg;
}

dc_data *mean( const f_list &args ) {
  return avg( args ); /*REPLACE */
}

dc_data *count( const f_list &args ) { 
  return ( dc_data * )new dc_int( args.size() );
}

dc_data *rms( const f_list & ) { return nil; }

dc_data *poly( const f_list &args ) { 
  int size = args.size();
  if( !args.size() ) return nil;
  
  dc_data *d = args.head()->evaluate();
  if( d == nil ) return nil;
  double x;
  switch( d->type() ) {
  case Real_t :
    x = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    x = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "poly -- invalid argument type " << d->type_string()
	   << ". type must be real or int. returning <nil>\n";
    }
    delete( d );
    return nil;
  }
  delete( d );
  
  list_item li = args.succ( args.first() );
  double total = 0;
  int i = 2;
  while( li ) {
    d = args.inf( li )->evaluate();
    if( d == nil ) return nil;
    double n;
    switch( d->type() ) {
    case Real_t :
      n = ( ( dc_real * )d )->get();
      break;
    case Int_t :
      n = ( ( dc_int * )d )->get();
      break;
    default :
      dc_trace( TRACE_WARNING ) {
	cerr << "poly -- invalid argument type " << d->type_string()
	     << ". type must be real or int.\n";
      }
      delete( d );
      return nil;
    }
    total += pow( n, size - i );
  }
  return new dc_real( total );
}

dc_data *Exp( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "exp -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "exp -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( exp( n ) );
}

dc_data *Expm1( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "expm1 -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "expm1 -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( expm1( n ) );
}

dc_data *Log( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "log -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "log -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( log( n ) );
}

dc_data *Log1p( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "log1p -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "log1p -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( log1p( n ) );
}

dc_data *Log10( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "log10 -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = rmag( d );
    break;
  case Int_t :
    n = imag( d );
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "log10 -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  delete( d );

  return ( dc_data * )new dc_real( log10( n ) );
}

/* takes two args */
dc_data *Pow( const f_list &args ) {
  if( args.size() < 2 ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "pow -- requires 2 args. returning <nil>\n";
    }
    return nil;
  }

  list_item arg0 = args.first();
  list_item arg1 = args.succ( arg0 );
  dc_data *d1 = args.inf( arg0 )->evaluate();
  if( d1 == nil ) return nil;
  dc_data *d2 = args.inf( arg1 )->evaluate();
  if( d2 == nil ) return nil;
  double x, y;
  switch( d1->type() ) {
  case Real_t :
    x = ( ( dc_real * )d1 )->get();
    break;
  case Int_t :
    x = ( ( dc_int * )d1 )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "pow -- invalid argument type " << d1->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d1 );
    return nil;
  }

  switch( d2->type() ) {
  case Real_t :
    y = ( ( dc_real * )d2 )->get();
    break;
  case Int_t :
    y = ( ( dc_int * )d2 )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "pow -- invalid argument type " << d2->type_string()
	   << ". type must be scalar.returning <nil>\n";
    }
    delete( d1 );
    delete( d2 );
    return nil;
  }
  delete( d2 );

  dc_real *r = new dc_real( pow( x, y ) );
  
  r->set_units( ( ( dc_udata * )d1 )->get_units() );
  ( r->get_units() ) ^= y;
  delete( d1 );

  return r;
}

dc_data *Sqrt( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "sqrt -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();    
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "sqrt -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  dc_real *r = new dc_real( sqrt( n ) );

  r->set_units( ( ( dc_udata * )d )->get_units() );
  ( r->get_units() ) ^= (1./2.);
  delete( d );

  return r;
}

dc_data *Cbrt( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "cbrt -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "cbrt -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  dc_real *r = new dc_real( cbrt( n ) );

  r->set_units( ( ( dc_udata * )d )->get_units() );
  ( r->get_units() ) ^= (1./3.);
  delete( d );

  return r;
}

dc_data *Ceil( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "ceil -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "ceil -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  dc_int *i = new dc_int( ( long int )ceil( n ) );
  i->set_units( ( ( dc_udata * )d )->get_units() );

  delete( d );

  return i;
}

dc_data *Floor( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "floor -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "floor -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  dc_int *i = new dc_int( ( long int )floor( n ) );
  i->set_units( ( ( dc_udata * )d )->get_units() );

  delete( d );

  return i;
}

dc_data *Round( const f_list &args ) {
  list_item arg0 = args.first();
  if( arg0 == nil ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "round -- zero args. returning <nil>\n";
    }
    return nil;
  }
  
  dc_data *d = args.inf( arg0 )->evaluate();
  if( d == nil ) return nil;
  double n;
  switch( d->type() ) {
  case Real_t :
    n = ( ( dc_real * )d )->get();
    break;
  case Int_t :
    n = ( ( dc_int * )d )->get();
    break;
  default :
    dc_trace( TRACE_WARNING ) {
      cerr << "round -- invalid argument type " << d->type_string()
	   << ". type must be real or int.\n";
    }
    delete( d );
    return nil;
  }
  dc_int *i = new dc_int( ( long int )rint( n ) );
  i->set_units( ( ( dc_udata * )d )->get_units() );

  delete( d );

  return i;
}

dc_data *dist_min( const f_list &args ) {
  list_item arg = args.first();
  dc_data *dist;
  if( !arg || ( ( dist = ( args.inf( arg ) )->evaluate() )->sub_type() 
		!= Distrib_t ) ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "dist_min -- bad dist or dist not specified.  returning <nil>\n";
    }
    if( dist ) delete( dist );
    return nil;
  }
  dc_real *r = new dc_real( ( ( dc_distrib * )dist )->get_min() );
  r->set_units( ( ( dc_udata * )dist )->get_units() );
  delete( dist );
  return r;
}

dc_data *dist_max( const f_list &args ) {
  list_item arg = args.first();
  dc_data *dist;
  if( !arg || ( ( dist = ( args.inf( arg ) )->evaluate() )->sub_type() 
		!= Distrib_t ) ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "dist_max -- bad dist or dist not specified.  returning <nil>\n";
    }
    if( dist ) delete( dist );
    return nil;
  }

  dc_real *r = new dc_real( ( ( dc_distrib * )dist )->get_max() );
  r->set_units( ( ( dc_udata * )dist )->get_units() );
  delete( dist );
  return r;
}

dc_data *dist_mean( const f_list &args ) {
  list_item arg = args.first();
  dc_data *dist;
  if( !arg || ( ( dist = ( args.inf( arg ) )->evaluate() )->sub_type() 
		!= Distrib_t ) ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "dist_mean -- bad arg.  returning <nil>\n";
    }
    if( dist ) delete( dist );
    return nil;
  }

  dc_real *r = new dc_real( ( ( dc_distrib * )dist )->get_mean() );
  r->set_units( ( ( dc_udata * )dist )->get_units() );
  delete( dist );
  return r;
}

dc_data *dist_stddev( const f_list &args ) {
  list_item arg = args.first();
  dc_data *dist;
  if( !arg || ( ( dist = ( args.inf( arg ) )->evaluate() )->sub_type() 
		!= Distrib_t ) ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "dist_stddev -- bad arg.  returning <nil>\n";
    }
    if( dist ) delete( dist );
    return nil;
  }

  dc_real *r = new dc_real( ( ( dc_distrib * )dist )->
					 get_stddev() );
  r->set_units( ( ( dc_udata * )dist )->get_units() );
  delete( dist );
  return r;
}

dc_data *dist_sample( const f_list &args ) {
  list_item arg = args.first();
  dc_data *dist;
  if( !arg || ( ( dist = ( args.inf( arg ) )->evaluate() )->sub_type() 
		!= Distrib_t ) ) {
    dc_trace( TRACE_WARNING ) {
      cerr << "dist_sample -- bad arg.  returning <nil>\n";
    }
    if( dist ) delete( dist );
    return nil;
  }

  dc_real *r = new dc_real( ( ( dc_distrib * )dist )->get_sample() );
  r->set_units( ( ( dc_udata * )dist )->get_units() );
  delete( dist );
  return r;
}

dc_data *gdistrib( const f_list &args ) {
  int nargs = args.size();
  if( nargs < 2 || nargs > 3 ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "gdistrib -- called with invalid number of arguments " << nargs 
	   << "\n\t2 args -> mean, stddev\t3 args -> mean, min, max\n";
    }
    exit( 1 );
  }
  if( nargs == 2 ) {
    double Mean, stddev;
    list_item arg = args.first();
    dc_data *d = ( args.inf( arg ) )->evaluate();
    switch( d->type() ) {
    case Real_t :
      Mean = ( ( dc_real * )d )->get();
      break;
    case Int_t :
      Mean = ( double )( ( ( dc_int * )d )->get() );
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "gdistrib -- non-scalar type \"" << d->type_string()
	     << "\" supplied for mean value\n";
      }
      delete( d );
      exit( 1 );
    }
    delete( d );
    arg = args.last();
    d = ( args.inf( arg ) )->evaluate();
    switch( d->type() ) {
    case Real_t :
      stddev = ( ( dc_real * )d )->get();
      break;
    case Int_t :
      stddev = ( double )( ( ( dc_int * )d )->get() );
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "gdistrib -- non-scalar type \"" << d->type_string()
	     << "\" supplied for standard deviation\n";
      }
      delete( d );
      exit( 1 );
    }
    dc_distrib *dist = new dc_distrib( Mean, stddev );
    dist->set_units( ( ( dc_udata * )d )->get_units() );
    delete( d );
    return dist;
  } else {
    double Mean, Min, Max;
    list_item arg = args.first();
    dc_data *d = ( args.inf( arg ) )->evaluate();
    switch( d->type() ) {
    case Real_t :
      Mean = ( ( dc_real * )d )->get();
      break;
    case Int_t :
      Mean = ( double )( ( ( dc_int * )d )->get() );
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "gdistrib -- non-scalar type \"" << d->type_string()
	     << "\" supplied for mean value\n";
      }
      delete( d );
      exit( 1 );
    }
    delete( d );
    arg = args.succ( arg );
    d = ( args.inf( arg ) )->evaluate();
    switch( d->type() ) {
    case Real_t :
      Min = ( ( dc_real * )d )->get();
      break;
    case Int_t :
      Min = ( double )( ( ( dc_int * )d )->get() );
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "gdistrib -- non-scalar type \"" << d->type_string()
	     << "\" supplied for min value\n";
      }
      delete( d );
      exit( 1 );
    }
    delete( d );
    arg = args.succ( arg );
    d = ( args.inf( arg ) )->evaluate();
    switch( d->type() ) {
    case Real_t :
      Max = ( ( dc_real * )d )->get();
      break;
    case Int_t :
      Max = ( double )( ( ( dc_int * )d )->get() );
      break;
    default :
      dc_trace( TRACE_ERROR ) {
	cerr << "gdistrib -- non-scalar type \"" << d->type_string()
	     << "\" supplied for max value\n";
      }
      delete( d );
      exit( 1 );
    }
    dc_distrib *dist = new dc_distrib( Mean, Min, Max );
    dist->set_units( ( ( dc_udata * )d )->get_units() );
    delete( d );
    return dist;
  }
}

dc_data *gvec( const f_list &args ) {
  int n = args.size();
  if( !n ) return nil;

  double *d_arr;
  dc_matrix *m;
  if( n == 3 ) {
    m = new dc_triple();
  } else {
    m = new dc_vector( n );
  }
  d_arr = m->get_store();

  int i = 0;
  bool first = true;
  for( list_item li = args.first(); li ; li = args.succ( li ) ) {
    dc_data *d = args.inf( li )->evaluate();
    if( !d ) return nil;

    switch( d->type() ) {
    case Int_t :
      d_arr[i++] = ( double )( ( dc_int * )d )->get();
      break;;
    case Real_t :
      d_arr[i++] = ( ( dc_real * )d )->get();
      break;;
    default :
      delete( d );
      delete( m );
      return nil;
    }
    if( first ) {
      m->set_units( ( ( dc_udata * )d )->get_units() );
      first = false;
    }

    delete( d );
  }

  return ( dc_data * )m;
}

dc_data *assignment( const f_list &args ) {
  cerr << "********************************ASSIGNMENT*************************\n";

  if( args.size() != 2 ) {
    dc_trace( TRACE_ERROR ) {
      cerr << "assignment -- must have 2 args.  number is " 
	   << args.size() << "\n";
    }
    exit( 1 );
  }
  
  dc_func *dest = args.head();
  dc_data *src = ( args.tail() )->evaluate();
  if( dest->assign( src ) ) { /* takes care of deleting src if successful */
    dc_trace( TRACE_ERROR ) {
      cerr << "assignment -- failed\n";
    }
    delete( src );
    exit( 1 );
  }
  cerr << *dest << " TO " << *src << "\n";

  return dest->evaluate();
}

/* TYPING FUNCTIONS **********************************************/

inline bool is_scalar( dc_type T ) {
  return T == Real_t || T == Int_t || T == Distrib_t;
}

dc_type t_2rl( const f_list &args ) { 
  /* takes two scalar returns a real */
  if( args.size() != 2 ) return Undef_t;
  if( !is_scalar( ( args.head() )->get_rtype() ) || 
      !is_scalar( ( args.tail() )->get_rtype() ) ) return Undef_t;
  return Real_t;
}

dc_type t_rl( const f_list &args ) {
  /* takes one scalar returns a real */
  if( args.size() != 1 ) return Undef_t;
  if( !is_scalar( ( args.head() )->get_rtype() ) ) return Undef_t;
  return Real_t;
}

dc_type t_rl2int( const f_list &args ) {
  /* takes one scalar returns a real */
  if( args.size() != 1 ) return Undef_t;
  if( ( ( args.head() )->get_rtype() ) != Real_t ) return Undef_t;
  return Int_t;
}

dc_type t_mod( const f_list &args ) {
  /* takes two scalar returns a real if one or both are real, otherwise returns 
     an int */
  if( args.size() != 2 ) return Undef_t;
  dc_type T1, T2;
  T1 = ( args.head() )->get_rtype();
  T2 = ( args.tail() )->get_rtype();
  switch( T1 ) {
  case Real_t : 
    switch( T2 ) {
    case Real_t : case Int_t : return Real_t;
    default : return Undef_t;
    }
  case Int_t :
    switch( T2 ) {
    case Real_t : case Int_t : return T2;
    default : return Undef_t;
    }
  default :
    return Undef_t;
  }
}

dc_type t_mag( const f_list &args ) {
  if( args.size() != 1 ) return Undef_t;
  dc_type T = ( args.head() )->get_rtype();
  if( T == Boolean_t || T == Symbol_t ) return Undef_t;
  if( T == Int_t || T == String_t ) return Int_t;
  return Real_t;
}

dc_type t_inv_prod( const f_list &args ) {
  /* takes any number of args >= 1. iterative. */
  if( !args.size() ) return Undef_t;
  list_item li = args.succ( args.first() );
  dc_type T = ( args.head() )->get_rtype();
  while( li ) {
    dc_type T2 = ( args.inf( li ) )->get_rtype();
    switch( T ) {
    case Distrib_t : case Int_t : case Real_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : T = Real_t; break;
      default : return Undef_t;
      } break;
    case Matrix_t : case Rect_Matrix_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : 
	T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    case Triple_t : case Vector_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : T = T2; break;
      default : return Undef_t;
      } break;
    default : return Undef_t;
    }
    li = args.succ( li );
  }
  return T;
}

dc_type t_prod( const f_list &args ) {
  /* takes any number of args >= 1. iterative */
  if( !args.size() ) return Undef_t;
  list_item li = args.succ( args.first() );
  dc_type T = ( args.head() )->get_rtype();
  while( li ) {
    dc_type T2 = ( args.inf( li ) )->get_rtype();
    switch( T ) {
    case Distrib_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : T = Real_t; break;
      case Rect_Matrix_t : case Triple_t : case Vector_t : T = T2; break;
      case Matrix_t : T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    case Int_t :
      switch( T2 ) {
      case Distrib_t : case Real_t : T = Real_t; break;
      case Int_t : case Rect_Matrix_t : case Triple_t : case Vector_t : 
	T = T2; break;
      case Matrix_t : T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    case Matrix_t : case Rect_Matrix_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Matrix_t : case Real_t : 
      case Rect_Matrix_t : case Triple_t : case Vector_t : 
	T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    case Real_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : T = Real_t; break;
      case Rect_Matrix_t : case Triple_t : case Vector_t : 
	T = T2; break;
      case Matrix_t : T = Rect_Matrix_t;
      default : return Undef_t;
      } break;
    case Triple_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : T = Triple_t; break;
      case Rect_Matrix_t : case Triple_t : case Vector_t : 
	T = T2; break;
      case Matrix_t : T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    case Vector_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : case Triple_t : 
      case Vector_t : T = Vector_t; break;
      case Rect_Matrix_t : case Matrix_t : T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    default : return Undef_t;
    }
    li = args.succ( li );
  }
  return T;
}

dc_type t_dot_prod( const f_list &args ) {
  /* takes two of type triple or vector and returns a real */
  if( args.size() != 2 ) return Undef_t;

  dc_type T1 = ( args.head() )->get_rtype();
  if( T1 != Triple_t && T1 != Vector_t ) {
    return Undef_t;
  }
  dc_type T2 = ( args.tail() )->get_rtype();  
  if( T2 != Triple_t && T2 != Vector_t ) {
    return Undef_t;
  }

  return Real_t;
}

dc_type t_int_div( const f_list &args ) {
  /* takes any number of args >= 1. iterative */
  if( !args.size() ) return Undef_t;
  list_item li = args.succ( args.first() );
  dc_type T = ( args.head() )->get_rtype();
  while( li ) {
    dc_type T2 = ( args.inf( li ) )->get_rtype();
    switch( T ) {
    case Distrib_t : case Real_t :
      switch( T2 ) {
      case Distrib_t : case Real_t : case Int_t : T = Real_t; break;
      default : return Undef_t;
      } break;
    case Int_t :
      switch( T2 ) {
      case Distrib_t : case Real_t : T = Real_t; break;
      case Int_t : T = Int_t; break;
      default : return Undef_t;
      } break;
    case Matrix_t : case Rect_Matrix_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : 
	T = Rect_Matrix_t; break;
      default : return Undef_t;
      } break;
    case Triple_t : case Vector_t :
      switch( T2 ) {
      case Distrib_t : case Int_t : case Real_t : T = T2; break;
      default : return Undef_t;
      } break;
    default : return Undef_t;
    }
    li = args.succ( li );
  }
  return T;
}

dc_type t_same( const f_list &args ) {
/* takes any number of args.  must be scalar or all of one type except bool,
   string or symbol. if scalar and at least one is real then result is real 
   otherwise int.  if not scalar, return that one type */
  if( !args.size() ) return Undef_t;
  list_item li = args.first();
  dc_type T = ( args.inf( li ) )->get_rtype();
  li = args.succ( li );
  if( is_scalar( T ) ) {
    if( T == Int_t ) { /* return int if all int.  if real encountered change T
			  and drop to while loop outside if block */
      while( li && T == Int_t ) {
	if( !is_scalar( T = ( ( args.inf( li ) )->get_rtype() ) ) ) 
	  return Undef_t;

	li = args.succ( li );
      }
    }
    while( li ) {
      if( !is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
      li = args.succ( li );
    }
  } else {
    if( T == Boolean_t || T == Symbol_t || T == String_t ) return Undef_t;
    while( li ) {
      if( T != ( args.inf( li ) )->get_rtype() ) return Undef_t;
      li = args.succ( li );
    }
  }

  return T;  
}

dc_type t_sum( const f_list &args ) {
  /* takes any number of args.  must be scalar or all of one type except bool or
   symbol. if scalar and at least one is real then result is real otherwise int.
   if not scalar return that one type */
  if( !args.size() ) return Undef_t;
  list_item li = args.first();
  dc_type T = ( args.inf( li ) )->get_rtype();
  li = args.succ( li );
  if( is_scalar( T ) ) {
    if( T == Int_t ) { /* return int if all int.  if real encountered change T
			  and drop to while loop outside if block */
      while( li && T == Int_t ) {
	if( !is_scalar( T = ( ( args.inf( li ) )->get_rtype() ) ) ) 
	  return Undef_t;

	li = args.succ( li );
      }
    }
    while( li ) {
      if( !is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
      li = args.succ( li );
    }
  } else {
    if( T == Boolean_t || T == Symbol_t ) return Undef_t;
    while( li ) {
      if( T != ( args.inf( li ) )->get_rtype() ) return Undef_t;
      li = args.succ( li );
    }
  }

  return T;  
}

dc_type t_not( const f_list &args ) {
  /* takes one bool returns bool */
  if( args.size() != 1 ) return Undef_t;
  if( ( args.head() )->get_rtype() != Boolean_t ) return Undef_t;
  return Boolean_t;
}

dc_type t_equal( const f_list &args ) {
  /* takes any number of arguments of scalar type or same type that can be 
     tested for equality and returns bool */  
  if( !args.size() ) return Undef_t;
  list_item li = args.first();
  li = args.succ( li );
  dc_type T = ( args.inf( li ) )->get_rtype();
  if( is_scalar( T ) ) {
    while( li ) {
      if( !is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
      li = args.succ( li );
    }
  } else {
    while( li ) {
      if( T != ( args.inf( li ) )->get_rtype() ) return Undef_t;
      li = args.succ( li );
    }
  }

  return Boolean_t;
}

dc_type t_comp( const f_list &args ) {
  /* takes any number >= 1 of scalar or any number of same non-matrix type and 
     returns bool */
  if( !args.size() ) return Undef_t;
  list_item li = args.first();
  li = args.succ( li );
  dc_type T = ( args.inf( li ) )->get_rtype();
  if( is_scalar( T ) ) {
    while( li ) {
      if( !is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
      li = args.succ( li );
    }
  } else {
    if( T == Matrix_t || T == Vector_t || T == Triple_t || T == Rect_Matrix_t )
      return Undef_t;
    while( li ) {
      if( T != ( args.inf( li ) )->get_rtype() ) return Undef_t;
      li = args.succ( li );
    }
  }

  return Boolean_t;
}

dc_type t_andor( const f_list &args ) {
  /* takes any number of bools and returns bool */
  if( !args.size() ) return Undef_t;
  list_item li = args.first();
  while( li ) {
    if( ( args.inf( li ) )->get_rtype() != Boolean_t ) return Undef_t;
    li = args.succ( li );
  }

  return Boolean_t;
}

dc_type t_gdistrib( const f_list &args ) { 
  /* takes two or three scalar and returns distrib */
  int size;
  if( ( size = args.size() ) == 2 ) {
    if( !is_scalar( ( args.head() )->get_rtype() ) || 
	!is_scalar( ( args.tail() )->get_rtype() ) ) return Undef_t;
    return Distrib_t;
  } else if( size == 3 ) {
    list_item li = args.succ( args.first() );
    if( !is_scalar( ( args.head() )->get_rtype() ) || 
	!is_scalar( ( args.tail() )->get_rtype() ) ||
	!is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
    return Distrib_t;
  }
  return Undef_t;
}

dc_type t_gvec( const f_list &args ) {
  /* takes any number of scalars and if number is 3 returns a triple else
     a vector */
  int n = args.size();
  if( !n ) return Undef_t;

  dc_func *f;
  forall( f, args ) {
    if( !is_scalar( f->get_rtype() ) ) return Undef_t;
  }

  if( n == 3 ) return Triple_t;
  return Vector_t;
}

dc_type t_int( const f_list & ) {
  /* returns any number or no args and returns int */
  return Int_t;
}

dc_type t_sclr2rl( const f_list &args ) { 
  /* takes any number of scalars and returns a real */
  if( !args.size() ) return Undef_t;

  /* check coefficients */
  list_item li = args.first();
  while( li ) {
    if( !is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
    li = args.succ( li );
  }
  return Real_t;
}

dc_type t_mnmx( const f_list &args ) {
  /* takes any number of scalar args.if one is real then result is real */
  if( !args.size() ) return Undef_t;
  list_item li = args.first();
  li = args.succ( li );
  dc_type T = ( args.inf( li ) )->get_rtype();
  if( is_scalar( T ) ) {
    if( T == Int_t ) { /* return int if all int.  if real encountered change T
			  and drop to while loop outside if block */
      while( li && T == Int_t ) {
	if( !is_scalar( T = ( ( args.inf( li ) )->get_rtype() ) ) ) 
	  return Undef_t;

	li = args.succ( li );
      }
    }
    while( li ) {
      if( !is_scalar( ( args.inf( li ) )->get_rtype() ) ) return Undef_t;
      li = args.succ( li );
    }
  } else {
    return Undef_t;
  }

  return T;  
}

dc_type t_distop( const f_list &args ) {
  /* takes a distrib and returns a real */
  if( args.size() != 1 ) return Undef_t;
  if( ( args.head() )->get_rtype() != Distrib_t ) return Undef_t;
  return Real_t;
}

dc_type t_cond( const f_list &args ) {
  /* number of arguments must be odd.  every even argument must be scalar
     or of same type.  every odd argument except last must be boolean. last 
     argument must be same type as even args */
  if( !( args.size() & 1 ) ) return Undef_t;
  dc_type T = ( args.tail()->get_rtype() );
  list_item cond = args.first();
  
  if( is_scalar( T ) ) {
    if( T == Int_t ) {
      while( 1 ) {
	list_item rval = args.succ( cond );
	if( !rval ) return T;
	if( ( args.inf( cond ) )->get_rtype() != Boolean_t ) return Undef_t;
	dc_type T2 = ( args.inf( rval ) )->get_rtype();
	if( T2 != Int_t ) {
	  if( T2 == Real_t ) {
	    cond = args.succ( rval );	    
	    break;
	  }
	  return Undef_t;
	}
	
	cond = args.succ( rval );
      }
    }
    while( 1 ) {
      list_item rval = args.succ( cond );
      if( !rval ) return T;
      if( ( args.inf( cond ) )->get_rtype() != Boolean_t ) return Undef_t;
      if( !is_scalar( ( args.inf( rval ) )->get_rtype() ) ) return Undef_t;
      cond = args.succ( rval );
    }
  } else {
    while( 1 ) {
      list_item rval = args.succ( cond );
      if( !rval ) return T;
      if( ( args.inf( cond ) )->get_rtype() != Boolean_t ) return Undef_t;
      if( ( args.inf( rval ) )->get_rtype() != T ) return Undef_t;
      cond = args.succ( rval );
    }
  }
}

dc_type t_assignment( const f_list &args ) {
  if( args.size() != 2 ) return Undef_t;
  
  dc_type dest_t = ( args.head() )->get_rtype(),
    src_t = ( args.tail() )->get_rtype();
  switch( dest_t ) {
  case Boolean_t : case Distrib_t : case Pointer_t : case String_t :
  case Symbol_t :
    if( dest_t == src_t ) return dest_t; else return Undef_t;
  case Int_t : case Real_t :
    if( src_t == Int_t || src_t == Real_t ) return dest_t; else return Undef_t;
  case Rect_Matrix_t : case Matrix_t : 
    if( src_t == Rect_Matrix_t || src_t == Triple_t || src_t == Vector_t || 
	src_t == Matrix_t ) return Rect_Matrix_t; else return Undef_t;
  case Triple_t : case Vector_t :
    if( src_t == Triple_t || src_t == Vector_t ) return dest_t;
  default : return Undef_t;
  }
}

dc_type st_sum( dc_type T ) {
  switch( T ) {
  case Real_t : case Int_t : case Matrix_t : case Vector_t : 
  case Rect_Matrix_t : case Triple_t : return T;
  default : return Undef_t;
  }
}

dc_type st_prod( dc_type T ) {
  switch( T ) {
  case Real_t : case Int_t : case Matrix_t : case Vector_t : 
  case Rect_Matrix_t : case Triple_t : return T;
  default : return Undef_t;
  }
}

dc_type st_mnmx( dc_type T ) {
  if( is_scalar( T ) ) return T;
  return Undef_t;
}

dc_type st_sclr2rl( dc_type T ) {
  if( is_scalar( T ) ) return Real_t;
  return Undef_t;
}

dc_type st_fail( dc_type ) { return Undef_t; }
dc_type st_int( dc_type ) { return Int_t; }
