=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/puref.c,v retrieving revision 1.5 retrieving revision 1.8 diff -u -p -r1.5 -r1.8 --- OpenXM_contrib2/asir2000/parse/puref.c 2003/05/20 06:15:01 1.5 +++ OpenXM_contrib2/asir2000/parse/puref.c 2005/10/05 08:57:25 1.8 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/parse/puref.c,v 1.4 2001/10/09 01:36:24 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/parse/puref.c,v 1.7 2004/08/18 00:50:37 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -183,7 +183,7 @@ void appendpfins(V v,V *vp) for ( node = fdef->ins; node; node = NEXT(node) ) { for ( i = 0, tad = ((PFINS)((V)node->body)->priv)->ad; i < fdef->argc; i++ ) - if ( (ad[i].d != tad[i].d) || compr(CO,ad[i].arg,tad[i].arg) ) + if ( (ad[i].d != tad[i].d) || !equalr(CO,ad[i].arg,tad[i].arg) ) break; if ( i == fdef->argc ) { *vp = (V)node->body; @@ -284,6 +284,37 @@ void derivr(VL vl,Obj a,V v,Obj *b) } } +int obj_is_dependent(Obj a,V v) +{ + if ( !a || OID(a) <= O_N ) return 0; + else if ( OID(a) == O_P ) return poly_is_dependent((P)a,v); + else if ( OID(a) == O_R ) return poly_is_dependent(NM((R)a),v) + || poly_is_dependent(DN((R)a),v); + else + error("obj_is_dependent : not implemented"); +} + +int poly_is_dependent(P p,V v) +{ + DCP dc; + + if ( !p || OID(p) <= O_N ) return 0; + else if ( v == VR(p) ) return 1; + else { + for ( dc = DC(p); dc; dc = NEXT(dc) ) + if ( poly_is_dependent(COEF(dc),v) ) return 1; + return 0; + } +} + +void gen_pwrr(VL vl,Obj a,Obj d,Obj *r) +{ + if ( INT(d) ) + pwrr(vl,a,d,r); + else + mkpow(vl,a,d,r); +} + void substr(VL vl,int partial,Obj a,V v,Obj b,Obj *c) { Obj nm,dn,t; @@ -338,7 +369,8 @@ void substpr(VL vl,int partial,Obj p,V v0,Obj p0,Obj * for ( c = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) { substpr(vl,partial,(Obj)COEF(dc),v0,p0,&t); if ( DEG(dc) ) { - pwrp(vl,x,DEG(dc),(P *)&s); mulr(vl,s,t,&m); + gen_pwrr(vl,(Obj)x,(Obj)DEG(dc),&s); + mulr(vl,s,t,&m); addr(vl,m,c,&a); c = a; } else { addr(vl,t,c,&a); c = a; @@ -352,7 +384,8 @@ void substpr(VL vl,int partial,Obj p,V v0,Obj p0,Obj * else c = (Obj)COEF(dc); for ( d = DEG(dc), dc = NEXT(dc); dc; d = DEG(dc), dc = NEXT(dc) ) { - subq(d,DEG(dc),(Q *)&t); pwrr(vl,p0,t,&s); mulr(vl,s,c,&m); + subq(d,DEG(dc),(Q *)&t); + gen_pwrr(vl,p0,t,&s); mulr(vl,s,c,&m); if ( !partial ) substpr(vl,partial,(Obj)COEF(dc),v0,p0,&t); else @@ -360,7 +393,8 @@ void substpr(VL vl,int partial,Obj p,V v0,Obj p0,Obj * addr(vl,m,t,&c); } if ( d ) { - pwrr(vl,p0,(Obj)d,&t); mulr(vl,t,c,&m); + gen_pwrr(vl,p0,(Obj)d,&t); + mulr(vl,t,c,&m); c = m; } *pr = c; @@ -658,7 +692,8 @@ void substfp(VL vl,Obj p,PF u,PF f,Obj *pr) for ( c = 0; dc; dc = NEXT(dc) ) { substfp(vl,(Obj)COEF(dc),u,f,&t); if ( DEG(dc) ) { - pwrp(vl,x,DEG(dc),(P *)&s); mulr(vl,s,t,&m); + gen_pwrr(vl,(Obj)x,(Obj)DEG(dc),&s); + mulr(vl,s,t,&m); addr(vl,m,c,&a); c = a; } else { addr(vl,t,c,&a); c = a; @@ -668,11 +703,12 @@ void substfp(VL vl,Obj p,PF u,PF f,Obj *pr) substfv(vl,v,u,f,&p0); substfp(vl,(Obj)COEF(dc),u,f,&c); for ( d = DEG(dc), dc = NEXT(dc); dc; d = DEG(dc), dc = NEXT(dc) ) { - subq(d,DEG(dc),(Q *)&t); pwrr(vl,p0,t,&s); mulr(vl,s,c,&m); + subq(d,DEG(dc),(Q *)&t); + gen_pwrr(vl,p0,t,&s); mulr(vl,s,c,&m); substfp(vl,(Obj)COEF(dc),u,f,&t); addr(vl,m,t,&c); } if ( d ) { - pwrr(vl,p0,(Obj)d,&t); mulr(vl,t,c,&m); + gen_pwrr(vl,p0,(Obj)d,&t); mulr(vl,t,c,&m); c = m; } }