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.103 and 1.110

version 1.103, 2005/11/30 04:51:46

version 1.110, 2005/12/14 09:06:54

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.102 2005/11/27 00:07:05 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.109 2005/12/14 06:07:30 noro Exp $

#include "ca.h"

#include "parse.h"

Line 92 void Pquotetotex();

void Pquotetotex_env();

void Pflatten_quote();

void Pquote_is_integer(),Pquote_is_rational(),Pquote_is_number();

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

void Pquote_is_dependent(),Pquote_is_function();

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

void Pquote_normalize();

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

void Pnquote_comp();

void Pqt_normalize();

void Pnquote_match();

void Pnqt_comp();

void Pnqt_match();

void Pnqt_match_rewrite();

void Pquote_to_nbp();

void Pqt_to_nbp();

void Pshuffle_mul(), Pharmonic_mul();

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

void Pnbm_deg();

Line 107 void Pnbm_hxky(), Pnbm_xky_rest();

Line 109 void Pnbm_hxky(), Pnbm_xky_rest();

void Pnbm_hv(), Pnbm_rest();

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

void Pquote_match(),Pget_quote_id(),Pquote_match_rewrite();

void Pqt_match(),Pget_quote_id();

void Pquote_to_nary(),Pquote_to_bin();

void Pqt_to_nary(),Pqt_to_bin();

void fnode_do_assign(NODE arg);

void do_assign(NODE arg);

void fnodetotex_tb(FNODE f,TB tb);

Line 120 void tb_to_string(TB tb,STRING *rp);

Line 122 void tb_to_string(TB tb,STRING *rp);

void fnodenodetotex_tb(NODE n,TB tb);

void fargstotex_tb(char *opname,FNODE f,TB tb);

int top_is_minus(FNODE f);

int quote_match(Obj f,Obj pat,NODE *rp);

int qt_match(Obj f,Obj pat,NODE *rp);

FNODE partial_eval(FNODE), fnode_to_nary(FNODE), fnode_to_bin(FNODE,int);

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(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,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);

FNODE rewrite_fnode(FNODE f,NODE arg,int qarg);

