![[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.3 ! noro 1: /* $OpenXM$ */
! 2:
1.1 noro 3: #include "ca.h"
4: #include "parse.h"
5:
6: void addquote(vl,a,b,c)
7: VL vl;
8: QUOTE a,b;
9: QUOTE *c;
10: {
11: FNODE fn;
12:
13: fn = mkfnode(3,I_BOP,addfs,BDY(a),BDY(b));
14: MKQUOTE(*c,fn);
15: }
16:
17: void subquote(vl,a,b,c)
18: VL vl;
19: QUOTE a,b;
20: QUOTE *c;
21: {
22: FNODE fn;
23:
24: fn = mkfnode(3,I_BOP,subfs,BDY(a),BDY(b));
25: MKQUOTE(*c,fn);
26: }
27:
28: void mulquote(vl,a,b,c)
29: VL vl;
30: QUOTE a,b;
31: QUOTE *c;
32: {
33: FNODE fn;
34:
35: fn = mkfnode(3,I_BOP,mulfs,BDY(a),BDY(b));
36: MKQUOTE(*c,fn);
37: }
38:
39: void divquote(vl,a,b,c)
40: VL vl;
41: QUOTE a,b;
42: QUOTE *c;
43: {
44: FNODE fn;
45:
46: fn = mkfnode(3,I_BOP,divfs,BDY(a),BDY(b));
47: MKQUOTE(*c,fn);
48: }
49:
50: void pwrquote(vl,a,b,c)
51: VL vl;
52: QUOTE a,b;
53: QUOTE *c;
54: {
55: FNODE fn;
56:
57: if ( !b || OID(b) != O_QUOTE )
58: error("pwrquote : invalid argument");
59: fn = mkfnode(3,I_BOP,pwrfs,BDY(a),BDY(b));
60: MKQUOTE(*c,fn);
61: }
62:
63: void chsgnquote(a,c)
64: QUOTE a;
65: QUOTE *c;
66: {
67: FNODE fn;
68:
69: fn = mkfnode(3,I_BOP,subfs,0,BDY(a));
70: MKQUOTE(*c,fn);
71: }
1.2 noro 72:
73: void polytoquote(), dctoquote(), vartoquote();
74:
75: void objtoquote(a,c)
76: Obj a;
77: QUOTE *c;
78: {
79: QUOTE nm,dn;
80:
81: if ( !a ) {
82: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
83: return;
84: }
85: switch ( OID(a) ) {
86: case O_N:
87: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
88: break;
89: case O_P:
90: polytoquote((P)a,c);
91: break;
92: case O_R:
93: polytoquote(NM((R)a),&nm);
94: polytoquote(DN((R)a),&dn);
95: divquote(CO,nm,dn,c);
96: break;
97: case O_QUOTE:
98: *c = (QUOTE)a;
99: break;
100: default:
101: error("objtoquote : not implemented");
102: }
103: }
104:
105: void polytoquote(a,c)
106: P a;
107: QUOTE *c;
108: {
109: DCP dc,t;
110: DCP *dca;
111: int n,i;
112: QUOTE v,r,s,u;
113:
114: if ( !a || (OID(a) == O_N) ) {
115: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
116: return;
117: }
118: dc = DC((P)a);
119: vartoquote(VR((P)a),&v);
120: for ( t = dc, n = 0; t; t = NEXT(t), n++ );
121: dca = (DCP *)ALLOCA(n*sizeof(DCP));
122: for ( t = dc, i = 0; t; t = NEXT(t), i++ )
123: dca[i] = t;
124: dctoquote(dca[n-1],v,&r);
125: for ( i = n-2; i >= 0; i-- ) {
126: dctoquote(dca[i],v,&s);
127: addquote(CO,s,r,&u);
128: r = u;
129: }
130: *c = r;
131: }
132:
133: void dctoquote(dc,v,c)
134: DCP dc;
135: QUOTE v;
136: QUOTE *c;
137: {
138: QUOTE r,d,s,u;
139:
140: objtoquote(COEF(dc),&r);
141: if ( DEG(dc) ) {
142: objtoquote(DEG(dc),&d);
143: pwrquote(CO,v,d,&s);
144: mulquote(CO,r,s,&u);
145: r = u;
146: }
147: *c = r;
148: }
149:
150: void vartoquote(v,c)
151: V v;
152: QUOTE *c;
153: {
154: P x;
155: PF pf;
156: PFAD ad;
157: QUOTE a,b;
158: int i;
159: FUNC f;
160: NODE t,t1;
161:
162: if ( NAME(v) ) {
163: MKV(v,x);
164: MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)x));
165: } else if ( (vid)v->attr == V_PF ) {
166: /* pure function */
167: pf = ((PFINS)v->priv)->pf;
168: ad = ((PFINS)v->priv)->ad;
169: if ( !strcmp(NAME(pf),"pow") ) {
170: /* pow(a,b) = a^b */
171: objtoquote(ad[0].arg,&a); objtoquote(ad[1].arg,&b);
172: pwrquote(CO,a,b,c);
173: } else {
174: for ( i = 0; i < pf->argc; i++ )
175: if ( ad[i].d )
176: break;
177: if ( i < pf->argc )
178: error("vartoquote : not implemented");
179: gen_searchf(NAME(pf),&f);
180: t = 0;
181: for ( i = pf->argc-1; i >= 0; i-- ) {
182: objtoquote(ad[i].arg,&a);
183: MKNODE(t1,BDY(a),t);
184: t = t1;
185: }
186: MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
187: }
188: }
189: }