=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/quote.c,v retrieving revision 1.2 retrieving revision 1.6 diff -u -p -r1.2 -r1.6 --- OpenXM_contrib2/asir2000/parse/quote.c 2001/09/04 02:45:33 1.2 +++ OpenXM_contrib2/asir2000/parse/quote.c 2001/10/09 01:36:25 1.6 @@ -1,10 +1,9 @@ +/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.5 2001/09/05 09:01:28 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; @@ -12,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; @@ -23,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; @@ -34,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; @@ -45,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; @@ -58,9 +45,7 @@ QUOTE *c; MKQUOTE(*c,fn); } -void chsgnquote(a,c) -QUOTE a; -QUOTE *c; +void chsgnquote(QUOTE a,QUOTE *c) { FNODE fn; @@ -68,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)); @@ -82,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: @@ -92,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; @@ -100,9 +151,7 @@ QUOTE *c; } } -void polytoquote(a,c) -P a; -QUOTE *c; +void polytoquote(P a,QUOTE *c) { DCP dc,t; DCP *dca; @@ -128,26 +177,82 @@ QUOTE *c; *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; + 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; + } + for ( t = BDY(a), n = 0; t; t = NEXT(t), n++ ); + m = (MP *)ALLOCA(n*sizeof(MP)); + for ( t = BDY(a), i = 0; t; t = NEXT(t), i++ ) + m[i] = t; + nv = NV(a); + mptoquote(m[n-1],nv,&r); + for ( i = n-2; i >= 0; i-- ) { + mptoquote(m[i],nv,&s); + addquote(CO,s,r,&u); r = u; } *c = r; } -void vartoquote(v,c) -V v; -QUOTE *c; +void dctoquote(DCP dc,QUOTE v,QUOTE *c) +{ + QUOTE d,s,u; + + if ( UNIQ(COEF(dc)) ) { + if ( DEG(dc) ) { + if ( UNIQ(DEG(dc)) ) + *c = v; + else { + objtoquote((Obj)DEG(dc),&d); + pwrquote(CO,v,d,c); + } + } else + objtoquote((Obj)ONE,c); + } else { + objtoquote((Obj)COEF(dc),&u); + if ( DEG(dc) ) { + if ( UNIQ(DEG(dc)) ) + s = v; + else { + objtoquote((Obj)DEG(dc),&d); + pwrquote(CO,v,d,&s); + } + mulquote(CO,u,s,c); + } else + *c = u; + } +} + +void mptoquote(MP m,int n,QUOTE *c) +{ + QUOTE s,u; + NODE t,t1; + FNODE f; + Q q; + DL dl; + int i; + + objtoquote((Obj)C(m),&s); + 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)); + mulquote(CO,s,u,c); +} + +void vartoquote(V v,QUOTE *c) { P x; PF pf;