![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to quote.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / parse|
Return to quote.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / parse |
1.10 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.9 2004/03/04 03:31:28 noro Exp $ */
1.3 noro 2:
1.1 noro 3: #include "ca.h"
4: #include "parse.h"
5:
1.6 noro 6: void addquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1 noro 7: {
8: FNODE fn;
9:
10: fn = mkfnode(3,I_BOP,addfs,BDY(a),BDY(b));
11: MKQUOTE(*c,fn);
12: }
13:
1.6 noro 14: void subquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1 noro 15: {
16: FNODE fn;
17:
18: fn = mkfnode(3,I_BOP,subfs,BDY(a),BDY(b));
19: MKQUOTE(*c,fn);
20: }
21:
1.6 noro 22: void mulquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1 noro 23: {
24: FNODE fn;
25:
26: fn = mkfnode(3,I_BOP,mulfs,BDY(a),BDY(b));
27: MKQUOTE(*c,fn);
28: }
29:
1.6 noro 30: void divquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1 noro 31: {
32: FNODE fn;
33:
34: fn = mkfnode(3,I_BOP,divfs,BDY(a),BDY(b));
35: MKQUOTE(*c,fn);
36: }
37:
1.6 noro 38: void pwrquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1 noro 39: {
40: FNODE fn;
41:
42: if ( !b || OID(b) != O_QUOTE )
43: error("pwrquote : invalid argument");
44: fn = mkfnode(3,I_BOP,pwrfs,BDY(a),BDY(b));
45: MKQUOTE(*c,fn);
46: }
47:
1.6 noro 48: void chsgnquote(QUOTE a,QUOTE *c)
1.1 noro 49: {
50: FNODE fn;
51:
52: fn = mkfnode(3,I_BOP,subfs,0,BDY(a));
53: MKQUOTE(*c,fn);
54: }
1.2 noro 55:
1.6 noro 56: void objtoquote(Obj a,QUOTE *c)
1.2 noro 57: {
58: QUOTE nm,dn;
1.4 noro 59: NODE arg,t0,t,t1,t2,t3;
60: FNODE fn;
1.5 noro 61: Obj obj;
1.4 noro 62: Obj *b;
63: Obj **m;
64: int i,j,len,row,col;
65: Q q,qrow,qcol;
66: FUNC f;
1.2 noro 67:
68: if ( !a ) {
69: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
1.10 ! noro 70: (*c)->attr = mknode(1,mknode(2,"RisaId",0));
1.2 noro 71: return;
72: }
73: switch ( OID(a) ) {
74: case O_N:
1.5 noro 75: if ( negative_number((Num)a) ) {
76: arf_chsgn(a,&obj);
77: MKQUOTE(*c,mkfnode(1,I_MINUS,
78: mkfnode(1,I_FORMULA,(pointer)obj)));
79: } else {
80: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
81: }
1.10 ! noro 82: (*c)->attr = mknode(1,mknode(2,"RisaId",O_N));
1.5 noro 83: break;
1.4 noro 84: case O_STR:
1.2 noro 85: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
1.10 ! noro 86: (*c)->attr = mknode(1,mknode(2,"RisaId",O_STR));
1.2 noro 87: break;
88: case O_P:
89: polytoquote((P)a,c);
90: break;
91: case O_R:
92: polytoquote(NM((R)a),&nm);
93: polytoquote(DN((R)a),&dn);
94: divquote(CO,nm,dn,c);
1.10 ! noro 95: (*c)->attr = mknode(1,mknode(2,"RisaId",O_R));
1.2 noro 96: break;
1.4 noro 97: case O_LIST:
98: t0 = 0;
99: for ( arg = BDY((LIST)a); arg; arg = NEXT(arg) ) {
100: NEXTNODE(t0,t);
101: objtoquote(BDY(arg),&nm);
102: BDY(t) = BDY(nm);
103: }
104: if ( t0 )
105: NEXT(t) = 0;
106: MKQUOTE(*c,mkfnode(1,I_LIST,t0));
1.10 ! noro 107: (*c)->attr = mknode(1,mknode(2,"RisaId",O_LIST));
1.4 noro 108: break;
109: case O_VECT:
110: len = ((VECT)a)->len;
111: b = (Obj *)BDY(((VECT)a));
112: t = 0;
113: for ( i = len-1; i >= 0; i-- ) {
114: objtoquote(b[i],&nm);
115: MKNODE(t1,BDY(nm),t);
116: t = t1;
117: }
118: STOQ(len,q);
119: t = mknode(2,mkfnode(1,I_FORMULA,q),mkfnode(1,I_LIST,t));
120: gen_searchf("vector",&f);
121: MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
1.10 ! noro 122: (*c)->attr = mknode(1,mknode(2,"RisaId",O_VECT));
1.4 noro 123: break;
124: case O_MAT:
125: row = ((MAT)a)->row;
126: col = ((MAT)a)->row;
127: m = (Obj **)BDY(((MAT)a));
128: t2 = 0;
129: for ( i = row-1; i >= 0; i-- ) {
130: t = 0;
131: for ( j = col-1; j >= 0; j-- ) {
132: objtoquote(m[i][j],&nm);
133: MKNODE(t1,BDY(nm),t);
134: t = t1;
135: }
136: fn = mkfnode(1,I_LIST,t);
137: MKNODE(t3,fn,t2);
138: t2 = t3;
139: }
140: fn = mkfnode(1,I_LIST,t2);
141:
142: STOQ(row,qrow);
143: STOQ(col,qcol);
144: t = mknode(3,
145: mkfnode(1,I_FORMULA,qrow),mkfnode(1,I_FORMULA,qcol),fn);
146: gen_searchf("matrix",&f);
147: MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
1.10 ! noro 148: (*c)->attr = mknode(1,mknode(2,"RisaId",O_MAT));
1.4 noro 149: break;
150: case O_DP:
151: dptoquote((DP)a,c);
152: break;
1.2 noro 153: case O_QUOTE:
154: *c = (QUOTE)a;
155: break;
156: default:
157: error("objtoquote : not implemented");
158: }
159: }
160:
1.6 noro 161: void polytoquote(P a,QUOTE *c)
1.2 noro 162: {
163: DCP dc,t;
164: DCP *dca;
1.7 noro 165: int n,i,sgn;
1.2 noro 166: QUOTE v,r,s,u;
167:
1.10 ! noro 168: if ( !a ) {
! 169: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
! 170: (*c)->attr = mknode(1,mknode(2,"RisaId",0));
! 171: return;
! 172: } else if ( OID(a) == O_N ) {
1.2 noro 173: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
1.10 ! noro 174: (*c)->attr = mknode(1,mknode(2,"RisaId",O_N));
1.2 noro 175: return;
176: }
1.7 noro 177: vartoquote(VR((P)a),&v);
1.2 noro 178: dc = DC((P)a);
1.7 noro 179: dctoquote(dc,v,&r,&sgn);
180: if ( sgn == -1 ) {
181: MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r)));
182: r = u;
183: }
184: for (dc = NEXT(dc); dc; dc = NEXT(dc) ) {
185: dctoquote(dc,v,&s,&sgn);
186: if ( sgn == -1 )
187: subquote(CO,r,s,&u);
188: else
189: addquote(CO,r,s,&u);
1.2 noro 190: r = u;
191: }
192: *c = r;
1.10 ! noro 193: (*c)->attr = mknode(1,mknode(2,"RisaId",O_P));
1.2 noro 194: }
195:
1.6 noro 196: void dptoquote(DP a,QUOTE *c)
1.4 noro 197: {
198: MP t;
1.8 noro 199: MP m;
200: int i,n,nv,sgn;
1.4 noro 201: QUOTE s,r,u;
202:
203: if ( !a ) {
204: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
1.10 ! noro 205: (*c)->attr = mknode(1,mknode(2,"RisaId",0));
1.4 noro 206: return;
207: }
208: nv = NV(a);
1.8 noro 209: m = BDY(a);
210: mptoquote(m,nv,&r,&sgn);
211: if ( sgn == -1 ) {
212: MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r)));
213: r = u;
214: }
215: for ( m = NEXT(m); m; m = NEXT(m) ) {
216: mptoquote(m,nv,&s,&sgn);
217: if ( sgn < 0 )
218: subquote(CO,r,s,&u);
219: else
220: addquote(CO,r,s,&u);
1.4 noro 221: r = u;
222: }
223: *c = r;
1.10 ! noro 224: (*c)->attr = mknode(1,mknode(2,"RisaId",O_DP));
1.4 noro 225: }
226:
1.7 noro 227: void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn)
1.2 noro 228: {
1.7 noro 229: QUOTE t,s,u,r;
230: P c;
231: Q d;
232:
233: if ( mmono(COEF(dc)) ) {
234: /* -xyz... */
235: chsgnp(COEF(dc),&c);
236: *sgn = -1;
237: } else {
238: c = COEF(dc);
239: *sgn = 1;
240: }
241: d = DEG(dc);
242: if ( UNIQ(c) ) {
243: if ( d ) {
244: if ( UNIQ(d) )
245: r = v;
1.4 noro 246: else {
1.7 noro 247: objtoquote((Obj)d,&t);
248: pwrquote(CO,v,t,&r);
1.4 noro 249: }
250: } else
1.7 noro 251: objtoquote((Obj)ONE,&r);
1.4 noro 252: } else {
1.7 noro 253: objtoquote((Obj)c,&u);
254: if ( !NUM(c) && NEXT(DC(c)) ) {
255: MKQUOTE(t,mkfnode(1,I_PAREN,BDY(u)));
256: u = t;
257: }
258: if ( d ) {
259: if ( UNIQ(d) )
1.4 noro 260: s = v;
261: else {
1.7 noro 262: objtoquote((Obj)d,&t);
263: pwrquote(CO,v,t,&s);
1.4 noro 264: }
1.7 noro 265: mulquote(CO,u,s,&r);
1.4 noro 266: } else
1.7 noro 267: r = u;
1.4 noro 268: }
1.7 noro 269: *q = r;
1.4 noro 270: }
271:
1.8 noro 272: void mptoquote(MP m,int n,QUOTE *r,int *sgn)
1.4 noro 273: {
274: QUOTE s,u;
1.8 noro 275: P c;
1.4 noro 276: NODE t,t1;
277: FNODE f;
278: Q q;
279: DL dl;
280: int i;
281:
1.8 noro 282: if ( mmono(C(m)) ) {
283: chsgnp(C(m),&c);
284: *sgn = -1;
285: } else {
286: c = C(m);
287: *sgn = 1;
288: }
289: objtoquote((Obj)c,&s);
290: if ( !NUM(c) && NEXT(DC(c)) ) {
291: MKQUOTE(u,mkfnode(1,I_PAREN,BDY(s)));
292: s = u;
293: }
1.4 noro 294: dl = m->dl;
1.9 noro 295: for ( i = n-1, t = 0; i >= 0; i-- ) {
296: STOQ(dl->d[i],q);
297: f = mkfnode(1,I_FORMULA,q);
298: MKNODE(t1,f,t);
299: t = t1;
300: }
301: MKQUOTE(u,mkfnode(1,I_EV,t));
302: if ( UNIQ(c) )
303: *r = u;
304: else
305: mulquote(CO,s,u,r);
1.2 noro 306: }
307:
1.6 noro 308: void vartoquote(V v,QUOTE *c)
1.2 noro 309: {
310: P x;
311: PF pf;
312: PFAD ad;
313: QUOTE a,b;
314: int i;
315: FUNC f;
316: NODE t,t1;
317:
318: if ( NAME(v) ) {
319: MKV(v,x);
320: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)x));
321: } else if ( (vid)v->attr == V_PF ) {
322: /* pure function */
323: pf = ((PFINS)v->priv)->pf;
324: ad = ((PFINS)v->priv)->ad;
325: if ( !strcmp(NAME(pf),"pow") ) {
326: /* pow(a,b) = a^b */
327: objtoquote(ad[0].arg,&a); objtoquote(ad[1].arg,&b);
328: pwrquote(CO,a,b,c);
329: } else {
330: for ( i = 0; i < pf->argc; i++ )
331: if ( ad[i].d )
332: break;
333: if ( i < pf->argc )
334: error("vartoquote : not implemented");
335: gen_searchf(NAME(pf),&f);
336: t = 0;
337: for ( i = pf->argc-1; i >= 0; i-- ) {
338: objtoquote(ad[i].arg,&a);
339: MKNODE(t1,BDY(a),t);
340: t = t1;
341: }
342: MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
343: }
344: }
345: }