OpenXM_contrib2/asir2000/builtin/strobj.c - diff

Return to strobj.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/strobj.c between version 1.107 and 1.118

version 1.107, 2005/12/11 05:27:30

version 1.118, 2007/04/15 11:01:01

Line 45

* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,

* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.

* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.106 2005/12/10 14:14:15 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.117 2006/08/27 22:17:27 noro Exp $

#include "ca.h"

#include "parse.h"

Line 76 struct TeXSymbol {

#define IS_BINARYPWR(f) (((f)->id==I_BOP) &&(OPNAME(f)=='^'))

#define IS_NARYADD(f) (((f)->id==I_NARYOP) &&(OPNAME(f)=='+'))

#define IS_NARYMUL(f) (((f)->id==I_NARYOP) &&(OPNAME(f)=='*'))

#define IS_MUL(f) (((f)->id==I_NARYOP||(f)->id==I_BOP) &&(OPNAME(f)=='*'))

extern char *parse_strp;

Line 92 void Pquotetotex();

Line 93 void Pquotetotex();

void Pquotetotex_env();

void Pflatten_quote();

void Pqt_is_integer(),Pqt_is_rational(),Pqt_is_number();

void Pqt_is_integer(),Pqt_is_rational(),Pqt_is_number(),Pqt_is_coef();

void Pqt_is_dependent(),Pqt_is_function();

void Pqt_is_dependent(),Pqt_is_function(),Pqt_is_var();

void Pqt_set_ord();

void Pqt_set_ord(),Pqt_set_coef(),Pqt_set_weight();

void Pqt_normalize();

void Pnqt_comp();

void Pnqt_comp(),Pnqt_weight();

void Pnqt_match();

void Pnqt_match_rewrite();

void Pqt_to_nbp();

void Pshuffle_mul(), Pharmonic_mul();

void Pnbp_hm(), Pnbp_ht(), Pnbp_hc(), Pnbp_rest();

void Pnbm_deg();

void Pnbp_tm(), Pnbp_tt(), Pnbp_tc(), Pnbp_trest();

void Pnbm_deg(), Pnbm_index();

void Pnbm_hp_rest();

void Pnbm_hxky(), Pnbm_xky_rest();

void Pnbm_hv(), Pnbm_rest();

void Pnbm_hv(), Pnbm_tv(), Pnbm_rest(),Pnbm_trest();

void Pquote_to_funargs(),Pfunargs_to_quote(),Pget_function_name();

void Pqt_match(),Pget_quote_id();

Line 127 FNODE partial_eval(FNODE), fnode_to_nary(FNODE), fnode

Line 129 FNODE partial_eval(FNODE), fnode_to_nary(FNODE), fnode

FNODE nfnode_add(FNODE a1,FNODE a2,int expand);

FNODE nfnode_mul(FNODE a1,FNODE a2,int expand);

FNODE nfnode_pwr(FNODE a1,FNODE a2,int expand);

FNODE nfnode_mul_coef(Num c,FNODE f,int expand);

FNODE nfnode_mul_coef(Obj c,FNODE f,int expand);

FNODE fnode_expand_pwr(FNODE f,int n,int expand);

FNODE to_narymul(FNODE f);

FNODE to_naryadd(FNODE f);

FNODE fnode_node_to_nary(ARF op,NODE n);

void fnode_base_exp(FNODE f,FNODE *bp,FNODE *ep);

void fnode_coef_body(FNODE f,Num *cp,FNODE *bp);

void fnode_coef_body(FNODE f,Obj *cp,FNODE *bp);

FNODE nfnode_match_rewrite(FNODE f,FNODE p,FNODE c,FNODE a,int mode);

FNODE fnode_apply(FNODE f,FNODE (*func)(),int expand);

FNODE fnode_normalize(FNODE f,int expand);

Line 155 struct ftab str_tab[] = {

Line 157 struct ftab str_tab[] = {

{"string_to_tb",Pstring_to_tb,1},

{"get_quote_id",Pget_quote_id,1},

{"qt_is_var",Pqt_is_var,1},

{"qt_is_coef",Pqt_is_coef,1},

{"qt_is_number",Pqt_is_number,1},

{"qt_is_rational",Pqt_is_rational,1},

{"qt_is_integer",Pqt_is_integer,1},

{"qt_is_function",Pqt_is_function,1},

{"qt_is_dependent",Pqt_is_dependent,2},

{"qt_set_coef",Pqt_set_coef,-1},

{"qt_set_ord",Pqt_set_ord,-1},

{"qt_set_weight",Pqt_set_weight,-1},

{"qt_normalize",Pqt_normalize,-2},

{"qt_match",Pqt_match,2},

{"nqt_match_rewrite",Pnqt_match_rewrite,3},

{"nqt_weight",Pnqt_weight,1},

{"nqt_comp",Pnqt_comp,2},

{"nqt_match",Pnqt_match,-3},

{"qt_to_nbp",Pqt_to_nbp,1},

Line 176 struct ftab str_tab[] = {

Line 183 struct ftab str_tab[] = {

{"nbp_ht", Pnbp_ht,1},

{"nbp_hc", Pnbp_hc,1},

{"nbp_rest", Pnbp_rest,1},

{"nbp_tm", Pnbp_tm,1},

{"nbp_tt", Pnbp_tt,1},

{"nbp_tc", Pnbp_tc,1},

{"nbp_trest", Pnbp_trest,1},

{"nbm_deg", Pnbm_deg,1},

{"nbm_index", Pnbm_index,1},

{"nbm_hxky", Pnbm_hxky,1},

{"nbm_xky_rest", Pnbm_xky_rest,1},

{"nbm_hp_rest", Pnbm_hp_rest,1},

{"nbm_hv", Pnbm_hv,1},

{"nbm_tv", Pnbm_tv,1},

{"nbm_rest", Pnbm_rest,1},

{"nbm_trest", Pnbm_trest,1},

{"qt_to_nary",Pqt_to_nary,1},

{"qt_to_bin",Pqt_to_bin,2},

Line 607 void Pqt_to_bin(NODE arg,QUOTE *rp)

Line 621 void Pqt_to_bin(NODE arg,QUOTE *rp)

MKQUOTE(*rp,f);

}

void Pqt_is_var(NODE arg,Q *rp)

{

QUOTE q;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"qt_is_var");

ret = fnode_is_var(BDY(q));

STOQ(ret,*rp);

}

void Pqt_is_coef(NODE arg,Q *rp)

{

QUOTE q;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"qt_is_coef");

ret = fnode_is_coef(BDY(q));

STOQ(ret,*rp);

}

void Pqt_is_number(NODE arg,Q *rp)

{

QUOTE q;

Line 1404 void Pget_function_name(NODE arg,STRING *rp)

Line 1440 void Pget_function_name(NODE arg,STRING *rp)

}

FNODE strip_paren(FNODE);

void objtotex_tb(Obj obj,TB tb);

void fnodetotex_tb(FNODE f,TB tb)

{

Line 1412 void fnodetotex_tb(FNODE f,TB tb)

Line 1449 void fnodetotex_tb(FNODE f,TB tb)

char *opname,*vname_conv,*prefix_conv;

Obj obj;

int i,len,allzero,elen,elen2,si;

C cplx;

char *r;

FNODE fi,f2,f1;

Line 1480 void fnodetotex_tb(FNODE f,TB tb)

Line 1516 void fnodetotex_tb(FNODE f,TB tb)

write_tb("}",tb);

break;

case '^':

fnodetotex_tb((FNODE)FA1(f),tb);

f1 = (FNODE)FA1(f);

if ( fnode_is_var(f1) )

fnodetotex_tb(f1,tb);

else {

write_tb("(",tb);

fnodetotex_tb(f1,tb);

write_tb(")",tb);

}

write_tb("^{",tb);

fnodetotex_tb(strip_paren((FNODE)FA2(f)),tb);

write_tb("} ",tb);

Line 1497 void fnodetotex_tb(FNODE f,TB tb)

Line 1540 void fnodetotex_tb(FNODE f,TB tb)

break;

case I_NARYOP:

args = (NODE)FA1(f);

write_tb("(",tb);

switch ( OPNAME(f) ) {

case '+':

fnodetotex_tb((FNODE)BDY(args),tb);

for ( args = NEXT(args); args; args = NEXT(args) ) {

write_tb("+",tb);

fnodetotex_tb((FNODE)BDY(args),tb);

f1 = (FNODE)BDY(args);

/* if ( fnode_is_var(f1) || IS_MUL(f1) )

fnodetotex_tb(f1,tb);

else */ {

write_tb("(",tb);

fnodetotex_tb(f1,tb);

write_tb(")",tb);

}

break;

case '*':

f1 = (FNODE)BDY(args);

if ( f1->id == I_FORMULA && MUNIQ(FA0(f1)) )

if ( f1->id == I_FORMULA && MUNIQ(FA0(f1)) ) {

write_tb("-",tb);

write_tb("- ",tb); args = NEXT(args);

else

}

fnodetotex_tb(f1,tb);

for ( ; args; args = NEXT(args) ) {

write_tb(" ",tb);

for ( args = NEXT(args); args; args = NEXT(args) ) {

/* XXX special care for DP */

f2 = (FNODE)BDY(args);

if ( f2->id == I_EV ) {

if ( fnode_is_var(f2) || IS_BINARYPWR(f2) )

n = (NODE)FA0(f2);

for ( i = 0; n; n = NEXT(n), i++ ) {

fi = (FNODE)BDY(n);

if ( fi->id != I_FORMULA || FA0(fi) )

break;

}

if ( n )

fnodetotex_tb(f2,tb);

} else

fnodetotex_tb(f2,tb);

else {

write_tb("(",tb);

fnodetotex_tb(f2,tb);

write_tb(")",tb);

}

break;

default:

error("invalid nary op");

break;

}

write_tb(")",tb);

break;

case I_COP:

Line 1758 void fnodetotex_tb(FNODE f,TB tb)

Line 1799 void fnodetotex_tb(FNODE f,TB tb)

/* internal object */

case I_FORMULA:

obj = (Obj)FA0(f);

objtotex_tb((Obj)FA0(f),tb);

if ( !obj )

write_tb("0",tb);

else if ( OID(obj) == O_N && NID(obj) == N_C ) {

cplx = (C)obj;

write_tb("(",tb);

if ( cplx->r ) {

r = objtostr((Obj)cplx->r); write_tb(r,tb);

}

if ( cplx->i ) {

if ( cplx->r && compnum(0,cplx->i,0) > 0 ) {

write_tb("+",tb);

if ( !UNIQ(cplx->i) ) {

r = objtostr((Obj)cplx->i); write_tb(r,tb);

}

} else if ( MUNIQ(cplx->i) )

write_tb("-",tb);

else if ( !UNIQ(cplx->i) ) {

r = objtostr((Obj)cplx->i); write_tb(r,tb);

}

write_tb("\\sqrt{-1}",tb);

}

write_tb(")",tb);

} else if ( OID(obj) == O_P )

write_tb(conv_rule(VR((P)obj)->name),tb);

else

write_tb(objtostr(obj),tb);

break;

/* program variable */

Line 1800 void fnodetotex_tb(FNODE f,TB tb)

Line 1815 void fnodetotex_tb(FNODE f,TB tb)

}

void objtotex_tb(Obj obj,TB tb)

{

C cplx;

char *r;

P t;

DCP dc;

char *v;

if ( !obj ) {

write_tb("0",tb);

return;

}

switch ( OID(obj) ) {

case O_N:

switch ( NID(obj) ) {

case N_C:

cplx = (C)obj;

write_tb("(",tb);

if ( cplx->r ) {

r = objtostr((Obj)cplx->r); write_tb(r,tb);

}

if ( cplx->i ) {

if ( cplx->r && compnum(0,cplx->i,0) > 0 ) {

write_tb("+",tb);

if ( !UNIQ(cplx->i) ) {

r = objtostr((Obj)cplx->i); write_tb(r,tb);

}

} else if ( MUNIQ(cplx->i) )

write_tb("-",tb);

else if ( !UNIQ(cplx->i) ) {

r = objtostr((Obj)cplx->i); write_tb(r,tb);

}

write_tb("\\sqrt{-1}",tb);

}

write_tb(")",tb);

break;

default:

write_tb(objtostr(obj),tb);

break;

}

break;

case O_P:

v = conv_rule(VR((P)obj)->name);

for ( dc = DC((P)obj); dc; dc = NEXT(dc) ) {

if ( !DEG(dc) )

objtotex_tb((Obj)COEF(dc),tb);

else {

if ( NUM(COEF(dc)) && UNIQ((Q)COEF(dc)) )

;

else if ( NUM(COEF(dc)) && MUNIQ((Q)COEF(dc)) )

write_tb("-",tb);

else if ( NUM(COEF(dc)) || !NEXT(DC(COEF(dc))))

objtotex_tb((Obj)COEF(dc),tb);

else {

write_tb("(",tb); objtotex_tb((Obj)COEF(dc),tb);

write_tb(")",tb);

}

write_tb(v,tb);

if ( cmpq(DEG(dc),ONE) ) {

write_tb("^",tb);

if ( INT(DEG(dc)) && SGN(DEG(dc))>0 ) {

write_tb("{",tb);

objtotex_tb((Obj)DEG(dc),tb);

write_tb("}",tb);

} else {

write_tb("{",tb); objtotex_tb((Obj)DEG(dc),tb);

write_tb("}",tb);

}

if ( NEXT(dc) ) {

t = COEF(NEXT(dc));

if ( !DEG(NEXT(dc)) ) {

if ( NUM(t) ) {

if ( !mmono(t) ) write_tb("+",tb);

} else {

if ( !mmono(COEF(DC(t))) ) write_tb("+",tb);

}

} else {

if ( !mmono(t) ) write_tb("+",tb);

}

break;

case O_R:

write_tb("\\frac{",tb);

objtotex_tb((Obj)NM((R)obj),tb);

write_tb("}{",tb);

objtotex_tb((Obj)DN((R)obj),tb);

write_tb("}",tb);

break;

default:

write_tb(objtostr(obj),tb);

break;

}

char *objtostr(Obj obj)

{

int len;

Line 1915 int top_is_minus(FNODE f)

Line 2027 int top_is_minus(FNODE f)

case O_N:

return mmono((P)obj);

case O_P:

#if 0

/* must be a variable */

opname = conv_rule(VR((P)obj)->name);

return opname[0]=='-';

#else

return mmono((P)obj);

#endif

default:

/* ??? */

len = estimate_length(CO,obj);

Line 2141 VL reordvars(VL vl0,NODE head)

Line 2257 VL reordvars(VL vl0,NODE head)

return vl;

}

VL qt_current_ord;

struct wtab {

LIST qt_current_ord_obj;

V v;

int w;

};

struct wtab *qt_weight_tab;

VL qt_current_ord, qt_current_coef;

LIST qt_current_ord_obj,qt_current_coef_obj,qt_current_weight_obj;

LIST qt_current_weight_obj;

void Pqt_set_ord(NODE arg,LIST *rp)

{

NODE r0,r;

Line 2152 void Pqt_set_ord(NODE arg,LIST *rp)

Line 2275 void Pqt_set_ord(NODE arg,LIST *rp)

if ( !argc(arg) )

*rp = qt_current_ord_obj;

else {

else if ( !ARG0(arg) ) {

qt_current_ord_obj = 0;

qt_current_ord = 0;

} else {

qt_current_ord = reordvars(CO,BDY((LIST)ARG0(arg)));

for ( r0 = 0, vl = qt_current_ord; vl; vl = NEXT(vl) ) {

NEXTNODE(r0,r); MKV(vl->v,v); BDY(r) = v;

Line 2163 void Pqt_set_ord(NODE arg,LIST *rp)

Line 2289 void Pqt_set_ord(NODE arg,LIST *rp)

}

void Pqt_set_weight(NODE arg,LIST *rp)

{

NODE n,pair;

int l,i;

struct wtab *tab;

if ( !argc(arg) )

*rp = qt_current_weight_obj;

else if ( !ARG0(arg) ) {

qt_current_weight_obj = 0;

qt_weight_tab = 0;

} else {

n = BDY((LIST)ARG0(arg));

l = length(n);

tab = qt_weight_tab = (struct wtab *)MALLOC((l+1)*sizeof(struct wtab));

for ( i = 0; i < l; i++, n = NEXT(n) ) {

pair = BDY((LIST)BDY(n));

tab[i].v = VR((P)ARG0(pair));

tab[i].w = QTOS((Q)ARG1(pair));

}

tab[i].v = 0;

qt_current_weight_obj = (LIST)ARG0(arg);

*rp = qt_current_weight_obj;

}

void Pqt_set_coef(NODE arg,LIST *rp)

{

NODE r0,r,n;

VL vl0,vl;

P v;

if ( !argc(arg) )

*rp = qt_current_coef_obj;

else if ( !ARG0(arg) ) {

qt_current_coef_obj = 0;

qt_current_coef = 0;

} else {

n = BDY((LIST)ARG0(arg));

for ( vl0 = 0, r0 = 0; n; n = NEXT(n) ) {

NEXTNODE(r0,r);

NEXTVL(vl0,vl);

vl->v = VR((P)BDY(n));

MKV(vl->v,v); BDY(r) = v;

}

if ( r0 ) NEXT(r) = 0;

if ( vl0 ) NEXT(vl) = 0;

qt_current_coef = vl0;

MKLIST(*rp,r0);

qt_current_coef_obj = *rp;

}

void Pqt_normalize(NODE arg,QUOTE *rp)

{

QUOTE q,r;

Line 2239 void Pnbp_ht(NODE arg, NBP *rp)

Line 2418 void Pnbp_ht(NODE arg, NBP *rp)

else {

m = (NBM)BDY(BDY(p));

NEWNBM(m1);

m1->d = m->d; m1->c = ONE; m1->b = m->b;

m1->d = m->d; m1->c = (P)ONE; m1->b = m->b;

MKNODE(n,m1,0);

MKNBP(*rp,n);

}

void Pnbp_hc(NODE arg, Q *rp)

void Pnbp_hc(NODE arg, P *rp)

{

NBP p;

NBM m;

Line 2273 void Pnbp_rest(NODE arg, NBP *rp)

Line 2452 void Pnbp_rest(NODE arg, NBP *rp)

}

void Pnbp_tm(NODE arg, NBP *rp)

{

NBP p;

NODE n;

NBM m;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

for ( n = BDY(p); NEXT(n); n = NEXT(n) );

m = (NBM)BDY(n);

MKNODE(n,m,0);

MKNBP(*rp,n);

}

void Pnbp_tt(NODE arg, NBP *rp)

{

NBP p;

NODE n;

NBM m,m1;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

for ( n = BDY(p); NEXT(n); n = NEXT(n) );

m = (NBM)BDY(n);

NEWNBM(m1);

m1->d = m->d; m1->c = (P)ONE; m1->b = m->b;

MKNODE(n,m1,0);

MKNBP(*rp,n);

}

void Pnbp_tc(NODE arg, P *rp)

{

NBP p;

NBM m;

NODE n;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

for ( n = BDY(p); NEXT(n); n = NEXT(n) );

m = (NBM)BDY(n);

*rp = m->c;

}

void Pnbp_trest(NODE arg, NBP *rp)

{

NBP p;

NODE n,r,r0;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

n = BDY(p);

for ( r0 = 0; NEXT(n); n = NEXT(n) ) {

NEXTNODE(r0,r);

BDY(r) = (pointer)BDY(n);

}

if ( r0 ) {

NEXT(r) = 0;

MKNBP(*rp,r0);

} else

*rp = 0;

}

void Pnbm_deg(NODE arg, Q *rp)

{

NBP p;

Line 2287 void Pnbm_deg(NODE arg, Q *rp)

Line 2536 void Pnbm_deg(NODE arg, Q *rp)

}

void Pnbm_index(NODE arg, Q *rp)

{

NBP p;

NBM m;

unsigned int *b;

int d,i,r;

p = (NBP)ARG0(arg);

if ( !p )

STOQ(0,*rp);

else {

m = (NBM)BDY(BDY(p));

d = m->d;

if ( d > 32 )

error("nbm_index : weight too large");

b = m->b;

for ( r = 0, i = d-2; i > 0; i-- )

if ( !NBM_GET(b,i) ) r |= (1<<(d-2-i));

STOQ(r,*rp);

}

void Pnbm_hp_rest(NODE arg, LIST *rp)

{

NBP p,h,r;

Line 2308 void Pnbm_hp_rest(NODE arg, LIST *rp)

Line 2579 void Pnbm_hp_rest(NODE arg, LIST *rp)

for ( i = 1; i < d; i++ )

if ( NBM_GET(b,i) != v ) break;

NEWNBM(m1); NEWNBMBDY(m1,i);

b1 = m1->b; m1->d = i; m1->c = ONE;

b1 = m1->b; m1->d = i; m1->c = (P)ONE;

if ( v ) for ( j = 0; j < i; j++ ) NBM_SET(b1,j);

else for ( j = 0; j < i; j++ ) NBM_CLR(b1,j);

MKNODE(n,m1,0); MKNBP(h,n);

d1 = d-i;

NEWNBM(m1); NEWNBMBDY(m1,d1);

b1 = m1->b; m1->d = d1; m1->c = ONE;

b1 = m1->b; m1->d = d1; m1->c = (P)ONE;

for ( j = 0, k = i; j < d1; j++, k++ )

if ( NBM_GET(b,k) ) NBM_SET(b1,j);

else NBM_CLR(b1,j);

Line 2370 void Pnbm_rest(NODE arg, NBP *rp)

Line 2641 void Pnbm_rest(NODE arg, NBP *rp)

separate_nbm((NBM)BDY(BDY(p)),0,0,rp);

}

void Pnbm_tv(NODE arg, NBP *rp)

{

NBP p;

p = (NBP)ARG0(arg);

if ( !p )

*rp = 0;

else

separate_tail_nbm((NBM)BDY(BDY(p)),0,0,rp);

}

void Pnbm_trest(NODE arg, NBP *rp)

{

NBP p;

p = (NBP)ARG0(arg);

if ( !p )

*rp = 0;

else

separate_tail_nbm((NBM)BDY(BDY(p)),0,rp,0);

}

NBP fnode_to_nbp(FNODE f)

{

Q r;

Line 2383 NBP fnode_to_nbp(FNODE f)

Line 2676 NBP fnode_to_nbp(FNODE f)

r = eval(f);

NEWNBM(m);

if ( OID(r) == O_N ) {

m->d = 0; m->c = (Q)r; m->b = 0;

m->d = 0; m->c = (P)r; m->b = 0;

} else {

v = VR((P)r);

m->d = 1; m->c = ONE; NEWNBMBDY(m,1);

m->d = 1; m->c = (P)ONE; NEWNBMBDY(m,1);

if ( !strcmp(NAME(v),"x") ) NBM_SET(m->b,0);

else NBM_CLR(m->b,0);

}

Line 2414 NBP fnode_to_nbp(FNODE f)

Line 2707 NBP fnode_to_nbp(FNODE f)

}

void Pnqt_weight(NODE arg,Q *rp)

{

QUOTE q;

FNODE f;

int w;

q = (QUOTE)ARG0(arg); f = (FNODE)BDY(q);

f = fnode_normalize(f,0);

w = nfnode_weight(qt_weight_tab,f);

STOQ(w,*rp);

}

void Pnqt_comp(NODE arg,Q *rp)

{

QUOTE q1,q2;

Line 2428 void Pnqt_comp(NODE arg,Q *rp)

Line 2733 void Pnqt_comp(NODE arg,Q *rp)

STOQ(r,*rp);

}

INLINE int fnode_is_number(FNODE f)

int fnode_is_var(FNODE f)

{

Obj obj;

VL vl,t,s;

DCP dc;

if ( fnode_is_coef(f) ) return 0;

switch ( f->id ) {

case I_PAREN:

return fnode_is_var(FA0(f));

case I_FORMULA:

obj = FA0(f);

if ( obj && OID(obj) == O_P ) {

dc = DC((P)obj);

if ( !cmpq(DEG(dc),ONE) && !NEXT(dc)

&& !arf_comp(CO,(Obj)COEF(dc),(Obj)ONE) ) return 1;

else return 0;

} else return 0;

default:

return 0;

}

int fnode_is_coef(FNODE f)

{

Obj obj;

VL vl,t,s;

switch ( f->id ) {

case I_MINUS: case I_PAREN:

return fnode_is_coef(FA0(f));

case I_FORMULA:

obj = FA0(f);

if ( !obj ) return 1;

else if ( OID(obj) == O_QUOTE )

return fnode_is_coef(BDY((QUOTE)obj));

else if ( NUM(obj) ) return 1;

else if ( OID(obj) == O_P || OID(obj) == O_R) {

get_vars_recursive(obj,&vl);

for ( t = vl; t; t = NEXT(t) ) {

if ( t->v->attr == (pointer)V_PF ) continue;

for ( s = qt_current_coef; s; s = NEXT(s) )

if ( t->v == s->v ) break;

if ( !s )

return 0;

}

return 1;

} else return 0;

case I_BOP:

return fnode_is_coef(FA1(f)) && fnode_is_coef(FA2(f));

default:

return 0;

}

int fnode_is_number(FNODE f)

{

Obj obj;

switch ( f->id ) {

case I_MINUS: case I_PAREN:

return fnode_is_number(FA0(f));

case I_FORMULA:

Line 2588 FNODE fnode_normalize(FNODE f,int expand)

Line 2953 FNODE fnode_normalize(FNODE f,int expand)

break;

case I_MINUS:

r = nfnode_mul_coef((Num)q,

r = nfnode_mul_coef((Obj)q,

fnode_normalize(FA0(f),expand),expand);

break;

Line 2601 FNODE fnode_normalize(FNODE f,int expand)

Line 2966 FNODE fnode_normalize(FNODE f,int expand)

r = nfnode_add(a1,a2,expand);

break;

case '-':

a2 = nfnode_mul_coef((Num)q,a2,expand);

a2 = nfnode_mul_coef((Obj)q,a2,expand);

r = nfnode_add(a1,a2,expand);

break;

case '*':

Line 2688 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

Line 3053 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

NODE n1,n2,r0,r;

FNODE b1,b2;

int s;

Num c1,c2,c;

Obj c1,c2,c;

if ( IS_ZERO(f1) ) return f2;

else if ( IS_ZERO(f2) ) return f1;

Line 2702 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

Line 3067 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

} else if ( s < 0 ) {

NEXTNODE(r0,r); BDY(r) = BDY(n2); n2 = NEXT(n2);

} else {

addnum(0,c1,c2,&c);

arf_add(CO,c1,c2,&c);

if ( c ) {

NEXTNODE(r0,r); BDY(r) = nfnode_mul_coef(c,b1,expand);

}

Line 2738 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

Line 3103 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

FNODE b1,b2,e1,e2,cc,t,t1;

FNODE *m;

int s;

Num c1,c2,c,e;

Obj c1,c2,c,e;

int l1,l,i,j;

if ( IS_ZERO(f1) || IS_ZERO(f2) ) return mkfnode(1,I_FORMULA,0);

else if ( fnode_is_number(f1) )

else if ( fnode_is_coef(f1) )

return nfnode_mul_coef((Num)eval(f1),f2,expand);

return nfnode_mul_coef((Obj)eval(f1),f2,expand);

else if ( fnode_is_number(f2) )

else if ( fnode_is_coef(f2) )

return nfnode_mul_coef((Num)eval(f2),f1,expand);

return nfnode_mul_coef((Obj)eval(f2),f1,expand);

if ( expand && IS_NARYADD(f1) ) {

t = mkfnode(1,I_FORMULA,0);

Line 2765 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

Line 3130 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

}

fnode_coef_body(f1,&c1,&b1); fnode_coef_body(f2,&c2,&b2);

mulnum(0,c1,c2,&c);

arf_mul(CO,c1,c2,&c);

if ( !c ) return mkfnode(1,I_FORMULA,0);

Line 2774 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

Line 3139 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

m = (FNODE *)ALLOCA(l*sizeof(FNODE));

for ( r = n1, i = 0; i < l1; r = NEXT(r), i++ ) m[i] = BDY(r);

for ( r = n2; r; r = NEXT(r) ) {

if ( i == 0 || (expand == 2) )

if ( i == 0 )

m[i++] = BDY(r);

else {

fnode_base_exp(m[i-1],&b1,&e1); fnode_base_exp(BDY(r),&b2,&e2);

if ( compfnode(b1,b2) ) break;

addnum(0,eval(e1),eval(e2),&e);

arf_add(CO,eval(e1),eval(e2),&e);

if ( !e ) i--;

else if ( UNIQ(e) )

else if ( expand == 2 ) {

if ( INT(e) && SGN((Q)e) < 0 ) {

t1 = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,e));

/* r=(r0|rest)->(r0,t1|rest) */

t = BDY(r);

MKNODE(r1,t1,NEXT(r));

MKNODE(r,t,r1);

i--;

} else

m[i++] = BDY(r);

} else if ( UNIQ(e) )

m[i-1] = b1;

else

m[i-1] = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,e));

Line 2799 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

Line 3174 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)

{

FNODE b,b1,e1,e,cc,r,mf2,mone,inv;

Num c,c1,nf2;

Obj c,c1;

Num nf2;

int ee;

NODE arg,n,t0,t1;

Q q;

if ( IS_ZERO(f2) ) return mkfnode(1,I_FORMULA,ONE);

else if ( IS_ZERO(f1) ) return mkfnode(1,I_FORMULA,0);

else if ( fnode_is_number(f1) ) {

else if ( fnode_is_coef(f1) ) {

if ( fnode_is_integer(f2) ) {

if ( fnode_is_one(f2) ) return f1;

else {

pwrnum(0,(Num)eval(f1),(Num)eval(f2),&c);

arf_pwr(CO,eval(f1),(Obj)eval(f2),&c);

return mkfnode(1,I_FORMULA,c);

}

} else

} else {

f1 = mkfnode(1,I_FORMULA,eval(f1));

return mkfnode(3,I_BOP,pwrfs,f1,f2);

}

} else if ( IS_BINARYPWR(f1) ) {

b1 = FA1(f1); e1 = FA2(f1);

e = nfnode_mul(e1,f2,expand);

Line 2826 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)

Line 3204 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)

&& fnode_is_integer(f2) ) {

fnode_coef_body(f1,&c1,&b1);

nf2 = (Num)eval(f2);

pwrnum(0,(Num)c1,nf2,&c);

arf_pwr(CO,c1,(Obj)nf2,&c);

ee = QTOS((Q)nf2);

cc = mkfnode(1,I_FORMULA,c);

if ( fnode_is_nonnegative_integer(f2) )

Line 2918 FNODE to_narymul(FNODE f)

Line 3296 FNODE to_narymul(FNODE f)

return r;

}

FNODE nfnode_mul_coef(Num c,FNODE f,int expand)

FNODE nfnode_mul_coef(Obj c,FNODE f,int expand)

{

FNODE b1,cc;

Num c1,c2;

Obj c1,c2;

NODE n,r,r0;

if ( !c )

return mkfnode(I_FORMULA,0);

else {

fnode_coef_body(f,&c1,&b1);

mulnum(0,c,c1,&c2);

arf_mul(CO,c,c1,&c2);

if ( UNIQ(c2) ) return b1;

else {

cc = mkfnode(1,I_FORMULA,c2);

Line 2953 FNODE nfnode_mul_coef(Num c,FNODE f,int expand)

Line 3331 FNODE nfnode_mul_coef(Num c,FNODE f,int expand)

}

void fnode_coef_body(FNODE f,Num *cp,FNODE *bp)

void fnode_coef_body(FNODE f,Obj *cp,FNODE *bp)

{

FNODE c;

if ( fnode_is_number(f) ) {

if ( fnode_is_coef(f) ) {

*cp = eval(f); *bp = mkfnode(1,I_FORMULA,ONE);

*cp = (Obj)eval(f); *bp = mkfnode(1,I_FORMULA,ONE);

} else if ( IS_NARYMUL(f) ) {

c=(FNODE)BDY((NODE)FA1(f));

if ( fnode_is_number(c) ) {

if ( fnode_is_coef(c) ) {

*cp = eval(c);

*cp = (Obj)eval(c);

*bp = fnode_node_to_nary(mulfs,NEXT((NODE)FA1(f)));

} else {

*cp = (Num)ONE; *bp = f;

*cp = (Obj)ONE; *bp = f;

}

} else {

*cp = (Num)ONE; *bp = f;

*cp = (Obj)ONE; *bp = f;

}

int nfnode_comp_pwr(FNODE f1,FNODE f2);

int nfnode_weight(struct wtab *tab,FNODE f)

{

NODE n;

int w,w1;

int i;

Q a2;

V v;

switch ( f->id ) {

case I_FORMULA:

if ( fnode_is_coef(f) ) return 0;

else if ( fnode_is_var(f) ) {

if ( !tab ) return 0;

v = VR((P)FA0(f));

for ( i = 0; tab[i].v; i++ )

if ( v == tab[i].v ) return tab[i].w;

return 0;

} else return 0;

/* XXX */

case I_PVAR: return 1;

/* XXX */

case I_FUNC: I_FUNC: I_FUNC_QARG:

/* w(f) = 1 */

/* w(f(a1,...,an)=w(a1)+...+w(an) */

n = FA0((FNODE)FA1(f));

for ( w = 0; n; n = NEXT(n) )

w += nfnode_weight(tab,BDY(n));

return w;

case I_NARYOP:

n = (NODE)FA1(f);

if ( IS_NARYADD(f) )

for ( w = nfnode_weight(tab,BDY(n)),

n = NEXT(n); n; n = NEXT(n) ) {

w1 = nfnode_weight(tab,BDY(n));

w = MAX(w,w1);

}

else

for ( w = 0; n; n = NEXT(n) )

w += nfnode_weight(tab,BDY(n));

return w;

case I_BOP:

/* must be binary power */

/* XXX w(2^x)=0 ? */

if ( fnode_is_rational(FA2(f)) ) {

a2 = (Q)eval(FA2(f));

w = QTOS(a2);

} else

w = nfnode_weight(tab,FA2(f));

return nfnode_weight(tab,FA1(f))*w;

default:

error("nfnode_weight : not_implemented");

}

int nfnode_comp(FNODE f1,FNODE f2)

{

int w1,w2;

if ( qt_weight_tab ) {

w1 = nfnode_weight(qt_weight_tab,f1);

w2 = nfnode_weight(qt_weight_tab,f2);

if ( w1 > w2 ) return 1;

if ( w1 < w2 ) return -1;

}

return nfnode_comp_lex(f1,f2);

}

int nfnode_comp_lex(FNODE f1,FNODE f2)

{

NODE n1,n2;

int r,i1,i2,ret;

char *nm1,*nm2;

FNODE b1,b2,e1,e2,g,a1,a2,fn1,fn2;

FNODE b1,b2,e1,e2,g,a1,a2,fn1,fn2,h1,h2;

Num ee,ee1,c1,c2;

Num ee,ee1;

Obj c1,c2;

int w1,w2;

if ( IS_NARYADD(f1) || IS_NARYADD(f2) ) {

f1 = to_naryadd(f1); f2 = to_naryadd(f2);

n1 = (NODE)FA1(f1); n2 = (NODE)FA1(f2);

while ( n1 && n2 )

for ( ; n1 && n2; n1 = NEXT(n1), n2 = NEXT(n2) ) {

if ( r = nfnode_comp(BDY(n1),BDY(n2)) ) return r;

r = nfnode_comp_lex(BDY(n1),BDY(n2));

else {

if ( r ) return r;

n1 = NEXT(n1); n2 = NEXT(n2);

}

if ( !n1 && !n2 ) return 0;

return n1?1:(n2?-1:0);

h1 = n1 ? (FNODE)BDY(n1) : mkfnode(1,I_FORMULA,0);

h2 = n2 ? (FNODE)BDY(n2) : mkfnode(1,I_FORMULA,0);

return nfnode_comp_lex(h1,h2);

}

if ( IS_NARYMUL(f1) || IS_NARYMUL(f2) ) {

fnode_coef_body(f1,&c1,&b1);

fnode_coef_body(f2,&c2,&b2);

if ( !compfnode(b1,b2) ) return compnum(0,c1,c2);

if ( !compfnode(b1,b2) ) return arf_comp(CO,c1,c2);

b1 = to_narymul(b1); b2 = to_narymul(b2);

n1 = (NODE)FA1(b1); n2 = (NODE)FA1(b2);

while ( 1 ) {

for ( ; n1 && n2; n1 = NEXT(n1), n2 = NEXT(n2) ) {

while ( n1 && n2 && !compfnode(BDY(n1),BDY(n2)) ) {

r = nfnode_comp_lex(BDY(n1),BDY(n2));

n1 = NEXT(n1); n2 = NEXT(n2);

if ( r ) return r;

}

if ( !n1 || !n2 ) {

return n1?1:(n2?-1:0);

}

fnode_base_exp(BDY(n1),&b1,&e1);

fnode_base_exp(BDY(n2),&b2,&e2);

if ( r = nfnode_comp(b1,b2) ) {

if ( r > 0 )

return nfnode_comp(e1,mkfnode(1,I_FORMULA,0));

else if ( r < 0 )

return nfnode_comp(mkfnode(1,I_FORMULA,0),e2);

} else {

n1 = NEXT(n1); n2 = NEXT(n2);

if ( fnode_is_number(e1) && fnode_is_number(e2) ) {

/* f1 = t b^e1 ... , f2 = t b^e2 ... */

subnum(0,eval(e1),eval(e2),&ee);

r = compnum(0,ee,0);

if ( r > 0 ) {

g = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,ee));

MKNODE(n1,g,n1);

} else if ( r < 0 ) {

chsgnnum(ee,&ee1);

g = mkfnode(3,I_BOP,pwrfs,b1,mkfnode(1,I_FORMULA,ee1));

MKNODE(n2,g,n2);

}

} else {

r = nfnode_comp(e1,e2);

if ( r > 0 ) return 1;

else if ( r < 0 ) return -1;

}

if ( !n1 && !n2 ) return 0;

h1 = n1 ? (FNODE)BDY(n1) : mkfnode(1,I_FORMULA,ONE);

h2 = n2 ? (FNODE)BDY(n2) : mkfnode(1,I_FORMULA,ONE);

return nfnode_comp_lex(h1,h2);

}

if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) )

if ( IS_BINARYPWR(f1) || IS_BINARYPWR(f2) ) {

return nfnode_comp_pwr(f1,f2);

fnode_base_exp(f1,&b1,&e1);

fnode_base_exp(f2,&b2,&e2);

if ( r = nfnode_comp_lex(b1,b2) ) {

if ( r > 0 )

return nfnode_comp_lex(e1,mkfnode(1,I_FORMULA,0));

else if ( r < 0 )

return nfnode_comp_lex(mkfnode(1,I_FORMULA,0),e2);

} else return nfnode_comp_lex(e1,e2);

}

/* now, IDs of f1 and f2 must be I_FORMULA, I_FUNC, I_IFUNC or I_PVAR */

/* I_IFUNC > I_PVAR > I_FUNC=I_FUNC_QARG > I_FORMULA */

Line 3048 int nfnode_comp(FNODE f1,FNODE f2)

Line 3476 int nfnode_comp(FNODE f1,FNODE f2)

case I_FUNC: case I_IFUNC: case I_PVAR:

return -1;

default:

error("nfnode_comp : undefined");

error("nfnode_comp_lex : undefined");

}

break;

case I_FUNC: case I_FUNC_QARG:

Line 3066 int nfnode_comp(FNODE f1,FNODE f2)

Line 3494 int nfnode_comp(FNODE f1,FNODE f2)

/* compare args */

n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2));

while ( n1 && n2 )

if ( r = nfnode_comp(BDY(n1),BDY(n2)) ) return r;

if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r;

else {

n1 = NEXT(n1); n2 = NEXT(n2);

}

Line 3074 int nfnode_comp(FNODE f1,FNODE f2)

Line 3502 int nfnode_comp(FNODE f1,FNODE f2)

}

break;

default:

error("nfnode_comp : undefined");

error("nfnode_comp_lex : undefined");

}

case I_PVAR:

switch ( f2->id ) {

Line 3088 int nfnode_comp(FNODE f1,FNODE f2)

Line 3516 int nfnode_comp(FNODE f1,FNODE f2)

else if ( i1 < i2 ) return -1;

else return 0;

default:

error("nfnode_comp : undefined");

error("nfnode_comp_lex : undefined");

}

break;

case I_IFUNC:

Line 3104 int nfnode_comp(FNODE f1,FNODE f2)

Line 3532 int nfnode_comp(FNODE f1,FNODE f2)

/* compare args */

n1 = FA0((FNODE)FA1(f1)); n2 = FA0((FNODE)FA1(f2));

while ( n1 && n2 )

if ( r = nfnode_comp(BDY(n1),BDY(n2)) ) return r;

if ( r = nfnode_comp_lex(BDY(n1),BDY(n2)) ) return r;

else {

n1 = NEXT(n1); n2 = NEXT(n2);

}

Line 3113 int nfnode_comp(FNODE f1,FNODE f2)

Line 3541 int nfnode_comp(FNODE f1,FNODE f2)

break;

default:

error("nfnode_comp : undefined");

error("nfnode_comp_lex : undefined");

}

break;

default:

error("nfnode_comp : undefined");

error("nfnode_comp_lex : undefined");

}

int nfnode_comp_pwr(FNODE f1,FNODE f2)

{

FNODE b1,b2,e1,e2;

int r;

fnode_base_exp(f1,&b1,&e1);

fnode_base_exp(f2,&b2,&e2);

if ( r = nfnode_comp(b1,b2) ) {

if ( r > 0 )

return nfnode_comp(e1,mkfnode(1,I_FORMULA,0));

else if ( r < 0 )

return nfnode_comp(mkfnode(1,I_FORMULA,0),e2);

} else return nfnode_comp(e1,e2);

}

NODE append_node(NODE a1,NODE a2)

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>