/*
 * $OpenXM: OpenXM_contrib2/asir2000/engine/dalg.c,v 1.2 2004/12/02 08:39:54 noro Exp $
*/

#include "ca.h"
#include "base.h"

typedef struct oNumberField {
	int n;
	int dim;
	VL vl;
	P *defpoly;
	DP *mb;
	DP *ps;
	NODE ind;
	struct order_spec *spec;
} *NumberField;

typedef struct oDAlg {
	short id;
	char nid;
	char pad;
	DP nm;
	Q dn;
} *DAlg;

#define N_DA 11
#define NEWDAlg(r) ((r)=(DAlg)MALLOC(sizeof(struct oDAlg)),OID(r)=O_N,NID(r)=N_DA)
#define MKDAlg(dp,den,r) (NEWDAlg(r),(r)->nm = (dp),(r)->dn=(den))

static NumberField current_numberfield;
extern struct order_spec *dp_current_spec;
void simpdalg(DAlg da,DAlg *r);

void setfield_dalg(NODE alist)
{
	NumberField nf;
	VL vl,vl1,vl2;
	int n,i,dim;
	Alg *gen;
	P *defpoly;
	P p;
	Q c,iq,two;
	DP *ps,*mb;
	NODE t,b,b1,b2,hlist,mblist;
	struct order_spec *current_spec;

	nf = (NumberField)MALLOC(sizeof(struct oNumberField));
	current_numberfield = nf;
	vl = 0;
	for ( t = alist; t; t = NEXT(t) ) {
		clctalg(BDY((Alg)BDY(t)),&vl1);
		mergev(ALG,vl,vl1,&vl2); vl = vl2;
	}
	for ( n = 0, vl1 = vl; vl1; vl1 = NEXT(vl1), n++ ); 
	nf->n = n;
	nf->vl = vl;
	nf->defpoly = defpoly = (P *)MALLOC(n*sizeof(P));
	nf->ps = ps = (DP *)MALLOC(n*sizeof(DP));
	current_spec = dp_current_spec;
	STOQ(2,two);
	create_order_spec(0,(Obj)two,&nf->spec);
	initd(nf->spec);	
	for ( b = hlist = 0, i = 0, vl1 = vl; i < n; vl1 = NEXT(vl1), i++ ) {
		ptozp(vl1->v->attr,1,&c,&defpoly[i]);
		ptod(ALG,vl,defpoly[i],&ps[i]);
		STOQ(i,iq); MKNODE(b1,(pointer)iq,b); b = b1;
		MKNODE(b2,(pointer)ps[i],&hlist); hlist = b2;
	}
	initd(current_spec);	
	nf->ind = b;
	dp_base(hlist,&mblist);
	nf->dim = dim = length(mblist);
	nf->mb = mb = (DP *)MALLOC(dim*sizeof(DP));
	for ( i = 0, t = mblist; t; t = NEXT(t), i++ )
		mb[i] = (DP)BDY(mblist);	
}

void algtodalg(Alg a,DAlg *r)
{
	P ap,p,p1;
	Q c,dn,nm;
	DP dp;
	DAlg da;
	NumberField nf;
	struct order_spec *current_spec;

	if ( !(nf=current_numberfield) )
		error("algtodalg : current_numberfield is not set");
	ap = (P)BDY(a);
	ptozp(ap,1,&c,&p);
	if ( INT(c) ) {
		p = ap;
		dn = ONE;
	} else {
		NTOQ(NM(c),SGN(c),nm);
		NTOQ(DN(c),1,dn);
		mulpq(p,(P)nm,&p1); p = p1;
	}
	current_spec = dp_current_spec;
	initd(nf->spec);
	ptod(ALG,nf->vl,p,&dp);
	MKDAlg(dp,dn,da);
	simpdalg(da,r);
}

void dalgtoalg(DAlg da,Alg *r)
{
	NumberField nf;
	P p,p1;
	Q inv;

	if ( !(nf=current_numberfield) )
		error("algtodalg : current_numberfield is not set");
	dtop(ALG,nf->vl,da->nm,&p);
	invq(da->dn,&inv);
	mulpq(p,(P)inv,&p1);
	MKAlg(p1,*r);
}

void simpdalg(DAlg da,DAlg *r)
{
	NumberField nf;
	DP nm;
	Q dn,dn1;

	if ( !(nf=current_numberfield) )
		error("algtodalg : current_numberfield is not set");
	dp_true_nf(nf->ind,da->nm,nf->ps,1,&nm,&dn);
	mulq(da->dn,dn,&dn1);
	MKDAlg(nm,dn1,*r);
}

void adddalg(DAlg a,DAlg b,DAlg *c)
{
	if ( !current_numberfield )
		error("algtodalg : current_numberfield is not set");
}

void subdalg(DAlg a,DAlg b,DAlg *c)
{
	if ( !current_numberfield )
		error("algtodalg : current_numberfield is not set");
}

void muldalg(DAlg a,DAlg b,DAlg *c)
{
	if ( !current_numberfield )
		error("algtodalg : current_numberfield is not set");
}


void divdalg(DAlg a,DAlg b,DAlg *c)
{
	if ( !current_numberfield )
		error("algtodalg : current_numberfield is not set");
}

void invdalg(DAlg a,DAlg *c)
{
	if ( !current_numberfield )
		error("algtodalg : current_numberfield is not set");
}

void chsgndalg(DAlg a,DAlg *c)
{
}

void pwrdalg(DAlg a,Q b,DAlg *c)
{
	if ( !current_numberfield )
		error("algtodalg : current_numberfield is not set");
}

int cmpgdalg(DAlg a,DAlg b)
{
}