struct ftab str_tab[] = {

{"sprintf",Psprintf,-99999999},

Line 138 struct ftab str_tab[] = {

Line 155 struct ftab str_tab[] = {

{"string_to_tb",Pstring_to_tb,1},

{"get_quote_id",Pget_quote_id,1},

{"quote_is_number",Pquote_is_number,1},

{"qt_is_var",Pqt_is_var,1},

{"quote_is_rational",Pquote_is_rational,1},

{"qt_is_coef",Pqt_is_coef,1},

{"quote_is_integer",Pquote_is_integer,1},

{"qt_is_number",Pqt_is_number,1},

{"quote_is_function",Pquote_is_function,1},

{"qt_is_rational",Pqt_is_rational,1},

{"quote_is_dependent",Pquote_is_dependent,2},

{"qt_is_integer",Pqt_is_integer,1},

{"qt_is_function",Pqt_is_function,1},

{"qt_is_dependent",Pqt_is_dependent,2},

{"quote_normalize",Pquote_normalize,-2},

{"qt_set_coef",Pqt_set_coef,-1},

{"quote_match",Pquote_match,2},

{"qt_set_ord",Pqt_set_ord,-1},

{"quote_match_rewrite",Pquote_match_rewrite,-4},

{"qt_set_weight",Pqt_set_weight,-1},

{"qt_normalize",Pqt_normalize,-2},

{"qt_match",Pqt_match,2},

{"nqt_match_rewrite",Pnqt_match_rewrite,3},

{"nquote_comp",Pnquote_comp,2},

{"nqt_comp",Pnqt_comp,2},

{"nquote_match",Pnquote_match,2},

{"nqt_match",Pnqt_match,-3},

{"quote_to_nbp",Pquote_to_nbp,1},

{"qt_to_nbp",Pqt_to_nbp,1},

{"shuffle_mul",Pshuffle_mul,2},

{"harmonic_mul",Pharmonic_mul,2},

Line 165 struct ftab str_tab[] = {

Line 187 struct ftab str_tab[] = {

{"nbm_hv", Pnbm_hv,1},

{"nbm_rest", Pnbm_rest,1},

{"quote_to_nary",Pquote_to_nary,1},

{"qt_to_nary",Pqt_to_nary,1},

{"quote_to_bin",Pquote_to_bin,2},

{"qt_to_bin",Pqt_to_bin,2},

{"quotetotex_tb",Pquotetotex_tb,2},

{"quotetotex",Pquotetotex,1},

Line 570 void Pwrite_to_tb(NODE arg,Q *rp)

Line 592 void Pwrite_to_tb(NODE arg,Q *rp)

*rp = 0;

}

FNODE partial_eval(FNODE), fnode_to_nary(FNODE), fnode_to_bin(FNODE,int);

void Pqt_to_nary(NODE arg,QUOTE *rp)

void Pquote_to_nary(NODE arg,QUOTE *rp)

{

FNODE f;

Line 580 void Pquote_to_nary(NODE arg,QUOTE *rp)

Line 600 void Pquote_to_nary(NODE arg,QUOTE *rp)

MKQUOTE(*rp,f);

}

void Pquote_to_bin(NODE arg,QUOTE *rp)

void Pqt_to_bin(NODE arg,QUOTE *rp)

{

FNODE f;

int direction;

Line 591 void Pquote_to_bin(NODE arg,QUOTE *rp)

Line 611 void Pquote_to_bin(NODE arg,QUOTE *rp)

MKQUOTE(*rp,f);

}

void Pquote_is_number(NODE arg,Q *rp)

void Pqt_is_var(NODE arg,Q *rp)

{

QUOTE q;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"quote_is_number");

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;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"qt_is_number");

ret = fnode_is_number(BDY(q));

STOQ(ret,*rp);

}

void Pquote_is_rational(NODE arg,Q *rp)

void Pqt_is_rational(NODE arg,Q *rp)

{

QUOTE q;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"quote_is_rational");

asir_assert(q,O_QUOTE,"qt_is_rational");

ret = fnode_is_rational(BDY(q));

STOQ(ret,*rp);

}

void Pquote_is_integer(NODE arg,Q *rp)

void Pqt_is_integer(NODE arg,Q *rp)

{

QUOTE q;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"quote_is_integer");

asir_assert(q,O_QUOTE,"qt_is_integer");

ret = fnode_is_integer(BDY(q));

STOQ(ret,*rp);

}

void Pquote_is_function(NODE arg,Q *rp)

void Pqt_is_function(NODE arg,Q *rp)

{

QUOTE q;

int ret;

q = (QUOTE)ARG0(arg);

asir_assert(q,O_QUOTE,"quote_is_function");

asir_assert(q,O_QUOTE,"qt_is_function");

if ( q->id == I_FUNC || q->id == I_IFUNC )

ret = 1;

else

Line 638 void Pquote_is_function(NODE arg,Q *rp)

Line 680 void Pquote_is_function(NODE arg,Q *rp)

STOQ(ret,*rp);

}

void Pquote_is_dependent(NODE arg,Q *rp)

void Pqt_is_dependent(NODE arg,Q *rp)

{

P x;

QUOTE q,v;

Line 647 void Pquote_is_dependent(NODE arg,Q *rp)

Line 689 void Pquote_is_dependent(NODE arg,Q *rp)

q = (QUOTE)ARG0(arg);

v = (QUOTE)ARG1(arg);

asir_assert(q,O_QUOTE,"quote_is_dependent");

asir_assert(q,O_QUOTE,"qt_is_dependent");

asir_assert(v,O_QUOTE,"quote_is_dependent");

asir_assert(v,O_QUOTE,"qt_is_dependent");

x = (P)eval(BDY(v));

if ( !x || OID(x) != O_P )

*rp = 0;

Line 658 void Pquote_is_dependent(NODE arg,Q *rp)

Line 700 void Pquote_is_dependent(NODE arg,Q *rp)

}

void Pquote_match(NODE arg,Q *rp)

void Pqt_match(NODE arg,Q *rp)

