/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.3 2001/09/04 02:46:15 noro Exp $ */

#include "ca.h"
#include "parse.h"

void addquote(vl,a,b,c)
VL vl;
QUOTE a,b;
QUOTE *c;
{
	FNODE fn;

	fn = mkfnode(3,I_BOP,addfs,BDY(a),BDY(b));
	MKQUOTE(*c,fn);
}

void subquote(vl,a,b,c)
VL vl;
QUOTE a,b;
QUOTE *c;
{
	FNODE fn;

	fn = mkfnode(3,I_BOP,subfs,BDY(a),BDY(b));
	MKQUOTE(*c,fn);
}

void mulquote(vl,a,b,c)
VL vl;
QUOTE a,b;
QUOTE *c;
{
	FNODE fn;

	fn = mkfnode(3,I_BOP,mulfs,BDY(a),BDY(b));
	MKQUOTE(*c,fn);
}

void divquote(vl,a,b,c)
VL vl;
QUOTE a,b;
QUOTE *c;
{
	FNODE fn;

	fn = mkfnode(3,I_BOP,divfs,BDY(a),BDY(b));
	MKQUOTE(*c,fn);
}

void pwrquote(vl,a,b,c)
VL vl;
QUOTE a,b;
QUOTE *c;
{
	FNODE fn;

	if ( !b || OID(b) != O_QUOTE )
		error("pwrquote : invalid argument");
	fn = mkfnode(3,I_BOP,pwrfs,BDY(a),BDY(b));
	MKQUOTE(*c,fn);
}

void chsgnquote(a,c)
QUOTE a;
QUOTE *c;
{
	FNODE fn;

	fn = mkfnode(3,I_BOP,subfs,0,BDY(a));
	MKQUOTE(*c,fn);
}

void polytoquote(), dctoquote(), vartoquote();

void objtoquote(a,c)
Obj a;
QUOTE *c;
{
	QUOTE nm,dn;

	if ( !a ) {
		MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
		return;
	}
	switch ( OID(a) ) {
		case O_N:
			MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
			break;
		case O_P:
			polytoquote((P)a,c);
			break;
		case O_R:
			polytoquote(NM((R)a),&nm);
			polytoquote(DN((R)a),&dn);
			divquote(CO,nm,dn,c);
			break;
		case O_QUOTE:
			*c = (QUOTE)a;
			break;
		default:
			error("objtoquote : not implemented");
	}
}

void polytoquote(a,c)
P a;
QUOTE *c;
{
	DCP dc,t;
	DCP *dca;
	int n,i;
	QUOTE v,r,s,u;

	if ( !a || (OID(a) == O_N) ) {
		MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
		return;
	}
	dc = DC((P)a);
	vartoquote(VR((P)a),&v);
	for ( t = dc, n = 0; t; t = NEXT(t), n++ );
	dca = (DCP *)ALLOCA(n*sizeof(DCP));
	for ( t = dc, i = 0; t; t = NEXT(t), i++ )
		dca[i] = t;
	dctoquote(dca[n-1],v,&r);
	for ( i = n-2; i >= 0; i-- ) {
		dctoquote(dca[i],v,&s);
		addquote(CO,s,r,&u);
		r = u;
	}
	*c = r;
}

void dctoquote(dc,v,c)
DCP dc;
QUOTE v;
QUOTE *c;
{
	QUOTE r,d,s,u;

	objtoquote(COEF(dc),&r);
	if ( DEG(dc) ) {
		objtoquote(DEG(dc),&d);
		pwrquote(CO,v,d,&s);
		mulquote(CO,r,s,&u);
		r = u;
	}
	*c = r;
}

void vartoquote(v,c)
V v;
QUOTE *c;
{
	P x;
	PF pf;
	PFAD ad;
	QUOTE a,b;
	int i;
	FUNC f;
	NODE t,t1;

	if ( NAME(v) ) {
		MKV(v,x);
		MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)x));
	} else if ( (vid)v->attr == V_PF ) {
		/* pure function */
		pf = ((PFINS)v->priv)->pf;
		ad = ((PFINS)v->priv)->ad;
		if ( !strcmp(NAME(pf),"pow") ) {
			/* pow(a,b) = a^b */
			objtoquote(ad[0].arg,&a); objtoquote(ad[1].arg,&b);
			pwrquote(CO,a,b,c);
		} else {
			for ( i = 0; i < pf->argc; i++ )
				if ( ad[i].d )
					break;
			if ( i < pf->argc )
				error("vartoquote : not implemented");
			gen_searchf(NAME(pf),&f);
			t = 0;
			for ( i = pf->argc-1; i >= 0; i-- ) {
				objtoquote(ad[i].arg,&a);
				MKNODE(t1,BDY(a),t);
				t = t1;
			}
			MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
		}
	}
}