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