{

FNODE f,g;

Obj obj;

Line 666 void Pquote_match(NODE arg,Q *rp)

Line 708 void Pquote_match(NODE arg,Q *rp)

NODE r;

int ret;

#if 0

g = partial_eval(BDY(((QUOTE)ARG0(arg))));

MKQUOTE(q,g);

ret = quote_match((Obj)q,(Obj)ARG1(arg),&r);

#else

obj = (Obj)ARG0(arg);

ret = quote_match(obj,(Obj)ARG1(arg),&r);

ret = qt_match(obj,(Obj)ARG1(arg),&r);

#endif

if ( ret ) {

do_assign(r);

*rp = ONE;

Line 681 void Pquote_match(NODE arg,Q *rp)

Line 717 void Pquote_match(NODE arg,Q *rp)

*rp = 0;

}

void Pnquote_match(NODE arg,Q *rp)

void Pnqt_match(NODE arg,Q *rp)

{

QUOTE fq,pq;

FNODE f,p;

Q two;

int ret;

Q mode;

NODE r;

STOQ(2,two);

mode = argc(arg)==3 ? (Q)ARG2(arg) : 0;

fq = (QUOTE)ARG0(arg); Pquote_normalize(mknode(2,fq,two),&fq); f = (FNODE)BDY(fq);

fq = (QUOTE)ARG0(arg); Pqt_normalize(mknode(2,fq,mode),&fq); f = (FNODE)BDY(fq);

pq = (QUOTE)ARG1(arg); Pquote_normalize(mknode(2,pq,two),&pq); p = (FNODE)BDY(pq);

pq = (QUOTE)ARG1(arg); Pqt_normalize(mknode(2,pq,mode),&pq); p = (FNODE)BDY(pq);

ret = nfnode_match(f,p,&r);

if ( ret ) {

fnode_do_assign(r);

Line 700 void Pnquote_match(NODE arg,Q *rp)

Line 736 void Pnquote_match(NODE arg,Q *rp)

*rp = 0;

}

void Pnqt_match_rewrite(NODE arg,Obj *rp)

{

FNODE f,p,c,a,r;

Obj obj,pat,cond,action;

NODE rule;

QUOTE q;

Q mode;

int m;

FNODE rewrite_fnode(FNODE,NODE);

obj = (Obj)ARG0(arg);

rule = BDY((LIST)ARG1(arg));

mode = (Q)ARG2(arg);

if ( length(rule) == 2 ) {

pat = ARG0(rule);

cond = (Obj)ONE;

action = (Obj)ARG1(rule);

} else {

pat = ARG0(rule);

cond = ARG1(rule);

action = (Obj)ARG2(rule);

}

Pqt_normalize(mknode(2,obj,mode),&q); f = (FNODE)BDY(q);

Pqt_normalize(mknode(2,pat,mode),&q); p = (FNODE)BDY(q);

Pqt_normalize(mknode(2,action,mode),&q);

a = (FNODE)BDY(q);

if ( OID(cond) == O_QUOTE ) c = BDY((QUOTE)cond);

else c = mkfnode(1,I_FORMULA,ONE);

extern Obj VOIDobj;

m = QTOS(mode);

r = nfnode_match_rewrite(f,p,c,a,m);

if ( r ) {

MKQUOTE(q,r);

*rp = (Obj)q;

} else

*rp = obj;

}

void Pquote_match_rewrite(NODE arg,Obj *rp)

/* f is NARYOP => do submatch */

#define PV_ANY 99999999

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

{

FNODE f,g,h,c,value;

ARF op;

Obj obj;

NODE arg,h0,t,h,valuen;

NODE r,s0,s,pair;

FNODE any,pany,head,tail,a1,a2;

QUOTE q;

NODE r,t,s,s0,pair;

int ret;

int ret,ind,ac;

FNODE value;

int ind;

obj = (Obj)ARG0(arg);

if ( f->id == I_NARYOP ) {

ret = quote_match(obj,(Obj)ARG1(arg),&r);

op = (ARF)FA0(f);

if ( ret ) {

arg = (NODE)FA1(f);

for ( t = r, s0 = 0; t; t = NEXT(t) ) {

pany = 0;

NEXTNODE(s0,s);

for ( h0 = 0, t = arg; t; t = NEXT(t) ) {

pair = BDY((LIST)BDY(t));

tail = fnode_node_to_nary(op,t);

ind = (int)FA0((FNODE)BDY((QUOTE)BDY(pair)));

ret = nfnode_match(tail,p,&r) && eval(rewrite_fnode(c,r,1));

value = BDY((QUOTE)(BDY(NEXT(pair))));

if ( ret ) break;

BDY(s) = mknode(2,ind,value);

}

/* append a variable to the pattern */

if ( s0 ) NEXT(s) = 0;

if ( !pany ) {

switch ( ac = argc(arg) ) {

any = mkfnode(1,I_PVAR,PV_ANY);

case 3:

pany = mkfnode(3,I_BOP,op,p,any);

h = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0);

pany = fnode_normalize(pany,mode);

MKQUOTE(q,h); *rp = (Obj)q;

}

ret = nfnode_match(tail,pany,&r) && eval(rewrite_fnode(c,r,1));

if ( ret ) {

a = fnode_normalize(mkfnode(3,I_BOP,op,a,any),mode);

break;

case 4:

}

c = rewrite_fnode(BDY((QUOTE)ARG2(arg)),s0);

if ( eval(c) ) {

NEXTNODE(h0,h);

h = rewrite_fnode(BDY((QUOTE)ARG3(arg)),s0);

BDY(h) = BDY(t);

MKQUOTE(q,h); *rp = (Obj)q;

} else

*rp = VOIDobj;

break;

default:

error("quote_match_rewrite : invalid argument");

}

if ( t ) {

if ( h0 ) NEXT(h) = 0;

head = fnode_node_to_nary(op,h0);

a = fnode_normalize(mkfnode(3,I_BOP,op,head,a),mode);

ret = 1;

} else

ret = 0;

} else

*rp = VOIDobj;

ret = nfnode_match(f,p,&r) && eval(rewrite_fnode(c,r,1));

if ( ret ) {

a1 = rewrite_fnode(a,r,0);

a2 = partial_eval(a1);

return fnode_normalize(a2,mode);

} else

return 0;

}

void do_assign(NODE arg)

Line 818 int merge_matching_node(NODE n,NODE a,NODE *rp)

Line 904 int merge_matching_node(NODE n,NODE a,NODE *rp)

return 1;

}

int quote_match_node(NODE f,NODE pat,NODE *rp) {

int qt_match_node(NODE f,NODE pat,NODE *rp) {

NODE r,a,tf,tp,r1;

int ret;

if ( length(f) != length(pat) ) return 0;

r = 0;

for ( tf = f, tp = pat; tf; tf = NEXT(tf), tp = NEXT(tp) ) {

ret = quote_match((Obj)BDY(tf),(Obj)BDY(tp),&a);

ret = qt_match((Obj)BDY(tf),(Obj)BDY(tp),&a);

if ( !ret ) return 0;

ret = merge_matching_node(r,a,&r1);

if ( !ret ) return 0;

Line 837 int quote_match_node(NODE f,NODE pat,NODE *rp) {

Line 923 int quote_match_node(NODE f,NODE pat,NODE *rp) {

/* f = [a,b,c,...] pat = [X,Y,...] rpat matches the rest of f */

int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) {

int qt_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp) {

QUOTE q;

Q id;

FNODE fn;

Line 849 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp

Line 935 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp

if ( length(f) < length(pat) ) return 0;

r = 0;

for ( tf = f, tp = pat; tp; tf = NEXT(tf), tp = NEXT(tp) ) {

ret = quote_match((Obj)BDY(tf),(Obj)BDY(tp),&a);

ret = qt_match((Obj)BDY(tf),(Obj)BDY(tp),&a);

if ( !ret ) return 0;

ret = merge_matching_node(r,a,&r1);

if ( !ret ) return 0;

Line 861 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp

Line 947 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp

MKLIST(alist,a);

arg = mknode(1,alist);

Pfunargs_to_quote(arg,&q);

ret = quote_match((Obj)q,rpat,&a);

ret = qt_match((Obj)q,rpat,&a);

if ( !ret ) return 0;

ret = merge_matching_node(r,a,&r1);

if ( !ret ) return 0;

Line 880 void get_quote_id_arg(QUOTE f,int *id,NODE *r)

Line 966 void get_quote_id_arg(QUOTE f,int *id,NODE *r)

/* *rp : [[quote(A),quote(1)],...] */

int quote_match(Obj f, Obj pat, NODE *rp)

int qt_match(Obj f, Obj pat, NODE *rp)

{

NODE tf,tp,head,body;

NODE parg,farg,r;

Line 899 int quote_match(Obj f, Obj pat, NODE *rp)

Line 985 int quote_match(Obj f, Obj pat, NODE *rp)

return 0;

else if ( OID(pat) == O_LIST ) {

if ( OID(f) == O_LIST )

return quote_match_node(BDY((LIST)f),BDY((LIST)pat),rp);

return qt_match_node(BDY((LIST)f),BDY((LIST)pat),rp);

else

return 0;

} else if ( OID(pat) == O_QUOTE ) {

Line 926 int quote_match(Obj f, Obj pat, NODE *rp)

Line 1012 int quote_match(Obj f, Obj pat, NODE *rp)

tp = BDY((LIST)BDY(parg));

if ( pid == I_LIST )

return quote_match_node(tf,tp,rp);

return qt_match_node(tf,tp,rp);

else {

rpat = (Obj)BDY(NEXT(parg));

return quote_match_cons(tf,tp,rpat,rp);

return qt_match_cons(tf,tp,rpat,rp);

}

case I_PVAR:

Line 945 int quote_match(Obj f, Obj pat, NODE *rp)

Line 1031 int quote_match(Obj f, Obj pat, NODE *rp)

if ( id == I_FUNC ) {

r = mknode(2,BDY(parg),BDY(farg)); MKLIST(l,r);

head = mknode(1,l);

ret = quote_match(BDY(NEXT(farg)),

ret = qt_match(BDY(NEXT(farg)),

BDY(NEXT(parg)),&body);

if ( !ret ) return 0;

else return merge_matching_node(head,body,rp);

Line 973 int quote_match(Obj f, Obj pat, NODE *rp)

Line 1059 int quote_match(Obj f, Obj pat, NODE *rp)

get_quote_id_arg((QUOTE)pat,&pid,&parg);

get_quote_id_arg((QUOTE)f,&id,&farg);

if ( compqa(CO,BDY(farg),BDY(parg)) ) return 0;

return quote_match_node(NEXT(farg),NEXT(parg),rp);

return qt_match_node(NEXT(farg),NEXT(parg),rp);

default:

if ( OID(f) != O_QUOTE ) return 0;

Line 981 int quote_match(Obj f, Obj pat, NODE *rp)

Line 1067 int quote_match(Obj f, Obj pat, NODE *rp)

if ( id != pid ) return 0;

get_quote_id_arg((QUOTE)pat,&pid,&parg);

get_quote_id_arg((QUOTE)f,&id,&farg);

return quote_match_node(farg,parg,rp);

return qt_match_node(farg,parg,rp);

}

Line 2048 void Pfunargs_to_quote(NODE arg,QUOTE *rp)

Line 2134 void Pfunargs_to_quote(NODE arg,QUOTE *rp)

MKQUOTE(*rp,f);

}

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

VL reordvars(VL vl0,NODE head)

FNODE fnode_normalize(FNODE f,int expand);

{

VL vl,svl,tvl;

int i,j;

NODE n;

P t;

V *va;

V v;

void Pquote_normalize(NODE arg,QUOTE *rp)

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

NEXTVL(vl,tvl);

if ( !(t = (P)BDY(n)) || (OID(t) != O_P) )

error("reordvars : invalid argument");

VR(tvl) = VR(t);

}

va = (V *)ALLOCA(i*sizeof(V));

for ( j = 0, svl = vl; j < i; j++, svl = NEXT(svl) )

va[j] = VR(svl);

for ( svl = vl0; svl; svl = NEXT(svl) ) {

v = VR(svl);

for ( j = 0; j < i; j++ )

if ( v == va[j] )

break;

if ( j == i ) {

NEXTVL(vl,tvl);

VR(tvl) = v;

}

if ( vl )

NEXT(tvl) = 0;

return vl;

}

struct wtab {

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;

VL vl;

P v;

if ( !argc(arg) )

*rp = qt_current_ord_obj;

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;

}

if ( r0 ) NEXT(r) = 0;

MKLIST(*rp,r0);

qt_current_ord_obj = *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;

FNODE f;

int expand,ac;

ac = argc(arg);

if ( !ac ) error("quote_normalize : invalid argument");

if ( !ac ) error("qt_normalize : invalid argument");

q = (QUOTE)ARG0(arg);

if ( ac == 2 )

expand = QTOS((Q)ARG1(arg));

Line 2073 void Pquote_normalize(NODE arg,QUOTE *rp)

Line 2274 void Pquote_normalize(NODE arg,QUOTE *rp)

NBP fnode_to_nbp(FNODE f);

void Pquote_to_nbp(NODE arg,NBP *rp)

void Pqt_to_nbp(NODE arg,NBP *rp)

{

QUOTE q;

FNODE f;

Line 2302 NBP fnode_to_nbp(FNODE f)

Line 2503 NBP fnode_to_nbp(FNODE f)

}

void Pnquote_comp(NODE arg,Q *rp)

void Pnqt_comp(NODE arg,Q *rp)

{

QUOTE q1,q2;

FNODE f1,f2;

Line 2316 void Pnquote_comp(NODE arg,Q *rp)

Line 2517 void Pnquote_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) ) {

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 2460 int fnode_is_dependent(FNODE f,V v)

Line 2719 int fnode_is_dependent(FNODE f,V v)

}

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 fnode_expand_pwr(FNODE f,int n,int expand);

FNODE to_narymul(FNODE f);

FNODE to_naryadd(FNODE f);

FNODE fnode_node_to_naryadd(NODE n);

FNODE fnode_node_to_narymul(NODE n);

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

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

FNODE fnode_normalize(FNODE f,int expand)

{

FNODE a1,a2,mone,r,b2;

Line 2488 FNODE fnode_normalize(FNODE f,int expand)

Line 2735 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 2501 FNODE fnode_normalize(FNODE f,int expand)

Line 2748 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 2588 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

Line 2835 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 2602 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

Line 2849 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 2618 FNODE nfnode_add(FNODE f1,FNODE f2,int expand)

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

else if ( r0 )

NEXT(r) = 0;

return fnode_node_to_naryadd(r0);

return fnode_node_to_nary(addfs,r0);

}

FNODE fnode_node_to_naryadd(NODE n)

FNODE fnode_node_to_nary(ARF op,NODE n)

{

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

if ( !n ) {

else if ( !NEXT(n) ) return BDY(n);

if ( op->name[0] == '+' )

else return mkfnode(2,I_NARYOP,addfs,n);

return mkfnode(1,I_FORMULA,0);

else

return mkfnode(1,I_FORMULA,ONE);

} else if ( !NEXT(n) ) return BDY(n);

else return mkfnode(2,I_NARYOP,op,n);

}

FNODE fnode_node_to_narymul(NODE n)

{

if ( !n ) return mkfnode(1,I_FORMULA,ONE);

else if ( !NEXT(n) ) return BDY(n);

else return mkfnode(2,I_NARYOP,mulfs,n);

}

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

{

NODE n1,n2,r0,r,r1;

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 2668 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

Line 2912 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 2682 FNODE nfnode_mul(FNODE f1,FNODE f2,int expand)

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

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) )

m[i-1] = b1;

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

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

if ( !UNIQ(c) ) {

cc = mkfnode(1,I_FORMULA,c); MKNODE(r1,cc,r); r = r1;

}

return fnode_node_to_narymul(r);

return fnode_node_to_nary(mulfs,r);

}

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 2729 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)

Line 2976 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 2742 FNODE nfnode_pwr(FNODE f1,FNODE f2,int expand)

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

inv = mkfnode(3,I_BOP,pwrfs,BDY(n),mone);

MKNODE(t1,inv,t0); t0 = t1;

}

b1 = fnode_node_to_narymul(t0);

b1 = fnode_node_to_nary(mulfs,t0);

b = fnode_expand_pwr(b1,-ee,expand);

}

if ( fnode_is_one(cc) )

return b;

else

return fnode_node_to_narymul(mknode(2,cc,b));

return fnode_node_to_nary(mulfs,mknode(2,cc,b));

} else if ( expand && fnode_is_integer(f2)

&& fnode_is_nonnegative_integer(f2) ) {

q = (Q)eval(f2);

Line 2821 FNODE to_narymul(FNODE f)

Line 3068 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 2842 FNODE nfnode_mul_coef(Num c,FNODE f,int expand)

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

return cc;

} else if ( IS_NARYMUL(b1) ) {

MKNODE(n,cc,FA1(b1));

return fnode_node_to_narymul(n);

return fnode_node_to_nary(mulfs,n);

} else if ( expand && IS_NARYADD(b1) ) {

for ( r0 = 0, n = (NODE)FA1(b1); n; n = NEXT(n) ) {

NEXTNODE(r0,r);

BDY(r) = nfnode_mul_coef(c2,BDY(n),expand);

}

if ( r0 ) NEXT(r) = 0;

return fnode_node_to_naryadd(r0);

return fnode_node_to_nary(addfs,r0);

} else

return fnode_node_to_narymul(mknode(2,cc,b1));

return fnode_node_to_nary(mulfs,mknode(2,cc,b1));

}

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_narymul(NEXT((NODE)FA1(f)));

*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) ) {

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

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

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

return w;

} 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;

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 )

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 2898 int nfnode_comp(FNODE f1,FNODE f2)

