/**********************************************************************
 
	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	"memory_routine.h"
#include	"utils.h"
#include	"xl.h"
#include	"task.h"
#include	"mlong_char.h"

/*
UNIT_ALIAS * name_hash[HASH_UNIT_SIZE];
UNIT_ALIAS * dim_hash[HASH_UNIT_SIZE];
SYSTEM_UNIT * sys_unit[DIM];
SYSTEM_UNIT ** no2su[DIM];
int no2su_len[DIM];
*/

extern SEM unit_lock;

UNIT_ENV *	ue_name_list;


void gc_unit_env();
void gc_system_unit();
void gc_unit_alias();

void
gc_unit()
{
UNIT_ENV * ue;
	for ( ue = ue_name_list ; ue ; ue = ue->next )
		gc_unit_env(ue);
}


UNIT_ENV *
new_uenv()
{
	return mmalloc(sizeof(UNIT_ENV),gc_unit_env);
}



UNIT_ENV *
_search_uenv_name(L_CHAR * name)
{
UNIT_ENV * ret;
	for ( ret = ue_name_list ; ret ; ret = ret->next )
		if ( l_strcmp(ret->name,name) == 0 )
			return ret;
	return 0;
}

UNIT_ENV *
search_uenv_name(L_CHAR * name)
{
UNIT_ENV * ret;
	lock_task(unit_lock);
	ret = _search_uenv_name(name);
	unlock_task(unit_lock,"search_uenv_name");
	return ret;
}

void
_del_uenv_name(L_CHAR * name)
{
UNIT_ENV ** uep;
	for ( uep = &ue_name_list ; *uep ; uep = &(*uep)->next ) {
		if ( l_strcmp((*uep)->name,name) )
			continue;
		*uep = (*uep)->next;
		break;
	}
}

void
_set_uenv_name(UNIT_ENV * ue,L_CHAR * name)
{
	if ( ue->name )
		_del_uenv_name(ue->name);
	ue->name = ll_copy_mstr(name);
	ue->next = ue_name_list;
	ue_name_list = ue;
}

void
del_uenv_name(L_CHAR * name)
{
	lock_task(unit_lock);
	_del_uenv_name(name);
	unlock_task(unit_lock,"del_uenv_name");
}

void
set_uenv_name(UNIT_ENV * ue,L_CHAR * name)
{
	lock_task(unit_lock);
	_set_uenv_name(ue,name);
	unlock_task(unit_lock,"set_uenv_name");
}

unsigned int
name_hash_key(L_CHAR * name)
{
unsigned int key;
	key = 0;
	for ( ; *name ; name ++ )
		key += *name;
	return key%HASH_UNIT_SIZE;
}

unsigned int
dim_hash_key(DIMENSION * dim)
{
unsigned int key;
int i;
	key = 0;
	for ( i = 0 ; i < DIM ; i ++ )
		key += dim[i].p + dim[i].u + dim[i].r;
	return key%HASH_UNIT_SIZE;
}

int
dim_cmp(DIMENSION * d1,DIMENSION * d2)
{
int i;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( d1[i].r != d2[i].r )
			return -1;
		if ( d1[i].u != d2[i].u )
			return -1;
		if ( d1[i].p != d2[i].p )
			return -1;
	}
	return 0;
}

UNIT_ALIAS *
search_alias_by_name(UNIT_ENV * ue,L_CHAR * name)
{
UNIT_ALIAS * ua;
int key;
	key = name_hash_key(name);
	for ( ua = ue->name_hash[key] ; ua ; ua = ua->n_next )
		if ( l_strcmp(ua->name,name) == 0 )
			return ua;
	return 0;
}

UNIT_ALIAS *
search_alias_by_dim(UNIT_ENV * ue,DIMENSION * dim)
{
UNIT_ALIAS * ua;
int key;
	key = dim_hash_key(dim);
	for ( ua = ue->dim_hash[key] ; ua ; ua = ua->d_next )
		if ( dim_cmp(ua->dim,dim) == 0 )
			return ua;
	return 0;
}

SYSTEM_UNIT *
search_system_unit(UNIT_ENV * ue,int d,L_CHAR * name)
{
SYSTEM_UNIT * su;
	for ( su = ue->sys_unit[d] ; su ; su = su->next )
		if ( l_strcmp(su->name,name) == 0 )
			return su;
	return 0;
}

int
new_ua(UNIT_ENV * ue,DIMENSION * dim,L_CHAR * name)
{
UNIT_ALIAS * ua;
unsigned int key;

	if ( search_alias_by_name(ue,name) )
		return -1;
	if ( search_alias_by_dim(ue,dim) )
		return -1;
	ua = mmalloc(sizeof(*ua),gc_unit_alias);
	ua->name = ll_copy_mstr(name);
	memcpy(ua->dim,dim,sizeof(DIMENSION)*DIM);
	key = name_hash_key(name);
	ua->n_next = ue->name_hash[key];
	ue->name_hash[key] = ua;
	key = dim_hash_key(dim);
	ua->d_next = ue->dim_hash[key];
	ue->dim_hash[key] = ua;
	return 0;
}

int
n_new_ua(UNIT_ENV * ue,DIMENSION * dim,char * name)
{
	return new_ua(ue,dim,l_string(std_cm,name));
}

void
system_unit_alias(UNIT_ENV * ue)
{
int i,j;
SYSTEM_UNIT * su;
DIMENSION dim[DIM];
	for ( i = 0 ; i < DIM ; i ++ )
		for ( su = ue->sys_unit[i] ; su ; su = su->next ) {
			for ( j = 0 ; j < DIM ; j ++ ) {
				if ( j == i ) {
					dim[j].u = su->no;
					dim[j].p = 1;
					dim[j].r = 1;
				}
				else {
					dim[j].u = 0;
					dim[j].p = 0;
					dim[j].r = 1;
				}
			}
			new_ua(ue,dim,su->name);
		}
}


int
new_su(UNIT_ENV * ue,
	int sys,L_CHAR * name,
	 double shi,double bo)
{
SYSTEM_UNIT * su,* su1, ** sup;
int i,no;

	if ( search_system_unit(ue,sys,name) )
		return -1;
	su = mmalloc(sizeof(*su),gc_system_unit);
	su->name = ll_copy_mstr(name);
	su->shi = shi;
	su->bo = bo;
	su->shi_int = shi;
	su->bo_int = bo;
	for ( sup = &ue->sys_unit[sys];
			*sup;
			sup = &(*sup)->next )
		if ( (*sup)->shi/(*sup)->bo < shi/bo )
			break;
	su->next = *sup;
	*sup = su;
	no = 1;
	for ( su1 = ue->sys_unit[sys] ; su1 ; su1 = su1->next )
		su1->no = no ++;
	if ( ue->no2su_len[sys] < no ) {
		ue->no2su_len[sys] = no;
		if ( ue->no2su[sys] == 0 )
			ue->no2su[sys] = mmalloc(sizeof(su)*no,gc_text);
		else	ue->no2su[sys] = mrealloc(ue->no2su[sys],
						sizeof(su)*no,
						gc_text);
	}
	ue->no2su[sys][0] = 0;
	for ( su1 = ue->sys_unit[sys] ; su1 ; su1 = su1->next )
		ue->no2su[sys][su1->no] = su1;
	return 0;
}


int
n_new_su(UNIT_ENV * ue,int sys,char * name,double shi,double bo)
{
	return new_su(ue,sys,l_string(std_cm,name),shi,bo);
}

L_CHAR *
dim2name(UNIT_ENV * ue,DIMENSION * dim)
{
L_CHAR * a,* n;
char buf[20];
int len,p;
UNIT_ALIAS * ua;
int i;

	for ( i = 0 ; i < DIM ; i ++ )
		if ( dim[i].p )
			goto next;
	return 0;
next:
	ua = search_alias_by_dim(ue,dim);
	if ( ua )
		return ua->name;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( dim[i].p == 0 )
			continue;
		if ( dim[i].r != 1 )
			return 0;
	}
	len = 1;
	a = d_alloc(1000,612);
	p = 0;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( dim[i].p == 0 )
			continue;
		if ( p )
			a[p++] = '*';
		n = ue->no2su[i][dim[i].u]->name;
		l_strcpy(&a[p],n);
		p += l_strlen(n);
		if ( dim[i].p == 1 )
			goto last;
		a[p] = '^';
		p ++;
		sprintf(buf,"%i",dim[i].p);
		l_strcpy(&a[p],l_string(std_cm,buf));
		p += strlen(buf);
	last:	{}
	}
	a[p] = 0;
	a = d_re_alloc(a,(p+1)*sizeof(L_CHAR));
	set_buffer(a);
	return a;
}

void
zero_unit(DIMENSION * dim)
{
int i;
	for ( i = 0 ; i < DIM ; i ++ ) {
		dim[i].p = 0;
		dim[i].u = 0;
		dim[i].r = 1;
	}
}

