Annotation of OpenXM/src/kan96xx/Kan/kanExport0.c, Revision 1.41
1.41 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.40 2004/09/23 12:20:52 takayama Exp $ */
1.1 maekawa 2: #include <stdio.h>
3: #include "datatype.h"
4: #include "stackm.h"
5: #include "extern.h"
6: #include "extern2.h"
7: #include "lookup.h"
8: #include "matrix.h"
9: #include "gradedset.h"
10: #include "kclass.h"
11:
12: #define universalToPoly(un,rp) (isZero(un)?ZERO:coeffToPoly(un,rp))
13:
14: static void checkDuplicateName(char *xvars[],char *dvars[],int n);
15:
16: static void yet() { fprintf(stderr,"Not implemented."); }
17:
18: int SerialCurrent = -1; /* Current Serial number of the recieved packet as server. */
19:
20: int ReverseOutputOrder = 1;
21: int WarningNoVectorVariable = 1;
1.19 takayama 22: extern int QuoteMode;
1.1 maekawa 23:
24: /** :arithmetic **/
25: struct object KooAdd(ob1,ob2)
1.7 takayama 26: struct object ob1,ob2;
1.1 maekawa 27: {
28: extern struct ring *CurrentRingp;
29: struct object rob = NullObject;
30: POLY r;
31: int s,i;
32: objectp f1,f2,g1,g2;
33: struct object nn,dd;
34:
35: switch (Lookup[ob1.tag][ob2.tag]) {
36: case SintegerSinteger:
37: return(KpoInteger(ob1.lc.ival + ob2.lc.ival));
38: break;
39: case SpolySpoly:
40: r = ppAdd(ob1.lc.poly,ob2.lc.poly);
41: rob.tag = Spoly; rob.lc.poly = r;
42: return(rob);
43: break;
44: case SarraySarray:
45: s = getoaSize(ob1);
46: if (s != getoaSize(ob2)) {
47: errorKan1("%s\n","Two arrays must have a same size.");
48: }
49: rob = newObjectArray(s);
50: for (i=0; i<s; i++) {
51: putoa(rob,i,KooAdd(getoa(ob1,i),getoa(ob2,i)));
52: }
53: return(rob);
54: break;
55: case SuniversalNumberSuniversalNumber:
56: rob.tag = SuniversalNumber;
57: rob.lc.universalNumber = newUniversalNumber(0);
58: Cadd(rob.lc.universalNumber,ob1.lc.universalNumber,ob2.lc.universalNumber);
59: return(rob);
60: break;
61: case SuniversalNumberSpoly:
62: rob.tag = Spoly;
63: r = ob2.lc.poly;
64: if (r ISZERO) {
65: /*warningKan("KooAdd(universalNumber,0 polynomial) cannot determine the ring for the result. Assume the current ring.");
66: rob.lc.poly = universalToPoly(ob1.lc.universalNumber,CurrentRingp);*/
67: rob = ob1;
68: return(rob); /* returns universal number. */
69: }
70: rob.lc.poly = ppAdd(universalToPoly(ob1.lc.universalNumber,r->m->ringp),r);
71: return(rob);
72: break;
73: case SpolySuniversalNumber:
74: return(KooAdd(ob2,ob1));
75: break;
76: case SuniversalNumberSinteger:
77: rob.tag = SuniversalNumber;
78: rob.lc.universalNumber = newUniversalNumber(0);
79: nn.tag = SuniversalNumber;
80: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob2));
81: Cadd(rob.lc.universalNumber,ob1.lc.universalNumber,nn.lc.universalNumber);
82: return(rob);
83: break;
84: case SintegerSuniversalNumber:
85: rob.tag = SuniversalNumber;
86: rob.lc.universalNumber = newUniversalNumber(0);
87: nn.tag = SuniversalNumber;
88: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob1));
89: Cadd(rob.lc.universalNumber,nn.lc.universalNumber,ob2.lc.universalNumber);
90: return(rob);
91: break;
92:
93: case SrationalFunctionSrationalFunction:
94: f1 = Knumerator(ob1);
95: f2 = Kdenominator(ob1);
96: g1 = Knumerator(ob2);
97: g2 = Kdenominator(ob2);
98: nn = KooAdd(KooMult(*g2,*f1),KooMult(*f2,*g1));
99: dd = KooMult(*f2,*g2);
100: rob = KnewRationalFunction0(copyObjectp(&nn),copyObjectp(&dd));
101: KisInvalidRational(&rob);
102: return(rob);
103: break;
104: case SpolySrationalFunction: /* f1 + g1/g2 = (g2 f1 + g1)/g2 */
105: case SuniversalNumberSrationalFunction:
106: g1 = Knumerator(ob2);
107: g2 = Kdenominator(ob2);
108: nn = KooAdd(KooMult(*g2,ob1),*g1);
109: rob = KnewRationalFunction0(copyObjectp(&nn),g2);
110: KisInvalidRational(&rob);
111: return(rob);
112: break;
113: case SrationalFunctionSpoly:
114: case SrationalFunctionSuniversalNumber:
115: return(KooAdd(ob2,ob1));
116: break;
117: case SdoubleSdouble:
118: return(KpoDouble( KopDouble(ob1) + KopDouble(ob2) ));
119: break;
120: case SdoubleSinteger:
121: case SdoubleSuniversalNumber:
122: case SdoubleSrationalFunction:
123: return(KpoDouble( KopDouble(ob1) + toDouble0(ob2) ) );
124: break;
125: case SintegerSdouble:
126: case SuniversalNumberSdouble:
127: case SrationalFunctionSdouble:
128: return(KpoDouble( toDouble0(ob1) + KopDouble(ob2) ) );
129: break;
130: case SclassSclass:
131: case SclassSinteger:
132: case SclassSpoly:
133: case SclassSuniversalNumber:
134: case SclassSrationalFunction:
135: case SclassSdouble:
136: case SpolySclass:
137: case SintegerSclass:
138: case SuniversalNumberSclass:
139: case SrationalFunctionSclass:
140: case SdoubleSclass:
141: return(Kclass_ooAdd(ob1,ob2));
142: break;
143:
144:
145: default:
1.19 takayama 146: if (QuoteMode) {
1.22 takayama 147: rob = addTree(ob1,ob2);
1.19 takayama 148: }else{
149: warningKan("KooAdd() has not supported yet these objects.\n");
150: }
1.1 maekawa 151: break;
152: }
153: return(rob);
154: }
155:
156: struct object KooSub(ob1,ob2)
1.7 takayama 157: struct object ob1,ob2;
1.1 maekawa 158: {
159: struct object rob = NullObject;
160: POLY r;
161: int s,i;
162: objectp f1,f2,g1,g2;
163: extern struct coeff *UniversalZero;
164: struct object nn,dd;
165:
166: switch (Lookup[ob1.tag][ob2.tag]) {
167: case SintegerSinteger:
168: return(KpoInteger(ob1.lc.ival - ob2.lc.ival));
169: break;
170: case SpolySpoly:
171: r = ppSub(ob1.lc.poly,ob2.lc.poly);
172: rob.tag = Spoly; rob.lc.poly = r;
173: return(rob);
174: break;
175: case SarraySarray:
176: s = getoaSize(ob1);
177: if (s != getoaSize(ob2)) {
178: errorKan1("%s\n","Two arrays must have a same size.");
179: }
180: rob = newObjectArray(s);
181: for (i=0; i<s; i++) {
182: putoa(rob,i,KooSub(getoa(ob1,i),getoa(ob2,i)));
183: }
184: return(rob);
185: break;
186: case SuniversalNumberSuniversalNumber:
187: rob.tag = SuniversalNumber;
188: rob.lc.universalNumber = newUniversalNumber(0);
189: Csub(rob.lc.universalNumber,ob1.lc.universalNumber,ob2.lc.universalNumber);
190: return(rob);
191: break;
192:
193: case SuniversalNumberSpoly:
194: rob.tag = Spoly;
195: r = ob2.lc.poly;
196: if (r ISZERO) {
197: rob = ob1;
198: return(rob); /* returns universal number. */
199: }
200: rob.lc.poly = ppSub(universalToPoly(ob1.lc.universalNumber,r->m->ringp),r);
201: return(rob);
202: break;
203: case SpolySuniversalNumber:
204: rob.tag = Spoly;
205: r = ob1.lc.poly;
206: if (r ISZERO) {
207: rob.tag = SuniversalNumber;
208: rob.lc.universalNumber = newUniversalNumber(0);
209: Csub(rob.lc.universalNumber,UniversalZero,ob2.lc.universalNumber);
210: return(rob); /* returns universal number. */
211: }
212: rob.lc.poly = ppSub(r,universalToPoly(ob2.lc.universalNumber,r->m->ringp));
213: return(rob);
214: break;
215:
216: case SuniversalNumberSinteger:
217: rob.tag = SuniversalNumber;
218: rob.lc.universalNumber = newUniversalNumber(0);
219: nn.tag = SuniversalNumber;
220: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob2));
221: Csub(rob.lc.universalNumber,ob1.lc.universalNumber,nn.lc.universalNumber);
222: return(rob);
223: break;
224: case SintegerSuniversalNumber:
225: rob.tag = SuniversalNumber;
226: rob.lc.universalNumber = newUniversalNumber(0);
227: nn.tag = SuniversalNumber;
228: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob1));
229: Csub(rob.lc.universalNumber,nn.lc.universalNumber,ob2.lc.universalNumber);
230: return(rob);
231: break;
232:
233: case SrationalFunctionSrationalFunction:
234: f1 = Knumerator(ob1);
235: f2 = Kdenominator(ob1);
236: g1 = Knumerator(ob2);
237: g2 = Kdenominator(ob2);
238: nn = KooSub(KooMult(*g2,*f1),KooMult(*f2,*g1));
239: dd = KooMult(*f2,*g2);
240: rob = KnewRationalFunction0(copyObjectp(&nn),copyObjectp(&dd));
241: KisInvalidRational(&rob);
242: return(rob);
243: break;
244: case SpolySrationalFunction: /* f1 - g1/g2 = (g2 f1 - g1)/g2 */
245: case SuniversalNumberSrationalFunction:
246: g1 = Knumerator(ob2);
247: g2 = Kdenominator(ob2);
248: nn = KooSub(KooMult(*g2,ob1),*g1);
249: rob = KnewRationalFunction0(copyObjectp(&nn),g2);
250: KisInvalidRational(&rob);
251: return(rob);
252: break;
253: case SrationalFunctionSpoly:
254: case SrationalFunctionSuniversalNumber: /* f1/f2 - ob2= (f1 - f2*ob2)/f2 */
255: f1 = Knumerator(ob1);
256: f2 = Kdenominator(ob1);
257: nn = KooSub(*f1,KooMult(*f2,ob2));
258: rob = KnewRationalFunction0(copyObjectp(&nn),f2);
259: KisInvalidRational(&rob);
260: return(rob);
261: break;
262:
263: case SdoubleSdouble:
264: return(KpoDouble( KopDouble(ob1) - KopDouble(ob2) ));
265: break;
266: case SdoubleSinteger:
267: case SdoubleSuniversalNumber:
268: case SdoubleSrationalFunction:
269: return(KpoDouble( KopDouble(ob1) - toDouble0(ob2) ) );
270: break;
271: case SintegerSdouble:
272: case SuniversalNumberSdouble:
273: case SrationalFunctionSdouble:
274: return(KpoDouble( toDouble0(ob1) - KopDouble(ob2) ) );
275: break;
276:
277: default:
1.20 takayama 278: if (QuoteMode) {
279: rob = minusTree(ob1,ob2);
280: }else{
281: warningKan("KooSub() has not supported yet these objects.\n");
282: }
1.1 maekawa 283: break;
284: }
285: return(rob);
286: }
287:
288: struct object KooMult(ob1,ob2)
1.7 takayama 289: struct object ob1,ob2;
1.1 maekawa 290: {
291: struct object rob = NullObject;
292: POLY r;
293: int i,s;
294: objectp f1,f2,g1,g2;
295: struct object dd,nn;
296:
297:
298: switch (Lookup[ob1.tag][ob2.tag]) {
299: case SintegerSinteger:
300: return(KpoInteger(ob1.lc.ival * ob2.lc.ival));
301: break;
302: case SpolySpoly:
303: r = ppMult(ob1.lc.poly,ob2.lc.poly);
304: rob.tag = Spoly; rob.lc.poly = r;
305: return(rob);
306: break;
307: case SarraySarray:
308: return(KaoMult(ob1,ob2));
309: break;
310: case SpolySarray:
311: case SuniversalNumberSarray:
312: case SrationalFunctionSarray:
313: case SintegerSarray:
314: s = getoaSize(ob2);
315: rob = newObjectArray(s);
316: for (i=0; i<s; i++) {
317: putoa(rob,i,KooMult(ob1,getoa(ob2,i)));
318: }
319: return(rob);
320: break;
321:
322: case SarraySpoly:
323: case SarraySuniversalNumber:
324: case SarraySrationalFunction:
325: case SarraySinteger:
326: s = getoaSize(ob1);
327: rob = newObjectArray(s);
328: for (i=0; i<s; i++) {
329: putoa(rob,i,KooMult(getoa(ob1,i),ob2));
330: }
331: return(rob);
332: break;
333:
334:
335: case SuniversalNumberSuniversalNumber:
336: rob.tag = SuniversalNumber;
337: rob.lc.universalNumber = newUniversalNumber(0);
338: Cmult(rob.lc.universalNumber,ob1.lc.universalNumber,ob2.lc.universalNumber);
339: return(rob);
340: break;
341:
342: case SuniversalNumberSpoly:
343: r = ob2.lc.poly;
344: if (r ISZERO) {
345: rob.tag = SuniversalNumber;
346: rob.lc.universalNumber = newUniversalNumber(0);
347: return(rob); /* returns universal number. */
348: }
349: if (isZero(ob1.lc.universalNumber)) {
350: rob.tag = Spoly;
351: rob.lc.poly = ZERO;
352: return(rob);
353: }
354: rob.tag = Spoly;
355: rob.lc.poly = ppMult(universalToPoly(ob1.lc.universalNumber,r->m->ringp),r);
356: return(rob);
357: break;
358: case SpolySuniversalNumber:
359: return(KooMult(ob2,ob1));
360: break;
361:
362: case SuniversalNumberSinteger:
363: rob.tag = SuniversalNumber;
364: rob.lc.universalNumber = newUniversalNumber(0);
365: nn.tag = SuniversalNumber;
366: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob2));
367: Cmult(rob.lc.universalNumber,ob1.lc.universalNumber,nn.lc.universalNumber);
368: return(rob);
369: break;
370: case SintegerSuniversalNumber:
371: rob.tag = SuniversalNumber;
372: rob.lc.universalNumber = newUniversalNumber(0);
373: nn.tag = SuniversalNumber;
374: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob1));
375: Cmult(rob.lc.universalNumber,nn.lc.universalNumber,ob2.lc.universalNumber);
376: return(rob);
377: break;
378:
379: case SrationalFunctionSrationalFunction:
380: f1 = Knumerator(ob1);
381: f2 = Kdenominator(ob1);
382: g1 = Knumerator(ob2);
383: g2 = Kdenominator(ob2);
384: nn = KooMult(*f1,*g1);
385: dd = KooMult(*f2,*g2);
386: rob = KnewRationalFunction0(copyObjectp(&nn),copyObjectp(&dd));
387: KisInvalidRational(&rob);
388: return(rob);
389: break;
390: case SpolySrationalFunction: /* ob1 g1/g2 */
391: case SuniversalNumberSrationalFunction:
392: g1 = Knumerator(ob2);
393: g2 = Kdenominator(ob2);
394: nn = KooMult(ob1,*g1);
395: rob = KnewRationalFunction0(copyObjectp(&nn),g2);
396: KisInvalidRational(&rob);
397: return(rob);
398: break;
399: case SrationalFunctionSpoly:
400: case SrationalFunctionSuniversalNumber: /* f1*ob2/f2 */
401: f1 = Knumerator(ob1);
402: f2 = Kdenominator(ob1);
403: nn = KooMult(*f1,ob2);
404: rob = KnewRationalFunction0(copyObjectp(&nn),f2);
405: KisInvalidRational(&rob);
406: return(rob);
407: break;
408:
409: case SdoubleSdouble:
410: return(KpoDouble( KopDouble(ob1) * KopDouble(ob2) ));
411: break;
412: case SdoubleSinteger:
413: case SdoubleSuniversalNumber:
414: case SdoubleSrationalFunction:
415: return(KpoDouble( KopDouble(ob1) * toDouble0(ob2) ) );
416: break;
417: case SintegerSdouble:
418: case SuniversalNumberSdouble:
419: case SrationalFunctionSdouble:
420: return(KpoDouble( toDouble0(ob1) * KopDouble(ob2) ) );
421: break;
422:
423: default:
1.20 takayama 424: if (QuoteMode) {
1.22 takayama 425: rob = timesTree(ob1,ob2);
1.20 takayama 426: }else{
427: warningKan("KooMult() has not supported yet these objects.\n");
428: }
1.1 maekawa 429: break;
430: }
431: return(rob);
432: }
433:
434:
435:
436: struct object KoNegate(obj)
1.7 takayama 437: struct object obj;
1.1 maekawa 438: {
439: struct object rob = NullObject;
440: extern struct ring SmallRing;
441: struct object tob;
442: switch(obj.tag) {
443: case Sinteger:
444: rob = obj;
445: rob.lc.ival = -rob.lc.ival;
446: break;
447: case Spoly:
448: rob.tag = Spoly;
449: rob.lc.poly = ppSub(ZERO,obj.lc.poly);
450: break;
451: case SuniversalNumber:
452: rob.tag = SuniversalNumber;
453: rob.lc.universalNumber = coeffNeg(obj.lc.universalNumber,&SmallRing);
454: break;
455: case SrationalFunction:
456: rob.tag = SrationalFunction;
457: tob = KoNegate(*(Knumerator(obj)));
458: Knumerator(rob) = copyObjectp( &tob);
459: Kdenominator(rob) = Kdenominator(obj);
460: break;
461:
462: case Sdouble:
463: rob = KpoDouble( - toDouble0(obj) );
464: break;
465:
466: default:
1.20 takayama 467: if (QuoteMode) {
468: rob = unaryminusTree(obj);
469: }else{
470: warningKan("KoNegate() has not supported yet these objects.\n");
471: }
1.1 maekawa 472: break;
473: }
474: return(rob);
475: }
476:
477: struct object KoInverse(obj)
1.7 takayama 478: struct object obj;
1.1 maekawa 479: {
480: struct object rob = NullObject;
481: extern struct coeff *UniversalOne;
482: objectp onep;
483: struct object tob;
484: switch(obj.tag) {
485: case Spoly:
486: tob.tag = SuniversalNumber;
487: tob.lc.universalNumber = UniversalOne;
488: onep = copyObjectp(& tob);
489: rob = KnewRationalFunction0(onep,copyObjectp(&obj));
490: KisInvalidRational(&rob);
491: break;
492: case SuniversalNumber:
493: tob.tag = SuniversalNumber;
494: tob.lc.universalNumber = UniversalOne;
495: onep = copyObjectp(& tob);
496: rob = KnewRationalFunction0(onep,copyObjectp(&obj));
497: KisInvalidRational(&rob);
498: break;
499: case SrationalFunction:
500: rob = obj;
501: Knumerator(rob) = Kdenominator(obj);
502: Kdenominator(rob) = Knumerator(obj);
503: KisInvalidRational(&rob);
504: break;
505: default:
506: warningKan("KoInverse() has not supported yet these objects.\n");
507: break;
508: }
509: return(rob);
510: }
511:
512:
513: static int isVector(ob)
1.7 takayama 514: struct object ob;
1.1 maekawa 515: {
516: int i,n;
517: n = getoaSize(ob);
518: for (i=0; i<n; i++) {
519: if (getoa(ob,i).tag == Sarray) return(0);
520: }
521: return(1);
522: }
523:
524: static int isMatrix(ob,m,n)
1.7 takayama 525: struct object ob;
526: int m,n;
1.1 maekawa 527: {
528: int i,j;
529: for (i=0; i<m; i++) {
530: if (getoa(ob,i).tag != Sarray) return(0);
531: if (getoaSize(getoa(ob,i)) != n) return(0);
532: for (j=0; j<n; j++) {
533: if (getoa(getoa(ob,i),j).tag != Spoly) return(-1);
534: }
535: }
536: return(1);
537: }
538:
539:
540: struct object KaoMult(aa,bb)
1.7 takayama 541: struct object aa,bb;
542: /* aa and bb is assumed to be array. */
1.1 maekawa 543: {
544: int m,n,m2,n2;
545: int i,j,k;
546: POLY tmp;
547: POLY fik;
548: POLY gkj;
549: struct object rob;
550: int r1,r2;
551: int rsize;
552: struct object tob;
553: struct object ob1;
554: extern struct ring SmallRing;
555:
556: m = getoaSize(aa); m2 = getoaSize(bb);
557: if (m == 0 || m2 == 0) errorKan1("%s\n","KaoMult(). Invalid matrix size.");
558:
559: /* new code for vector x vector,... etc */
560: r1 = isVector(aa); r2 = isVector(bb);
561: if (r1 && r2 ) { /* vector X vector ---> scalar.*/
562: rsize = getoaSize(aa);
563: if (rsize != getoaSize(bb)) {
564: errorKan1("%s\n","KaoMult(vector,vector). The size of the vectors must be the same.");
565: }
566: if (r1 != 0) {
567: ob1 = getoa(aa,0);
568: if (ob1.tag == Spoly) {
1.7 takayama 569: rob.tag = Spoly; rob.lc.poly = ZERO;
1.1 maekawa 570: }else if (ob1.tag == Sinteger) {
1.7 takayama 571: rob.tag = Sinteger; rob.lc.ival = 0;
1.1 maekawa 572: }else {
1.7 takayama 573: rob.tag = SuniversalNumber;
574: rob.lc.universalNumber = intToCoeff(0,&SmallRing);
1.1 maekawa 575: }
576: }else{
577: rob.tag = Spoly; rob.lc.poly = ZERO;
578: }
579: for (i=0; i<rsize; i++) {
580: rob = KooAdd(rob,KooMult(getoa(aa,i),getoa(bb,i)));
581: }
582: return(rob);
583: } else if (r1 == 0 && r2 ) { /* matrix X vector ---> vector */
1.7 takayama 584: /* (m n) (m2=n) */
1.1 maekawa 585: n = getoaSize(getoa(aa,0));
586: if (isMatrix(aa,m,n) == 0) {
587: errorKan1("%s\n","KaoMult(matrix,vector). The left object is not matrix.");
588: }else if (n != m2) {
589: errorKan1("%s\n","KaoMult(). Invalid matrix and vector sizes for mult.");
590: } else ;
591: rob = newObjectArray(m);
592: for (i=0; i<m; i++) {
593: getoa(rob,i) = KooMult(getoa(aa,i),bb);
594: }
595: return(rob);
596: }else if (r1 && r2 == 0) { /* vector X matrix ---> vector */
597: tob = newObjectArray(1);
598: getoa(tob,0) = aa; /* [aa] * bb and strip [ ] */
599: tob = KooMult(tob,bb);
600: return(getoa(tob,0));
601: } else ; /* continue: matrix X matrix case. */
602: /* end of new code */
603:
604: if (getoa(aa,0).tag != Sarray || getoa(bb,0).tag != Sarray) {
605: errorKan1("%s\n","KaoMult(). Matrix must be given.");
606: }
607: n = getoaSize(getoa(aa,0));
608: n2 = getoaSize(getoa(bb,0));
609: if (n != m2) errorKan1("%s\n","KaoMult(). Invalid matrix size for mult. ((p,q)X(q,r)");
610: r1 = isMatrix(aa,m,n); r2 = isMatrix(bb,m2,n2);
611: if (r1 == -1 || r2 == -1) {
612: /* Object multiplication. Elements are not polynomials. */
613: struct object ofik,ogkj,otmp;
614: rob = newObjectArray(m);
615: for (i=0; i<m; i++) {
616: getoa(rob,i) = newObjectArray(n2);
617: }
618: for (i=0; i<m; i++) {
619: for (j=0; j<n2; j++) {
1.7 takayama 620: ofik = getoa(getoa(aa,i),0);
621: ogkj = getoa(getoa(bb,0),j);
622: otmp = KooMult( ofik, ogkj);
623: for (k=1; k<n; k++) {
624: ofik = getoa(getoa(aa,i),k);
625: ogkj = getoa(getoa(bb,k),j);
626: otmp = KooAdd(otmp, KooMult( ofik, ogkj));
627: }
628: getoa(getoa(rob,i),j) = otmp;
1.1 maekawa 629: }
630: }
631: return(rob);
632: /*errorKan1("%s\n","KaoMult().Elements of the matrix must be polynomials.");*/
633: }
634: if (r1 == 0 || r2 == 0)
635: errorKan1("%s\n","KaoMult(). Invalid matrix form for mult.");
636:
637: rob = newObjectArray(m);
638: for (i=0; i<m; i++) {
639: getoa(rob,i) = newObjectArray(n2);
640: }
641: for (i=0; i<m; i++) {
642: for (j=0; j<n2; j++) {
643: tmp = ZERO;
644: for (k=0; k<n; k++) {
1.7 takayama 645: fik = KopPOLY(getoa(getoa(aa,i),k));
646: gkj = KopPOLY(getoa(getoa(bb,k),j));
647: tmp = ppAdd(tmp, ppMult( fik, gkj));
1.1 maekawa 648: }
649: getoa(getoa(rob,i),j) = KpoPOLY(tmp);
650: }
651: }
652: return(rob);
653: }
654:
655: struct object KooDiv(ob1,ob2)
1.7 takayama 656: struct object ob1,ob2;
1.1 maekawa 657: {
658: struct object rob = NullObject;
659: switch (Lookup[ob1.tag][ob2.tag]) {
660: case SintegerSinteger:
661: return(KpoInteger((ob1.lc.ival) / (ob2.lc.ival)));
662: break;
663: case SuniversalNumberSuniversalNumber:
664: rob.tag = SuniversalNumber;
665: rob.lc.universalNumber = newUniversalNumber(0);
666: universalNumberDiv(rob.lc.universalNumber,ob1.lc.universalNumber,
1.7 takayama 667: ob2.lc.universalNumber);
1.1 maekawa 668: return(rob);
669: break;
670:
671:
672: default:
1.20 takayama 673: if (QuoteMode) {
674: rob = divideTree(ob1,ob2);
675: }else{
676: warningKan("KooDiv() has not supported yet these objects.\n");
677: }
1.1 maekawa 678: break;
679: }
680: return(rob);
681: }
682:
683: /* :relation */
684: KooEqualQ(obj1,obj2)
1.7 takayama 685: struct object obj1;
686: struct object obj2;
1.1 maekawa 687: {
688: struct object ob;
689: int i;
1.35 takayama 690: extern int Verbose;
1.1 maekawa 691: if (obj1.tag != obj2.tag) {
692: warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n");
1.35 takayama 693: if (Verbose & 0x10) {
1.36 takayama 694: fprintf(stderr,"obj1(tag:%d)=",obj1.tag);
1.35 takayama 695: printObject(obj1,0,stderr);
1.36 takayama 696: fprintf(stderr,", obj2(tag:%d)=",obj2.tag);
1.35 takayama 697: printObject(obj2,0,stderr);
698: fprintf(stderr,"\n"); fflush(stderr);
699: }
1.1 maekawa 700: return(0);
701: }
702: switch(obj1.tag) {
1.7 takayama 703: case 0:
704: return(1); /* case of NullObject */
705: break;
706: case Sinteger:
707: if (obj1.lc.ival == obj2.lc.ival) return(1);
708: else return(0);
709: break;
710: case Sstring:
711: case Sdollar:
712: if (strcmp(obj1.lc.str, obj2.lc.str)==0) return(1);
713: else return(0);
714: break;
715: case Spoly:
716: ob = KooSub(obj1,obj2);
717: if (KopPOLY(ob) == ZERO) return(1);
718: else return(0);
719: case Sarray:
720: if (getoaSize(obj1) != getoaSize(obj2)) return(0);
721: for (i=0; i< getoaSize(obj1); i++) {
722: if (KooEqualQ(getoa(obj1,i),getoa(obj2,i))) { ; }
723: else { return(0); }
724: }
725: return(1);
726: case Slist:
727: if (KooEqualQ(*(obj1.lc.op),*(obj2.lc.op))) {
728: if (isNullList(obj1.rc.op)) {
729: if (isNullList(obj2.rc.op)) return(1);
730: else return(0);
1.1 maekawa 731: }else{
1.7 takayama 732: if (isNullList(obj2.rc.op)) return(0);
733: return(KooEqualQ(*(obj1.rc.op),*(obj2.rc.op)));
1.1 maekawa 734: }
1.7 takayama 735: }else{
736: return(0);
1.1 maekawa 737: }
1.7 takayama 738: break;
739: case SuniversalNumber:
740: return(coeffEqual(obj1.lc.universalNumber,obj2.lc.universalNumber));
741: break;
742: case Sring:
743: return(KopRingp(obj1) == KopRingp(obj2));
744: break;
745: case Sclass:
746: return(KclassEqualQ(obj1,obj2));
747: break;
748: case Sdouble:
749: return(KopDouble(obj1) == KopDouble(obj2));
750: break;
751: default:
752: errorKan1("%s\n","KooEqualQ() has not supported these objects yet.");
753: break;
754: }
1.1 maekawa 755: }
756:
757:
758: struct object KoIsPositive(ob1)
1.7 takayama 759: struct object ob1;
1.1 maekawa 760: {
761: struct object rob = NullObject;
762: switch (ob1.tag) {
763: case Sinteger:
764: return(KpoInteger(ob1.lc.ival > 0));
765: break;
766: default:
767: warningKan("KoIsPositive() has not supported yet these objects.\n");
768: break;
769: }
770: return(rob);
771: }
772:
773: struct object KooGreater(obj1,obj2)
1.7 takayama 774: struct object obj1;
775: struct object obj2;
1.1 maekawa 776: {
777: struct object ob;
778: int tt;
779: if (obj1.tag != obj2.tag) {
780: errorKan1("%s\n","You cannot compare different kinds of objects.");
781: }
782: switch(obj1.tag) {
1.7 takayama 783: case 0:
784: return(KpoInteger(1)); /* case of NullObject */
785: break;
786: case Sinteger:
787: if (obj1.lc.ival > obj2.lc.ival) return(KpoInteger(1));
788: else return(KpoInteger(0));
789: break;
790: case Sstring:
791: case Sdollar:
792: if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1));
793: else return(KpoInteger(0));
794: break;
795: case Spoly:
796: if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1));
797: else return(KpoInteger(0));
798: break;
799: case SuniversalNumber:
800: tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
801: if (tt > 0) return(KpoInteger(1));
802: else return(KpoInteger(0));
803: break;
804: case Sdouble:
805: if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1));
806: else return(KpoInteger(0));
807: break;
1.26 takayama 808: case Sarray:
809: {
810: int i,m1,m2;
811: struct object rr;
812: m1 = getoaSize(obj1); m2 = getoaSize(obj2);
813: for (i=0; i< (m1>m2?m2:m1); i++) {
814: rr=KooGreater(getoa(obj1,i),getoa(obj2,i));
815: if (KopInteger(rr) == 1) return rr;
816: rr=KooGreater(getoa(obj2,i),getoa(obj1,i));
817: if (KopInteger(rr) == 1) return KpoInteger(0);
818: }
819: if (m1 > m2) return KpoInteger(1);
820: else return KpoInteger(0);
821: }
822: break;
1.7 takayama 823: default:
824: errorKan1("%s\n","KooGreater() has not supported these objects yet.");
825: break;
826: }
1.1 maekawa 827: }
828:
829: struct object KooLess(obj1,obj2)
1.7 takayama 830: struct object obj1;
831: struct object obj2;
1.1 maekawa 832: {
833: struct object ob;
834: int tt;
835: if (obj1.tag != obj2.tag) {
836: errorKan1("%s\n","You cannot compare different kinds of objects.");
837: }
838: switch(obj1.tag) {
1.7 takayama 839: case 0:
840: return(KpoInteger(1)); /* case of NullObject */
841: break;
842: case Sinteger:
843: if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1));
844: else return(KpoInteger(0));
845: break;
846: case Sstring:
847: case Sdollar:
848: if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1));
849: else return(KpoInteger(0));
850: break;
851: case Spoly:
852: if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1));
853: else return(KpoInteger(0));
854: break;
855: case SuniversalNumber:
856: tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
857: if (tt < 0) return(KpoInteger(1));
858: else return(KpoInteger(0));
859: break;
860: case Sdouble:
861: if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1));
862: else return(KpoInteger(0));
863: break;
1.26 takayama 864: case Sarray:
865: {
866: int i,m1,m2;
867: struct object rr;
868: m1 = getoaSize(obj1); m2 = getoaSize(obj2);
869: for (i=0; i< (m1>m2?m2:m1); i++) {
870: rr=KooLess(getoa(obj1,i),getoa(obj2,i));
871: if (KopInteger(rr) == 1) return rr;
872: rr=KooLess(getoa(obj2,i),getoa(obj1,i));
873: if (KopInteger(rr) == 1) return KpoInteger(0);
874: }
875: if (m1 < m2) return KpoInteger(1);
876: else return KpoInteger(0);
877: }
878: break;
1.7 takayama 879: default:
880: errorKan1("%s\n","KooLess() has not supported these objects yet.");
881: break;
882: }
1.1 maekawa 883: }
884:
885: /* :conversion */
886:
887: struct object KdataConversion(obj,key)
1.7 takayama 888: struct object obj;
889: char *key;
1.1 maekawa 890: {
891: char tmps[128]; /* Assume that double is not more than 128 digits */
892: char intstr[100]; /* Assume that int is not more than 100 digits */
893: struct object rob;
894: extern struct ring *CurrentRingp;
895: extern struct ring SmallRing;
896: int flag;
897: struct object rob1,rob2;
898: char *s;
899: int i;
1.2 takayama 900: double f;
901: double f2;
1.1 maekawa 902: /* reports the data type */
903: if (key[0] == 't' || key[0] =='e') {
904: if (strcmp(key,"type?")==0) {
905: rob = KpoInteger(obj.tag);
906: return(rob);
907: }else if (strcmp(key,"type??")==0) {
908: if (obj.tag != Sclass) {
1.7 takayama 909: rob = KpoInteger(obj.tag);
1.1 maekawa 910: }else {
1.7 takayama 911: rob = KpoInteger(ectag(obj));
1.1 maekawa 912: }
913: return(rob);
914: }else if (strcmp(key,"error")==0) {
915: rob = KnewErrorPacketObj(obj);
916: return(rob);
917: }
918: }
919: switch(obj.tag) {
920: case Snull:
921: if (strcmp(key,"integer") == 0) {
922: rob = KpoInteger(0);
923: return(rob);
924: }else if (strcmp(key,"universalNumber") == 0) {
925: rob.tag = SuniversalNumber;
926: rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);
927: return(rob);
928: }else if (strcmp(key,"poly") == 0) {
929: rob = KpoPOLY(ZERO);
1.32 takayama 930: return rob;
931: }else if (strcmp(key,"array") == 0) {
932: rob = newObjectArray(0);
933: return rob;
1.1 maekawa 934: }else{
935: warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");
936: }
937: break;
938: case Sinteger:
939: if (strcmp(key,"string") == 0) { /* ascii code */
940: rob.tag = Sdollar;
941: rob.lc.str = (char *)sGC_malloc(2);
942: if (rob.lc.str == (char *)NULL) errorKan1("%s","No more memory.\n");
943: (rob.lc.str)[0] = obj.lc.ival; (rob.lc.str)[1] = '\0';
944: return(rob);
945: }else if (strcmp(key,"integer")==0) {
946: return(obj);
947: }else if (strcmp(key,"poly") == 0) {
948: rob.tag = Spoly;
949: rob.lc.poly = cxx(obj.lc.ival,0,0,CurrentRingp);
950: return(rob);
951: }else if (strcmp(key,"dollar") == 0) {
952: rob.tag = Sdollar;
953: sprintf(intstr,"%d",obj.lc.ival);
954: rob.lc.str = (char *)sGC_malloc(strlen(intstr)+2);
955: if (rob.lc.str == (char *)NULL) errorKan1("%s","No more memory.\n");
956: strcpy(rob.lc.str,intstr);
957: return(rob);
958: }else if (strcmp(key,"universalNumber")==0) {
1.25 takayama 959: rob = KintToUniversalNumber(obj.lc.ival);
1.1 maekawa 960: return(rob);
961: }else if (strcmp(key,"double") == 0) {
962: rob = KpoDouble((double) (obj.lc.ival));
963: return(rob);
964: }else if (strcmp(key,"null") == 0) {
965: rob = NullObject;
966: return(rob);
967: }else{
968: warningKan("Sorry. This type of data conversion has not supported yet.\n");
969: }
970: break;
971: case Sdollar:
972: if (strcmp(key,"dollar") == 0 || strcmp(key,"string")==0) {
973: rob = obj;
974: return(rob);
975: }else if (strcmp(key,"literal") == 0) {
976: rob.tag = Sstring;
977: s = (char *) sGC_malloc(sizeof(char)*(strlen(obj.lc.str)+3));
978: if (s == (char *) NULL) {
1.7 takayama 979: errorKan1("%s\n","No memory.");
1.1 maekawa 980: }
981: s[0] = '/';
982: strcpy(&(s[1]),obj.lc.str);
983: rob.lc.str = &(s[1]);
984: /* set the hashing value. */
985: rob2 = lookupLiteralString(s);
986: rob.rc.op = rob2.lc.op;
987: return(rob);
988: }else if (strcmp(key,"poly")==0) {
989: rob.tag = Spoly;
990: rob.lc.poly = stringToPOLY(obj.lc.str,CurrentRingp);
991: return(rob);
992: }else if (strcmp(key,"array")==0) {
993: rob = newObjectArray(strlen(obj.lc.str));
994: for (i=0; i<strlen(obj.lc.str); i++) {
1.7 takayama 995: putoa(rob,i,KpoInteger((obj.lc.str)[i]));
1.1 maekawa 996: }
997: return(rob);
998: }else if (strcmp(key,"universalNumber") == 0) {
999: rob.tag = SuniversalNumber;
1000: rob.lc.universalNumber = stringToUniversalNumber(obj.lc.str,&flag);
1001: if (flag == -1) errorKan1("KdataConversion(): %s",
1.7 takayama 1002: "It's not number.\n");
1.2 takayama 1003: return(rob);
1004: }else if (strcmp(key,"double") == 0) {
1005: /* Check the format. 2.3432 e2 is not allowed. It should be 2.3232e2.*/
1006: flag = 0;
1007: for (i=0; (obj.lc.str)[i] != '\0'; i++) {
1.7 takayama 1008: if ((obj.lc.str)[i] > ' ' && flag == 0) flag=1;
1009: else if ((obj.lc.str)[i] <= ' ' && flag == 1) flag = 2;
1010: else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3;
1.2 takayama 1011: }
1012: if (flag == 3) errorKan1("KdataConversion(): %s","The data for the double contains blanck(s)");
1013: /* Read the double. */
1014: if (sscanf(obj.lc.str,"%lf",&f) <= 0) {
1.7 takayama 1015: errorKan1("KdataConversion(): %s","It cannot be translated to double.");
1.2 takayama 1016: }
1017: rob = KpoDouble(f);
1.1 maekawa 1018: return(rob);
1019: }else if (strcmp(key,"null") == 0) {
1020: rob = NullObject;
1021: return(rob);
1022: }else{
1023: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1024: }
1025: break;
1026: case Sarray:
1027: if (strcmp(key,"array") == 0) {
1028: return(rob);
1029: }else if (strcmp(key,"list") == 0) {
1.32 takayama 1030: rob = KarrayToList(obj);
1.1 maekawa 1031: return(rob);
1032: }else if (strcmp(key,"arrayOfPOLY")==0) {
1033: rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));
1034: return(rob);
1035: }else if (strcmp(key,"matrixOfPOLY")==0) {
1036: rob = KpoMatrixOfPOLY(arrayToMatrixOfPOLY(obj));
1037: return(rob);
1038: }else if (strcmp(key,"gradedPolySet")==0) {
1039: rob = KpoGradedPolySet(arrayToGradedPolySet(obj));
1040: return(rob);
1041: }else if (strcmp(key,"null") == 0) {
1042: rob = NullObject;
1043: return(rob);
1.38 takayama 1044: }else if (strcmp(key,"byteArray") == 0) {
1045: rob = newByteArray(getoaSize(obj),obj);
1046: return(rob);
1.1 maekawa 1047: }else {
1.23 takayama 1048: { /* Automatically maps the elements. */
1049: int n,i;
1050: n = getoaSize(obj);
1051: rob = newObjectArray(n);
1052: for (i=0; i<n; i++) {
1053: putoa(rob,i,KdataConversion(getoa(obj,i),key));
1054: }
1055: return(rob);
1056: }
1.1 maekawa 1057: }
1058: break;
1059: case Spoly:
1.15 takayama 1060: if ((strcmp(key,"poly")==0) || (strcmp(key,"numerator")==0)) {
1.5 takayama 1061: rob = obj;
1.1 maekawa 1062: return(rob);
1063: }else if (strcmp(key,"integer")==0) {
1064: if (obj.lc.poly == ZERO) return(KpoInteger(0));
1065: else {
1.7 takayama 1066: return(KpoInteger(coeffToInt(obj.lc.poly->coeffp)));
1.1 maekawa 1067: }
1068: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1069: rob.tag = Sdollar;
1070: rob.lc.str = KPOLYToString(KopPOLY(obj));
1071: return(rob);
1072: }else if (strcmp(key,"array") == 0) {
1073: return( POLYToArray(KopPOLY(obj)));
1074: }else if (strcmp(key,"map")==0) {
1075: return(KringMap(obj));
1076: }else if (strcmp(key,"universalNumber")==0) {
1077: if (obj.lc.poly == ZERO) {
1.7 takayama 1078: rob.tag = SuniversalNumber;
1079: rob.lc.universalNumber = newUniversalNumber(0);
1.1 maekawa 1080: } else {
1.7 takayama 1081: if (obj.lc.poly->coeffp->tag == MP_INTEGER) {
1082: rob.tag = SuniversalNumber;
1083: rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp);
1084: }else {
1085: rob = NullObject;
1086: warningKan("Coefficient is not MP_INT.");
1087: }
1.1 maekawa 1088: }
1089: return(rob);
1090: }else if (strcmp(key,"ring")==0) {
1091: if (obj.lc.poly ISZERO) {
1.7 takayama 1092: warningKan("Zero polynomial does not have the ring structure field.\n");
1.1 maekawa 1093: }else{
1.7 takayama 1094: rob.tag = Sring;
1095: rob.lc.ringp = (obj.lc.poly)->m->ringp;
1096: return(rob);
1.1 maekawa 1097: }
1098: }else if (strcmp(key,"null") == 0) {
1099: rob = NullObject;
1100: return(rob);
1101: }else{
1102: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1103: }
1104: break;
1105: case SarrayOfPOLY:
1106: if (strcmp(key,"array")==0) {
1107: rob = arrayOfPOLYToArray(KopArrayOfPOLYp(obj));
1108: return(rob);
1109: }else{
1110: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1111: }
1112: break;
1113: case SmatrixOfPOLY:
1114: if (strcmp(key,"array")==0) {
1115: rob = matrixOfPOLYToArray(KopMatrixOfPOLYp(obj));
1116: return(rob);
1117: }else if (strcmp(key,"null") == 0) {
1118: rob = NullObject;
1119: return(rob);
1120: }else{
1121: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1122: }
1123: break;
1124: case Slist:
1125: if (strcmp(key,"array") == 0) {
1.32 takayama 1126: rob = KlistToArray(obj);
1.1 maekawa 1127: return(rob);
1128: }
1129: break;
1130: case SuniversalNumber:
1.15 takayama 1131: if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) {
1.27 takayama 1132: rob = obj;
1.1 maekawa 1133: return(rob);
1134: }else if (strcmp(key,"integer")==0) {
1135: rob = KpoInteger(coeffToInt(obj.lc.universalNumber));
1136: return(rob);
1137: }else if (strcmp(key,"poly")==0) {
1138: rob = KpoPOLY(universalToPoly(obj.lc.universalNumber,CurrentRingp));
1139: return(rob);
1140: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1141: rob.tag = Sdollar;
1142: rob.lc.str = coeffToString(obj.lc.universalNumber);
1143: return(rob);
1144: }else if (strcmp(key,"null") == 0) {
1145: rob = NullObject;
1146: return(rob);
1147: }else if (strcmp(key,"double") == 0) {
1148: rob = KpoDouble( toDouble0(obj) );
1149: return(rob);
1.25 takayama 1150: }else if (strcmp(key,"denominator") == 0) {
1151: rob = KintToUniversalNumber(1);
1152: return(rob);
1.1 maekawa 1153: }else{
1154: warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n");
1155: }
1156: break;
1157: case SrationalFunction:
1158: if (strcmp(key,"rationalFunction")==0) {
1159: return(rob);
1160: } if (strcmp(key,"numerator")==0) {
1161: rob = *(Knumerator(obj));
1162: return(rob);
1163: }else if (strcmp(key,"denominator")==0) {
1164: rob = *(Kdenominator(obj));
1165: return(rob);
1166: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1167: rob1 = KdataConversion(*(Knumerator(obj)),"string");
1168: rob2 = KdataConversion(*(Kdenominator(obj)),"string");
1169: s = sGC_malloc(sizeof(char)*( strlen(rob1.lc.str) + strlen(rob2.lc.str) + 10));
1170: if (s == (char *)NULL) errorKan1("%s\n","KdataConversion(): No memory");
1171: sprintf(s,"(%s)/(%s)",rob1.lc.str,rob2.lc.str);
1172: rob.tag = Sdollar;
1173: rob.lc.str = s;
1174: return(rob);
1175: }else if (strcmp(key,"cancel")==0) {
1176: warningKan("Sorry. Data conversion <<cancel>> of rationalFunction has not supported yet.\n");
1177: return(obj);
1178: }else if (strcmp(key,"null") == 0) {
1179: rob = NullObject;
1180: return(rob);
1181: }else if (strcmp(key,"double") == 0) {
1182: rob = KpoDouble( toDouble0(obj) );
1183: return(rob);
1184: }else{
1185: warningKan("Sorry. This type of data conversion of rationalFunction has not supported yet.\n");
1186: }
1187: break;
1188: case Sdouble:
1189: if (strcmp(key,"integer") == 0) {
1190: rob = KpoInteger( (int) KopDouble(obj));
1191: return(rob);
1192: } else if (strcmp(key,"universalNumber") == 0) {
1193: rob.tag = SuniversalNumber;
1194: rob.lc.universalNumber = intToCoeff((int) KopDouble(obj),&SmallRing);
1195: return(rob);
1196: }else if ((strcmp(key,"string") == 0) || (strcmp(key,"dollar") == 0)) {
1197: sprintf(tmps,"%f",KopDouble(obj));
1198: s = sGC_malloc(strlen(tmps)+2);
1199: if (s == (char *)NULL) errorKan1("%s\n","KdataConversion(): No memory");
1200: strcpy(s,tmps);
1201: rob.tag = Sdollar;
1202: rob.lc.str = s;
1203: return(rob);
1204: }else if (strcmp(key,"double")==0) {
1205: return(obj);
1206: }else if (strcmp(key,"null") == 0) {
1207: rob = NullObject;
1208: return(rob);
1209: }else {
1210: warningKan("Sorry. This type of data conversion of rationalFunction has not supported yet.\n");
1211: }
1212: break;
1213: case Sring:
1214: if (strcmp(key,"orderMatrix")==0) {
1215: rob = oGetOrderMatrix(KopRingp(obj));
1216: return(rob);
1.22 takayama 1217: }else if (strcmp(key,"oxRingStructure")==0) {
1218: rob = oRingToOXringStructure(KopRingp(obj));
1219: return(rob);
1.1 maekawa 1220: }else{
1221: warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");
1222: }
1223: break;
1.38 takayama 1224: case SbyteArray:
1225: if (strcmp(key,"array") == 0) {
1226: rob = byteArrayToArray(obj);
1227: return(rob);
1228: } else {
1229: warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");
1230: }
1231: break;
1.1 maekawa 1232: default:
1233: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1234: }
1235: return(NullObject);
1236: }
1.28 takayama 1237:
1.29 takayama 1238: /* cf. macro to_int32 */
1239: struct object Kto_int32(struct object ob) {
1.28 takayama 1240: int n,i;
1241: struct object otmp;
1242: struct object rob;
1243: if (ob.tag == SuniversalNumber) return KdataConversion(ob,"integer");
1244: if (ob.tag == Sarray) {
1245: n = getoaSize(ob);
1246: rob = newObjectArray(n);
1247: for (i=0; i<n; i++) {
1.29 takayama 1248: otmp = Kto_int32(getoa(ob,i));
1.28 takayama 1249: putoa(rob,i,otmp);
1250: }
1251: return rob;
1252: }
1253: return ob;
1254: }
1.1 maekawa 1255: /* conversion functions between primitive data and objects.
1256: If it's not time critical, it is recommended to use these functions */
1257: struct object KpoInteger(k)
1.7 takayama 1258: int k;
1.1 maekawa 1259: {
1260: struct object obj;
1261: obj.tag = Sinteger;
1262: obj.lc.ival = k; obj.rc.ival = 0;
1263: return(obj);
1264: }
1265: struct object KpoString(s)
1.7 takayama 1266: char *s;
1.1 maekawa 1267: {
1268: struct object obj;
1269: obj.tag = Sdollar;
1270: obj.lc.str = s; obj.rc.ival = 0;
1271: return(obj);
1272: }
1273: struct object KpoPOLY(f)
1.7 takayama 1274: POLY f;
1.1 maekawa 1275: {
1276: struct object obj;
1277: obj.tag = Spoly;
1278: obj.lc.poly = f; obj.rc.ival = 0;
1279: return(obj);
1280: }
1281: struct object KpoArrayOfPOLY(ap)
1.7 takayama 1282: struct arrayOfPOLY *ap ;
1.1 maekawa 1283: {
1284: struct object obj;
1285: obj.tag = SarrayOfPOLY;
1286: obj.lc.arrayp = ap; obj.rc.ival = 0;
1287: return(obj);
1288: }
1289:
1290: struct object KpoMatrixOfPOLY(mp)
1.7 takayama 1291: struct matrixOfPOLY *mp ;
1.1 maekawa 1292: {
1293: struct object obj;
1294: obj.tag = SmatrixOfPOLY;
1295: obj.lc.matrixp = mp; obj.rc.ival = 0;
1296: return(obj);
1297: }
1298:
1299: struct object KpoRingp(ringp)
1.7 takayama 1300: struct ring *ringp;
1.1 maekawa 1301: {
1302: struct object obj;
1303: obj.tag = Sring;
1304: obj.lc.ringp = ringp;
1305: return(obj);
1306: }
1307:
1.22 takayama 1308: struct object KpoUniversalNumber(u)
1309: struct coeff *u;
1310: {
1311: struct object obj;
1312: obj.tag = SuniversalNumber;
1313: obj.lc.universalNumber = u;
1314: return(obj);
1315: }
1.25 takayama 1316: struct object KintToUniversalNumber(n)
1317: int n;
1318: {
1319: struct object rob;
1320: extern struct ring SmallRing;
1321: rob.tag = SuniversalNumber;
1322: rob.lc.universalNumber = intToCoeff(n,&SmallRing);
1323: return(rob);
1324: }
1325:
1.1 maekawa 1326: /*** conversion 2. Data conversions on arrays and matrices. ****/
1327: struct object arrayOfPOLYToArray(aa)
1.7 takayama 1328: struct arrayOfPOLY *aa;
1.1 maekawa 1329: {
1330: POLY *a;
1331: int size;
1332: struct object r;
1333: int j;
1334: struct object tmp;
1335:
1336: size = aa->n; a = aa->array;
1337: r = newObjectArray(size);
1338: for (j=0; j<size; j++) {
1339: tmp.tag = Spoly;
1340: tmp.lc.poly= a[j];
1341: putoa(r,j,tmp);
1342: }
1343: return( r );
1344: }
1345:
1346: struct object matrixOfPOLYToArray(pmat)
1.7 takayama 1347: struct matrixOfPOLY *pmat;
1.1 maekawa 1348: {
1349: struct object r;
1350: struct object tmp;
1351: int i,j;
1352: int m,n;
1353: POLY *mat;
1354: struct arrayOfPOLY ap;
1355:
1356: m = pmat->m; n = pmat->n; mat = pmat->mat;
1357: r = newObjectArray(m);
1358: for (i=0; i<m; i++) {
1359: ap.n = n; ap.array = &(mat[ind(i,0)]);
1360: tmp = arrayOfPOLYToArray(&ap);
1361: /* ind() is the macro defined in matrix.h. */
1362: putoa(r,i,tmp);
1363: }
1364: return(r);
1365: }
1366:
1367: struct arrayOfPOLY *arrayToArrayOfPOLY(oa)
1.7 takayama 1368: struct object oa;
1.1 maekawa 1369: {
1370: POLY *a;
1371: int size;
1372: int i;
1373: struct object tmp;
1374: struct arrayOfPOLY *ap;
1375:
1376: if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",
1.7 takayama 1377: "Argument is not array\n");
1.1 maekawa 1378: size = getoaSize(oa);
1379: a = (POLY *)sGC_malloc(sizeof(POLY)*size);
1380: for (i=0; i<size; i++) {
1381: tmp = getoa(oa,i);
1382: if (tmp.tag != Spoly) errorKan1("KarrayToArrayOfPOLY():%s ",
1.7 takayama 1383: "element must be polynomial.\n");
1.1 maekawa 1384: a[i] = tmp.lc.poly;
1385: }
1386: ap = (struct arrayOfPOLY *)sGC_malloc(sizeof(struct arrayOfPOLY));
1387: ap->n = size;
1388: ap->array = a;
1389: return(ap);
1390: }
1391:
1392: struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)
1.7 takayama 1393: struct object oa;
1.1 maekawa 1394: {
1395: POLY *a;
1396: int m;
1397: int n;
1398: int i,j;
1399: struct matrixOfPOLY *ma;
1400:
1401: struct object tmp,tmp2;
1402: if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",
1.7 takayama 1403: "Argument is not array\n");
1.1 maekawa 1404: m = getoaSize(oa);
1405: tmp = getoa(oa,0);
1406: if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY():%s ",
1.7 takayama 1407: "Argument is not array\n");
1.1 maekawa 1408: n = getoaSize(tmp);
1409: a = (POLY *)sGC_malloc(sizeof(POLY)*(m*n));
1410: for (i=0; i<m; i++) {
1411: tmp = getoa(oa,i);
1412: if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY(): %s",
1.7 takayama 1413: "element must be array.\n");
1.1 maekawa 1414: for (j=0; j<n; j++) {
1415: tmp2 = getoa(tmp,j);
1416: if (tmp2.tag != Spoly) errorKan1("arrayToMatrixOfPOLY(): %s",
1.7 takayama 1417: "element must be a polynomial.\n");
1.1 maekawa 1418: a[ind(i,j)] = tmp2.lc.poly;
1419: /* we use the macro ind here. Be careful of using m and n. */
1420: }
1421: }
1422: ma = (struct matrixOfPOLY *)sGC_malloc(sizeof(struct matrixOfPOLY));
1423: ma->m = m; ma->n = n;
1424: ma->mat = a;
1425: return(ma);
1426: }
1427:
1428: /* :misc */
1429:
1430: /* :ring :kan */
1431: int objArrayToOrderMatrix(oA,order,n,oasize)
1.7 takayama 1432: struct object oA;
1433: int order[];
1434: int n;
1435: int oasize;
1.1 maekawa 1436: {
1437: int size;
1438: int k,j;
1439: struct object tmpOa;
1440: struct object obj;
1441: if (oA.tag != Sarray) {
1442: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1443: return(-1);
1444: }
1445: size = getoaSize(oA);
1446: if (size != oasize) {
1447: warningKan("The row size of the array is wrong.");
1448: return(-1);
1449: }
1450: for (k=0; k<size; k++) {
1451: tmpOa = getoa(oA,k);
1452: if (tmpOa.tag != Sarray) {
1453: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1454: return(-1);
1455: }
1456: if (getoaSize(tmpOa) != 2*n) {
1457: warningKan("The column size of the array is wrong.");
1458: return(-1);
1459: }
1460: for (j=0; j<2*n; j++) {
1461: obj = getoa(tmpOa,j);
1462: order[k*2*n+j] = obj.lc.ival;
1463: }
1464: }
1465: return(0);
1466: }
1467:
1468: int KsetOrderByObjArray(oA)
1.7 takayama 1469: struct object oA;
1.1 maekawa 1470: {
1471: int *order;
1472: int n,c,l, oasize;
1473: extern struct ring *CurrentRingp;
1474: extern int AvoidTheSameRing;
1475: /* n,c,l must be set in the CurrentRing */
1476: if (AvoidTheSameRing) {
1477: errorKan1("%s\n","KsetOrderByObjArray(): You cannot change the order matrix when AvoidTheSameRing == 1.");
1478: }
1479: n = CurrentRingp->n;
1480: c = CurrentRingp->c;
1481: l = CurrentRingp->l;
1482: if (oA.tag != Sarray) {
1483: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1484: return(-1);
1485: }
1486: oasize = getoaSize(oA);
1487: order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
1488: if (order == (int *)NULL) errorKan1("%s\n","KsetOrderByObjArray(): No memory.");
1489: if (objArrayToOrderMatrix(oA,order,n,oasize) == -1) {
1490: return(-1);
1491: }
1492: setOrderByMatrix(order,n,c,l,oasize); /* Set order to the current ring. */
1493: return(0);
1494: }
1495:
1496: static int checkRelations(c,l,m,n,cc,ll,mm,nn)
1.7 takayama 1497: int c,l,m,n,cc,ll,mm,nn;
1.1 maekawa 1498: {
1499: if (!(1<=c && c<=l && l<=m && m<=n)) return(1);
1500: if (!(cc<=ll && ll<=mm && mm<=nn && nn <= n)) return(1);
1501: if (!(cc<c || ll < l || mm < m || nn < n)) {
1502: if (WarningNoVectorVariable) {
1.4 takayama 1503: warningKanNoStrictMode("Ring definition: there is no variable to represent vectors.\n");
1.1 maekawa 1504: }
1505: }
1506: if (!(cc<=c && ll <= l && mm <= m && nn <= n)) return(1);
1507: return(0);
1508: }
1509:
1510: struct object KgetOrderMatrixOfCurrentRing()
1511: {
1512: extern struct ring *CurrentRingp;
1513: return(oGetOrderMatrix(CurrentRingp));
1514: }
1515:
1516:
1517: int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
1.7 takayama 1518: struct object ob1,ob2,ob3,ob4,ob5;
1519: /* ob1 = [x(0), ..., x(n-1)];
1520: ob2 = [D(0), ..., D(n-1)];
1521: ob3 = [p,c,l,m,n,cc,ll,mm,nn,next];
1522: ob4 = Order matrix
1523: ob5 = [(keyword) value (keyword) value ....]
1524: */
1.41 ! takayama 1525: #define RP_LIMIT 5000
1.1 maekawa 1526: {
1527: int i;
1528: struct object ob;
1529: int c,l,m,n;
1530: int cc,ll,mm,nn;
1531: int p;
1532: char **xvars;
1533: char **dvars;
1534: int *outputVars;
1535: int *order;
1536: static int rp = 0;
1537: static struct ring *rstack[RP_LIMIT];
1538:
1539: extern struct ring *CurrentRingp;
1540: struct ring *newRingp;
1541: int ob3Size;
1542: struct ring *nextRing;
1543: int oasize;
1544: static int ringSerial = 0;
1545: char *ringName = NULL;
1546: int aa;
1547: extern int AvoidTheSameRing;
1548: extern char *F_mpMult;
1549: char *fmp_mult_saved;
1550: char *mpMultName = NULL;
1551: struct object rob;
1552: struct ring *savedCurrentRingp;
1553:
1554: /* To get the ring structure. */
1555: if (ob1.tag == Snull) {
1556: rob = newObjectArray(rp);
1557: for (i=0; i<rp; i++) {
1558: putoa(rob,i,KpoRingp(rstack[i]));
1559: }
1560: KSpush(rob);
1561: return(0);
1562: }
1563:
1564: if (ob3.tag != Sarray) errorKan1("%s\n","Error in the 3rd argument. You need to give 4 arguments.");
1565: ob3Size = getoaSize(ob3);
1566: if (ob3Size != 9 && ob3Size != 10)
1567: errorKan1("%s\n","Error in the 3rd argument.");
1568: for (i=0; i<9; i++) {
1569: ob = getoa(ob3,i);
1570: if (ob.tag != Sinteger) errorKan1("%s\n","The 3rd argument should be a list of integers.");
1571: }
1572: if (ob3Size == 10) {
1573: ob = getoa(ob3,9);
1574: if (ob.tag != Sring)
1575: errorKan1("%s\n","The last arguments of the 3rd argument must be a pointer to a ring.");
1576: nextRing = KopRingp(ob);
1577: } else {
1578: nextRing = (struct ring *)NULL;
1579: }
1580:
1581: p = getoa(ob3,0).lc.ival;
1582: c = getoa(ob3,1).lc.ival; l = getoa(ob3,2).lc.ival;
1583: m = getoa(ob3,3).lc.ival; n = getoa(ob3,4).lc.ival;
1584: cc = getoa(ob3,5).lc.ival; ll = getoa(ob3,6).lc.ival;
1585: mm = getoa(ob3,7).lc.ival; nn = getoa(ob3,8).lc.ival;
1586: if (checkRelations(c,l,m,n,cc,ll,mm,nn,n)) {
1587: errorKan1("%s\n","1<=c<=l<=m<=n and cc<=c<=ll<=l<=mm<=m<=nn<=n \nand (cc<c or ll < l or mm < m or nn < n) must be satisfied.");
1588: }
1589: if (getoaSize(ob2) != n || getoaSize(ob1) != n) {
1590: errorKan1("%s\n","Error in the 1st or 2nd arguments.");
1591: }
1592: for (i=0; i<n; i++) {
1593: if (getoa(ob1,i).tag != Sdollar || getoa(ob2,i).tag != Sdollar) {
1594: errorKan1("%s\n","Error in the 1st or 2nd arguments.");
1595: }
1596: }
1597: xvars = (char **) sGC_malloc(sizeof(char *)*n);
1598: dvars = (char **) sGC_malloc(sizeof(char *)*n);
1599: if (xvars == (char **)NULL || dvars == (char **)NULL) {
1600: fprintf(stderr,"No more memory.\n");
1601: exit(15);
1602: }
1603: for (i=0; i<n; i++) {
1604: xvars[i] = getoa(ob1,i).lc.str;
1605: dvars[i] = getoa(ob2,i).lc.str;
1606: }
1607: checkDuplicateName(xvars,dvars,n);
1608:
1609: outputVars = (int *)sGC_malloc(sizeof(int)*n*2);
1610: if (outputVars == NULL) {
1611: fprintf(stderr,"No more memory.\n");
1612: exit(15);
1613: }
1614: if (ReverseOutputOrder) {
1615: for (i=0; i<n; i++) outputVars[i] = n-i-1;
1616: for (i=0; i<n; i++) outputVars[n+i] = 2*n-i-1;
1617: }else{
1618: for (i=0; i<2*n; i++) {
1619: outputVars[i] = i;
1620: }
1621: }
1.28 takayama 1622:
1.29 takayama 1623: ob4 = Kto_int32(ob4); /* order matrix */
1.1 maekawa 1624: oasize = getoaSize(ob4);
1625: order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
1626: if (order == (int *)NULL) errorKan1("%s\n","No memory.");
1627: if (objArrayToOrderMatrix(ob4,order,n,oasize) == -1) {
1628: errorKan1("%s\n","Errors in the 4th matrix (order matrix).");
1629: }
1630: /* It's better to check the consistency of the order matrix here. */
1631: savedCurrentRingp = CurrentRingp;
1632:
1633: newRingp = (struct ring *)sGC_malloc(sizeof(struct ring));
1634: if (newRingp == NULL) errorKan1("%s\n","No more memory.");
1635: /* Generate the new ring before calling setOrder...(). */
1636: *newRingp = *CurrentRingp;
1637: CurrentRingp = newRingp; /* Push the current ring. */
1638: setOrderByMatrix(order,n,c,l,oasize); /* set order to the CurrentRing. */
1639: CurrentRingp = savedCurrentRingp; /* recover it. */
1640:
1641:
1642: /* Set the default name of the ring */
1643: ringName = (char *)sGC_malloc(16);
1644: sprintf(ringName,"ring%05d",ringSerial);
1645: ringSerial++;
1646:
1647: /* Set the current ring */
1648: newRingp->n = n; newRingp->m = m; newRingp->l = l; newRingp->c = c;
1649: newRingp->nn = nn; newRingp->mm = mm; newRingp->ll = ll;
1650: newRingp->cc = cc;
1651: newRingp->x = xvars;
1652: newRingp->D = dvars;
1653: /* You don't need to set order and orderMatrixSize here.
1654: It was set by setOrder(). */
1655: setFromTo(newRingp);
1656:
1657: newRingp->p = p;
1658: newRingp->next = nextRing;
1659: newRingp->multiplication = mpMult;
1660: /* These values should will be reset if the optional value is given. */
1661: newRingp->schreyer = 0;
1662: newRingp->gbListTower = NULL;
1663: newRingp->outputOrder = outputVars;
1.9 takayama 1664: newRingp->weightedHomogenization = 0;
1.11 takayama 1665: newRingp->degreeShiftSize = 0;
1.12 takayama 1666: newRingp->degreeShiftN = 0;
1667: newRingp->degreeShift = NULL;
1.34 takayama 1668: newRingp->partialEcart = 0;
1669: newRingp->partialEcartGlobalVarX = NULL;
1.1 maekawa 1670:
1671: if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {
1672: errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");
1673: }
1674: for (i=0; i < getoaSize(ob5); i += 2) {
1675: if (getoa(ob5,i).tag == Sdollar) {
1676: if (strcmp(KopString(getoa(ob5,i)),"mpMult") == 0) {
1.7 takayama 1677: if (getoa(ob5,i+1).tag != Sdollar) {
1678: errorKan1("%s\n","A keyword should be given. (mpMult)");
1679: }
1680: fmp_mult_saved = F_mpMult;
1681: mpMultName = KopString(getoa(ob5,i+1));
1682: switch_function("mpMult",mpMultName);
1683: /* Note that this cause a global effect. It will be done again. */
1684: newRingp->multiplication = mpMult;
1685: switch_function("mpMult",fmp_mult_saved);
1.1 maekawa 1686: } else if (strcmp(KopString(getoa(ob5,i)),"coefficient ring") == 0) {
1.7 takayama 1687: if (getoa(ob5,i+1).tag != Sring) {
1688: errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)");
1689: }
1690: nextRing = KopRingp(getoa(ob5,i+1));
1691: newRingp->next = nextRing;
1.1 maekawa 1692: } else if (strcmp(KopString(getoa(ob5,i)),"valuation") == 0) {
1.7 takayama 1693: errorKan1("%s\n","Not implemented. (valuation)");
1.1 maekawa 1694: } else if (strcmp(KopString(getoa(ob5,i)),"characteristic") == 0) {
1.7 takayama 1695: if (getoa(ob5,i+1).tag != Sinteger) {
1696: errorKan1("%s\n","A integer should be given. (characteristic)");
1697: }
1698: p = KopInteger(getoa(ob5,i+1));
1699: newRingp->p = p;
1.1 maekawa 1700: } else if (strcmp(KopString(getoa(ob5,i)),"schreyer") == 0) {
1.7 takayama 1701: if (getoa(ob5,i+1).tag != Sinteger) {
1702: errorKan1("%s\n","A integer should be given. (schreyer)");
1703: }
1704: newRingp->schreyer = KopInteger(getoa(ob5,i+1));
1.1 maekawa 1705: } else if (strcmp(KopString(getoa(ob5,i)),"gbListTower") == 0) {
1.7 takayama 1706: if (getoa(ob5,i+1).tag != Slist) {
1707: errorKan1("%s\n","A list should be given (gbListTower).");
1708: }
1709: newRingp->gbListTower = newObject();
1710: *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1);
1.1 maekawa 1711: } else if (strcmp(KopString(getoa(ob5,i)),"ringName") == 0) {
1.7 takayama 1712: if (getoa(ob5,i+1).tag != Sdollar) {
1713: errorKan1("%s\n","A name should be given. (ringName)");
1714: }
1715: ringName = KopString(getoa(ob5,i+1));
1.9 takayama 1716: } else if (strcmp(KopString(getoa(ob5,i)),"weightedHomogenization") == 0) {
1717: if (getoa(ob5,i+1).tag != Sinteger) {
1718: errorKan1("%s\n","A integer should be given. (weightedHomogenization)");
1719: }
1.11 takayama 1720: newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1));
1721: } else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) {
1722: if (getoa(ob5,i+1).tag != Sarray) {
1.12 takayama 1723: errorKan1("%s\n","An array of array should be given. (degreeShift)");
1.11 takayama 1724: }
1725: {
1726: struct object ods;
1.12 takayama 1727: struct object ods2;
1728: int dssize,k,j,nn;
1.11 takayama 1729: ods=getoa(ob5,i+1);
1.12 takayama 1730: if ((getoaSize(ods) < 1) || (getoa(ods,0).tag != Sarray)) {
1731: errorKan1("%s\n", "An array of array should be given. (degreeShift)");
1732: }
1733: nn = getoaSize(ods);
1734: dssize = getoaSize(getoa(ods,0));
1.11 takayama 1735: newRingp->degreeShiftSize = dssize;
1.12 takayama 1736: newRingp->degreeShiftN = nn;
1737: newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize*nn+1));
1.11 takayama 1738: if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory.");
1.12 takayama 1739: for (j=0; j<nn; j++) {
1740: ods2 = getoa(ods,j);
1741: for (k=0; k<dssize; k++) {
1742: if (getoa(ods2,k).tag == SuniversalNumber) {
1743: (newRingp->degreeShift)[j*dssize+k] = coeffToInt(getoa(ods2,k).lc.universalNumber);
1744: }else{
1745: (newRingp->degreeShift)[j*dssize+k] = KopInteger(getoa(ods2,k));
1746: }
1.11 takayama 1747: }
1748: }
1749: }
1.34 takayama 1750: } else if (strcmp(KopString(getoa(ob5,i)),"partialEcartGlobalVarX") == 0) {
1751: if (getoa(ob5,i+1).tag != Sarray) {
1752: errorKan1("%s\n","An array of array should be given. (partialEcart)");
1753: }
1754: {
1755: struct object odv;
1756: struct object ovv;
1757: int k,j,nn;
1758: char *vname;
1759: odv=getoa(ob5,i+1);
1760: nn = getoaSize(odv);
1761: newRingp->partialEcart = nn;
1762: newRingp->partialEcartGlobalVarX = (int *) sGC_malloc(sizeof(int)*nn+1);
1763: if (newRingp->partialEcartGlobalVarX == NULL) errorKan1("%s\n","No more memory.");
1764: for (j=0; j<nn; j++)
1765: (newRingp->partialEcartGlobalVarX)[j] = -1;
1766: for (j=0; j<nn; j++) {
1767: ovv = getoa(odv,j);
1768: if (ovv.tag != Sdollar) errorKan1("%s\n","partialEcartGlobalVarX: string is expected.");
1769: vname = KopString(ovv);
1770: for (k=0; k<n; k++) {
1771: if (strcmp(vname,xvars[k]) == 0) {
1772: (newRingp->partialEcartGlobalVarX)[j] = k; break;
1773: }else{
1774: if (k == n-1) errorKan1("%s\n","partialEcartGlobalVarX: no such variable.");
1775: }
1776: }
1777: }
1778: }
1779:
1.22 takayama 1780: switch_function("grade","module1v");
1781: /* Warning: grading is changed to module1v!! */
1.1 maekawa 1782: } else {
1.7 takayama 1783: errorKan1("%s\n","Unknown keyword to set_up_ring@");
1.1 maekawa 1784: }
1785: }else{
1786: errorKan1("%s\n","A keyword enclosed by braces have to be given.");
1787: }
1788: }
1789:
1790: newRingp->name = ringName;
1791:
1792:
1793: if (AvoidTheSameRing) {
1794: aa = isTheSameRing(rstack,rp,newRingp);
1795: if (aa < 0) {
1796: /* This ring has never been defined. */
1797: CurrentRingp = newRingp;
1798: /* Install it to the RingStack */
1799: if (rp <RP_LIMIT) {
1.7 takayama 1800: rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
1.1 maekawa 1801: }else{
1.7 takayama 1802: rp = 0;
1803: errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
1.1 maekawa 1804: }
1805: }else{
1806: /* This ring has been defined. */
1807: /* Discard the newRingp */
1808: CurrentRingp = rstack[aa];
1809: ringSerial--;
1810: }
1811: }else{
1812: CurrentRingp = newRingp;
1813: /* Install it to the RingStack */
1814: if (rp <RP_LIMIT) {
1815: rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
1816: }else{
1817: rp = 0;
1818: errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
1819: }
1820: }
1821: if (mpMultName != NULL) {
1822: switch_function("mpMult",mpMultName);
1823: }
1824:
1825: initSyzRingp();
1826:
1827: return(0);
1828: }
1829:
1830:
1831: struct object KsetVariableNames(struct object ob,struct ring *rp)
1832: {
1833: int n,i;
1834: struct object ox;
1835: struct object otmp;
1836: char **xvars;
1837: char **dvars;
1838: if (ob.tag != Sarray) {
1839: errorKan1("%s\n","KsetVariableNames(): the argument must be of the form [(x) (y) (z) ...]");
1840: }
1841: n = rp->n;
1842: ox = ob;
1843: if (getoaSize(ox) != 2*n) {
1844: errorKan1("%s\n","KsetVariableNames(): the argument must be of the form [(x) (y) (z) ...] and the length of [(x) (y) (z) ...] must be equal to the number of x and D variables.");
1845: }
1846: xvars = (char **)sGC_malloc(sizeof(char *)*n);
1847: dvars = (char **)sGC_malloc(sizeof(char *)*n);
1848: if (xvars == NULL || dvars == NULL) {
1849: errorKan1("%s\n","KsetVariableNames(): no more memory.");
1850: }
1851: for (i=0; i<2*n; i++) {
1852: otmp = getoa(ox,i);
1853: if(otmp.tag != Sdollar) {
1854: errorKan1("%s\n","KsetVariableNames(): elements must be strings.");
1855: }
1856: if (i < n) {
1857: xvars[i] = KopString(otmp);
1858: }else{
1859: dvars[i-n] = KopString(otmp);
1860: }
1861: }
1862: checkDuplicateName(xvars,dvars,n);
1863: rp->x = xvars;
1864: rp->D = dvars;
1865: return(ob);
1866: }
1867:
1868:
1869:
1870: void KshowRing(ringp)
1.7 takayama 1871: struct ring *ringp;
1.1 maekawa 1872: {
1873: showRing(1,ringp);
1874: }
1875:
1876: struct object KswitchFunction(ob1,ob2)
1.7 takayama 1877: struct object ob1,ob2;
1.1 maekawa 1878: {
1879: char *ans ;
1880: struct object rob;
1881: int needWarningForAvoidTheSameRing = 0;
1882: extern int AvoidTheSameRing;
1883: if ((ob1.tag != Sdollar) || (ob2.tag != Sdollar)) {
1884: errorKan1("%s\n","$function$ $name$ switch_function\n");
1885: }
1886: if (AvoidTheSameRing && needWarningForAvoidTheSameRing) {
1887: if (strcmp(KopString(ob1),"mmLarger") == 0 ||
1888: strcmp(KopString(ob1),"mpMult") == 0 ||
1889: strcmp(KopString(ob1),"monomialAdd") == 0 ||
1890: strcmp(KopString(ob1),"isSameComponent") == 0) {
1891: fprintf(stderr,",switch_function ==> %s ",KopString(ob1));
1892: warningKan("switch_function might cause a trouble under AvoidTheSameRing == 1.\n");
1893: }
1894: }
1895: if (AvoidTheSameRing) {
1896: if (strcmp(KopString(ob1),"mmLarger") == 0 &&
1.7 takayama 1897: strcmp(KopString(ob2),"matrix") != 0) {
1.1 maekawa 1898: fprintf(stderr,"mmLarger = %s",KopString(ob2));
1899: errorKan1("%s\n","mmLarger can set only to matrix under AvoidTheSameRing == 1.");
1900: }
1901: }
1902:
1903: ans = switch_function(ob1.lc.str,ob2.lc.str);
1904: if (ans == NULL) {
1905: rob = NullObject;
1906: }else{
1907: rob = KpoString(ans);
1908: }
1909: return(rob);
1910:
1911: }
1912:
1913: void KprintSwitchStatus(void)
1914: {
1915: print_switch_status();
1916: }
1917:
1918: struct object KoReplace(of,rule)
1.7 takayama 1919: struct object of;
1920: struct object rule;
1.1 maekawa 1921: {
1922: struct object rob;
1923: POLY f;
1924: POLY lRule[N0*2];
1925: POLY rRule[N0*2];
1926: POLY r;
1927: int i;
1928: int n;
1929: struct object trule;
1930:
1931:
1932: if (rule.tag != Sarray) {
1933: errorKan1("%s\n"," KoReplace(): The second argument must be array.");
1934: }
1935: n = getoaSize(rule);
1936:
1.6 takayama 1937: if (of.tag == Spoly) {
1938: }else if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
1.7 takayama 1939: return(KreplaceRecursivePolynomial(of,rule));
1.6 takayama 1940: }else{
1.1 maekawa 1941: errorKan1("%s\n"," KoReplace(): The first argument must be a polynomial.");
1942: }
1943: f = KopPOLY(of);
1944:
1945: if (f ISZERO) {
1946: }else{
1947: if (n >= 2*(f->m->ringp->n)) {
1948: errorKan1("%s\n"," KoReplace(): too many rules for replacement. ");
1949: }
1950: }
1951:
1952: for (i=0; i<n; i++) {
1953: trule = getoa(rule,i);
1954: if (trule.tag != Sarray) {
1955: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....].");
1956: }
1957: if (getoaSize(trule) != 2) {
1958: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....].");
1959: }
1960:
1961: if (getoa(trule,0).tag != Spoly) {
1962: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1963: }
1964: if (getoa(trule,1).tag != Spoly) {
1965: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1966: }
1967:
1968: lRule[i] = KopPOLY(getoa(trule,0));
1969: rRule[i] = KopPOLY(getoa(trule,1));
1970: }
1971:
1972: r = replace(f,lRule,rRule,n);
1973: rob.tag = Spoly; rob.lc.poly = r;
1974:
1975: return(rob);
1976: }
1977:
1978:
1979: struct object Kparts(f,v)
1.7 takayama 1980: struct object f;
1981: struct object v;
1.1 maekawa 1982: {
1983: POLY ff;
1984: POLY vv;
1985: struct object obj;
1986: struct matrixOfPOLY *co;
1987: /* check the data type */
1988: if (f.tag != Spoly || v.tag != Spoly)
1989: errorKan1("%s\n","arguments of Kparts() must have polynomial as arguments.");
1990:
1991: co = parts(KopPOLY(f),KopPOLY(v));
1992: obj = matrixOfPOLYToArray(co);
1993: return(obj);
1994: }
1995:
1996: struct object Kparts2(f,v)
1.7 takayama 1997: struct object f;
1998: struct object v;
1.1 maekawa 1999: {
2000: POLY ff;
2001: POLY vv;
2002: struct object obj;
2003: struct matrixOfPOLY *co;
2004: /* check the data type */
2005: if (f.tag != Spoly || v.tag != Spoly)
2006: errorKan1("%s\n","arguments of Kparts2() must have polynomial as arguments.");
2007:
2008: obj = parts2(KopPOLY(f),KopPOLY(v));
2009: return(obj);
2010: }
2011:
2012:
2013: struct object Kdegree(ob1,ob2)
1.7 takayama 2014: struct object ob1,ob2;
1.1 maekawa 2015: {
2016: if (ob1.tag != Spoly || ob2.tag != Spoly)
2017: errorKan1("%s\n","The arguments must be polynomials.");
2018:
2019: return(KpoInteger(pDegreeWrtV(KopPOLY(ob1),KopPOLY(ob2))));
2020: }
2021:
2022: struct object KringMap(obj)
1.7 takayama 2023: struct object obj;
1.1 maekawa 2024: {
2025: extern struct ring *CurrentRingp;
2026: extern struct ring *SyzRingp;
2027: POLY f;
2028: POLY r;
2029: if (obj.tag != Spoly)
2030: errorKan1("%s\n","The argments must be polynomial.");
2031: f = KopPOLY(obj);
2032: if (f ISZERO) return(obj);
2033: if (f->m->ringp == CurrentRingp) return(obj);
2034: if (f->m->ringp == CurrentRingp->next) {
2035: r = newCell(newCoeff(),newMonomial(CurrentRingp));
2036: r->coeffp->tag = POLY_COEFF;
2037: r->coeffp->val.f = f;
2038: return(KpoPOLY(r));
2039: }else if (f->m->ringp == SyzRingp) {
2040: return(KpoPOLY(f->coeffp->val.f));
2041: }
2042: errorKan1("%s\n","The ring map is not defined in this case.");
2043: }
2044:
2045:
2046: struct object Ksp(ob1,ob2)
1.7 takayama 2047: struct object ob1,ob2;
1.1 maekawa 2048: {
2049: struct spValue sv;
2050: struct object rob,cob;
2051: POLY f;
2052: if (ob1.tag != Spoly || ob2.tag != Spoly)
2053: errorKan1("%s\n","Ksp(): The arguments must be polynomials.");
2054: sv = (*sp)(ob1.lc.poly,ob2.lc.poly);
2055: f = ppAddv(ppMult(sv.a,KopPOLY(ob1)),
1.7 takayama 2056: ppMult(sv.b,KopPOLY(ob2)));
1.1 maekawa 2057: rob = newObjectArray(2);
2058: cob = newObjectArray(2);
2059: putoa(rob,1,KpoPOLY(f));
2060: putoa(cob,0,KpoPOLY(sv.a));
2061: putoa(cob,1,KpoPOLY(sv.b));
2062: putoa(rob,0,cob);
2063: return(rob);
2064: }
2065:
2066: struct object Khead(ob)
1.7 takayama 2067: struct object ob;
1.1 maekawa 2068: {
2069: if (ob.tag != Spoly) errorKan1("%s\n","Khead(): The argument should be a polynomial.");
2070: return(KpoPOLY(head( KopPOLY(ob))));
2071: }
2072:
2073:
2074: /* :eval */
2075: struct object Keval(obj)
1.7 takayama 2076: struct object obj;
1.1 maekawa 2077: {
2078: char *key;
2079: int size;
2080: struct object rob;
2081: rob = NullObject;
2082:
2083: if (obj.tag != Sarray)
2084: errorKan1("%s\n","[$key$ arguments] eval");
2085: if (getoaSize(obj) < 1)
2086: errorKan1("%s\n","[$key$ arguments] eval");
2087: if (getoa(obj,0).tag != Sdollar)
2088: errorKan1("%s\n","[$key$ arguments] eval");
2089: key = getoa(obj,0).lc.str;
2090: size = getoaSize(obj);
2091:
2092:
2093: return(rob);
2094: }
2095:
2096: /* :Utilities */
2097: char *KremoveSpace(str)
1.7 takayama 2098: char str[];
1.1 maekawa 2099: {
2100: int size;
2101: int start;
2102: int end;
2103: char *s;
2104: int i;
2105:
2106: size = strlen(str);
2107: for (start = 0; start <= size; start++) {
2108: if (str[start] > ' ') break;
2109: }
2110: for (end = size-1; end >= 0; end--) {
2111: if (str[end] > ' ') break;
2112: }
2113: if (start > end) return((char *) NULL);
2114: s = (char *) sGC_malloc(sizeof(char)*(end-start+2));
2115: if (s == (char *)NULL) errorKan1("%s\n","removeSpace(): No more memory.");
2116: for (i=0; i< end-start+1; i++)
2117: s[i] = str[i+start];
2118: s[end-start+1] = '\0';
2119: return(s);
2120: }
2121:
2122: struct object KtoRecords(ob)
1.7 takayama 2123: struct object ob;
1.1 maekawa 2124: {
2125: struct object obj;
2126: struct object tmp;
2127: int i;
2128: int size;
2129: char **argv;
2130:
2131: obj = NullObject;
2132: switch(ob.tag) {
2133: case Sdollar: break;
2134: default:
2135: errorKan1("%s","Argument of KtoRecords() must be a string enclosed by dollars.\n");
2136: break;
2137: }
2138: size = strlen(ob.lc.str)+3;
2139: argv = (char **) sGC_malloc((size+1)*sizeof(char *));
2140: if (argv == (char **)NULL)
2141: errorKan1("%s","No more memory.\n");
2142: size = KtoArgvbyCurryBrace(ob.lc.str,argv,size);
2143: if (size < 0)
2144: errorKan1("%s"," KtoRecords(): You have an error in the argument.\n");
2145:
2146: obj = newObjectArray(size);
2147: for (i=0; i<size; i++) {
2148: tmp.tag = Sdollar;
2149: tmp.lc.str = argv[i];
2150: (obj.rc.op)[i] = tmp;
2151: }
2152: return(obj);
2153: }
2154:
2155: int KtoArgvbyCurryBrace(str,argv,limit)
1.7 takayama 2156: char *str;
2157: char *argv[];
2158: int limit;
2159: /* This function returns argc */
2160: /* decompose into tokens by the separators
1.1 maekawa 2161: { }, [ ], and characters of which code is less than SPACE.
2162: Example. { } ---> nothing (argc=0)
2163: {x}----> x (argc=1)
2164: {x,y} --> x y (argc=2)
1.7 takayama 2165: {ab, y, z } --> ab y z (argc=3)
1.1 maekawa 2166: [[ab],c,d] --> [ab] c d
2167: */
2168: {
2169: int argc;
2170: int n;
2171: int i;
2172: int k;
2173: char *a;
2174: char *ident;
2175: int level = 0;
2176: int comma;
2177:
2178: if (str == (char *)NULL) {
2179: fprintf(stderr,"You use NULL string to toArgvbyCurryBrace()\n");
2180: return(0);
2181: }
2182:
2183: n = strlen(str);
2184: a = (char *) sGC_malloc(sizeof(char)*(n+3));
2185: a[0]=' ';
2186: strcpy(&(a[1]),str);
2187: n = strlen(a); a[0] = '\0';
2188: comma = -1;
2189: for (i=1; i<n; i++) {
2190: if (a[i] == '{' || a[i] == '[') level++;
2191: if (level <= 1 && ( a[i] == ',')) {a[i] = '\0'; ++comma;}
2192: if (level <= 1 && (a[i]=='{' || a[i]=='}' || a[i]=='[' || a[i]==']'))
2193: a[i] = '\0';
2194: if (a[i] == '}' || a[i] == ']') level--;
2195: if ((level <= 1) && (comma == -1) && ( a[i] > ' ')) comma = 0;
2196: }
2197:
2198: if (comma == -1) return(0);
2199:
2200: argc=0;
2201: for (i=0; i<n; i++) {
2202: if ((a[i] == '\0') && (a[i+1] != '\0')) ++argc;
2203: }
2204: if (argc > limit) return(-argc);
2205:
2206: k = 0;
2207: for (i=0; i<n; i++) {
2208: if ((a[i] == '\0') && (a[i+1] != '\0')) {
2209: ident = (char *) sGC_malloc(sizeof(char)*( strlen(&(a[i+1])) + 3));
2210: strcpy(ident,&(a[i+1]));
2211: argv[k] = KremoveSpace(ident);
2212: if (argv[k] != (char *)NULL) k++;
2213: if (k >= limit) errorKan1("%s\n","KtoArgvbyCurryBraces(): k>=limit.");
2214: }
2215: }
2216: argc = k;
2217: /*for (i=0; i<argc; i++) fprintf(stderr,"%d %s\n",i,argv[i]);*/
2218: return(argc);
2219: }
2220:
1.14 takayama 2221: struct object KstringToArgv(struct object ob) {
2222: struct object rob;
2223: char *s;
2224: int n,wc,i,inblank;
2225: char **argv;
2226: if (ob.tag != Sdollar)
1.22 takayama 2227: errorKan1("%s\n","KstringToArgv(): the argument must be a string.");
1.14 takayama 2228: n = strlen(KopString(ob));
2229: s = (char *) sGC_malloc(sizeof(char)*(n+2));
2230: if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory.");
2231: strcpy(s,KopString(ob));
2232: inblank = 1; wc = 0;
2233: for (i=0; i<n; i++) {
1.22 takayama 2234: if (inblank && (s[i] > ' ')) {
2235: wc++; inblank = 0;
2236: }else if ((!inblank) && (s[i] <= ' ')) {
2237: inblank = 1;
2238: }
1.14 takayama 2239: }
2240: argv = (char **) sGC_malloc(sizeof(char *)*(wc+2));
2241: argv[0] = NULL;
2242: inblank = 1; wc = 0;
2243: for (i=0; i<n; i++) {
1.22 takayama 2244: if (inblank && (s[i] > ' ')) {
2245: argv[wc] = &(s[i]); argv[wc+1]=NULL;
2246: wc++; inblank = 0;
2247: }else if ((inblank == 0) && (s[i] <= ' ')) {
2248: inblank = 1; s[i] = 0;
2249: }else if (inblank && (s[i] <= ' ')) {
2250: s[i] = 0;
2251: }
1.14 takayama 2252: }
2253:
2254: rob = newObjectArray(wc);
2255: for (i=0; i<wc; i++) {
1.22 takayama 2256: putoa(rob,i,KpoString(argv[i]));
2257: /* printf("%s\n",argv[i]); */
1.14 takayama 2258: }
2259: return(rob);
2260: }
1.1 maekawa 2261:
2262: static void checkDuplicateName(xvars,dvars,n)
1.7 takayama 2263: char *xvars[];
2264: char *dvars[];
2265: int n;
1.1 maekawa 2266: {
2267: int i,j;
2268: char *names[N0*2];
2269: for (i=0; i<n; i++) {
2270: names[i] = xvars[i]; names[i+n] = dvars[i];
2271: }
2272: n = 2*n;
2273: for (i=0; i<n; i++) {
2274: for (j=i+1; j<n; j++) {
2275: if (strcmp(names[i],names[j]) == 0) {
1.7 takayama 2276: fprintf(stderr,"\n%d=%s, %d=%s\n",i,names[i],j,names[j]);
2277: errorKan1("%s\n","Duplicate definition of the name above in SetUpRing().");
1.1 maekawa 2278: }
2279: }
2280: }
2281: }
2282:
1.20 takayama 2283: struct object KooPower(struct object ob1,struct object ob2) {
2284: struct object rob;
2285: /* Bug. It has not yet been implemented. */
2286: if (QuoteMode) {
1.22 takayama 2287: rob = powerTree(ob1,ob2);
1.20 takayama 2288: }else{
1.22 takayama 2289: warningKan("KooDiv2() has not supported yet these objects.\n");
1.20 takayama 2290: }
2291: return(rob);
2292: }
1.1 maekawa 2293:
2294:
2295:
2296: struct object KooDiv2(ob1,ob2)
1.7 takayama 2297: struct object ob1,ob2;
1.1 maekawa 2298: {
2299: struct object rob = NullObject;
2300: POLY f;
2301: extern struct ring *CurrentRingp;
2302: int s,i;
2303: double d;
2304:
2305: switch (Lookup[ob1.tag][ob2.tag]) {
2306: case SpolySpoly:
2307: case SuniversalNumberSuniversalNumber:
2308: case SuniversalNumberSpoly:
2309: case SpolySuniversalNumber:
2310: rob = KnewRationalFunction0(copyObjectp(&ob1),copyObjectp(&ob2));
2311: KisInvalidRational(&rob);
2312: return(rob);
2313: break;
2314: case SarraySpoly:
2315: case SarraySuniversalNumber:
2316: case SarraySrationalFunction:
2317: s = getoaSize(ob1);
2318: rob = newObjectArray(s);
2319: for (i=0; i<s; i++) {
2320: putoa(rob,i,KooDiv2(getoa(ob1,i),ob2));
2321: }
2322: return(rob);
2323: break;
2324: case SpolySrationalFunction:
2325: case SrationalFunctionSpoly:
2326: case SrationalFunctionSrationalFunction:
2327: case SuniversalNumberSrationalFunction:
2328: case SrationalFunctionSuniversalNumber:
2329: rob = KoInverse(ob2);
2330: rob = KooMult(ob1,rob);
2331: return(rob);
2332: break;
2333:
2334: case SdoubleSdouble:
2335: d = KopDouble(ob2);
2336: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2337: return(KpoDouble( KopDouble(ob1) / d ));
2338: break;
2339: case SdoubleSinteger:
2340: case SdoubleSuniversalNumber:
2341: case SdoubleSrationalFunction:
2342: d = toDouble0(ob2);
2343: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2344: return(KpoDouble( KopDouble(ob1) / d) );
2345: break;
2346: case SintegerSdouble:
2347: case SuniversalNumberSdouble:
2348: case SrationalFunctionSdouble:
2349: d = KopDouble(ob2);
2350: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2351: return(KpoDouble( toDouble0(ob1) / d ) );
2352: break;
2353:
2354: default:
1.20 takayama 2355: if (QuoteMode) {
2356: rob = divideTree(ob1,ob2);
2357: }else{
2358: warningKan("KooDiv2() has not supported yet these objects.\n");
2359: }
1.1 maekawa 2360: break;
2361: }
2362: return(rob);
2363: }
2364: /* Template
2365: case SrationalFunctionSrationalFunction:
2366: warningKan("Koo() has not supported yet these objects.\n");
2367: return(rob);
2368: break;
2369: case SpolySrationalFunction:
2370: warningKan("Koo() has not supported yet these objects.\n");
2371: return(rob);
2372: break;
2373: case SrationalFunctionSpoly:
2374: warningKan("Koo() has not supported yet these objects.\n");
2375: return(rob);
2376: break;
2377: case SuniversalNumberSrationalFunction:
2378: warningKan("Koo() has not supported yet these objects.\n");
2379: return(rob);
2380: break;
2381: case SrationalFunctionSuniversalNumber:
2382: warningKan("Koo() has not supported yet these objects.\n");
2383: return(rob);
2384: break;
2385: */
2386:
2387: int KisInvalidRational(op)
1.7 takayama 2388: objectp op;
1.1 maekawa 2389: {
2390: extern struct coeff *UniversalZero;
2391: if (op->tag != SrationalFunction) return(0);
2392: if (KisZeroObject(Kdenominator(*op))) {
2393: errorKan1("%s\n","KisInvalidRational(): zero division. You have f/0.");
2394: }
2395: if (KisZeroObject(Knumerator(*op))) {
2396: op->tag = SuniversalNumber;
2397: op->lc.universalNumber = UniversalZero;
2398: }
2399: return(0);
2400: }
2401:
2402: struct object KgbExtension(struct object obj)
2403: {
2404: char *key;
2405: int size;
2406: struct object keyo;
2407: struct object rob = NullObject;
2408: struct object obj1,obj2,obj3;
2409: POLY f1;
2410: POLY f2;
2411: POLY f3;
2412: POLY f;
2413: int m,i;
2414: struct pairOfPOLY pf;
1.16 takayama 2415: struct coeff *cont;
1.1 maekawa 2416:
2417: if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array.");
2418: size = getoaSize(obj);
2419: if (size < 1) errorKan1("%s\n","KgbExtension(): Empty array.");
2420: keyo = getoa(obj,0);
2421: if (keyo.tag != Sdollar) errorKan1("%s\n","KgbExtension(): No key word.");
2422: key = KopString(keyo);
2423:
2424: /* branch by the key word. */
2425: if (strcmp(key,"isReducible")==0) {
2426: if (size != 3) errorKan1("%s\n","[(isReducible) poly1 poly2] gbext.");
2427: obj1 = getoa(obj,1);
2428: obj2 = getoa(obj,2);
2429: if (obj1.tag != Spoly || obj2.tag != Spoly)
2430: errorKan1("%s\n","[(isReducible) poly1 poly2] gb.");
2431: f1 = KopPOLY(obj1);
2432: f2 = KopPOLY(obj2);
2433: rob = KpoInteger((*isReducible)(f1,f2));
2434: }else if (strcmp(key,"lcm") == 0) {
2435: if (size != 3) errorKan1("%s\n","[(lcm) poly1 poly2] gb.");
2436: obj1 = getoa(obj,1);
2437: obj2 = getoa(obj,2);
2438: if (obj1.tag != Spoly || obj2.tag != Spoly)
2439: errorKan1("%s\n","[(lcm) poly1 poly2] gbext.");
2440: f1 = KopPOLY(obj1);
2441: f2 = KopPOLY(obj2);
2442: rob = KpoPOLY((*lcm)(f1,f2));
2443: }else if (strcmp(key,"grade")==0) {
2444: if (size != 2) errorKan1("%s\n","[(grade) poly1 ] gbext.");
2445: obj1 = getoa(obj,1);
2446: if (obj1.tag != Spoly)
2447: errorKan1("%s\n","[(grade) poly1 ] gbext.");
2448: f1 = KopPOLY(obj1);
2449: rob = KpoInteger((*grade)(f1));
2450: }else if (strcmp(key,"mod")==0) {
2451: if (size != 3) errorKan1("%s\n","[(mod) poly num] gbext");
2452: obj1 = getoa(obj,1);
2453: obj2 = getoa(obj,2);
2454: if (obj1.tag != Spoly || obj2.tag != SuniversalNumber) {
2455: errorKan1("%s\n","The datatype of the argument mismatch: [(mod) polynomial universalNumber] gbext");
2456: }
2457: rob = KpoPOLY( modulopZ(KopPOLY(obj1),KopUniversalNumber(obj2)) );
2458: }else if (strcmp(key,"tomodp")==0) {
2459: /* The ring must be a ring of characteristic p. */
2460: if (size != 3) errorKan1("%s\n","[(tomod) poly ring] gbext");
2461: obj1 = getoa(obj,1);
2462: obj2 = getoa(obj,2);
2463: if (obj1.tag != Spoly || obj2.tag != Sring) {
2464: errorKan1("%s\n","The datatype of the argument mismatch: [(tomod) polynomial ring] gbext");
2465: }
2466: rob = KpoPOLY( modulop(KopPOLY(obj1),KopRingp(obj2)) );
2467: }else if (strcmp(key,"tomod0")==0) {
2468: /* Ring must be a ring of characteristic 0. */
2469: if (size != 3) errorKan1("%s\n","[(tomod0) poly ring] gbext");
2470: obj1 = getoa(obj,1);
2471: obj2 = getoa(obj,2);
2472: if (obj1.tag != Spoly || obj2.tag != Sring) {
2473: errorKan1("%s\n","The datatype of the argument mismatch: [(tomod0) polynomial ring] gbext");
2474: }
2475: errorKan1("%s\n","It has not been implemented.");
2476: rob = KpoPOLY( POLYNULL );
2477: }else if (strcmp(key,"divByN")==0) {
2478: if (size != 3) errorKan1("%s\n","[(divByN) poly num] gbext");
2479: obj1 = getoa(obj,1);
2480: obj2 = getoa(obj,2);
2481: if (obj1.tag != Spoly || obj2.tag != SuniversalNumber) {
2482: errorKan1("%s\n","The datatype of the argument mismatch: [(divByN) polynomial universalNumber] gbext");
2483: }
2484: pf = quotientByNumber(KopPOLY(obj1),KopUniversalNumber(obj2));
2485: rob = newObjectArray(2);
2486: putoa(rob,0,KpoPOLY(pf.first));
2487: putoa(rob,1,KpoPOLY(pf.second));
2488: }else if (strcmp(key,"isConstant")==0) {
2489: if (size != 2) errorKan1("%s\n","[(isConstant) poly ] gbext bool");
2490: obj1 = getoa(obj,1);
2491: if (obj1.tag != Spoly) {
2492: errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext");
2493: }
2494: return(KpoInteger(isConstant(KopPOLY(obj1))));
1.18 takayama 2495: }else if (strcmp(key,"isConstantAll")==0) {
2496: if (size != 2) errorKan1("%s\n","[(isConstantAll) poly ] gbext bool");
2497: obj1 = getoa(obj,1);
2498: if (obj1.tag != Spoly) {
2499: errorKan1("%s\n","The datatype of the argument mismatch: [(isConstantAll) polynomial] gbext");
2500: }
2501: return(KpoInteger(isConstantAll(KopPOLY(obj1))));
1.1 maekawa 2502: }else if (strcmp(key,"schreyerSkelton") == 0) {
2503: if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array");
2504: obj1 = getoa(obj,1);
2505: return(KschreyerSkelton(obj1));
2506: }else if (strcmp(key,"lcoeff") == 0) {
2507: if (size != 2) errorKan1("%s\n","[(lcoeff) poly] gbext poly");
2508: obj1 = getoa(obj,1);
2509: if (obj1.tag != Spoly) errorKan1("%s\n","[(lcoeff) poly] gbext poly");
2510: f = KopPOLY(obj1);
2511: if (f == POLYNULL) return(KpoPOLY(f));
2512: return(KpoPOLY( newCell(coeffCopy(f->coeffp),newMonomial(f->m->ringp))));
2513: }else if (strcmp(key,"lmonom") == 0) {
2514: if (size != 2) errorKan1("%s\n","[(lmonom) poly] gbext poly");
2515: obj1 = getoa(obj,1);
2516: if (obj1.tag != Spoly) errorKan1("%s\n","[(lmonom) poly] gbext poly");
2517: f = KopPOLY(obj1);
2518: if (f == POLYNULL) return(KpoPOLY(f));
2519: return(KpoPOLY( newCell(intToCoeff(1,f->m->ringp),monomialCopy(f->m))));
2520: }else if (strcmp(key,"toes") == 0) {
2521: if (size != 2) errorKan1("%s\n","[(toes) array] gbext poly");
2522: obj1 = getoa(obj,1);
2523: if (obj1.tag != Sarray) errorKan1("%s\n","[(toes) array] gbext poly");
2524: return(KvectorToSchreyer_es(obj1));
1.3 takayama 2525: }else if (strcmp(key,"toe_") == 0) {
2526: if (size != 2) errorKan1("%s\n","[(toe_) array] gbext poly");
2527: obj1 = getoa(obj,1);
2528: if (obj1.tag == Spoly) return(obj1);
2529: if (obj1.tag != Sarray) errorKan1("%s\n","[(toe_) array] gbext poly");
2530: return(KpoPOLY(arrayToPOLY(obj1)));
1.1 maekawa 2531: }else if (strcmp(key,"isOrdered") == 0) {
2532: if (size != 2) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
2533: obj1 = getoa(obj,1);
2534: if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
2535: return(KisOrdered(obj1));
1.16 takayama 2536: }else if (strcmp(key,"reduceContent")==0) {
2537: if (size != 2) errorKan1("%s\n","[(reduceContent) poly1 ] gbext.");
2538: obj1 = getoa(obj,1);
2539: if (obj1.tag != Spoly)
2540: errorKan1("%s\n","[(reduceContent) poly1 ] gbext.");
2541: f1 = KopPOLY(obj1);
1.22 takayama 2542: rob = newObjectArray(2);
2543: f1 = reduceContentOfPoly(f1,&cont);
2544: putoa(rob,0,KpoPOLY(f1));
2545: if (f1 == POLYNULL) {
2546: putoa(rob,1,KpoPOLY(f1));
2547: }else{
2548: putoa(rob,1,KpoPOLY(newCell(cont,newMonomial(f1->m->ringp))));
2549: }
1.17 takayama 2550: }else if (strcmp(key,"ord_ws_all")==0) {
2551: if (size != 3) errorKan1("%s\n","[(ord_ws_all) fv wv] gbext");
2552: obj1 = getoa(obj,1);
2553: obj2 = getoa(obj,2);
2554: rob = KordWsAll(obj1,obj2);
1.23 takayama 2555: }else if (strcmp(key,"exponents")==0) {
2556: if (size == 3) {
2557: obj1 = getoa(obj,1);
2558: obj2 = getoa(obj,2);
2559: rob = KgetExponents(obj1,obj2);
2560: }else if (size == 2) {
2561: obj1 = getoa(obj,1);
2562: obj2 = KpoInteger(2);
2563: rob = KgetExponents(obj1,obj2);
2564: }else{
2565: errorKan1("%s\n","[(exponents) f type] gbext");
2566: }
1.1 maekawa 2567: }else {
2568: errorKan1("%s\n","gbext : unknown tag.");
2569: }
2570: return(rob);
2571: }
2572:
2573: struct object KmpzExtension(struct object obj)
2574: {
2575: char *key;
2576: int size;
2577: struct object keyo;
2578: struct object rob = NullObject;
2579: struct object obj0,obj1,obj2,obj3;
2580: MP_INT *f;
2581: MP_INT *g;
2582: MP_INT *h;
2583: MP_INT *r0;
2584: MP_INT *r1;
2585: MP_INT *r2;
2586: int gi;
2587: extern struct ring *SmallRingp;
2588:
2589:
2590: if (obj.tag != Sarray) errorKan1("%s\n","KmpzExtension(): The argument must be an array.");
2591: size = getoaSize(obj);
2592: if (size < 1) errorKan1("%s\n","KmpzExtension(): Empty array.");
2593: keyo = getoa(obj,0);
2594: if (keyo.tag != Sdollar) errorKan1("%s\n","KmpzExtension(): No key word.");
2595: key = KopString(keyo);
2596:
2597: /* branch by the key word. */
2598: if (strcmp(key,"gcd")==0) {
2599: if (size != 3) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2600: obj1 = getoa(obj,1);
2601: obj2 = getoa(obj,2);
1.24 takayama 2602: if (obj1.tag != SuniversalNumber) {
2603: obj1 = KdataConversion(obj1,"universalNumber");
2604: }
2605: if (obj2.tag != SuniversalNumber) {
2606: obj2 = KdataConversion(obj2,"universalNumber");
2607: }
1.1 maekawa 2608: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2609: errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2610: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2611: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2612: errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2613: }
2614: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2615: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2616: r1 = newMP_INT();
2617: mpz_gcd(r1,f,g);
2618: rob.tag = SuniversalNumber;
2619: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2620: }else if (strcmp(key,"tdiv_qr")==0) {
2621: if (size != 3) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2622: obj1 = getoa(obj,1);
2623: obj2 = getoa(obj,2);
1.24 takayama 2624: if (obj1.tag != SuniversalNumber) {
2625: obj1 = KdataConversion(obj1,"universalNumber");
2626: }
2627: if (obj2.tag != SuniversalNumber) {
2628: obj2 = KdataConversion(obj2,"universalNumber");
2629: }
1.1 maekawa 2630: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2631: errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2632: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2633: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2634: errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2635: }
2636: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2637: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2638: r1 = newMP_INT();
2639: r2 = newMP_INT();
2640: mpz_tdiv_qr(r1,r2,f,g);
2641: obj1.tag = SuniversalNumber;
2642: obj1.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2643: obj2.tag = SuniversalNumber;
2644: obj2.lc.universalNumber = mpintToCoeff(r2,SmallRingp);
2645: rob = newObjectArray(2);
2646: putoa(rob,0,obj1); putoa(rob,1,obj2);
2647: } else if (strcmp(key,"cancel")==0) {
2648: if (size != 2) {
2649: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2650: }
2651: obj0 = getoa(obj,1);
2652: if (obj0.tag == SuniversalNumber) return(obj0);
2653: if (obj0.tag != SrationalFunction) {
2654: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2655: return(obj0);
2656: }
2657: obj1 = *(Knumerator(obj0));
2658: obj2 = *(Kdenominator(obj0));
2659: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) {
2660: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2661: return(obj0);
2662: }
2663: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2664: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2665: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2666: }
2667: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2668: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2669:
2670: r0 = newMP_INT();
2671: r1 = newMP_INT();
2672: r2 = newMP_INT();
2673: mpz_gcd(r0,f,g);
2674: mpz_divexact(r1,f,r0);
2675: mpz_divexact(r2,g,r0);
2676: obj1.tag = SuniversalNumber;
2677: obj1.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2678: obj2.tag = SuniversalNumber;
2679: obj2.lc.universalNumber = mpintToCoeff(r2,SmallRingp);
2680:
2681: rob = KnewRationalFunction0(copyObjectp(&obj1),copyObjectp(&obj2));
2682: KisInvalidRational(&rob);
2683: }else if (strcmp(key,"sqrt")==0 ||
1.7 takayama 2684: strcmp(key,"com")==0) {
1.1 maekawa 2685: /* One arg functions */
2686: if (size != 2) errorKan1("%s\n","[key num] mpzext");
2687: obj1 = getoa(obj,1);
1.24 takayama 2688: if (obj1.tag != SuniversalNumber) {
2689: obj1 = KdataConversion(obj1,"universalNumber");
2690: }
1.1 maekawa 2691: if (obj1.tag != SuniversalNumber)
2692: errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
2693: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber))
2694: errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
2695: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2696: if (strcmp(key,"sqrt")==0) {
2697: r1 = newMP_INT();
2698: mpz_sqrt(r1,f);
2699: }else if (strcmp(key,"com")==0) {
2700: r1 = newMP_INT();
2701: mpz_com(r1,f);
2702: }
2703: rob.tag = SuniversalNumber;
2704: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2705: }else if (strcmp(key,"probab_prime_p")==0 ||
1.7 takayama 2706: strcmp(key,"and") == 0 ||
2707: strcmp(key,"ior")==0) {
1.1 maekawa 2708: /* Two args functions */
2709: if (size != 3) errorKan1("%s\n","[key num1 num2] mpzext.");
2710: obj1 = getoa(obj,1);
2711: obj2 = getoa(obj,2);
1.24 takayama 2712: if (obj1.tag != SuniversalNumber) {
2713: obj1 = KdataConversion(obj1,"universalNumber");
2714: }
2715: if (obj2.tag != SuniversalNumber) {
2716: obj2 = KdataConversion(obj2,"universalNumber");
2717: }
1.1 maekawa 2718: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2719: errorKan1("%s\n","[key num1 num2] mpzext.");
2720: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2721: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2722: errorKan1("%s\n","[key num1 num2] mpzext.");
2723: }
2724: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2725: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2726: if (strcmp(key,"probab_prime_p")==0) {
2727: gi = (int) mpz_get_si(g);
2728: if (mpz_probab_prime_p(f,gi)) {
1.7 takayama 2729: rob = KpoInteger(1);
1.1 maekawa 2730: }else {
1.7 takayama 2731: rob = KpoInteger(0);
1.1 maekawa 2732: }
2733: }else if (strcmp(key,"and")==0) {
2734: r1 = newMP_INT();
2735: mpz_and(r1,f,g);
2736: rob.tag = SuniversalNumber;
2737: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2738: }else if (strcmp(key,"ior")==0) {
2739: r1 = newMP_INT();
2740: mpz_ior(r1,f,g);
2741: rob.tag = SuniversalNumber;
2742: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2743: }
2744:
2745: }else if (strcmp(key,"powm")==0) {
2746: /* three args */
2747: if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext");
2748: obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3);
1.24 takayama 2749: if (obj1.tag != SuniversalNumber) {
2750: obj1 = KdataConversion(obj1,"universalNumber");
2751: }
2752: if (obj2.tag != SuniversalNumber) {
2753: obj2 = KdataConversion(obj2,"universalNumber");
2754: }
2755: if (obj3.tag != SuniversalNumber) {
2756: obj3 = KdataConversion(obj3,"universalNumber");
2757: }
1.1 maekawa 2758: if (obj1.tag != SuniversalNumber ||
2759: obj2.tag != SuniversalNumber ||
2760: obj3.tag != SuniversalNumber ) {
2761: errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
2762: }
2763: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2764: ! is_this_coeff_MP_INT(obj2.lc.universalNumber) ||
2765: ! is_this_coeff_MP_INT(obj3.lc.universalNumber)) {
1.1 maekawa 2766: errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
2767: }
2768: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2769: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2770: h = coeff_to_MP_INT(obj3.lc.universalNumber);
2771: if (mpz_sgn(g) < 0) errorKan1("%s\n","[(powm) base exp mod] mpzext : exp must not be negative.");
2772: r1 = newMP_INT();
2773: mpz_powm(r1,f,g,h);
2774: rob.tag = SuniversalNumber;
2775: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
1.24 takayama 2776: } else if (strcmp(key,"lcm")==0) {
2777: if (size != 3) errorKan1("%s\n","[(lcm) universalNumber universalNumber] mpzext.");
2778: obj1 = getoa(obj,1);
2779: obj2 = getoa(obj,2);
2780: if (obj1.tag != SuniversalNumber) {
2781: obj1 = KdataConversion(obj1,"universalNumber");
2782: }
2783: if (obj2.tag != SuniversalNumber) {
2784: obj2 = KdataConversion(obj2,"universalNumber");
2785: }
2786: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2787: errorKan1("%s\n","[lcm num1 num2] mpzext.");
2788: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
2789: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
2790: errorKan1("%s\n","[(lcm) universalNumber universalNumber] mpzext.");
2791: }
2792: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2793: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2794: r1 = newMP_INT();
2795: mpz_lcm(r1,f,g);
2796: rob.tag = SuniversalNumber;
2797: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
1.1 maekawa 2798: }else {
2799: errorKan1("%s\n","mpzExtension(): Unknown tag.");
2800: }
2801: return(rob);
2802: }
2803:
2804:
2805: /** : context */
2806: struct object KnewContext(struct object superObj,char *name) {
2807: struct context *cp;
2808: struct object ob;
2809: if (superObj.tag != Sclass) {
2810: errorKan1("%s\n","The argument of KnewContext must be a Class.Context");
2811: }
2812: if (superObj.lc.ival != CLASSNAME_CONTEXT) {
2813: errorKan1("%s\n","The argument of KnewContext must be a Class.Context");
2814: }
2815: cp = newContext0((struct context *)(superObj.rc.voidp),name);
2816: ob.tag = Sclass;
2817: ob.lc.ival = CLASSNAME_CONTEXT;
2818: ob.rc.voidp = cp;
2819: return(ob);
2820: }
2821:
2822: struct object KcreateClassIncetance(struct object ob1,
1.7 takayama 2823: struct object ob2,
2824: struct object ob3)
1.1 maekawa 2825: {
2826: /* [class-tag super-obj] size [class-tag] cclass */
2827: struct object ob4;
2828: int size,size2,i;
2829: struct object ob5;
2830: struct object rob;
2831:
2832: if (ob1.tag != Sarray)
2833: errorKan1("%s\n","cclass: The first argument must be an array.");
2834: if (getoaSize(ob1) < 1)
2835: errorKan1("%s\n","cclass: The first argument must be [class-tag ....].");
2836: ob4 = getoa(ob1,0);
2837: if (ectag(ob4) != CLASSNAME_CONTEXT)
2838: errorKan1("%s\n","cclass: The first argument must be [class-tag ....].");
2839:
2840: if (ob2.tag != Sinteger)
2841: errorKan1("%s\n","cclass: The second argument must be an integer.");
2842: size = KopInteger(ob2);
2843: if (size < 1)
2844: errorKan1("%s\n","cclass: The size must be > 0.");
2845:
2846: if (ob3.tag != Sarray)
2847: errorKan1("%s\n","cclass: The third argument must be an array.");
2848: if (getoaSize(ob3) < 1)
2849: errorKan1("%s\n","cclass: The third argument must be [class-tag].");
2850: ob5 = getoa(ob3,0);
2851: if (ectag(ob5) != CLASSNAME_CONTEXT)
2852: errorKan1("%s\n","cclass: The third argument must be [class-tag].");
1.7 takayama 2853:
1.1 maekawa 2854: rob = newObjectArray(size);
2855: putoa(rob,0,ob5);
2856: if (getoaSize(ob1) < size) size2 = getoaSize(ob1);
2857: else size2 = size;
2858: for (i=1; i<size2; i++) {
2859: putoa(rob,i,getoa(ob1,i));
2860: }
2861: for (i=size2; i<size; i++) {
2862: putoa(rob,i,NullObject);
2863: }
2864: return(rob);
2865: }
2866:
2867:
2868: struct object KpoDouble(double a) {
2869: struct object rob;
2870: rob.tag = Sdouble;
2871: /* rob.lc.dbl = (double *)sGC_malloc_atomic(sizeof(double)); */
2872: rob.lc.dbl = (double *)sGC_malloc(sizeof(double));
2873: if (rob.lc.dbl == (double *)NULL) {
2874: fprintf(stderr,"No memory.\n"); exit(10);
2875: }
2876: *(rob.lc.dbl) = a;
2877: return(rob);
2878: }
2879:
2880: double toDouble0(struct object ob) {
2881: double r;
2882: int r3;
2883: struct object ob2;
2884: struct object ob3;
2885: switch(ob.tag) {
2886: case Sinteger:
2887: return( (double) (KopInteger(ob)) );
2888: case SuniversalNumber:
2889: return((double) coeffToInt(ob.lc.universalNumber));
2890: case SrationalFunction:
2891: /* The argument is assumed to be a rational number. */
2892: ob2 = newObjectArray(2); ob3 = KpoString("cancel");
2893: putoa(ob2,0,ob3); putoa(ob2,1,ob);
2894: ob = KmpzExtension(ob2);
2895: ob2 = *Knumerator(ob); ob3 = *Kdenominator(ob);
2896: r3 = coeffToInt(ob3.lc.universalNumber);
2897: if (r3 == 0) {
2898: errorKan1("%s\n","toDouble0(): Division by zero.");
2899: break;
2900: }
2901: r = ((double) coeffToInt(ob2.lc.universalNumber)) / ((double)r3);
2902: return(r);
2903: case Sdouble:
2904: return( KopDouble(ob) );
2905: default:
2906: errorKan1("%s\n","toDouble0(): This type of conversion is not supported.");
2907: break;
2908: }
2909: return(0.0);
2910: }
2911:
2912: struct object KpoGradedPolySet(struct gradedPolySet *grD) {
2913: struct object rob;
2914: rob.tag = Sclass;
2915: rob.lc.ival = CLASSNAME_GradedPolySet;
2916: rob.rc.voidp = (void *) grD;
2917: return(rob);
2918: }
2919:
2920: static char *getspace0(int a) {
2921: char *s;
2922: a = (a > 0? a:-a);
2923: s = (char *) sGC_malloc(a+1);
2924: if (s == (char *)NULL) {
2925: errorKan1("%s\n","no more memory.");
2926: }
2927: return(s);
2928: }
2929: struct object KdefaultPolyRing(struct object ob) {
2930: struct object rob;
2931: int i,j,k,n;
2932: struct object ob1,ob2,ob3,ob4,ob5;
2933: struct object t1;
2934: char *s1;
2935: extern struct ring *CurrentRingp;
2936: static struct ring *a[N0];
2937:
2938: rob = NullObject;
2939: if (ob.tag != Sinteger) {
2940: errorKan1("%s\n","KdefaultPolyRing(): the argument must be integer.");
2941: }
2942: n = KopInteger(ob);
2943: if (n <= 0) {
2944: /* initializing */
2945: for (i=0; i<N0; i++) {
2946: a[i] = (struct ring*) NULL;
2947: }
2948: return(rob);
2949: }
2950:
2951: if ( a[n] != (struct ring*)NULL) return(KpoRingp(a[n]));
2952:
2953: /* Let's construct ring of polynomials of 2n variables */
2954: /* x variables */
2955: ob1 = newObjectArray(n);
2956: for (i=0; i<n; i++) {
2957: s1 = getspace0(1+ ((n-i)/10) + 1);
2958: sprintf(s1,"x%d",n-i);
2959: putoa(ob1,i,KpoString(s1));
2960: }
2961: ob2 = newObjectArray(n);
2962: s1 = getspace0(1);
2963: sprintf(s1,"h");
2964: putoa(ob2,0,KpoString(s1));
2965: for (i=1; i<n; i++) {
2966: s1 = getspace0(1+((n+n-i)/10)+1);
2967: sprintf(s1,"x%d",n+n-i);
2968: putoa(ob2,i,KpoString(s1));
2969: }
2970:
2971: ob3 = newObjectArray(9);
2972: putoa(ob3,0,KpoInteger(0));
2973: for (i=1; i<9; i++) {
2974: putoa(ob3,i,KpoInteger(n));
2975: }
2976:
2977: ob4 = newObjectArray(2*n);
2978: t1 = newObjectArray(2*n);
2979: for (i=0; i<2*n; i++) {
2980: putoa(t1,i,KpoInteger(1));
2981: }
2982: putoa(ob4,0,t1);
2983: for (i=1; i<2*n; i++) {
2984: t1 = newObjectArray(2*n);
2985: for (j=0; j<2*n; j++) {
2986: putoa(t1,j,KpoInteger(0));
2987: if (j == (2*n-i)) {
1.7 takayama 2988: putoa(t1,j,KpoInteger(-1));
1.1 maekawa 2989: }
2990: }
2991: putoa(ob4,i,t1);
2992: }
2993:
2994: ob5 = newObjectArray(2);
2995: putoa(ob5,0,KpoString("mpMult"));
2996: putoa(ob5,1,KpoString("poly"));
2997:
2998: KsetUpRing(ob1,ob2,ob3,ob4,ob5);
2999: a[n] = CurrentRingp;
3000: return(KpoRingp(a[n]));
3001: }
3002:
3003:
1.31 takayama 3004: struct object Krest(struct object ob) {
3005: struct object rob;
3006: struct object *op;
3007: int n,i;
3008: if (ob.tag == Sarray) {
3009: n = getoaSize(ob);
3010: if (n == 0) return ob;
3011: rob = newObjectArray(n-1);
3012: for (i=1; i<n; i++) {
3013: putoa(rob,i-1,getoa(ob,i));
3014: }
3015: return rob;
1.32 takayama 3016: }else if ((ob.tag == Slist) || (ob.tag == Snull)) {
3017: return Kcdr(ob);
1.31 takayama 3018: }else{
3019: errorKan1("%s\n","Krest(ob): ob must be an array or a list.");
3020: }
3021: }
3022: struct object Kjoin(struct object ob1, struct object ob2) {
3023: struct object rob;
3024: int n1,n2,i;
3025: if ((ob1.tag == Sarray) && (ob2.tag == Sarray)) {
3026: n1 = getoaSize(ob1); n2 = getoaSize(ob2);
3027: rob = newObjectArray(n1+n2);
3028: for (i=0; i<n1; i++) {
3029: putoa(rob,i,getoa(ob1,i));
3030: }
3031: for (i=n1; i<n1+n2; i++) {
3032: putoa(rob,i,getoa(ob2,i-n1));
3033: }
3034: return rob;
1.32 takayama 3035: }else if ((ob1.tag == Slist) || (ob1.tag == Snull)) {
3036: if ((ob2.tag == Slist) || (ob2.tag == Snull)) {
3037: return KvJoin(ob1,ob2);
3038: }else{
3039: errorKan1("%s\n","Kjoin: both argument must be a list.");
3040: }
1.31 takayama 3041: }else{
3042: errorKan1("%s\n","Kjoin: arguments must be arrays.");
3043: }
3044: }
1.1 maekawa 3045:
1.33 takayama 3046: struct object Kget(struct object ob1, struct object ob2) {
3047: struct object rob;
3048: struct object tob;
3049: int i,j,size,n;
3050: if (ob2.tag == Sinteger) {
3051: i =ob2.lc.ival;
3052: }else if (ob2.tag == SuniversalNumber) {
3053: i = KopInteger(KdataConversion(ob2,"integer"));
3054: }else if (ob2.tag == Sarray) {
3055: n = getoaSize(ob2);
3056: if (n == 0) return ob1;
3057: rob = ob1;
3058: for (i=0; i<n; i++) {
3059: rob=Kget(rob,getoa(ob2,i));
3060: }
3061: return rob;
3062: }
3063: if (ob1.tag == Sarray) {
3064: size = getoaSize(ob1);
3065: if ((0 <= i) && (i<size)) {
3066: return(getoa(ob1,i));
3067: }else{
3068: errorKan1("%s\n","Kget: Index is out of bound. (get)\n");
3069: }
3070: }else if (ob1.tag == Slist) {
3071: rob = NullObject;
3072: if (i < 0) errorKan1("%s\n","Kget: Index is negative. (get)");
3073: for (j=0; j<i; j++) {
3074: rob = Kcdr(ob1);
3075: if ((ob1.tag == Snull) && (rob.tag == Snull)) {
3076: errorKan1("%s\n","Kget: Index is out of bound. (get) cdr of null list.\n");
3077: }
3078: ob1 = rob;
3079: }
3080: return Kcar(ob1);
1.38 takayama 3081: } else if (ob1.tag == SbyteArray) {
3082: size = getByteArraySize(ob1);
3083: if ((0 <= i) && (i<size)) {
3084: return(KpoInteger(KopByteArray(ob1)[i]));
3085: }else{
3086: errorKan1("%s\n","Kget: Index is out of bound. (get)\n");
3087: }
3088: } else if (ob1.tag == Sdollar) {
3089: unsigned char *sss;
3090: sss = (unsigned char *) KopString(ob1);
3091: size = strlen(sss);
3092: if ((0 <= i) && (i<size)) {
3093: return(KpoInteger(sss[i]));
3094: }else{
3095: errorKan1("%s\n","Kget: Index is out of bound. (get)\n");
3096: }
3097:
1.33 takayama 3098: }else errorKan1("%s\n","Kget: argument must be an array or a list.");
1.38 takayama 3099: }
3100:
3101: /* Constructor of byteArray */
3102: struct object newByteArray(int size,struct object obj) {
3103: unsigned char *ba;
3104: unsigned char *ba2;
3105: struct object rob,tob;
3106: int i,n;
3107: ba = NULL;
1.39 takayama 3108: if (size > 0) {
3109: ba = (unsigned char *) sGC_malloc(size);
3110: if (ba == NULL) errorKan1("%s\n","No more memory.");
3111: }
1.38 takayama 3112: rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size;
3113: if (obj.tag == SbyteArray) {
3114: n = getByteArraySize(obj);
3115: ba2 = KopByteArray(obj);
1.39 takayama 3116: for (i=0; i<(n<size?n:size); i++) {
1.38 takayama 3117: ba[i] = ba2[i];
3118: }
3119: for (i=n; i<size; i++) ba[i] = 0;
3120: return rob;
3121: }else if (obj.tag == Sarray) {
3122: n = getoaSize(obj);
3123: for (i=0; i<n; i++) {
3124: tob = getoa(obj,i);
3125: tob = Kto_int32(tob);
3126: if (tob.tag != Sinteger) errorKan1("%s\n","newByteArray: array is not an array of integer or universalNumber.");
3127: ba[i] = (unsigned char) KopInteger(tob);
3128: }
3129: for (i=n; i<size; i++) ba[i] = 0;
3130: return rob;
3131: }else{
3132: for (i=0; i<size; i++) ba[i] = 0;
3133: return rob;
3134: }
1.40 takayama 3135: }
3136: struct object newByteArrayFromStr(char *s,int size) {
3137: unsigned char *ba;
3138: struct object rob;
3139: int i;
3140: ba = NULL;
3141: if (size > 0) {
3142: ba = (unsigned char *) sGC_malloc(size);
3143: if (ba == NULL) errorKan1("%s\n","No more memory.");
3144: }
3145: rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size;
3146: for (i=0; i<size; i++) {
3147: ba[i] = (char) s[i];
3148: }
3149: return(rob);
1.38 takayama 3150: }
3151: struct object byteArrayToArray(struct object obj) {
3152: int n,i; unsigned char *ba;
3153: struct object rob;
3154: if (obj.tag != SbyteArray) errorKan1("%s\n","byteArrayToArray: argument is not an byteArray.");
3155: n = getByteArraySize(obj);
3156: rob = newObjectArray(n);
3157: ba = KopByteArray(obj);
3158: for (i=0; i<n; i++) putoa(rob,i,KpoInteger((int) ba[i]));
3159: return rob;
1.33 takayama 3160: }
1.1 maekawa 3161:
3162: /******************************************************************
3163: error handler
3164: ******************************************************************/
3165:
3166: errorKan1(str,message)
1.7 takayama 3167: char *str;
3168: char *message;
1.1 maekawa 3169: {
3170: extern char *GotoLabel;
3171: extern int GotoP;
3172: extern int ErrorMessageMode;
1.37 takayama 3173: extern int RestrictedMode, RestrictedMode_saved;
1.1 maekawa 3174: char tmpc[1024];
1.37 takayama 3175: RestrictedMode = RestrictedMode_saved;
1.10 takayama 3176: cancelAlarm();
1.1 maekawa 3177: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
3178: sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");
3179: if (strlen(message) < 900) {
3180: strcat(tmpc,message);
3181: }
3182: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
3183: }
3184: if (ErrorMessageMode != 1) {
3185: fprintf(stderr,"\nERROR(kanExport[0|1].c): ");
3186: fprintf(stderr,str,message);
1.30 takayama 3187: (void) traceShowStack(); traceClearStack();
1.1 maekawa 3188: }
3189: /* fprintf(stderr,"Hello "); */
3190: if (GotoP) {
3191: /* fprintf(stderr,"Hello. GOTO "); */
3192: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
3193: GotoP = 0;
3194: }
3195: stdOperandStack(); contextControl(CCRESTORE);
3196: /* fprintf(stderr,"Now. Long jump!\n"); */
1.8 takayama 3197: #if defined(__CYGWIN__)
3198: siglongjmp(EnvOfStackMachine,1);
3199: #else
1.1 maekawa 3200: longjmp(EnvOfStackMachine,1);
1.8 takayama 3201: #endif
1.1 maekawa 3202: }
1.22 takayama 3203:
1.1 maekawa 3204:
3205: warningKan(str)
1.7 takayama 3206: char *str;
1.1 maekawa 3207: {
3208: extern int WarningMessageMode;
3209: extern int Strict;
3210: char tmpc[1024];
3211: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
3212: sprintf(tmpc,"\nWARNING(kanExport[0|1].c): ");
3213: if (strlen(str) < 900) {
3214: strcat(tmpc,str);
3215: }
3216: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
3217: }
3218: if (WarningMessageMode != 1) {
3219: fprintf(stderr,"\nWARNING(kanExport[0|1].c): ");
3220: fprintf(stderr,str);
3221: fprintf(stderr,"\n");
3222: }
3223: /* if (Strict) errorKan1("%s\n"," "); */
3224: if (Strict) errorKan1("%s\n",str);
1.4 takayama 3225: return(0);
3226: }
3227:
3228: warningKanNoStrictMode(str)
1.7 takayama 3229: char *str;
1.4 takayama 3230: {
3231: extern int Strict;
3232: int t;
3233: t = Strict;
3234: Strict = 0;
3235: warningKan(str);
3236: Strict = t;
1.1 maekawa 3237: return(0);
3238: }
3239:
3240:
3241:
3242:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to kanExport0.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan