=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/quote.c,v retrieving revision 1.3 retrieving revision 1.4 diff -u -p -r1.3 -r1.4 --- OpenXM_contrib2/asir2000/parse/quote.c 2001/09/04 02:46:15 1.3 +++ OpenXM_contrib2/asir2000/parse/quote.c 2001/09/04 05:14:04 1.4 @@ -1,4 +1,4 @@ -/* $OpenXM$ */ +/* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.3 2001/09/04 02:46:15 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -71,12 +71,20 @@ QUOTE *c; } void polytoquote(), dctoquote(), vartoquote(); +void dptoquote(), mptoquote(); void objtoquote(a,c) Obj a; QUOTE *c; { QUOTE nm,dn; + NODE arg,t0,t,t1,t2,t3; + FNODE fn; + 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 +92,7 @@ QUOTE *c; } switch ( OID(a) ) { case O_N: + case O_STR: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a)); break; case O_P: @@ -94,6 +103,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; @@ -130,6 +192,33 @@ QUOTE *c; *c = r; } +void dptoquote(a,c) +DP a; +QUOTE *c; +{ + MP t; + MP *m; + int i,n,nv; + QUOTE s,r,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 dctoquote(dc,v,c) DCP dc; QUOTE v; @@ -137,14 +226,53 @@ 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; + if ( UNIQ(COEF(dc)) ) { + if ( DEG(dc) ) { + if ( UNIQ(DEG(dc)) ) + *c = v; + else { + objtoquote(DEG(dc),&d); + pwrquote(CO,v,d,c); + } + } else + objtoquote(ONE,c); + } else { + objtoquote(COEF(dc),&u); + if ( DEG(dc) ) { + if ( UNIQ(DEG(dc)) ) + s = v; + else { + objtoquote(DEG(dc),&d); + pwrquote(CO,v,d,&s); + } + mulquote(CO,u,s,c); + } else + *c = u; } - *c = r; +} + +void mptoquote(m,n,c) +MP m; +int n; +QUOTE *c; +{ + QUOTE s,u; + NODE t,t1; + FNODE f; + Q q; + DL dl; + int i; + + objtoquote(C(m),&s); + dl = m->dl; + for ( i = n-1; 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,c)