int
name2dim(
	UNIT_ENV * ue,
	DIMENSION * dim,
	L_CHAR *  name)
{
UNIT_ALIAS * ua;
DIV_STR ds,* dsp1;
int i,j;
L_CHAR * n;
int power;
SYSTEM_UNIT * su;

	zero_unit(dim);
	if ( name == 0 )
		return 0;
	ua = search_alias_by_name(ue,name);
	if ( ua ) {
		memcpy(dim,ua->dim,sizeof(DIMENSION)*DIM);
		return 0;
	}
	ds.term = DST_TERMINATE;
	ds.type = DST_STRING;
	ds.flags = DSF_DONTFREE;
	ds.d.str = name;
	divide_string(&ds,l_string(std_cm,"*"));
	divide_string(&ds,l_string(std_cm,"^"));
	for ( dsp1 = ds.d.ds ; ; dsp1 ++ ) {
		n = dsp1->d.ds[0].d.str;
		if ( dsp1->d.ds[0].term == DST_DATA ) {
			sscanf(
				n_string(std_cm,
					dsp1->d.ds[1].d.str),
				"%i",&power);
		}
		else {
			power = 1;
		}
		for ( i = 0 ; i < DIM ; i ++ ) {
			su = search_system_unit(ue,i,n);
			if ( su )
				break;
		}
		if ( su == 0 )
			goto last;
		dim[i].p = power;
		dim[i].u = su->no;
		dim[i].r = 1;
	last:
		if ( dsp1->term == 0 )
			break;
	}
	free_div_str(ds);
	return 0;
}

double
conv_unit_floating(int * er,
	UNIT_ENV * ue,double inp,DIMENSION * _from,DIMENSION * _to)
{
SYSTEM_UNIT * su_from,* su_to;
double ret;
int i,j;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( _from[i].p != _to[i].p ) {
			*er = -1;
			return inp;
		}
	}
	ret = inp;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( _from[i].u == _to[i].u )
			goto last;
		su_from = ue->no2su[i][_from[i].u];
		su_to = ue->no2su[i][_to[i].u];
		if ( _from[i].p > 0 )
			for ( j = 0 ; j < _from[i].p ; j ++ )
				ret = ret*su_to->shi*su_from->bo/
					(su_to->bo*su_from->shi);
		else if ( _from[i].p < 0 )
			for ( j = 0 ; j < -_from[i].p ; j ++ )
				ret = ret*
					su_to->bo*su_from->shi
					/(su_to->shi*su_from->bo);
	last:
		ret = ret*_from[i].r/_to[i].r;
	}
	*er = 0;
	return ret;
}


int
conv_unit_integer(int * er,
	UNIT_ENV * ue,int inp,DIMENSION * _from,DIMENSION * _to)
{
SYSTEM_UNIT * su_from,* su_to;
int ret;
int i,j;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( _from[i].p != _to[i].p ) {
			*er = -1;
			return inp;
		}
	}
	ret = inp;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( _from[i].u == _to[i].u )
			goto last;
		su_from = ue->no2su[i][_from[i].u];
		su_to = ue->no2su[i][_to[i].u];
		if ( _from[i].p > 0 )
			for ( j = 0 ; j < _from[i].p ; j ++ )
				ret = ret*su_to->shi_int*su_from->bo_int/
					(su_to->bo_int*su_from->shi_int);
		else if ( _from[i].p < 0 )
			for ( j = 0 ; j < -_from[i].p ; j ++ )
				ret = ret*
					su_to->bo_int*su_from->shi_int
					/(su_to->shi_int*su_from->bo_int);
	last:
		ret = ret*_from[i].r/_to[i].r;
	}
	*er = 0;
	return ret;
}


double
conv_unit(int * er,UNIT_ENV * ue,double inp,L_CHAR * from,L_CHAR * to)
{
DIMENSION _from[DIM],_to[DIM];
double ret1;
int ret2;
	name2dim(ue,_from,from);
	name2dim(ue,_to,to);
	ret1 = conv_unit_floating(er,ue,inp,_from,_to);
	ret2 = conv_unit_integer(er,ue,inp,_from,_to);
	if ( ret1 != ret2 )
		return ret1;
	else	return ret2;
}


void
fit_dimension_integer(DIMENSION * dest,DIMENSION * s1,DIMENSION * s2)
{
int i;
int f;
UNIT_ALIAS * ua;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( s1[i].p == 0 ) {
			dest[i] = s2[i];
			continue;
		}
		if ( s2[i].p == 0 ) {
			dest[i] = s1[i];
			continue;
		}
		if ( s1[i].u < s2[i].u ) {
			dest[i] = s1[i];
			continue;
		}
		else {
			dest[i] = s2[i];
			continue;
		}
	}
}

