=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/strobj.c,v retrieving revision 1.107 retrieving revision 1.110 diff -u -p -r1.107 -r1.110 --- OpenXM_contrib2/asir2000/builtin/strobj.c 2005/12/11 05:27:30 1.107 +++ OpenXM_contrib2/asir2000/builtin/strobj.c 2005/12/14 09:06:54 1.110 @@ -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/builtin/strobj.c,v 1.106 2005/12/10 14:14:15 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" @@ -92,9 +92,9 @@ void Pquotetotex(); void Pquotetotex_env(); void Pflatten_quote(); -void Pqt_is_integer(),Pqt_is_rational(),Pqt_is_number(); -void Pqt_is_dependent(),Pqt_is_function(); -void Pqt_set_ord(); +void Pqt_is_integer(),Pqt_is_rational(),Pqt_is_number(),Pqt_is_coef(); +void Pqt_is_dependent(),Pqt_is_function(),Pqt_is_var(); +void Pqt_set_ord(),Pqt_set_coef(),Pqt_set_weight(); void Pqt_normalize(); void Pnqt_comp(); void Pnqt_match(); @@ -127,13 +127,13 @@ 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); @@ -155,13 +155,17 @@ 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}, @@ -607,6 +611,28 @@ 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; @@ -2141,9 +2167,16 @@ VL reordvars(VL vl0,NODE head) return vl; } -VL qt_current_ord; -LIST qt_current_ord_obj; +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; @@ -2152,7 +2185,10 @@ 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; @@ -2163,6 +2199,59 @@ 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; @@ -2428,12 +2517,70 @@ 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) ) { + 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: @@ -2588,7 +2735,7 @@ 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; @@ -2601,7 +2748,7 @@ 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 '*': @@ -2688,7 +2835,7 @@ 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; @@ -2702,7 +2849,7 @@ 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); } @@ -2738,14 +2885,14 @@ 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) ) - return nfnode_mul_coef((Num)eval(f1),f2,expand); - else if ( fnode_is_number(f2) ) - return nfnode_mul_coef((Num)eval(f2),f1,expand); + else if ( fnode_is_coef(f1) ) + return nfnode_mul_coef((Obj)eval(f1),f2,expand); + else if ( fnode_is_coef(f2) ) + return nfnode_mul_coef((Obj)eval(f2),f1,expand); if ( expand && IS_NARYADD(f1) ) { t = mkfnode(1,I_FORMULA,0); @@ -2765,7 +2912,7 @@ 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); @@ -2779,7 +2926,7 @@ 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; @@ -2799,22 +2946,25 @@ 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); @@ -2826,7 +2976,7 @@ 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) ) @@ -2918,17 +3068,17 @@ 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); @@ -2953,40 +3103,107 @@ 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) ) { - *cp = eval(f); *bp = mkfnode(1,I_FORMULA,ONE); + if ( fnode_is_coef(f) ) { + *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) ) { - *cp = eval(c); + if ( fnode_is_coef(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) ) { + 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); } @@ -2995,7 +3212,7 @@ 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 ) { @@ -3008,11 +3225,11 @@ 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) ) { @@ -3028,15 +3245,23 @@ 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) ) - return nfnode_comp_pwr(f1,f2); + if ( IS_BINARYPWR(f1) || IS_BINARYPWR(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 */ @@ -3048,7 +3273,7 @@ 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: @@ -3066,7 +3291,7 @@ 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); } @@ -3074,7 +3299,7 @@ int nfnode_comp(FNODE f1,FNODE f2) } break; default: - error("nfnode_comp : undefined"); + error("nfnode_comp_lex : undefined"); } case I_PVAR: switch ( f2->id ) { @@ -3088,7 +3313,7 @@ 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: @@ -3104,7 +3329,7 @@ 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); } @@ -3113,27 +3338,12 @@ 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)