=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/quote.c,v retrieving revision 1.1 retrieving revision 1.2 diff -u -p -r1.1 -r1.2 --- OpenXM_contrib2/asir2000/parse/quote.c 2001/08/21 00:47:27 1.1 +++ OpenXM_contrib2/asir2000/parse/quote.c 2001/09/04 02:45:33 1.2 @@ -67,3 +67,121 @@ QUOTE *c; fn = mkfnode(3,I_BOP,subfs,0,BDY(a)); MKQUOTE(*c,fn); } + +void polytoquote(), dctoquote(), vartoquote(); + +void objtoquote(a,c) +Obj a; +QUOTE *c; +{ + QUOTE nm,dn; + + if ( !a ) { + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); + return; + } + switch ( OID(a) ) { + case O_N: + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); + break; + case O_P: + polytoquote((P)a,c); + break; + case O_R: + polytoquote(NM((R)a),&nm); + polytoquote(DN((R)a),&dn); + divquote(CO,nm,dn,c); + break; + case O_QUOTE: + *c = (QUOTE)a; + break; + default: + error("objtoquote : not implemented"); + } +} + +void polytoquote(a,c) +P a; +QUOTE *c; +{ + DCP dc,t; + DCP *dca; + int n,i; + QUOTE v,r,s,u; + + if ( !a || (OID(a) == O_N) ) { + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); + return; + } + dc = DC((P)a); + vartoquote(VR((P)a),&v); + for ( t = dc, n = 0; t; t = NEXT(t), n++ ); + dca = (DCP *)ALLOCA(n*sizeof(DCP)); + for ( t = dc, i = 0; t; t = NEXT(t), i++ ) + dca[i] = t; + dctoquote(dca[n-1],v,&r); + for ( i = n-2; i >= 0; i-- ) { + dctoquote(dca[i],v,&s); + addquote(CO,s,r,&u); + r = u; + } + *c = r; +} + +void dctoquote(dc,v,c) +DCP dc; +QUOTE v; +QUOTE *c; +{ + QUOTE r,d,s,u; + + objtoquote(COEF(dc),&r); + if ( DEG(dc) ) { + objtoquote(DEG(dc),&d); + pwrquote(CO,v,d,&s); + mulquote(CO,r,s,&u); + r = u; + } + *c = r; +} + +void vartoquote(v,c) +V v; +QUOTE *c; +{ + P x; + PF pf; + PFAD ad; + QUOTE a,b; + int i; + FUNC f; + NODE t,t1; + + if ( NAME(v) ) { + MKV(v,x); + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)x)); + } else if ( (vid)v->attr == V_PF ) { + /* pure function */ + pf = ((PFINS)v->priv)->pf; + ad = ((PFINS)v->priv)->ad; + if ( !strcmp(NAME(pf),"pow") ) { + /* pow(a,b) = a^b */ + objtoquote(ad[0].arg,&a); objtoquote(ad[1].arg,&b); + pwrquote(CO,a,b,c); + } else { + for ( i = 0; i < pf->argc; i++ ) + if ( ad[i].d ) + break; + if ( i < pf->argc ) + error("vartoquote : not implemented"); + gen_searchf(NAME(pf),&f); + t = 0; + for ( i = pf->argc-1; i >= 0; i-- ) { + objtoquote(ad[i].arg,&a); + MKNODE(t1,BDY(a),t); + t = t1; + } + MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); + } + } +}