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.96 and 1.105

version 1.96, 2005/11/04 07:03:38

version 1.105, 2005/12/09 08:10:44

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.95 2005/11/03 07:41:22 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.104 2005/11/30 05:08:00 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();

void Pquote_is_dependent(),Pquote_is_function();

void Pqt_is_dependent(),Pqt_is_function();

void Pquote_normalize();

void Pqt_set_ord();

void Pnquote_comp();

void Pqt_normalize();

void Pnquote_match();

void Pnqt_comp();

void Pnqt_match();

void Pqt_to_nbp();

void Pshuffle_mul(), Pharmonic_mul();

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

void Pnbm_deg();

void Pnbm_hp_rest();

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

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 112 void tb_to_string(TB tb,STRING *rp);

Line 121 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);

struct ftab str_tab[] = {

{"sprintf",Psprintf,-99999999},

Line 130 struct ftab str_tab[] = {

Line 139 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_number",Pqt_is_number,1},

{"quote_is_rational",Pquote_is_rational,1},

{"qt_is_rational",Pqt_is_rational,1},

{"quote_is_integer",Pquote_is_integer,1},

{"qt_is_integer",Pqt_is_integer,1},

{"quote_is_function",Pquote_is_function,1},

{"qt_is_function",Pqt_is_function,1},

{"quote_is_dependent",Pquote_is_dependent,2},

{"qt_is_dependent",Pqt_is_dependent,2},

{"quote_normalize",Pquote_normalize,-2},

{"qt_set_ord",Pqt_set_ord,-1},

{"quote_match",Pquote_match,2},

{"qt_normalize",Pqt_normalize,-2},

{"quote_match_rewrite",Pquote_match_rewrite,-4},

{"qt_match",Pqt_match,2},

{"nquote_comp",Pnquote_comp,2},

{"qt_match_rewrite",Pqt_match_rewrite,-4},

{"nquote_match",Pnquote_match,2},

{"quote_to_nary",Pquote_to_nary,1},

{"nqt_comp",Pnqt_comp,2},

{"quote_to_bin",Pquote_to_bin,2},

{"nqt_match",Pnqt_match,-3},

{"qt_to_nbp",Pqt_to_nbp,1},

{"shuffle_mul",Pshuffle_mul,2},

{"harmonic_mul",Pharmonic_mul,2},

{"nbp_hm", Pnbp_hm,1},

{"nbp_ht", Pnbp_ht,1},

{"nbp_hc", Pnbp_hc,1},

{"nbp_rest", Pnbp_rest,1},

{"nbm_deg", Pnbm_deg,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_rest", Pnbm_rest,1},

{"qt_to_nary",Pqt_to_nary,1},

{"qt_to_bin",Pqt_to_bin,2},

{"quotetotex_tb",Pquotetotex_tb,2},

{"quotetotex",Pquotetotex,1},

{"quotetotex_env",Pquotetotex_env,-99999999},

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

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

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

void Pquote_to_nary(NODE arg,QUOTE *rp)

void Pqt_to_nary(NODE arg,QUOTE *rp)

{

FNODE f;

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

Line 582 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 568 void Pquote_to_bin(NODE arg,QUOTE *rp)

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

MKQUOTE(*rp,f);

}

void Pquote_is_number(NODE arg,Q *rp)

void Pqt_is_number(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_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 615 void Pquote_is_function(NODE arg,Q *rp)

Line 640 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 624 void Pquote_is_dependent(NODE arg,Q *rp)

Line 649 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 635 void Pquote_is_dependent(NODE arg,Q *rp)

Line 660 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 646 void Pquote_match(NODE arg,Q *rp)

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

#if 0

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

MKQUOTE(q,g);

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

ret = qt_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);

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

Line 683 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;

int ret;

Q mode;

NODE r;

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

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

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

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

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 675 void Pnquote_match(NODE arg,Q *rp)

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

*rp = 0;

}

FNODE rewrite_fnode(FNODE,NODE);

extern Obj VOIDobj;

void Pquote_match_rewrite(NODE arg,Obj *rp)

void Pqt_match_rewrite(NODE arg,Obj *rp)

{

FNODE f,g,h,c,value;

Obj obj;

Line 688 void Pquote_match_rewrite(NODE arg,Obj *rp)

Line 716 void Pquote_match_rewrite(NODE arg,Obj *rp)

int ret,ind,ac;

obj = (Obj)ARG0(arg);

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

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

if ( ret ) {

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

NEXTNODE(s0,s);

Line 712 void Pquote_match_rewrite(NODE arg,Obj *rp)

Line 740 void Pquote_match_rewrite(NODE arg,Obj *rp)

*rp = VOIDobj;

break;

default:

error("quote_match_rewrite : invalid argument");

error("qt_match_rewrite : invalid argument");

}

} else

*rp = VOIDobj;

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

Line 820 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 811 int quote_match_node(NODE f,NODE pat,NODE *rp) {

Line 839 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 823 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp

Line 851 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 835 int quote_match_cons(NODE f,NODE pat,Obj rpat,NODE *rp

Line 863 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 854 void get_quote_id_arg(QUOTE f,int *id,NODE *r)

Line 882 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 873 int quote_match(Obj f, Obj pat, NODE *rp)

Line 901 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 900 int quote_match(Obj f, Obj pat, NODE *rp)

Line 928 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 919 int quote_match(Obj f, Obj pat, NODE *rp)

Line 947 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 947 int quote_match(Obj f, Obj pat, NODE *rp)

Line 975 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 955 int quote_match(Obj f, Obj pat, NODE *rp)

Line 983 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 2025 void Pfunargs_to_quote(NODE arg,QUOTE *rp)

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

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

FNODE fnode_normalize(FNODE f,int expand);

void Pquote_normalize(NODE arg,QUOTE *rp)

VL reordvars(VL vl0,NODE head)

{

VL vl,svl,tvl;

int i,j;

NODE n;

P t;

V *va;

V v;

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;

}

VL qt_current_ord;

LIST qt_current_ord_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 {

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

expand = ac==2 && ARG1(arg);

if ( ac == 2 )

if ( !q || OID(q) != O_QUOTE ) {

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

if ( !q || OID(q) != O_QUOTE )

*rp = q;

return;

} else if ( q->normalized && (q->expanded || !expand) )

*rp = q;

else {

f = fnode_normalize(BDY(q),expand);

MKQUOTE(r,f);

r->normalized = 1;

if ( expand ) r->expanded = 1;

*rp = r;

}

void Pnquote_comp(NODE arg,Q *rp)

NBP fnode_to_nbp(FNODE f);

void Pqt_to_nbp(NODE arg,NBP *rp)

{

QUOTE q;

FNODE f;

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

f = fnode_normalize(f,0);

*rp = fnode_to_nbp(f);

}

void Pshuffle_mul(NODE arg,NBP *rp)

{

NBP p1,p2;

p1 = (NBP)ARG0(arg);

p2 = (NBP)ARG1(arg);

shuffle_mulnbp(CO,p1,p2,rp);

}

void Pharmonic_mul(NODE arg,NBP *rp)

{

NBP p1,p2;

p1 = (NBP)ARG0(arg);

p2 = (NBP)ARG1(arg);

harmonic_mulnbp(CO,p1,p2,rp);

}

void Pnbp_hm(NODE arg, NBP *rp)

{

NBP p;

NODE n;

NBM m;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

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

MKNODE(n,m,0);

MKNBP(*rp,n);

}

void Pnbp_ht(NODE arg, NBP *rp)

{

NBP p;

NODE n;

NBM m,m1;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

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

NEWNBM(m1);

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

MKNODE(n,m1,0);

MKNBP(*rp,n);

}

void Pnbp_hc(NODE arg, Q *rp)

{

NBP p;

NBM m;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

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

*rp = m->c;

}

void Pnbp_rest(NODE arg, NBP *rp)

{

NBP p;

NODE n;

p = (NBP)ARG0(arg);

if ( !p ) *rp = 0;

else {

n = BDY(p);

if ( !NEXT(n) ) *rp = 0;

else

MKNBP(*rp,NEXT(n));

}

void Pnbm_deg(NODE arg, Q *rp)

{

NBP p;

NBM m;

p = (NBP)ARG0(arg);

if ( !p )

STOQ(-1,*rp);

else {

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

STOQ(m->d,*rp);

}

void Pnbm_hp_rest(NODE arg, LIST *rp)

{

NBP p,h,r;

NBM m,m1;

NODE n;

int *b,*b1;

int d,d1,v,i,j,k;

p = (NBP)ARG0(arg);

if ( !p )

MKLIST(*rp,0);

else {

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

b = m->b; d = m->d;

if ( !d )

MKLIST(*rp,0);

else {

v = NBM_GET(b,0);

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;

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;

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

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

else NBM_CLR(b1,j);

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

n = mknode(2,h,r);

MKLIST(*rp,n);

}

void Pnbm_hxky(NODE arg, LIST *rp)

{

NBP p;

p = (NBP)ARG0(arg);

if ( !p )

*rp = 0;

else

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

}

void Pnbm_xky_rest(NODE arg,NBP *rp)

{

NBP p;

p = (NBP)ARG0(arg);

if ( !p )

*rp = 0;

else

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

}

void Pnbm_hv(NODE arg, NBP *rp)

{

NBP p;

p = (NBP)ARG0(arg);

if ( !p )

*rp = 0;

else

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

}

void Pnbm_rest(NODE arg, NBP *rp)

{

NBP p;

p = (NBP)ARG0(arg);

if ( !p )

*rp = 0;

else

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

}

NBP fnode_to_nbp(FNODE f)

{

Q r;

int n,i;

NBM m;

V v;

NBP u,u1,u2;

NODE t,b;

if ( f->id == I_FORMULA ) {

r = eval(f);

NEWNBM(m);

if ( OID(r) == O_N ) {

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

} else {

v = VR((P)r);

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

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

else NBM_CLR(m->b,0);

}

MKNODE(b,m,0); MKNBP(u,b);

return u;

} else if ( IS_NARYADD(f) ) {

t = (NODE)FA1(f); u = fnode_to_nbp((FNODE)BDY(t));

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

u1 = fnode_to_nbp((FNODE)BDY(t));

addnbp(CO,u,u1,&u2); u = u2;

}

return u;

} else if ( IS_NARYMUL(f) ) {

t = (NODE)FA1(f); u = fnode_to_nbp((FNODE)BDY(t));

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

u1 = fnode_to_nbp((FNODE)BDY(t));

mulnbp(CO,u,u1,&u2); u = u2;

}

return u;

} else if ( IS_BINARYPWR(f) ) {

u = fnode_to_nbp((FNODE)FA1(f));

r = eval((FNODE)FA2(f));

pwrnbp(CO,u,r,&u1);

return u1;

}

void Pnqt_comp(NODE arg,Q *rp)

{

QUOTE q1,q2;

FNODE f1,f2;

int r;

q1 = (QUOTE)ARG0(arg); f1 = (FNODE)BDY(q1);

q2 = (QUOTE)ARG1(arg); f2 = (FNODE)BDY(q2);

if ( !q1->normalized ) f1 = fnode_normalize(f1,0);

f1 = fnode_normalize(f1,0);

if ( !q2->normalized ) f2 = fnode_normalize(f2,0);

f2 = fnode_normalize(f2,0);

r = nfnode_comp(f1,f2);

STOQ(r,*rp);

}

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

Line 2521 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);

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

Line 2226 FNODE fnode_normalize(FNODE f,int expand)

Line 2536 FNODE fnode_normalize(FNODE f,int expand)

NODE n;

Q q;

if ( f->normalized && (f->expanded || !expand) ) return f;

if ( f->normalized && (f->expanded == expand) ) return f;

STOQ(-1,q);

mone = mkfnode(1,I_FORMULA,q);

switch ( f->id ) {

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

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

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

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

else {

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

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

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

ee = QTOS((Q)nf2);

cc = mkfnode(1,I_FORMULA,c);

if ( fnode_is_nonnegative_integer(f2) )

b = fnode_expand_pwr(b1,ee);

b = fnode_expand_pwr(b1,ee,expand);

else {

STOQ(-1,q);

mone = mkfnode(1,I_FORMULA,q);

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

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

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

}

b1 = fnode_node_to_narymul(t0);

b = fnode_expand_pwr(b1,-ee);

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

}

if ( fnode_is_one(cc) )

return b;

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

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

&& fnode_is_nonnegative_integer(f2) ) {

q = (Q)eval(f2);

if ( PL(NM(q)) > 1 ) error("nfnode_pwr : exponent too large");

return fnode_expand_pwr(f1,QTOS(q));

return fnode_expand_pwr(f1,QTOS(q),expand);

} else

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

}

FNODE fnode_expand_pwr(FNODE f,int n)

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

{

int n1;

int n1,i;

FNODE f1,f2;

FNODE f1,f2,fn;

Q q;

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

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

else if ( n == 1 ) return f;

else {

n1 = n/2;

switch ( expand ) {

f1 = fnode_expand_pwr(f,n1);

case 1:

f2 = nfnode_mul(f1,f1,1);

n1 = n/2;

if ( n%2 ) f2 = nfnode_mul(f2,f,1);

f1 = fnode_expand_pwr(f,n1,expand);

return f2;

f2 = nfnode_mul(f1,f1,expand);

if ( n%2 ) f2 = nfnode_mul(f2,f,1);

return f2;

case 2:

for ( i = 1, f1 = f; i < n; i++ )

f1 = nfnode_mul(f1,f,expand);

return f1;

case 0: default:

STOQ(n,q);

fn = mkfnode(1,I_FORMULA,q);

return mkfnode(3,I_BOP,pwrfs,f,fn);

}

Line 2682 int nfnode_comp(FNODE f1,FNODE f2)

Line 3004 int nfnode_comp(FNODE f1,FNODE f2)

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:

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

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

FUNC ff,pf;

int r;

if ( !pat )

if ( !f ) {

*rp = 0;

return 1;

} else

return 0;

else if ( !f )

return 0;

switch ( pat->id ) {

case I_PVAR:

/* [[pat,f]] */

*rp = mknode(1,mknode(2,(int)FA0(pat),f),0);

*rp = mknode(1,mknode(2,(int)FA0(pat),f));

return 1;

case I_FORMULA:

Line 2901 FNODE fnode_left_narymul(FNODE p,int i)

Line 3231 FNODE fnode_left_narymul(FNODE p,int i)

a = (NODE)FA1(p);

l = length(a);

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

if ( i == 0 ) return mkfnode(1,I_FORMULA,ONE);

if ( i == 0 ) return 0;

else if ( i == 1 ) return (FNODE)BDY(a);

else {

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

Line 2922 FNODE fnode_right_narymul(FNODE p,int i)

Line 3252 FNODE fnode_right_narymul(FNODE p,int i)

a = (NODE)FA1(p);

l = length(a);

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

if ( i == l-1 ) return mkfnode(1,I_FORMULA,ONE);

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

else {

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

return fnode_node_to_narymul(t);

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

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

pright = fnode_right_narymul(p,pi);

/* XXX : incomplete */

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

if ( fi < pi ) continue;

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

fleft = fnode_left_narymul(f,fi);

pleft1 = rewrite_fnode(pleft,m);

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