Line 3212 int nfnode_comp(FNODE f1,FNODE f2)

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 ) {

Line 2911 int nfnode_comp(FNODE f1,FNODE f2)

Line 3225 int nfnode_comp(FNODE f1,FNODE f2)

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

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

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

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

if ( r > 0 )

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

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

else if ( r < 0 )

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

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

} else {

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

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

Line 2931 int nfnode_comp(FNODE f1,FNODE f2)

Line 3245 int nfnode_comp(FNODE f1,FNODE f2)

MKNODE(n2,g,n2);

}

} else {

r = nfnode_comp(e1,e2);

r = nfnode_comp_lex(e1,e2);

if ( r > 0 ) return 1;

else if ( r < 0 ) return -1;

}

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_FORMULA */

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

switch ( f1->id ) {

case I_FORMULA:

switch ( f2->id ) {

case I_FORMULA:

return arf_comp(CO,FA0(f1),FA0(f2));

return arf_comp(qt_current_ord?qt_current_ord:CO,FA0(f1),FA0(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: case I_FUNC_QARG:

switch ( f2->id ) {

case I_FORMULA:

return 1;

case I_PVAR: case I_IFUNC:

return -1;

case I_FUNC:

case I_FUNC: case I_FUNC_QARG:

nm1 = ((FUNC)FA0(f1))->name; nm2 = ((FUNC)FA0(f2))->name;

r = strcmp(nm1,nm2);

if ( r > 0 ) return 1;

Line 2969 int nfnode_comp(FNODE f1,FNODE f2)

Line 3291 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 2977 int nfnode_comp(FNODE f1,FNODE f2)

Line 3299 int nfnode_comp(FNODE f1,FNODE f2)

}

break;

default:

error("nfnode_comp : undefined");

error("nfnode_comp_lex : undefined");

}

case I_PVAR:

switch ( f2->id ) {

case I_FORMULA: case I_FUNC:

case I_FORMULA: case I_FUNC: case I_FUNC_QARG:

return 1;

case I_IFUNC:

return -1;

Line 2991 int nfnode_comp(FNODE f1,FNODE f2)

Line 3313 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:

switch ( f2->id ) {

case I_FORMULA: case I_FUNC: case I_PVAR:

case I_FORMULA: case I_FUNC: case I_FUNC_QARG: case I_PVAR:

return 1;

case I_IFUNC:

i1 = (int)FA0((FNODE)FA0(f1));

Line 3007 int nfnode_comp(FNODE f1,FNODE f2)

Line 3329 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 3016 int nfnode_comp(FNODE f1,FNODE f2)

Line 3338 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)

{

NODE t,t0;

Line 3093 int nfnode_match(FNODE f,FNODE pat,NODE *rp)

Line 3400 int nfnode_match(FNODE f,FNODE pat,NODE *rp)

fbase = f; fexp = mkfnode(1,I_FORMULA,ONE);

}

if ( !nfnode_match(fbase,FA1(pat),&base) ) return 0;

a = rewrite_fnode(FA2(pat),base);

a = rewrite_fnode(FA2(pat),base,0);

if ( !nfnode_match(fexp,a,&exp) ) return 0;

else {

*rp = append_node(base,exp);

Line 3117 int nfnode_match(FNODE f,FNODE pat,NODE *rp)

Line 3424 int nfnode_match(FNODE f,FNODE pat,NODE *rp)

fa = (NODE)FA0((FNODE)FA1(f));

pa = (NODE)FA0((FNODE)FA1(pat));

while ( fa && pa ) {

a = rewrite_fnode(BDY(pa),m);

a = rewrite_fnode(BDY(pa),m,0);

if ( !nfnode_match(BDY(fa),a,&m1) ) return 0;

m = append_node(m1,m);

fa = NEXT(fa); pa = NEXT(pa);

Line 3153 FNODE fnode_removeith_naryadd(FNODE p,int i)

Line 3460 FNODE fnode_removeith_naryadd(FNODE p,int i)

l = length(a);

if ( i < 0 || i >= l ) error("fnode_removeith_naryadd: invalid index");

else if ( i == 0 )

return fnode_node_to_naryadd(NEXT(a));

return fnode_node_to_nary(addfs,NEXT(a));

else {

for ( r0 = 0, k = 0, t = a; k < i; k++, t = NEXT(t) ) {

NEXTNODE(r0,r);

BDY(r) = BDY(t);

}

NEXT(r) = NEXT(t);

return fnode_node_to_naryadd(r0);

return fnode_node_to_nary(addfs,r0);

}

Line 3182 FNODE fnode_left_narymul(FNODE p,int i)

Line 3489 FNODE fnode_left_narymul(FNODE p,int i)

BDY(r) = BDY(t);

}

NEXT(r) = 0;

return fnode_node_to_narymul(r0);

return fnode_node_to_nary(mulfs,r0);

}

Line 3198 FNODE fnode_right_narymul(FNODE p,int i)

Line 3505 FNODE fnode_right_narymul(FNODE p,int i)

if ( i == l-1 ) return 0;

else {

for ( k = 0, t = a; k <= i; k++, t = NEXT(t) );

return fnode_node_to_narymul(t);

return fnode_node_to_nary(mulfs,t);

}

Line 3240 int nfnode_match_naryadd(FNODE f,FNODE p,NODE *rp)

Line 3547 int nfnode_match_naryadd(FNODE f,FNODE p,NODE *rp)

for ( s = fa, fi = 0; s; s = NEXT(s), fi++ ) {

if ( nfnode_match(BDY(s),pivot,&m) ) {

fr = fnode_removeith_naryadd(f,fi);

prr = rewrite_fnode(pr,m);

prr = rewrite_fnode(pr,m,0);

if ( nfnode_match(fr,prr,&m1) ) {

*rp = append_node(m,m1);

return 1;

Line 3274 int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)

Line 3581 int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)

/* all are I_PVAR */

m = 0;

for ( t = pa, s = fa; NEXT(t); t = NEXT(t), s = NEXT(s) ) {

pr = rewrite_fnode(BDY(t),m);

pr = rewrite_fnode(BDY(t),m,0);

if ( !nfnode_match(BDY(s),pr,&m1) ) return 0;

m = append_node(m1,m);

}

Line 3282 int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)

Line 3589 int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)

fr = (FNODE)BDY(s);

else

fr = mkfnode(2,I_NARYOP,FA0(f),s);

pr = rewrite_fnode(BDY(t),m);

pr = rewrite_fnode(BDY(t),m,0);

if ( !nfnode_match(fr,pr,&m1) ) return 0;

*rp = append_node(m1,m);

return 1;

Line 3295 int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)

Line 3602 int nfnode_match_narymul(FNODE f,FNODE p,NODE *rp)

if ( fi < pi ) continue;

if ( nfnode_match(BDY(s),pivot,&m) ) {

fleft = fnode_left_narymul(f,fi);

pleft1 = rewrite_fnode(pleft,m);

pleft1 = rewrite_fnode(pleft,m,0);

if ( nfnode_match(fleft,pleft1,&m1) ) {

m = append_node(m1,m);

fright = fnode_right_narymul(f,fi);

pright1 = rewrite_fnode(pright,m);

pright1 = rewrite_fnode(pright,m,0);

if ( nfnode_match(fright,pright1,&m1) ) {

*rp = append_node(m1,m);

return 1;

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