void
fit_dimension_floating(DIMENSION * dest,DIMENSION * s1,DIMENSION * s2)
{
int i;
int f;
UNIT_ALIAS * ua;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( s1[i].p == 0 ) {
			dest[i] = s2[i];
			continue;
		}
		if ( s2[i].p == 0 ) {
			dest[i] = s1[i];
			continue;
		}
		if ( s1[i].u > s2[i].u ) {
			dest[i] = s1[i];
			continue;
		}
		else {
			dest[i] = s2[i];
			continue;
		}
	}
}

void
normalize_dim_floating(UNIT_ENV * ue,DIMENSION * dim,double *data)
{
L_CHAR * name;
int i;
	name = dim2name(ue,dim);
	if ( name )
		return;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( dim[i].p == 0 )
			continue;
		if ( dim[i].r == 1 )
			continue;
		*data *= dim[i].r;
		dim[i].r = 1;
	}
}


void
normalize_dim_integer(UNIT_ENV * ue,DIMENSION * dim,int * data)
{
L_CHAR * name;
int i;
	name = dim2name(ue,dim);
	if ( name )
		return;
	for ( i = 0 ; i < DIM ; i ++ ) {
		if ( dim[i].p == 0 )
			continue;
		if ( dim[i].r == 1 )
			continue;
		*data *= dim[i].r;
		dim[i].r = 1;
	}
}

int
dim_power_cmp(DIMENSION * d1,DIMENSION * d2)
{
int i;
	for ( i = 0 ; i < DIM ; i ++ )
		if ( d1[i].p != d2[i].p )
			return -1;
	return 0;
}

void
print_dim(DIMENSION * d)
{
int i;
	for ( i = 0 ; i < DIM ; i ++ )
		printf("u%i^%i(%i)",d[i].u,d[i].p,d[i].r);
}


UNIT_ENV *
copy_uenv1(UNIT_ENV * ue)
{
UNIT_ENV * ret;
int i;
SYSTEM_UNIT * su;
	ret = mmalloc(sizeof(*ret),gc_unit_env);
	for ( i = 0 ; i < DIM ; i ++ ) {
		su = ue->sys_unit[i];
		for ( ; su ; su = su->next )
			new_su(ret,i,su->name,su->shi,su->bo);
	}
	return ret;
}

void
copy_uenv2(UNIT_ENV * to,UNIT_ENV * from)
{
int i,j;
UNIT_ALIAS * ua;
DIMENSION dim[DIM];
SYSTEM_UNIT * su;
	for ( i = 0; i < HASH_UNIT_SIZE ; i ++ ) {
		ua = from->name_hash[i];
		for ( ; ua ; ua = ua->n_next ) {
			memcpy(dim,ua->dim,sizeof(DIMENSION)*DIM);
			for ( j = 0 ; j < DIM ; j ++ ) {
				if ( dim[j].u == 0 )
					continue;
				su = search_system_unit(
					to,j,
					from->no2su[j][dim[j].u]->name);
				if ( su == 0 )
					er_panic("copy_uenv2(1)");
				dim[j].u = su->no;
			}
			new_ua(to,dim,ua->name);
		}
	}
}



void
free_c_unit(COORDINATE_UNIT * u)
{
	if ( u->system )
		d_f_ree(u->system);
	if ( u->unit )
		d_f_ree(u->unit);
	if ( u->url )
		d_f_ree(u->url);
}


L_CHAR *
reso_c_unit(COORDINATE_UNIT * u)
{
L_CHAR * ret;
	ret = ll_copy_str(u->unit,123);
	ret = d_re_alloc(ret,(l_strlen(ret)+4)*sizeof(L_CHAR));
	memcpy(&ret[l_strlen(ret)],l_string(std_cm,"^-1"),4*sizeof(L_CHAR));
	set_buffer(ret);
	return ret;
}

L_CHAR *
reso_c_unit_str(L_CHAR * str)
{
L_CHAR * ret;
	ret = ll_copy_str(str,123);
	ret = d_re_alloc(ret,(l_strlen(ret)+4)*sizeof(L_CHAR));
	memcpy(&ret[l_strlen(ret)],l_string(std_cm,"^-1"),4*sizeof(L_CHAR));
	set_buffer(ret);
	return ret;
}

void
zero_c_unit(COORDINATE_UNIT * u)
{
	u->system = 0;
	u->unit = 0;
	u->url = 0;
	u->uenv = 0;
	u->next = 0;
}


L_CHAR *
get_base_unit(XL_SEXP * s)
{
L_CHAR * ret;
	switch ( get_type(s) ) {
	case XLT_PAIR:
		for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
			ret = get_base_unit(car(s));
			if ( ret )
				return ret;
		}
	case XLT_INTEGER:
		return s->integer.unit;
	case XLT_FLOAT:
		return s->floating.unit;
	default:
		return 0;
	}
}
