/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	This program is distributed in the hope that it will be 
	useful, but WITHOUT ANY WARRANTY; without even the 
	implied warranty of MERCHANTABILITY or FITNESS FOR A 
	PARTICULAR PURPOSE.

**********************************************************************/


#include	"memory_debug.h"
#include	"xl.h"
#include	"xlerror.h"

XL_SEXP * xl_EA();
XL_SEXP * sort_list();
XL_SEXP * get_join_option();
XL_SEXP * njoin_cmp_s();
XL_SEXP * xl_GetElement();
void gc_gb_sexp();

int
njoin_cmp_field_list(XL_SEXP ** retp,XL_SEXP * flist,
	XL_SEXP * s1,XL_SEXP * s2);

void
init_EA(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"EA"),
		get_func_prim(xl_EA,FO_APPLICATIVE,0,3,4));
}

XL_SEXP *
xl_EA(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * e;
XLISP_ENV * _e;
XL_SEXP * index;
L_CHAR * _index;
char * buf;
XL_SEXP * ret;
int len;
	e = get_el(s,1);
	switch ( get_type(e) ) {
	case XLT_ENV:
		_e = e->env.data;
		break;
	case XLT_NULL:
		_e = env;
		break;
	default:
		goto type_missmatch;
	}
	index = get_el(s,2);
	buf = 0;
	switch ( get_type(index) ) {
	case XLT_SYMBOL:
		_index = index->symbol.data;
		break;
	case XLT_STRING:
		_index = index->string.data;
		break;
	case XLT_INTEGER:

		if ( index->integer.unit ) {
			buf = d_alloc(50+l_strlen(index->integer.unit)
					*4,123);
			sprintf(buf,"%i%s",
				index->integer.data,
				n_string(std_cm,index->integer.unit));
		}
		else {
			buf = d_alloc(50,123);
			sprintf(buf,"%i",
				index->integer.data);
		}
		_index = l_string(std_cm,buf);
		break;
	case XLT_FLOAT:
		if ( index->floating.unit ) {
			buf = d_alloc(1000+
				l_strlen(index->floating.unit)
					*4,123);
			sprintf(buf,"%i%s",
				index->floating.data,
				n_string(std_cm,index->floating.unit));
		}
		else {
			buf = d_alloc(50,123);
			sprintf(buf,"%i",
				index->floating.data);
		}
		_index = l_string(std_cm,buf);
		break;
	default:
		goto type_missmatch;
	}
	if ( buf )
		d_f_ree(buf);
	ret = eval(_e,get_symbol(_index));
	if ( get_type(ret) == XLT_ERROR ) {
		len = list_length(s);
		if ( len < 0 )
			return list_error(s);
		if ( len == 3 )
			return ret;
		return get_el(s,3);
	}
	return ret;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"EA"),
		0);
}
