=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/quote.c,v retrieving revision 1.3 retrieving revision 1.11 diff -u -p -r1.3 -r1.11 --- OpenXM_contrib2/asir2000/parse/quote.c 2001/09/04 02:46:15 1.3 +++ OpenXM_contrib2/asir2000/parse/quote.c 2004/03/10 02:41:08 1.11 @@ -1,12 +1,9 @@ -/* $OpenXM$ */ +/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.10 2004/03/09 08:02:01 noro Exp $ */ #include "ca.h" #include "parse.h" -void addquote(vl,a,b,c) -VL vl; -QUOTE a,b; -QUOTE *c; +void addquote(VL vl,QUOTE a,QUOTE b,QUOTE *c) { FNODE fn; @@ -14,10 +11,7 @@ QUOTE *c; MKQUOTE(*c,fn); } -void subquote(vl,a,b,c) -VL vl; -QUOTE a,b; -QUOTE *c; +void subquote(VL vl,QUOTE a,QUOTE b,QUOTE *c) { FNODE fn; @@ -25,10 +19,7 @@ QUOTE *c; MKQUOTE(*c,fn); } -void mulquote(vl,a,b,c) -VL vl; -QUOTE a,b; -QUOTE *c; +void mulquote(VL vl,QUOTE a,QUOTE b,QUOTE *c) { FNODE fn; @@ -36,10 +27,7 @@ QUOTE *c; MKQUOTE(*c,fn); } -void divquote(vl,a,b,c) -VL vl; -QUOTE a,b; -QUOTE *c; +void divquote(VL vl,QUOTE a,QUOTE b,QUOTE *c) { FNODE fn; @@ -47,10 +35,7 @@ QUOTE *c; MKQUOTE(*c,fn); } -void pwrquote(vl,a,b,c) -VL vl; -QUOTE a,b; -QUOTE *c; +void pwrquote(VL vl,QUOTE a,QUOTE b,QUOTE *c) { FNODE fn; @@ -60,9 +45,7 @@ QUOTE *c; MKQUOTE(*c,fn); } -void chsgnquote(a,c) -QUOTE a; -QUOTE *c; +void chsgnquote(QUOTE a,QUOTE *c) { FNODE fn; @@ -70,13 +53,17 @@ QUOTE *c; MKQUOTE(*c,fn); } -void polytoquote(), dctoquote(), vartoquote(); - -void objtoquote(a,c) -Obj a; -QUOTE *c; +void objtoquote(Obj a,QUOTE *c) { QUOTE nm,dn; + NODE arg,t0,t,t1,t2,t3; + FNODE fn; + Obj obj; + Obj *b; + Obj **m; + int i,j,len,row,col; + Q q,qrow,qcol; + FUNC f; if ( !a ) { MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); @@ -84,6 +71,15 @@ QUOTE *c; } switch ( OID(a) ) { case O_N: + if ( negative_number((Num)a) ) { + arf_chsgn(a,&obj); + MKQUOTE(*c,mkfnode(1,I_MINUS, + mkfnode(1,I_FORMULA,(pointer)obj))); + } else { + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); + } + break; + case O_STR: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); break; case O_P: @@ -94,6 +90,59 @@ QUOTE *c; polytoquote(DN((R)a),&dn); divquote(CO,nm,dn,c); break; + case O_LIST: + t0 = 0; + for ( arg = BDY((LIST)a); arg; arg = NEXT(arg) ) { + NEXTNODE(t0,t); + objtoquote(BDY(arg),&nm); + BDY(t) = BDY(nm); + } + if ( t0 ) + NEXT(t) = 0; + MKQUOTE(*c,mkfnode(1,I_LIST,t0)); + break; + case O_VECT: + len = ((VECT)a)->len; + b = (Obj *)BDY(((VECT)a)); + t = 0; + for ( i = len-1; i >= 0; i-- ) { + objtoquote(b[i],&nm); + MKNODE(t1,BDY(nm),t); + t = t1; + } + STOQ(len,q); + t = mknode(2,mkfnode(1,I_FORMULA,q),mkfnode(1,I_LIST,t)); + gen_searchf("vector",&f); + MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); + break; + case O_MAT: + row = ((MAT)a)->row; + col = ((MAT)a)->row; + m = (Obj **)BDY(((MAT)a)); + t2 = 0; + for ( i = row-1; i >= 0; i-- ) { + t = 0; + for ( j = col-1; j >= 0; j-- ) { + objtoquote(m[i][j],&nm); + MKNODE(t1,BDY(nm),t); + t = t1; + } + fn = mkfnode(1,I_LIST,t); + MKNODE(t3,fn,t2); + t2 = t3; + } + fn = mkfnode(1,I_LIST,t2); + + STOQ(row,qrow); + STOQ(col,qcol); + t = mknode(3, + mkfnode(1,I_FORMULA,qrow),mkfnode(1,I_FORMULA,qcol),fn); + gen_searchf("matrix",&f); + MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t))); + break; + case O_DP: + dptoquote((DP)a,c); + break; case O_QUOTE: *c = (QUOTE)a; break; @@ -102,54 +151,149 @@ QUOTE *c; } } -void polytoquote(a,c) -P a; -QUOTE *c; +void polytoquote(P a,QUOTE *c) { DCP dc,t; DCP *dca; - int n,i; + int n,i,sgn; QUOTE v,r,s,u; - if ( !a || (OID(a) == O_N) ) { + if ( !a ) { MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); return; + } else if ( 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); + dc = DC((P)a); + dctoquote(dc,v,&r,&sgn); + if ( sgn == -1 ) { + MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r))); r = u; } + for (dc = NEXT(dc); dc; dc = NEXT(dc) ) { + dctoquote(dc,v,&s,&sgn); + if ( sgn == -1 ) + subquote(CO,r,s,&u); + else + addquote(CO,r,s,&u); + r = u; + } *c = r; } -void dctoquote(dc,v,c) -DCP dc; -QUOTE v; -QUOTE *c; +void dptoquote(DP a,QUOTE *c) { - QUOTE r,d,s,u; + MP t; + MP m; + int i,n,nv,sgn; + QUOTE s,r,u; - objtoquote(COEF(dc),&r); - if ( DEG(dc) ) { - objtoquote(DEG(dc),&d); - pwrquote(CO,v,d,&s); - mulquote(CO,r,s,&u); + if ( !a ) { + MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); + return; + } + nv = NV(a); + m = BDY(a); + mptoquote(m,nv,&r,&sgn); + if ( sgn == -1 ) { + MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r))); r = u; } + for ( m = NEXT(m); m; m = NEXT(m) ) { + mptoquote(m,nv,&s,&sgn); + if ( sgn < 0 ) + subquote(CO,r,s,&u); + else + addquote(CO,r,s,&u); + r = u; + } *c = r; } -void vartoquote(v,c) -V v; -QUOTE *c; +void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn) +{ + QUOTE t,s,u,r; + P c; + Q d; + + if ( mmono(COEF(dc)) ) { + /* -xyz... */ + chsgnp(COEF(dc),&c); + *sgn = -1; + } else { + c = COEF(dc); + *sgn = 1; + } + d = DEG(dc); + if ( UNIQ(c) ) { + if ( d ) { + if ( UNIQ(d) ) + r = v; + else { + objtoquote((Obj)d,&t); + pwrquote(CO,v,t,&r); + } + } else + objtoquote((Obj)ONE,&r); + } else { + objtoquote((Obj)c,&u); + if ( !NUM(c) && NEXT(DC(c)) ) { + MKQUOTE(t,mkfnode(1,I_PAREN,BDY(u))); + u = t; + } + if ( d ) { + if ( UNIQ(d) ) + s = v; + else { + objtoquote((Obj)d,&t); + pwrquote(CO,v,t,&s); + } + mulquote(CO,u,s,&r); + } else + r = u; + } + *q = r; +} + +void mptoquote(MP m,int n,QUOTE *r,int *sgn) +{ + QUOTE s,u; + P c; + NODE t,t1; + FNODE f; + Q q; + DL dl; + int i; + + if ( mmono(C(m)) ) { + chsgnp(C(m),&c); + *sgn = -1; + } else { + c = C(m); + *sgn = 1; + } + objtoquote((Obj)c,&s); + if ( !NUM(c) && NEXT(DC(c)) ) { + MKQUOTE(u,mkfnode(1,I_PAREN,BDY(s))); + s = u; + } + dl = m->dl; + for ( i = n-1, t = 0; i >= 0; i-- ) { + STOQ(dl->d[i],q); + f = mkfnode(1,I_FORMULA,q); + MKNODE(t1,f,t); + t = t1; + } + MKQUOTE(u,mkfnode(1,I_EV,t)); + if ( UNIQ(c) ) + *r = u; + else + mulquote(CO,s,u,r); +} + +void vartoquote(V v,QUOTE *c) { P x; PF pf;