![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to algnum.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin|
Return to algnum.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/algnum.c,v 1.1.1.1 1999/11/10 08:12:25 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4:
! 5: void Pdefpoly(), Pnewalg(), Pmainalg(), Palgtorat(), Prattoalg(), Pgetalg();
! 6: void Palg(), Palgv(), Pgetalgtree();
! 7:
! 8: #if defined(THINK_C)
! 9: void mkalg(P,Alg *);
! 10: int cmpalgp(P,P);
! 11: void algptop(P,P *);
! 12: void algtorat(Num,Obj *);
! 13: void rattoalg(Obj,Alg *);
! 14: void ptoalgp(P,P *);
! 15: #else
! 16: void mkalg();
! 17: int cmpalgp();
! 18: void algptop();
! 19: void algtorat();
! 20: void rattoalg();
! 21: void ptoalgp();
! 22: void clctalg();
! 23: #endif
! 24:
! 25: struct ftab alg_tab[] = {
! 26: {"defpoly",Pdefpoly,1},
! 27: {"newalg",Pnewalg,1},
! 28: {"mainalg",Pmainalg,1},
! 29: {"algtorat",Palgtorat,1},
! 30: {"rattoalg",Prattoalg,1},
! 31: {"getalg",Pgetalg,1},
! 32: {"getalgtree",Pgetalgtree,1},
! 33: {"alg",Palg,1},
! 34: {"algv",Palgv,1},
! 35: {0,0,0},
! 36: };
! 37:
! 38: static int UCN,ACNT;
! 39:
! 40: void Pnewalg(arg,rp)
! 41: NODE arg;
! 42: Alg *rp;
! 43: {
! 44: P p;
! 45: VL vl;
! 46: P c;
! 47:
! 48: p = (P)ARG0(arg);
! 49: if ( !p || OID(p) != O_P )
! 50: error("newalg : invalid argument");
! 51: clctv(CO,p,&vl);
! 52: if ( NEXT(vl) )
! 53: error("newalg : invalid argument");
! 54: c = COEF(DC(p));
! 55: if ( !NUM(c) || !RATN(c) )
! 56: error("newalg : invalid argument");
! 57: mkalg(p,rp);
! 58: }
! 59:
! 60: void mkalg(p,r)
! 61: P p;
! 62: Alg *r;
! 63: {
! 64: VL vl,mvl,nvl;
! 65: V a,tv;
! 66: char buf[BUFSIZ];
! 67: char *name;
! 68: P x,t,s;
! 69: Num c;
! 70: DCP dc,dcr,dcr0;
! 71:
! 72: for ( vl = ALG; vl; vl = NEXT(vl) )
! 73: if ( !cmpalgp(p,(P)vl->v->attr) ) {
! 74: a = vl->v; break;
! 75: }
! 76: if ( !vl ) {
! 77: NEWVL(vl); NEXT(vl) = ALG; ALG = vl;
! 78: NEWV(a); vl->v = a;
! 79: sprintf(buf,"#%d",ACNT++);
! 80: name = (char *)MALLOC(strlen(buf)+1);
! 81: strcpy(name,buf); NAME(a) = name;
! 82:
! 83: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 84: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); c = (Num)COEF(dc);
! 85: if ( NID(c) != N_A )
! 86: COEF(dcr) = (P)c;
! 87: else
! 88: COEF(dcr) = (P)BDY(((Alg)c));
! 89: }
! 90: NEXT(dcr) = 0; MKP(a,dcr0,t); a->attr = (pointer)t;
! 91:
! 92: sprintf(buf,"t%s",name); makevar(buf,&s);
! 93:
! 94: if ( NEXT(ALG) ) {
! 95: tv = (V)NEXT(ALG)->v->priv;
! 96: for ( vl = CO; NEXT(NEXT(vl)); vl = NEXT(vl) );
! 97: nvl = NEXT(vl); NEXT(vl) = 0;
! 98: for ( vl = CO; NEXT(vl) && (NEXT(vl)->v != tv); vl = NEXT(vl) );
! 99: mvl = NEXT(vl); NEXT(vl) = nvl; NEXT(nvl) = mvl;
! 100: }
! 101:
! 102: a->priv = (pointer)VR(s); VR(s)->priv = (pointer)a;
! 103: }
! 104: MKV(a,x); MKAlg(x,*r);
! 105: }
! 106:
! 107: int cmpalgp(p,defp)
! 108: P p,defp;
! 109: {
! 110: DCP dc,dcd;
! 111: P t;
! 112:
! 113: for ( dc = DC(p), dcd = DC(defp); dc && dcd;
! 114: dc = NEXT(dc), dcd = NEXT(dcd) ) {
! 115: if ( cmpq(DEG(dc),DEG(dcd)) )
! 116: break;
! 117: t = NID((Num)COEF(dc)) == N_A ? (P)BDY((Alg)COEF(dc)) : COEF(dc);
! 118: if ( compp(ALG,t,COEF(dcd)) )
! 119: break;
! 120: }
! 121: if ( dc || dcd )
! 122: return 1;
! 123: else
! 124: return 0;
! 125: }
! 126:
! 127: void Pdefpoly(arg,rp)
! 128: NODE arg;
! 129: P *rp;
! 130: {
! 131: asir_assert(ARG0(arg),O_N,"defpoly");
! 132: algptop((P)VR((P)BDY((Alg)ARG0(arg)))->attr,rp);
! 133: }
! 134:
! 135: void Pmainalg(arg,r)
! 136: NODE arg;
! 137: Alg *r;
! 138: {
! 139: Num c;
! 140: V v;
! 141: P b;
! 142:
! 143: c = (Num)(ARG0(arg));
! 144: if ( NID(c) <= N_R )
! 145: *r = 0;
! 146: else {
! 147: v = VR((P)BDY((Alg)c)); MKV(v,b); MKAlg(b,*r);
! 148: }
! 149: }
! 150:
! 151: void Palgtorat(arg,rp)
! 152: NODE arg;
! 153: Obj *rp;
! 154: {
! 155: asir_assert(ARG0(arg),O_N,"algtorat");
! 156: algtorat((Num)ARG0(arg),rp);
! 157: }
! 158:
! 159: void Prattoalg(arg,rp)
! 160: NODE arg;
! 161: Alg *rp;
! 162: {
! 163: asir_assert(ARG0(arg),O_R,"rattoalg");
! 164: rattoalg((Obj)ARG0(arg),rp);
! 165: }
! 166:
! 167: void Pgetalg(arg,rp)
! 168: NODE arg;
! 169: LIST *rp;
! 170: {
! 171: Obj t;
! 172: P p;
! 173: VL vl;
! 174: Num a;
! 175: Alg b;
! 176: NODE n0,n;
! 177:
! 178: if ( !(a = (Num)ARG0(arg)) || NID(a) <= N_R )
! 179: vl = 0;
! 180: else {
! 181: t = BDY((Alg)a);
! 182: switch ( OID(t) ) {
! 183: case O_P: case O_R:
! 184: clctvr(ALG,t,&vl); break;
! 185: default:
! 186: vl = 0; break;
! 187: }
! 188: }
! 189: for ( n0 = 0; vl; vl = NEXT(vl) ) {
! 190: NEXTNODE(n0,n); MKV(vl->v,p); MKAlg(p,b); BDY(n) = (pointer)b;
! 191: }
! 192: if ( n0 )
! 193: NEXT(n) = 0;
! 194: MKLIST(*rp,n0);
! 195: }
! 196:
! 197: void Pgetalgtree(arg,rp)
! 198: NODE arg;
! 199: LIST *rp;
! 200: {
! 201: Obj t;
! 202: P p;
! 203: VL vl,vl1,vl2;
! 204: Num a;
! 205: Alg b;
! 206: NODE n0,n;
! 207:
! 208: if ( !(a = (Num)ARG0(arg)) || NID(a) <= N_R )
! 209: vl = 0;
! 210: else {
! 211: t = BDY((Alg)a);
! 212: switch ( OID(t) ) {
! 213: case O_P:
! 214: clctalg(t,&vl); break;
! 215: case O_R:
! 216: clctalg(NM((R)t),&vl1);
! 217: clctalg(DN((R)t),&vl2);
! 218: mergev(ALG,vl1,vl2,&vl); break;
! 219: default:
! 220: vl = 0; break;
! 221: }
! 222: }
! 223: for ( n0 = 0; vl; vl = NEXT(vl) ) {
! 224: NEXTNODE(n0,n); MKV(vl->v,p); MKAlg(p,b); BDY(n) = (pointer)b;
! 225: }
! 226: if ( n0 )
! 227: NEXT(n) = 0;
! 228: MKLIST(*rp,n0);
! 229: }
! 230:
! 231: void clctalg(p,vl)
! 232: P p;
! 233: VL *vl;
! 234: {
! 235: int n,i;
! 236: VL tvl;
! 237: VN vn,vn1;
! 238: P d;
! 239: DCP dc;
! 240:
! 241: for ( n = 0, tvl = ALG; tvl; tvl = NEXT(tvl), n++ );
! 242: vn = (VN) ALLOCA((n+1)*sizeof(struct oVN));
! 243: for ( i = n-1, tvl = ALG; tvl; tvl = NEXT(tvl), i-- ) {
! 244: vn[i].v = tvl->v;
! 245: vn[i].n = 0;
! 246: }
! 247: markv(vn,n,p);
! 248: for ( i = n-1; i >= 0; i-- ) {
! 249: if ( !vn[i].n )
! 250: continue;
! 251: d = (P)vn[i].v->attr;
! 252: for ( dc = DC(d); dc; dc = NEXT(dc) )
! 253: markv(vn,i,COEF(dc));
! 254: }
! 255: vn1 = (VN) ALLOCA((n+1)*sizeof(struct oVN));
! 256: for ( i = 0; i < n; i++ ) {
! 257: vn1[i].v = vn[n-1-i].v; vn1[i].n = vn[n-1-i].n;
! 258: }
! 259: vntovl(vn1,n,vl);
! 260: }
! 261:
! 262: void Palg(arg,rp)
! 263: NODE arg;
! 264: Alg *rp;
! 265: {
! 266: Q a;
! 267: VL vl;
! 268: P x;
! 269: int n;
! 270:
! 271: a = (Q)ARG0(arg);
! 272: if ( a && (OID(a) != O_N || NID(a) != N_Q || !INT(a)) )
! 273: *rp = 0;
! 274: else {
! 275: n = ACNT-QTOS(a)-1;
! 276: for ( vl = ALG; vl && n; vl = NEXT(vl), n-- );
! 277: if ( vl ) {
! 278: MKV(vl->v,x); MKAlg(x,*rp);
! 279: } else
! 280: *rp = 0;
! 281: }
! 282: }
! 283:
! 284: void Palgv(arg,rp)
! 285: NODE arg;
! 286: Obj *rp;
! 287: {
! 288: Q a;
! 289: VL vl;
! 290: P x;
! 291: int n;
! 292: Alg b;
! 293:
! 294: a = (Q)ARG0(arg);
! 295: if ( a && (OID(a) != O_N || NID(a) != N_Q || !INT(a)) )
! 296: *rp = 0;
! 297: else {
! 298: n = ACNT-QTOS(a)-1;
! 299: for ( vl = ALG; vl && n; vl = NEXT(vl), n-- );
! 300: if ( vl ) {
! 301: MKV(vl->v,x); MKAlg(x,b); algtorat((Num)b,rp);
! 302: } else
! 303: *rp = 0;
! 304: }
! 305: }
! 306:
! 307: void algptop(p,r)
! 308: P p,*r;
! 309: {
! 310: DCP dc,dcr,dcr0;
! 311:
! 312: if ( NUM(p) )
! 313: *r = (P)p;
! 314: else {
! 315: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 316: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
! 317: algptop(COEF(dc),&COEF(dcr));
! 318: }
! 319: NEXT(dcr) = 0; MKP((V)(VR(p)->priv),dcr0,*r);
! 320: }
! 321: }
! 322:
! 323: void algtorat(n,r)
! 324: Num n;
! 325: Obj *r;
! 326: {
! 327: Obj obj;
! 328: P nm,dn;
! 329:
! 330: if ( !n || NID(n) <= N_R )
! 331: *r = (Obj)n;
! 332: else {
! 333: obj = BDY((Alg)n);
! 334: if ( ID(obj) <= O_P )
! 335: algptop((P)obj,(P *)r);
! 336: else {
! 337: algptop(NM((R)obj),&nm); algptop(DN((R)obj),&dn);
! 338: divr(CO,(Obj)nm,(Obj)dn,r);
! 339: }
! 340: }
! 341: }
! 342:
! 343: void rattoalg(obj,n)
! 344: Obj obj;
! 345: Alg *n;
! 346: {
! 347: P nm,dn;
! 348: Obj t;
! 349:
! 350: if ( !obj || ID(obj) == O_N )
! 351: *n = (Alg)obj;
! 352: else if ( ID(obj) == O_P ) {
! 353: ptoalgp((P)obj,(P *)&t); MKAlg(t,*n);
! 354: } else {
! 355: ptoalgp(NM((R)obj),&nm); ptoalgp(DN((R)obj),&dn);
! 356: divr(ALG,(Obj)nm,(Obj)dn,&t); MKAlg(t,*n);
! 357: }
! 358: }
! 359:
! 360: void ptoalgp(p,r)
! 361: P p,*r;
! 362: {
! 363: DCP dc,dcr,dcr0;
! 364:
! 365: if ( NUM(p) )
! 366: *r = (P)p;
! 367: else {
! 368: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 369: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
! 370: ptoalgp(COEF(dc),&COEF(dcr));
! 371: }
! 372: NEXT(dcr) = 0; MKP((V)(VR(p)->priv),dcr0,*r);
! 373: }
! 374: }