Annotation of OpenXM/src/kan96xx/Kan/kanExport0.c, Revision 1.22
1.22 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.21 2004/02/28 13:39:42 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;
690: if (obj1.tag != obj2.tag) {
691: warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n");
692: return(0);
693: }
694: switch(obj1.tag) {
1.7 takayama 695: case 0:
696: return(1); /* case of NullObject */
697: break;
698: case Sinteger:
699: if (obj1.lc.ival == obj2.lc.ival) return(1);
700: else return(0);
701: break;
702: case Sstring:
703: case Sdollar:
704: if (strcmp(obj1.lc.str, obj2.lc.str)==0) return(1);
705: else return(0);
706: break;
707: case Spoly:
708: ob = KooSub(obj1,obj2);
709: if (KopPOLY(ob) == ZERO) return(1);
710: else return(0);
711: case Sarray:
712: if (getoaSize(obj1) != getoaSize(obj2)) return(0);
713: for (i=0; i< getoaSize(obj1); i++) {
714: if (KooEqualQ(getoa(obj1,i),getoa(obj2,i))) { ; }
715: else { return(0); }
716: }
717: return(1);
718: case Slist:
719: if (KooEqualQ(*(obj1.lc.op),*(obj2.lc.op))) {
720: if (isNullList(obj1.rc.op)) {
721: if (isNullList(obj2.rc.op)) return(1);
722: else return(0);
1.1 maekawa 723: }else{
1.7 takayama 724: if (isNullList(obj2.rc.op)) return(0);
725: return(KooEqualQ(*(obj1.rc.op),*(obj2.rc.op)));
1.1 maekawa 726: }
1.7 takayama 727: }else{
728: return(0);
1.1 maekawa 729: }
1.7 takayama 730: break;
731: case SuniversalNumber:
732: return(coeffEqual(obj1.lc.universalNumber,obj2.lc.universalNumber));
733: break;
734: case Sring:
735: return(KopRingp(obj1) == KopRingp(obj2));
736: break;
737: case Sclass:
738: return(KclassEqualQ(obj1,obj2));
739: break;
740: case Sdouble:
741: return(KopDouble(obj1) == KopDouble(obj2));
742: break;
743: default:
744: errorKan1("%s\n","KooEqualQ() has not supported these objects yet.");
745: break;
746: }
1.1 maekawa 747: }
748:
749:
750: struct object KoIsPositive(ob1)
1.7 takayama 751: struct object ob1;
1.1 maekawa 752: {
753: struct object rob = NullObject;
754: switch (ob1.tag) {
755: case Sinteger:
756: return(KpoInteger(ob1.lc.ival > 0));
757: break;
758: default:
759: warningKan("KoIsPositive() has not supported yet these objects.\n");
760: break;
761: }
762: return(rob);
763: }
764:
765: struct object KooGreater(obj1,obj2)
1.7 takayama 766: struct object obj1;
767: struct object obj2;
1.1 maekawa 768: {
769: struct object ob;
770: int tt;
771: if (obj1.tag != obj2.tag) {
772: errorKan1("%s\n","You cannot compare different kinds of objects.");
773: }
774: switch(obj1.tag) {
1.7 takayama 775: case 0:
776: return(KpoInteger(1)); /* case of NullObject */
777: break;
778: case Sinteger:
779: if (obj1.lc.ival > obj2.lc.ival) return(KpoInteger(1));
780: else return(KpoInteger(0));
781: break;
782: case Sstring:
783: case Sdollar:
784: if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1));
785: else return(KpoInteger(0));
786: break;
787: case Spoly:
788: if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1));
789: else return(KpoInteger(0));
790: break;
791: case SuniversalNumber:
792: tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
793: if (tt > 0) return(KpoInteger(1));
794: else return(KpoInteger(0));
795: break;
796: case Sdouble:
797: if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1));
798: else return(KpoInteger(0));
799: break;
800: default:
801: errorKan1("%s\n","KooGreater() has not supported these objects yet.");
802: break;
803: }
1.1 maekawa 804: }
805:
806: struct object KooLess(obj1,obj2)
1.7 takayama 807: struct object obj1;
808: struct object obj2;
1.1 maekawa 809: {
810: struct object ob;
811: int tt;
812: if (obj1.tag != obj2.tag) {
813: errorKan1("%s\n","You cannot compare different kinds of objects.");
814: }
815: switch(obj1.tag) {
1.7 takayama 816: case 0:
817: return(KpoInteger(1)); /* case of NullObject */
818: break;
819: case Sinteger:
820: if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1));
821: else return(KpoInteger(0));
822: break;
823: case Sstring:
824: case Sdollar:
825: if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1));
826: else return(KpoInteger(0));
827: break;
828: case Spoly:
829: if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1));
830: else return(KpoInteger(0));
831: break;
832: case SuniversalNumber:
833: tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
834: if (tt < 0) return(KpoInteger(1));
835: else return(KpoInteger(0));
836: break;
837: case Sdouble:
838: if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1));
839: else return(KpoInteger(0));
840: break;
841: default:
842: errorKan1("%s\n","KooLess() has not supported these objects yet.");
843: break;
844: }
1.1 maekawa 845: }
846:
847: /* :conversion */
848:
849: struct object KdataConversion(obj,key)
1.7 takayama 850: struct object obj;
851: char *key;
1.1 maekawa 852: {
853: char tmps[128]; /* Assume that double is not more than 128 digits */
854: char intstr[100]; /* Assume that int is not more than 100 digits */
855: struct object rob;
856: extern struct ring *CurrentRingp;
857: extern struct ring SmallRing;
858: int flag;
859: struct object rob1,rob2;
860: char *s;
861: int i;
1.2 takayama 862: double f;
863: double f2;
1.1 maekawa 864: /* reports the data type */
865: if (key[0] == 't' || key[0] =='e') {
866: if (strcmp(key,"type?")==0) {
867: rob = KpoInteger(obj.tag);
868: return(rob);
869: }else if (strcmp(key,"type??")==0) {
870: if (obj.tag != Sclass) {
1.7 takayama 871: rob = KpoInteger(obj.tag);
1.1 maekawa 872: }else {
1.7 takayama 873: rob = KpoInteger(ectag(obj));
1.1 maekawa 874: }
875: return(rob);
876: }else if (strcmp(key,"error")==0) {
877: rob = KnewErrorPacketObj(obj);
878: return(rob);
879: }
880: }
881: switch(obj.tag) {
882: case Snull:
883: if (strcmp(key,"integer") == 0) {
884: rob = KpoInteger(0);
885: return(rob);
886: }else if (strcmp(key,"universalNumber") == 0) {
887: rob.tag = SuniversalNumber;
888: rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);
889: return(rob);
890: }else if (strcmp(key,"poly") == 0) {
891: rob = KpoPOLY(ZERO);
892: }else{
893: warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");
894: }
895: break;
896: case Sinteger:
897: if (strcmp(key,"string") == 0) { /* ascii code */
898: rob.tag = Sdollar;
899: rob.lc.str = (char *)sGC_malloc(2);
900: if (rob.lc.str == (char *)NULL) errorKan1("%s","No more memory.\n");
901: (rob.lc.str)[0] = obj.lc.ival; (rob.lc.str)[1] = '\0';
902: return(rob);
903: }else if (strcmp(key,"integer")==0) {
904: return(obj);
905: }else if (strcmp(key,"poly") == 0) {
906: rob.tag = Spoly;
907: rob.lc.poly = cxx(obj.lc.ival,0,0,CurrentRingp);
908: return(rob);
909: }else if (strcmp(key,"dollar") == 0) {
910: rob.tag = Sdollar;
911: sprintf(intstr,"%d",obj.lc.ival);
912: rob.lc.str = (char *)sGC_malloc(strlen(intstr)+2);
913: if (rob.lc.str == (char *)NULL) errorKan1("%s","No more memory.\n");
914: strcpy(rob.lc.str,intstr);
915: return(rob);
916: }else if (strcmp(key,"universalNumber")==0) {
917: rob.tag = SuniversalNumber;
918: rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);
919: return(rob);
920: }else if (strcmp(key,"double") == 0) {
921: rob = KpoDouble((double) (obj.lc.ival));
922: return(rob);
923: }else if (strcmp(key,"null") == 0) {
924: rob = NullObject;
925: return(rob);
926: }else{
927: warningKan("Sorry. This type of data conversion has not supported yet.\n");
928: }
929: break;
930: case Sdollar:
931: if (strcmp(key,"dollar") == 0 || strcmp(key,"string")==0) {
932: rob = obj;
933: return(rob);
934: }else if (strcmp(key,"literal") == 0) {
935: rob.tag = Sstring;
936: s = (char *) sGC_malloc(sizeof(char)*(strlen(obj.lc.str)+3));
937: if (s == (char *) NULL) {
1.7 takayama 938: errorKan1("%s\n","No memory.");
1.1 maekawa 939: }
940: s[0] = '/';
941: strcpy(&(s[1]),obj.lc.str);
942: rob.lc.str = &(s[1]);
943: /* set the hashing value. */
944: rob2 = lookupLiteralString(s);
945: rob.rc.op = rob2.lc.op;
946: return(rob);
947: }else if (strcmp(key,"poly")==0) {
948: rob.tag = Spoly;
949: rob.lc.poly = stringToPOLY(obj.lc.str,CurrentRingp);
950: return(rob);
951: }else if (strcmp(key,"array")==0) {
952: rob = newObjectArray(strlen(obj.lc.str));
953: for (i=0; i<strlen(obj.lc.str); i++) {
1.7 takayama 954: putoa(rob,i,KpoInteger((obj.lc.str)[i]));
1.1 maekawa 955: }
956: return(rob);
957: }else if (strcmp(key,"universalNumber") == 0) {
958: rob.tag = SuniversalNumber;
959: rob.lc.universalNumber = stringToUniversalNumber(obj.lc.str,&flag);
960: if (flag == -1) errorKan1("KdataConversion(): %s",
1.7 takayama 961: "It's not number.\n");
1.2 takayama 962: return(rob);
963: }else if (strcmp(key,"double") == 0) {
964: /* Check the format. 2.3432 e2 is not allowed. It should be 2.3232e2.*/
965: flag = 0;
966: for (i=0; (obj.lc.str)[i] != '\0'; i++) {
1.7 takayama 967: if ((obj.lc.str)[i] > ' ' && flag == 0) flag=1;
968: else if ((obj.lc.str)[i] <= ' ' && flag == 1) flag = 2;
969: else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3;
1.2 takayama 970: }
971: if (flag == 3) errorKan1("KdataConversion(): %s","The data for the double contains blanck(s)");
972: /* Read the double. */
973: if (sscanf(obj.lc.str,"%lf",&f) <= 0) {
1.7 takayama 974: errorKan1("KdataConversion(): %s","It cannot be translated to double.");
1.2 takayama 975: }
976: rob = KpoDouble(f);
1.1 maekawa 977: return(rob);
978: }else if (strcmp(key,"null") == 0) {
979: rob = NullObject;
980: return(rob);
981: }else{
982: warningKan("Sorry. This type of data conversion has not supported yet.\n");
983: }
984: break;
985: case Sarray:
986: if (strcmp(key,"array") == 0) {
987: return(rob);
988: }else if (strcmp(key,"list") == 0) {
989: rob = *( arrayToList(obj) );
990: return(rob);
991: }else if (strcmp(key,"arrayOfPOLY")==0) {
992: rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));
993: return(rob);
994: }else if (strcmp(key,"matrixOfPOLY")==0) {
995: rob = KpoMatrixOfPOLY(arrayToMatrixOfPOLY(obj));
996: return(rob);
997: }else if (strcmp(key,"gradedPolySet")==0) {
998: rob = KpoGradedPolySet(arrayToGradedPolySet(obj));
999: return(rob);
1000: }else if (strcmp(key,"null") == 0) {
1001: rob = NullObject;
1002: return(rob);
1003: }else {
1004: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1005: }
1006: break;
1007: case Spoly:
1.15 takayama 1008: if ((strcmp(key,"poly")==0) || (strcmp(key,"numerator")==0)) {
1.5 takayama 1009: rob = obj;
1.1 maekawa 1010: return(rob);
1011: }else if (strcmp(key,"integer")==0) {
1012: if (obj.lc.poly == ZERO) return(KpoInteger(0));
1013: else {
1.7 takayama 1014: return(KpoInteger(coeffToInt(obj.lc.poly->coeffp)));
1.1 maekawa 1015: }
1016: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1017: rob.tag = Sdollar;
1018: rob.lc.str = KPOLYToString(KopPOLY(obj));
1019: return(rob);
1020: }else if (strcmp(key,"array") == 0) {
1021: return( POLYToArray(KopPOLY(obj)));
1022: }else if (strcmp(key,"map")==0) {
1023: return(KringMap(obj));
1024: }else if (strcmp(key,"universalNumber")==0) {
1025: if (obj.lc.poly == ZERO) {
1.7 takayama 1026: rob.tag = SuniversalNumber;
1027: rob.lc.universalNumber = newUniversalNumber(0);
1.1 maekawa 1028: } else {
1.7 takayama 1029: if (obj.lc.poly->coeffp->tag == MP_INTEGER) {
1030: rob.tag = SuniversalNumber;
1031: rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp);
1032: }else {
1033: rob = NullObject;
1034: warningKan("Coefficient is not MP_INT.");
1035: }
1.1 maekawa 1036: }
1037: return(rob);
1038: }else if (strcmp(key,"ring")==0) {
1039: if (obj.lc.poly ISZERO) {
1.7 takayama 1040: warningKan("Zero polynomial does not have the ring structure field.\n");
1.1 maekawa 1041: }else{
1.7 takayama 1042: rob.tag = Sring;
1043: rob.lc.ringp = (obj.lc.poly)->m->ringp;
1044: return(rob);
1.1 maekawa 1045: }
1046: }else if (strcmp(key,"null") == 0) {
1047: rob = NullObject;
1048: return(rob);
1049: }else{
1050: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1051: }
1052: break;
1053: case SarrayOfPOLY:
1054: if (strcmp(key,"array")==0) {
1055: rob = arrayOfPOLYToArray(KopArrayOfPOLYp(obj));
1056: return(rob);
1057: }else{
1058: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1059: }
1060: break;
1061: case SmatrixOfPOLY:
1062: if (strcmp(key,"array")==0) {
1063: rob = matrixOfPOLYToArray(KopMatrixOfPOLYp(obj));
1064: return(rob);
1065: }else if (strcmp(key,"null") == 0) {
1066: rob = NullObject;
1067: return(rob);
1068: }else{
1069: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1070: }
1071: break;
1072: case Slist:
1073: if (strcmp(key,"array") == 0) {
1074: rob = listToArray(&obj);
1075: return(rob);
1076: }
1077: break;
1078: case SuniversalNumber:
1.15 takayama 1079: if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) {
1.1 maekawa 1080: return(rob);
1081: }else if (strcmp(key,"integer")==0) {
1082: rob = KpoInteger(coeffToInt(obj.lc.universalNumber));
1083: return(rob);
1084: }else if (strcmp(key,"poly")==0) {
1085: rob = KpoPOLY(universalToPoly(obj.lc.universalNumber,CurrentRingp));
1086: return(rob);
1087: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1088: rob.tag = Sdollar;
1089: rob.lc.str = coeffToString(obj.lc.universalNumber);
1090: return(rob);
1091: }else if (strcmp(key,"null") == 0) {
1092: rob = NullObject;
1093: return(rob);
1094: }else if (strcmp(key,"double") == 0) {
1095: rob = KpoDouble( toDouble0(obj) );
1096: return(rob);
1097: }else{
1098: warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n");
1099: }
1100: break;
1101: case SrationalFunction:
1102: if (strcmp(key,"rationalFunction")==0) {
1103: return(rob);
1104: } if (strcmp(key,"numerator")==0) {
1105: rob = *(Knumerator(obj));
1106: return(rob);
1107: }else if (strcmp(key,"denominator")==0) {
1108: rob = *(Kdenominator(obj));
1109: return(rob);
1110: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1111: rob1 = KdataConversion(*(Knumerator(obj)),"string");
1112: rob2 = KdataConversion(*(Kdenominator(obj)),"string");
1113: s = sGC_malloc(sizeof(char)*( strlen(rob1.lc.str) + strlen(rob2.lc.str) + 10));
1114: if (s == (char *)NULL) errorKan1("%s\n","KdataConversion(): No memory");
1115: sprintf(s,"(%s)/(%s)",rob1.lc.str,rob2.lc.str);
1116: rob.tag = Sdollar;
1117: rob.lc.str = s;
1118: return(rob);
1119: }else if (strcmp(key,"cancel")==0) {
1120: warningKan("Sorry. Data conversion <<cancel>> of rationalFunction has not supported yet.\n");
1121: return(obj);
1122: }else if (strcmp(key,"null") == 0) {
1123: rob = NullObject;
1124: return(rob);
1125: }else if (strcmp(key,"double") == 0) {
1126: rob = KpoDouble( toDouble0(obj) );
1127: return(rob);
1128: }else{
1129: warningKan("Sorry. This type of data conversion of rationalFunction has not supported yet.\n");
1130: }
1131: break;
1132: case Sdouble:
1133: if (strcmp(key,"integer") == 0) {
1134: rob = KpoInteger( (int) KopDouble(obj));
1135: return(rob);
1136: } else if (strcmp(key,"universalNumber") == 0) {
1137: rob.tag = SuniversalNumber;
1138: rob.lc.universalNumber = intToCoeff((int) KopDouble(obj),&SmallRing);
1139: return(rob);
1140: }else if ((strcmp(key,"string") == 0) || (strcmp(key,"dollar") == 0)) {
1141: sprintf(tmps,"%f",KopDouble(obj));
1142: s = sGC_malloc(strlen(tmps)+2);
1143: if (s == (char *)NULL) errorKan1("%s\n","KdataConversion(): No memory");
1144: strcpy(s,tmps);
1145: rob.tag = Sdollar;
1146: rob.lc.str = s;
1147: return(rob);
1148: }else if (strcmp(key,"double")==0) {
1149: return(obj);
1150: }else if (strcmp(key,"null") == 0) {
1151: rob = NullObject;
1152: return(rob);
1153: }else {
1154: warningKan("Sorry. This type of data conversion of rationalFunction has not supported yet.\n");
1155: }
1156: break;
1157: case Sring:
1158: if (strcmp(key,"orderMatrix")==0) {
1159: rob = oGetOrderMatrix(KopRingp(obj));
1160: return(rob);
1.22 ! takayama 1161: }else if (strcmp(key,"oxRingStructure")==0) {
! 1162: rob = oRingToOXringStructure(KopRingp(obj));
! 1163: return(rob);
1.1 maekawa 1164: }else{
1165: warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");
1166: }
1167: break;
1168: default:
1169: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1170: }
1171: return(NullObject);
1172: }
1173:
1174: /* conversion functions between primitive data and objects.
1175: If it's not time critical, it is recommended to use these functions */
1176: struct object KpoInteger(k)
1.7 takayama 1177: int k;
1.1 maekawa 1178: {
1179: struct object obj;
1180: obj.tag = Sinteger;
1181: obj.lc.ival = k; obj.rc.ival = 0;
1182: return(obj);
1183: }
1184: struct object KpoString(s)
1.7 takayama 1185: char *s;
1.1 maekawa 1186: {
1187: struct object obj;
1188: obj.tag = Sdollar;
1189: obj.lc.str = s; obj.rc.ival = 0;
1190: return(obj);
1191: }
1192: struct object KpoPOLY(f)
1.7 takayama 1193: POLY f;
1.1 maekawa 1194: {
1195: struct object obj;
1196: obj.tag = Spoly;
1197: obj.lc.poly = f; obj.rc.ival = 0;
1198: return(obj);
1199: }
1200: struct object KpoArrayOfPOLY(ap)
1.7 takayama 1201: struct arrayOfPOLY *ap ;
1.1 maekawa 1202: {
1203: struct object obj;
1204: obj.tag = SarrayOfPOLY;
1205: obj.lc.arrayp = ap; obj.rc.ival = 0;
1206: return(obj);
1207: }
1208:
1209: struct object KpoMatrixOfPOLY(mp)
1.7 takayama 1210: struct matrixOfPOLY *mp ;
1.1 maekawa 1211: {
1212: struct object obj;
1213: obj.tag = SmatrixOfPOLY;
1214: obj.lc.matrixp = mp; obj.rc.ival = 0;
1215: return(obj);
1216: }
1217:
1218: struct object KpoRingp(ringp)
1.7 takayama 1219: struct ring *ringp;
1.1 maekawa 1220: {
1221: struct object obj;
1222: obj.tag = Sring;
1223: obj.lc.ringp = ringp;
1224: return(obj);
1225: }
1226:
1.22 ! takayama 1227: struct object KpoUniversalNumber(u)
! 1228: struct coeff *u;
! 1229: {
! 1230: struct object obj;
! 1231: obj.tag = SuniversalNumber;
! 1232: obj.lc.universalNumber = u;
! 1233: return(obj);
! 1234: }
1.1 maekawa 1235: /*** conversion 2. Data conversions on arrays and matrices. ****/
1236: struct object arrayOfPOLYToArray(aa)
1.7 takayama 1237: struct arrayOfPOLY *aa;
1.1 maekawa 1238: {
1239: POLY *a;
1240: int size;
1241: struct object r;
1242: int j;
1243: struct object tmp;
1244:
1245: size = aa->n; a = aa->array;
1246: r = newObjectArray(size);
1247: for (j=0; j<size; j++) {
1248: tmp.tag = Spoly;
1249: tmp.lc.poly= a[j];
1250: putoa(r,j,tmp);
1251: }
1252: return( r );
1253: }
1254:
1255: struct object matrixOfPOLYToArray(pmat)
1.7 takayama 1256: struct matrixOfPOLY *pmat;
1.1 maekawa 1257: {
1258: struct object r;
1259: struct object tmp;
1260: int i,j;
1261: int m,n;
1262: POLY *mat;
1263: struct arrayOfPOLY ap;
1264:
1265: m = pmat->m; n = pmat->n; mat = pmat->mat;
1266: r = newObjectArray(m);
1267: for (i=0; i<m; i++) {
1268: ap.n = n; ap.array = &(mat[ind(i,0)]);
1269: tmp = arrayOfPOLYToArray(&ap);
1270: /* ind() is the macro defined in matrix.h. */
1271: putoa(r,i,tmp);
1272: }
1273: return(r);
1274: }
1275:
1276: struct arrayOfPOLY *arrayToArrayOfPOLY(oa)
1.7 takayama 1277: struct object oa;
1.1 maekawa 1278: {
1279: POLY *a;
1280: int size;
1281: int i;
1282: struct object tmp;
1283: struct arrayOfPOLY *ap;
1284:
1285: if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",
1.7 takayama 1286: "Argument is not array\n");
1.1 maekawa 1287: size = getoaSize(oa);
1288: a = (POLY *)sGC_malloc(sizeof(POLY)*size);
1289: for (i=0; i<size; i++) {
1290: tmp = getoa(oa,i);
1291: if (tmp.tag != Spoly) errorKan1("KarrayToArrayOfPOLY():%s ",
1.7 takayama 1292: "element must be polynomial.\n");
1.1 maekawa 1293: a[i] = tmp.lc.poly;
1294: }
1295: ap = (struct arrayOfPOLY *)sGC_malloc(sizeof(struct arrayOfPOLY));
1296: ap->n = size;
1297: ap->array = a;
1298: return(ap);
1299: }
1300:
1301: struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)
1.7 takayama 1302: struct object oa;
1.1 maekawa 1303: {
1304: POLY *a;
1305: int m;
1306: int n;
1307: int i,j;
1308: struct matrixOfPOLY *ma;
1309:
1310: struct object tmp,tmp2;
1311: if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",
1.7 takayama 1312: "Argument is not array\n");
1.1 maekawa 1313: m = getoaSize(oa);
1314: tmp = getoa(oa,0);
1315: if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY():%s ",
1.7 takayama 1316: "Argument is not array\n");
1.1 maekawa 1317: n = getoaSize(tmp);
1318: a = (POLY *)sGC_malloc(sizeof(POLY)*(m*n));
1319: for (i=0; i<m; i++) {
1320: tmp = getoa(oa,i);
1321: if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY(): %s",
1.7 takayama 1322: "element must be array.\n");
1.1 maekawa 1323: for (j=0; j<n; j++) {
1324: tmp2 = getoa(tmp,j);
1325: if (tmp2.tag != Spoly) errorKan1("arrayToMatrixOfPOLY(): %s",
1.7 takayama 1326: "element must be a polynomial.\n");
1.1 maekawa 1327: a[ind(i,j)] = tmp2.lc.poly;
1328: /* we use the macro ind here. Be careful of using m and n. */
1329: }
1330: }
1331: ma = (struct matrixOfPOLY *)sGC_malloc(sizeof(struct matrixOfPOLY));
1332: ma->m = m; ma->n = n;
1333: ma->mat = a;
1334: return(ma);
1335: }
1336:
1337: /* :misc */
1338:
1339: /* :ring :kan */
1340: int objArrayToOrderMatrix(oA,order,n,oasize)
1.7 takayama 1341: struct object oA;
1342: int order[];
1343: int n;
1344: int oasize;
1.1 maekawa 1345: {
1346: int size;
1347: int k,j;
1348: struct object tmpOa;
1349: struct object obj;
1350: if (oA.tag != Sarray) {
1351: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1352: return(-1);
1353: }
1354: size = getoaSize(oA);
1355: if (size != oasize) {
1356: warningKan("The row size of the array is wrong.");
1357: return(-1);
1358: }
1359: for (k=0; k<size; k++) {
1360: tmpOa = getoa(oA,k);
1361: if (tmpOa.tag != Sarray) {
1362: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1363: return(-1);
1364: }
1365: if (getoaSize(tmpOa) != 2*n) {
1366: warningKan("The column size of the array is wrong.");
1367: return(-1);
1368: }
1369: for (j=0; j<2*n; j++) {
1370: obj = getoa(tmpOa,j);
1371: order[k*2*n+j] = obj.lc.ival;
1372: }
1373: }
1374: return(0);
1375: }
1376:
1377: int KsetOrderByObjArray(oA)
1.7 takayama 1378: struct object oA;
1.1 maekawa 1379: {
1380: int *order;
1381: int n,c,l, oasize;
1382: extern struct ring *CurrentRingp;
1383: extern int AvoidTheSameRing;
1384: /* n,c,l must be set in the CurrentRing */
1385: if (AvoidTheSameRing) {
1386: errorKan1("%s\n","KsetOrderByObjArray(): You cannot change the order matrix when AvoidTheSameRing == 1.");
1387: }
1388: n = CurrentRingp->n;
1389: c = CurrentRingp->c;
1390: l = CurrentRingp->l;
1391: if (oA.tag != Sarray) {
1392: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1393: return(-1);
1394: }
1395: oasize = getoaSize(oA);
1396: order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
1397: if (order == (int *)NULL) errorKan1("%s\n","KsetOrderByObjArray(): No memory.");
1398: if (objArrayToOrderMatrix(oA,order,n,oasize) == -1) {
1399: return(-1);
1400: }
1401: setOrderByMatrix(order,n,c,l,oasize); /* Set order to the current ring. */
1402: return(0);
1403: }
1404:
1405: static int checkRelations(c,l,m,n,cc,ll,mm,nn)
1.7 takayama 1406: int c,l,m,n,cc,ll,mm,nn;
1.1 maekawa 1407: {
1408: if (!(1<=c && c<=l && l<=m && m<=n)) return(1);
1409: if (!(cc<=ll && ll<=mm && mm<=nn && nn <= n)) return(1);
1410: if (!(cc<c || ll < l || mm < m || nn < n)) {
1411: if (WarningNoVectorVariable) {
1.4 takayama 1412: warningKanNoStrictMode("Ring definition: there is no variable to represent vectors.\n");
1.1 maekawa 1413: }
1414: }
1415: if (!(cc<=c && ll <= l && mm <= m && nn <= n)) return(1);
1416: return(0);
1417: }
1418:
1419: struct object KgetOrderMatrixOfCurrentRing()
1420: {
1421: extern struct ring *CurrentRingp;
1422: return(oGetOrderMatrix(CurrentRingp));
1423: }
1424:
1425:
1426: int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
1.7 takayama 1427: struct object ob1,ob2,ob3,ob4,ob5;
1428: /* ob1 = [x(0), ..., x(n-1)];
1429: ob2 = [D(0), ..., D(n-1)];
1430: ob3 = [p,c,l,m,n,cc,ll,mm,nn,next];
1431: ob4 = Order matrix
1432: ob5 = [(keyword) value (keyword) value ....]
1433: */
1.1 maekawa 1434: #define RP_LIMIT 500
1435: {
1436: int i;
1437: struct object ob;
1438: int c,l,m,n;
1439: int cc,ll,mm,nn;
1440: int p;
1441: char **xvars;
1442: char **dvars;
1443: int *outputVars;
1444: int *order;
1445: static int rp = 0;
1446: static struct ring *rstack[RP_LIMIT];
1447:
1448: extern struct ring *CurrentRingp;
1449: struct ring *newRingp;
1450: int ob3Size;
1451: struct ring *nextRing;
1452: int oasize;
1453: static int ringSerial = 0;
1454: char *ringName = NULL;
1455: int aa;
1456: extern int AvoidTheSameRing;
1457: extern char *F_mpMult;
1458: char *fmp_mult_saved;
1459: char *mpMultName = NULL;
1460: struct object rob;
1461: struct ring *savedCurrentRingp;
1462:
1463: /* To get the ring structure. */
1464: if (ob1.tag == Snull) {
1465: rob = newObjectArray(rp);
1466: for (i=0; i<rp; i++) {
1467: putoa(rob,i,KpoRingp(rstack[i]));
1468: }
1469: KSpush(rob);
1470: return(0);
1471: }
1472:
1473: if (ob3.tag != Sarray) errorKan1("%s\n","Error in the 3rd argument. You need to give 4 arguments.");
1474: ob3Size = getoaSize(ob3);
1475: if (ob3Size != 9 && ob3Size != 10)
1476: errorKan1("%s\n","Error in the 3rd argument.");
1477: for (i=0; i<9; i++) {
1478: ob = getoa(ob3,i);
1479: if (ob.tag != Sinteger) errorKan1("%s\n","The 3rd argument should be a list of integers.");
1480: }
1481: if (ob3Size == 10) {
1482: ob = getoa(ob3,9);
1483: if (ob.tag != Sring)
1484: errorKan1("%s\n","The last arguments of the 3rd argument must be a pointer to a ring.");
1485: nextRing = KopRingp(ob);
1486: } else {
1487: nextRing = (struct ring *)NULL;
1488: }
1489:
1490: p = getoa(ob3,0).lc.ival;
1491: c = getoa(ob3,1).lc.ival; l = getoa(ob3,2).lc.ival;
1492: m = getoa(ob3,3).lc.ival; n = getoa(ob3,4).lc.ival;
1493: cc = getoa(ob3,5).lc.ival; ll = getoa(ob3,6).lc.ival;
1494: mm = getoa(ob3,7).lc.ival; nn = getoa(ob3,8).lc.ival;
1495: if (checkRelations(c,l,m,n,cc,ll,mm,nn,n)) {
1496: 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.");
1497: }
1498: if (getoaSize(ob2) != n || getoaSize(ob1) != n) {
1499: errorKan1("%s\n","Error in the 1st or 2nd arguments.");
1500: }
1501: for (i=0; i<n; i++) {
1502: if (getoa(ob1,i).tag != Sdollar || getoa(ob2,i).tag != Sdollar) {
1503: errorKan1("%s\n","Error in the 1st or 2nd arguments.");
1504: }
1505: }
1506: xvars = (char **) sGC_malloc(sizeof(char *)*n);
1507: dvars = (char **) sGC_malloc(sizeof(char *)*n);
1508: if (xvars == (char **)NULL || dvars == (char **)NULL) {
1509: fprintf(stderr,"No more memory.\n");
1510: exit(15);
1511: }
1512: for (i=0; i<n; i++) {
1513: xvars[i] = getoa(ob1,i).lc.str;
1514: dvars[i] = getoa(ob2,i).lc.str;
1515: }
1516: checkDuplicateName(xvars,dvars,n);
1517:
1518: outputVars = (int *)sGC_malloc(sizeof(int)*n*2);
1519: if (outputVars == NULL) {
1520: fprintf(stderr,"No more memory.\n");
1521: exit(15);
1522: }
1523: if (ReverseOutputOrder) {
1524: for (i=0; i<n; i++) outputVars[i] = n-i-1;
1525: for (i=0; i<n; i++) outputVars[n+i] = 2*n-i-1;
1526: }else{
1527: for (i=0; i<2*n; i++) {
1528: outputVars[i] = i;
1529: }
1530: }
1531:
1532: oasize = getoaSize(ob4);
1533: order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
1534: if (order == (int *)NULL) errorKan1("%s\n","No memory.");
1535: if (objArrayToOrderMatrix(ob4,order,n,oasize) == -1) {
1536: errorKan1("%s\n","Errors in the 4th matrix (order matrix).");
1537: }
1538: /* It's better to check the consistency of the order matrix here. */
1539: savedCurrentRingp = CurrentRingp;
1540:
1541: newRingp = (struct ring *)sGC_malloc(sizeof(struct ring));
1542: if (newRingp == NULL) errorKan1("%s\n","No more memory.");
1543: /* Generate the new ring before calling setOrder...(). */
1544: *newRingp = *CurrentRingp;
1545: CurrentRingp = newRingp; /* Push the current ring. */
1546: setOrderByMatrix(order,n,c,l,oasize); /* set order to the CurrentRing. */
1547: CurrentRingp = savedCurrentRingp; /* recover it. */
1548:
1549:
1550: /* Set the default name of the ring */
1551: ringName = (char *)sGC_malloc(16);
1552: sprintf(ringName,"ring%05d",ringSerial);
1553: ringSerial++;
1554:
1555: /* Set the current ring */
1556: newRingp->n = n; newRingp->m = m; newRingp->l = l; newRingp->c = c;
1557: newRingp->nn = nn; newRingp->mm = mm; newRingp->ll = ll;
1558: newRingp->cc = cc;
1559: newRingp->x = xvars;
1560: newRingp->D = dvars;
1561: /* You don't need to set order and orderMatrixSize here.
1562: It was set by setOrder(). */
1563: setFromTo(newRingp);
1564:
1565: newRingp->p = p;
1566: newRingp->next = nextRing;
1567: newRingp->multiplication = mpMult;
1568: /* These values should will be reset if the optional value is given. */
1569: newRingp->schreyer = 0;
1570: newRingp->gbListTower = NULL;
1571: newRingp->outputOrder = outputVars;
1.9 takayama 1572: newRingp->weightedHomogenization = 0;
1.11 takayama 1573: newRingp->degreeShiftSize = 0;
1.12 takayama 1574: newRingp->degreeShiftN = 0;
1575: newRingp->degreeShift = NULL;
1.1 maekawa 1576:
1577: if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {
1578: errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");
1579: }
1580: for (i=0; i < getoaSize(ob5); i += 2) {
1581: if (getoa(ob5,i).tag == Sdollar) {
1582: if (strcmp(KopString(getoa(ob5,i)),"mpMult") == 0) {
1.7 takayama 1583: if (getoa(ob5,i+1).tag != Sdollar) {
1584: errorKan1("%s\n","A keyword should be given. (mpMult)");
1585: }
1586: fmp_mult_saved = F_mpMult;
1587: mpMultName = KopString(getoa(ob5,i+1));
1588: switch_function("mpMult",mpMultName);
1589: /* Note that this cause a global effect. It will be done again. */
1590: newRingp->multiplication = mpMult;
1591: switch_function("mpMult",fmp_mult_saved);
1.1 maekawa 1592: } else if (strcmp(KopString(getoa(ob5,i)),"coefficient ring") == 0) {
1.7 takayama 1593: if (getoa(ob5,i+1).tag != Sring) {
1594: errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)");
1595: }
1596: nextRing = KopRingp(getoa(ob5,i+1));
1597: newRingp->next = nextRing;
1.1 maekawa 1598: } else if (strcmp(KopString(getoa(ob5,i)),"valuation") == 0) {
1.7 takayama 1599: errorKan1("%s\n","Not implemented. (valuation)");
1.1 maekawa 1600: } else if (strcmp(KopString(getoa(ob5,i)),"characteristic") == 0) {
1.7 takayama 1601: if (getoa(ob5,i+1).tag != Sinteger) {
1602: errorKan1("%s\n","A integer should be given. (characteristic)");
1603: }
1604: p = KopInteger(getoa(ob5,i+1));
1605: newRingp->p = p;
1.1 maekawa 1606: } else if (strcmp(KopString(getoa(ob5,i)),"schreyer") == 0) {
1.7 takayama 1607: if (getoa(ob5,i+1).tag != Sinteger) {
1608: errorKan1("%s\n","A integer should be given. (schreyer)");
1609: }
1610: newRingp->schreyer = KopInteger(getoa(ob5,i+1));
1.1 maekawa 1611: } else if (strcmp(KopString(getoa(ob5,i)),"gbListTower") == 0) {
1.7 takayama 1612: if (getoa(ob5,i+1).tag != Slist) {
1613: errorKan1("%s\n","A list should be given (gbListTower).");
1614: }
1615: newRingp->gbListTower = newObject();
1616: *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1);
1.1 maekawa 1617: } else if (strcmp(KopString(getoa(ob5,i)),"ringName") == 0) {
1.7 takayama 1618: if (getoa(ob5,i+1).tag != Sdollar) {
1619: errorKan1("%s\n","A name should be given. (ringName)");
1620: }
1621: ringName = KopString(getoa(ob5,i+1));
1.9 takayama 1622: } else if (strcmp(KopString(getoa(ob5,i)),"weightedHomogenization") == 0) {
1623: if (getoa(ob5,i+1).tag != Sinteger) {
1624: errorKan1("%s\n","A integer should be given. (weightedHomogenization)");
1625: }
1.11 takayama 1626: newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1));
1627: } else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) {
1628: if (getoa(ob5,i+1).tag != Sarray) {
1.12 takayama 1629: errorKan1("%s\n","An array of array should be given. (degreeShift)");
1.11 takayama 1630: }
1631: {
1632: struct object ods;
1.12 takayama 1633: struct object ods2;
1634: int dssize,k,j,nn;
1.11 takayama 1635: ods=getoa(ob5,i+1);
1.12 takayama 1636: if ((getoaSize(ods) < 1) || (getoa(ods,0).tag != Sarray)) {
1637: errorKan1("%s\n", "An array of array should be given. (degreeShift)");
1638: }
1639: nn = getoaSize(ods);
1640: dssize = getoaSize(getoa(ods,0));
1.11 takayama 1641: newRingp->degreeShiftSize = dssize;
1.12 takayama 1642: newRingp->degreeShiftN = nn;
1643: newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize*nn+1));
1.11 takayama 1644: if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory.");
1.12 takayama 1645: for (j=0; j<nn; j++) {
1646: ods2 = getoa(ods,j);
1647: for (k=0; k<dssize; k++) {
1648: if (getoa(ods2,k).tag == SuniversalNumber) {
1649: (newRingp->degreeShift)[j*dssize+k] = coeffToInt(getoa(ods2,k).lc.universalNumber);
1650: }else{
1651: (newRingp->degreeShift)[j*dssize+k] = KopInteger(getoa(ods2,k));
1652: }
1.11 takayama 1653: }
1654: }
1655: }
1.22 ! takayama 1656: switch_function("grade","module1v");
! 1657: /* Warning: grading is changed to module1v!! */
1.1 maekawa 1658: } else {
1.7 takayama 1659: errorKan1("%s\n","Unknown keyword to set_up_ring@");
1.1 maekawa 1660: }
1661: }else{
1662: errorKan1("%s\n","A keyword enclosed by braces have to be given.");
1663: }
1664: }
1665:
1666: newRingp->name = ringName;
1667:
1668:
1669: if (AvoidTheSameRing) {
1670: aa = isTheSameRing(rstack,rp,newRingp);
1671: if (aa < 0) {
1672: /* This ring has never been defined. */
1673: CurrentRingp = newRingp;
1674: /* Install it to the RingStack */
1675: if (rp <RP_LIMIT) {
1.7 takayama 1676: rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
1.1 maekawa 1677: }else{
1.7 takayama 1678: rp = 0;
1679: errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
1.1 maekawa 1680: }
1681: }else{
1682: /* This ring has been defined. */
1683: /* Discard the newRingp */
1684: CurrentRingp = rstack[aa];
1685: ringSerial--;
1686: }
1687: }else{
1688: CurrentRingp = newRingp;
1689: /* Install it to the RingStack */
1690: if (rp <RP_LIMIT) {
1691: rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
1692: }else{
1693: rp = 0;
1694: errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
1695: }
1696: }
1697: if (mpMultName != NULL) {
1698: switch_function("mpMult",mpMultName);
1699: }
1700:
1701: initSyzRingp();
1702:
1703: return(0);
1704: }
1705:
1706:
1707: struct object KsetVariableNames(struct object ob,struct ring *rp)
1708: {
1709: int n,i;
1710: struct object ox;
1711: struct object otmp;
1712: char **xvars;
1713: char **dvars;
1714: if (ob.tag != Sarray) {
1715: errorKan1("%s\n","KsetVariableNames(): the argument must be of the form [(x) (y) (z) ...]");
1716: }
1717: n = rp->n;
1718: ox = ob;
1719: if (getoaSize(ox) != 2*n) {
1720: 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.");
1721: }
1722: xvars = (char **)sGC_malloc(sizeof(char *)*n);
1723: dvars = (char **)sGC_malloc(sizeof(char *)*n);
1724: if (xvars == NULL || dvars == NULL) {
1725: errorKan1("%s\n","KsetVariableNames(): no more memory.");
1726: }
1727: for (i=0; i<2*n; i++) {
1728: otmp = getoa(ox,i);
1729: if(otmp.tag != Sdollar) {
1730: errorKan1("%s\n","KsetVariableNames(): elements must be strings.");
1731: }
1732: if (i < n) {
1733: xvars[i] = KopString(otmp);
1734: }else{
1735: dvars[i-n] = KopString(otmp);
1736: }
1737: }
1738: checkDuplicateName(xvars,dvars,n);
1739: rp->x = xvars;
1740: rp->D = dvars;
1741: return(ob);
1742: }
1743:
1744:
1745:
1746: void KshowRing(ringp)
1.7 takayama 1747: struct ring *ringp;
1.1 maekawa 1748: {
1749: showRing(1,ringp);
1750: }
1751:
1752: struct object KswitchFunction(ob1,ob2)
1.7 takayama 1753: struct object ob1,ob2;
1.1 maekawa 1754: {
1755: char *ans ;
1756: struct object rob;
1757: int needWarningForAvoidTheSameRing = 0;
1758: extern int AvoidTheSameRing;
1759: if ((ob1.tag != Sdollar) || (ob2.tag != Sdollar)) {
1760: errorKan1("%s\n","$function$ $name$ switch_function\n");
1761: }
1762: if (AvoidTheSameRing && needWarningForAvoidTheSameRing) {
1763: if (strcmp(KopString(ob1),"mmLarger") == 0 ||
1764: strcmp(KopString(ob1),"mpMult") == 0 ||
1765: strcmp(KopString(ob1),"monomialAdd") == 0 ||
1766: strcmp(KopString(ob1),"isSameComponent") == 0) {
1767: fprintf(stderr,",switch_function ==> %s ",KopString(ob1));
1768: warningKan("switch_function might cause a trouble under AvoidTheSameRing == 1.\n");
1769: }
1770: }
1771: if (AvoidTheSameRing) {
1772: if (strcmp(KopString(ob1),"mmLarger") == 0 &&
1.7 takayama 1773: strcmp(KopString(ob2),"matrix") != 0) {
1.1 maekawa 1774: fprintf(stderr,"mmLarger = %s",KopString(ob2));
1775: errorKan1("%s\n","mmLarger can set only to matrix under AvoidTheSameRing == 1.");
1776: }
1777: }
1778:
1779: ans = switch_function(ob1.lc.str,ob2.lc.str);
1780: if (ans == NULL) {
1781: rob = NullObject;
1782: }else{
1783: rob = KpoString(ans);
1784: }
1785: return(rob);
1786:
1787: }
1788:
1789: void KprintSwitchStatus(void)
1790: {
1791: print_switch_status();
1792: }
1793:
1794: struct object KoReplace(of,rule)
1.7 takayama 1795: struct object of;
1796: struct object rule;
1.1 maekawa 1797: {
1798: struct object rob;
1799: POLY f;
1800: POLY lRule[N0*2];
1801: POLY rRule[N0*2];
1802: POLY r;
1803: int i;
1804: int n;
1805: struct object trule;
1806:
1807:
1808: if (rule.tag != Sarray) {
1809: errorKan1("%s\n"," KoReplace(): The second argument must be array.");
1810: }
1811: n = getoaSize(rule);
1812:
1.6 takayama 1813: if (of.tag == Spoly) {
1814: }else if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
1.7 takayama 1815: return(KreplaceRecursivePolynomial(of,rule));
1.6 takayama 1816: }else{
1.1 maekawa 1817: errorKan1("%s\n"," KoReplace(): The first argument must be a polynomial.");
1818: }
1819: f = KopPOLY(of);
1820:
1821: if (f ISZERO) {
1822: }else{
1823: if (n >= 2*(f->m->ringp->n)) {
1824: errorKan1("%s\n"," KoReplace(): too many rules for replacement. ");
1825: }
1826: }
1827:
1828: for (i=0; i<n; i++) {
1829: trule = getoa(rule,i);
1830: if (trule.tag != Sarray) {
1831: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....].");
1832: }
1833: if (getoaSize(trule) != 2) {
1834: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....].");
1835: }
1836:
1837: if (getoa(trule,0).tag != Spoly) {
1838: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1839: }
1840: if (getoa(trule,1).tag != Spoly) {
1841: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1842: }
1843:
1844: lRule[i] = KopPOLY(getoa(trule,0));
1845: rRule[i] = KopPOLY(getoa(trule,1));
1846: }
1847:
1848: r = replace(f,lRule,rRule,n);
1849: rob.tag = Spoly; rob.lc.poly = r;
1850:
1851: return(rob);
1852: }
1853:
1854:
1855: struct object Kparts(f,v)
1.7 takayama 1856: struct object f;
1857: struct object v;
1.1 maekawa 1858: {
1859: POLY ff;
1860: POLY vv;
1861: struct object obj;
1862: struct matrixOfPOLY *co;
1863: /* check the data type */
1864: if (f.tag != Spoly || v.tag != Spoly)
1865: errorKan1("%s\n","arguments of Kparts() must have polynomial as arguments.");
1866:
1867: co = parts(KopPOLY(f),KopPOLY(v));
1868: obj = matrixOfPOLYToArray(co);
1869: return(obj);
1870: }
1871:
1872: struct object Kparts2(f,v)
1.7 takayama 1873: struct object f;
1874: struct object v;
1.1 maekawa 1875: {
1876: POLY ff;
1877: POLY vv;
1878: struct object obj;
1879: struct matrixOfPOLY *co;
1880: /* check the data type */
1881: if (f.tag != Spoly || v.tag != Spoly)
1882: errorKan1("%s\n","arguments of Kparts2() must have polynomial as arguments.");
1883:
1884: obj = parts2(KopPOLY(f),KopPOLY(v));
1885: return(obj);
1886: }
1887:
1888:
1889: struct object Kdegree(ob1,ob2)
1.7 takayama 1890: struct object ob1,ob2;
1.1 maekawa 1891: {
1892: if (ob1.tag != Spoly || ob2.tag != Spoly)
1893: errorKan1("%s\n","The arguments must be polynomials.");
1894:
1895: return(KpoInteger(pDegreeWrtV(KopPOLY(ob1),KopPOLY(ob2))));
1896: }
1897:
1898: struct object KringMap(obj)
1.7 takayama 1899: struct object obj;
1.1 maekawa 1900: {
1901: extern struct ring *CurrentRingp;
1902: extern struct ring *SyzRingp;
1903: POLY f;
1904: POLY r;
1905: if (obj.tag != Spoly)
1906: errorKan1("%s\n","The argments must be polynomial.");
1907: f = KopPOLY(obj);
1908: if (f ISZERO) return(obj);
1909: if (f->m->ringp == CurrentRingp) return(obj);
1910: if (f->m->ringp == CurrentRingp->next) {
1911: r = newCell(newCoeff(),newMonomial(CurrentRingp));
1912: r->coeffp->tag = POLY_COEFF;
1913: r->coeffp->val.f = f;
1914: return(KpoPOLY(r));
1915: }else if (f->m->ringp == SyzRingp) {
1916: return(KpoPOLY(f->coeffp->val.f));
1917: }
1918: errorKan1("%s\n","The ring map is not defined in this case.");
1919: }
1920:
1921:
1922: struct object Ksp(ob1,ob2)
1.7 takayama 1923: struct object ob1,ob2;
1.1 maekawa 1924: {
1925: struct spValue sv;
1926: struct object rob,cob;
1927: POLY f;
1928: if (ob1.tag != Spoly || ob2.tag != Spoly)
1929: errorKan1("%s\n","Ksp(): The arguments must be polynomials.");
1930: sv = (*sp)(ob1.lc.poly,ob2.lc.poly);
1931: f = ppAddv(ppMult(sv.a,KopPOLY(ob1)),
1.7 takayama 1932: ppMult(sv.b,KopPOLY(ob2)));
1.1 maekawa 1933: rob = newObjectArray(2);
1934: cob = newObjectArray(2);
1935: putoa(rob,1,KpoPOLY(f));
1936: putoa(cob,0,KpoPOLY(sv.a));
1937: putoa(cob,1,KpoPOLY(sv.b));
1938: putoa(rob,0,cob);
1939: return(rob);
1940: }
1941:
1942: struct object Khead(ob)
1.7 takayama 1943: struct object ob;
1.1 maekawa 1944: {
1945: if (ob.tag != Spoly) errorKan1("%s\n","Khead(): The argument should be a polynomial.");
1946: return(KpoPOLY(head( KopPOLY(ob))));
1947: }
1948:
1949:
1950: /* :eval */
1951: struct object Keval(obj)
1.7 takayama 1952: struct object obj;
1.1 maekawa 1953: {
1954: char *key;
1955: int size;
1956: struct object rob;
1957: rob = NullObject;
1958:
1959: if (obj.tag != Sarray)
1960: errorKan1("%s\n","[$key$ arguments] eval");
1961: if (getoaSize(obj) < 1)
1962: errorKan1("%s\n","[$key$ arguments] eval");
1963: if (getoa(obj,0).tag != Sdollar)
1964: errorKan1("%s\n","[$key$ arguments] eval");
1965: key = getoa(obj,0).lc.str;
1966: size = getoaSize(obj);
1967:
1968:
1969: return(rob);
1970: }
1971:
1972: /* :Utilities */
1973: char *KremoveSpace(str)
1.7 takayama 1974: char str[];
1.1 maekawa 1975: {
1976: int size;
1977: int start;
1978: int end;
1979: char *s;
1980: int i;
1981:
1982: size = strlen(str);
1983: for (start = 0; start <= size; start++) {
1984: if (str[start] > ' ') break;
1985: }
1986: for (end = size-1; end >= 0; end--) {
1987: if (str[end] > ' ') break;
1988: }
1989: if (start > end) return((char *) NULL);
1990: s = (char *) sGC_malloc(sizeof(char)*(end-start+2));
1991: if (s == (char *)NULL) errorKan1("%s\n","removeSpace(): No more memory.");
1992: for (i=0; i< end-start+1; i++)
1993: s[i] = str[i+start];
1994: s[end-start+1] = '\0';
1995: return(s);
1996: }
1997:
1998: struct object KtoRecords(ob)
1.7 takayama 1999: struct object ob;
1.1 maekawa 2000: {
2001: struct object obj;
2002: struct object tmp;
2003: int i;
2004: int size;
2005: char **argv;
2006:
2007: obj = NullObject;
2008: switch(ob.tag) {
2009: case Sdollar: break;
2010: default:
2011: errorKan1("%s","Argument of KtoRecords() must be a string enclosed by dollars.\n");
2012: break;
2013: }
2014: size = strlen(ob.lc.str)+3;
2015: argv = (char **) sGC_malloc((size+1)*sizeof(char *));
2016: if (argv == (char **)NULL)
2017: errorKan1("%s","No more memory.\n");
2018: size = KtoArgvbyCurryBrace(ob.lc.str,argv,size);
2019: if (size < 0)
2020: errorKan1("%s"," KtoRecords(): You have an error in the argument.\n");
2021:
2022: obj = newObjectArray(size);
2023: for (i=0; i<size; i++) {
2024: tmp.tag = Sdollar;
2025: tmp.lc.str = argv[i];
2026: (obj.rc.op)[i] = tmp;
2027: }
2028: return(obj);
2029: }
2030:
2031: int KtoArgvbyCurryBrace(str,argv,limit)
1.7 takayama 2032: char *str;
2033: char *argv[];
2034: int limit;
2035: /* This function returns argc */
2036: /* decompose into tokens by the separators
1.1 maekawa 2037: { }, [ ], and characters of which code is less than SPACE.
2038: Example. { } ---> nothing (argc=0)
2039: {x}----> x (argc=1)
2040: {x,y} --> x y (argc=2)
1.7 takayama 2041: {ab, y, z } --> ab y z (argc=3)
1.1 maekawa 2042: [[ab],c,d] --> [ab] c d
2043: */
2044: {
2045: int argc;
2046: int n;
2047: int i;
2048: int k;
2049: char *a;
2050: char *ident;
2051: int level = 0;
2052: int comma;
2053:
2054: if (str == (char *)NULL) {
2055: fprintf(stderr,"You use NULL string to toArgvbyCurryBrace()\n");
2056: return(0);
2057: }
2058:
2059: n = strlen(str);
2060: a = (char *) sGC_malloc(sizeof(char)*(n+3));
2061: a[0]=' ';
2062: strcpy(&(a[1]),str);
2063: n = strlen(a); a[0] = '\0';
2064: comma = -1;
2065: for (i=1; i<n; i++) {
2066: if (a[i] == '{' || a[i] == '[') level++;
2067: if (level <= 1 && ( a[i] == ',')) {a[i] = '\0'; ++comma;}
2068: if (level <= 1 && (a[i]=='{' || a[i]=='}' || a[i]=='[' || a[i]==']'))
2069: a[i] = '\0';
2070: if (a[i] == '}' || a[i] == ']') level--;
2071: if ((level <= 1) && (comma == -1) && ( a[i] > ' ')) comma = 0;
2072: }
2073:
2074: if (comma == -1) return(0);
2075:
2076: argc=0;
2077: for (i=0; i<n; i++) {
2078: if ((a[i] == '\0') && (a[i+1] != '\0')) ++argc;
2079: }
2080: if (argc > limit) return(-argc);
2081:
2082: k = 0;
2083: for (i=0; i<n; i++) {
2084: if ((a[i] == '\0') && (a[i+1] != '\0')) {
2085: ident = (char *) sGC_malloc(sizeof(char)*( strlen(&(a[i+1])) + 3));
2086: strcpy(ident,&(a[i+1]));
2087: argv[k] = KremoveSpace(ident);
2088: if (argv[k] != (char *)NULL) k++;
2089: if (k >= limit) errorKan1("%s\n","KtoArgvbyCurryBraces(): k>=limit.");
2090: }
2091: }
2092: argc = k;
2093: /*for (i=0; i<argc; i++) fprintf(stderr,"%d %s\n",i,argv[i]);*/
2094: return(argc);
2095: }
2096:
1.14 takayama 2097: struct object KstringToArgv(struct object ob) {
2098: struct object rob;
2099: char *s;
2100: int n,wc,i,inblank;
2101: char **argv;
2102: if (ob.tag != Sdollar)
1.22 ! takayama 2103: errorKan1("%s\n","KstringToArgv(): the argument must be a string.");
1.14 takayama 2104: n = strlen(KopString(ob));
2105: s = (char *) sGC_malloc(sizeof(char)*(n+2));
2106: if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory.");
2107: strcpy(s,KopString(ob));
2108: inblank = 1; wc = 0;
2109: for (i=0; i<n; i++) {
1.22 ! takayama 2110: if (inblank && (s[i] > ' ')) {
! 2111: wc++; inblank = 0;
! 2112: }else if ((!inblank) && (s[i] <= ' ')) {
! 2113: inblank = 1;
! 2114: }
1.14 takayama 2115: }
2116: argv = (char **) sGC_malloc(sizeof(char *)*(wc+2));
2117: argv[0] = NULL;
2118: inblank = 1; wc = 0;
2119: for (i=0; i<n; i++) {
1.22 ! takayama 2120: if (inblank && (s[i] > ' ')) {
! 2121: argv[wc] = &(s[i]); argv[wc+1]=NULL;
! 2122: wc++; inblank = 0;
! 2123: }else if ((inblank == 0) && (s[i] <= ' ')) {
! 2124: inblank = 1; s[i] = 0;
! 2125: }else if (inblank && (s[i] <= ' ')) {
! 2126: s[i] = 0;
! 2127: }
1.14 takayama 2128: }
2129:
2130: rob = newObjectArray(wc);
2131: for (i=0; i<wc; i++) {
1.22 ! takayama 2132: putoa(rob,i,KpoString(argv[i]));
! 2133: /* printf("%s\n",argv[i]); */
1.14 takayama 2134: }
2135: return(rob);
2136: }
1.1 maekawa 2137:
2138: static void checkDuplicateName(xvars,dvars,n)
1.7 takayama 2139: char *xvars[];
2140: char *dvars[];
2141: int n;
1.1 maekawa 2142: {
2143: int i,j;
2144: char *names[N0*2];
2145: for (i=0; i<n; i++) {
2146: names[i] = xvars[i]; names[i+n] = dvars[i];
2147: }
2148: n = 2*n;
2149: for (i=0; i<n; i++) {
2150: for (j=i+1; j<n; j++) {
2151: if (strcmp(names[i],names[j]) == 0) {
1.7 takayama 2152: fprintf(stderr,"\n%d=%s, %d=%s\n",i,names[i],j,names[j]);
2153: errorKan1("%s\n","Duplicate definition of the name above in SetUpRing().");
1.1 maekawa 2154: }
2155: }
2156: }
2157: }
2158:
1.20 takayama 2159: struct object KooPower(struct object ob1,struct object ob2) {
2160: struct object rob;
2161: /* Bug. It has not yet been implemented. */
2162: if (QuoteMode) {
1.22 ! takayama 2163: rob = powerTree(ob1,ob2);
1.20 takayama 2164: }else{
1.22 ! takayama 2165: warningKan("KooDiv2() has not supported yet these objects.\n");
1.20 takayama 2166: }
2167: return(rob);
2168: }
1.1 maekawa 2169:
2170:
2171:
2172: struct object KooDiv2(ob1,ob2)
1.7 takayama 2173: struct object ob1,ob2;
1.1 maekawa 2174: {
2175: struct object rob = NullObject;
2176: POLY f;
2177: extern struct ring *CurrentRingp;
2178: int s,i;
2179: double d;
2180:
2181: switch (Lookup[ob1.tag][ob2.tag]) {
2182: case SpolySpoly:
2183: case SuniversalNumberSuniversalNumber:
2184: case SuniversalNumberSpoly:
2185: case SpolySuniversalNumber:
2186: rob = KnewRationalFunction0(copyObjectp(&ob1),copyObjectp(&ob2));
2187: KisInvalidRational(&rob);
2188: return(rob);
2189: break;
2190: case SarraySpoly:
2191: case SarraySuniversalNumber:
2192: case SarraySrationalFunction:
2193: s = getoaSize(ob1);
2194: rob = newObjectArray(s);
2195: for (i=0; i<s; i++) {
2196: putoa(rob,i,KooDiv2(getoa(ob1,i),ob2));
2197: }
2198: return(rob);
2199: break;
2200: case SpolySrationalFunction:
2201: case SrationalFunctionSpoly:
2202: case SrationalFunctionSrationalFunction:
2203: case SuniversalNumberSrationalFunction:
2204: case SrationalFunctionSuniversalNumber:
2205: rob = KoInverse(ob2);
2206: rob = KooMult(ob1,rob);
2207: return(rob);
2208: break;
2209:
2210: case SdoubleSdouble:
2211: d = KopDouble(ob2);
2212: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2213: return(KpoDouble( KopDouble(ob1) / d ));
2214: break;
2215: case SdoubleSinteger:
2216: case SdoubleSuniversalNumber:
2217: case SdoubleSrationalFunction:
2218: d = toDouble0(ob2);
2219: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2220: return(KpoDouble( KopDouble(ob1) / d) );
2221: break;
2222: case SintegerSdouble:
2223: case SuniversalNumberSdouble:
2224: case SrationalFunctionSdouble:
2225: d = KopDouble(ob2);
2226: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2227: return(KpoDouble( toDouble0(ob1) / d ) );
2228: break;
2229:
2230: default:
1.20 takayama 2231: if (QuoteMode) {
2232: rob = divideTree(ob1,ob2);
2233: }else{
2234: warningKan("KooDiv2() has not supported yet these objects.\n");
2235: }
1.1 maekawa 2236: break;
2237: }
2238: return(rob);
2239: }
2240: /* Template
2241: case SrationalFunctionSrationalFunction:
2242: warningKan("Koo() has not supported yet these objects.\n");
2243: return(rob);
2244: break;
2245: case SpolySrationalFunction:
2246: warningKan("Koo() has not supported yet these objects.\n");
2247: return(rob);
2248: break;
2249: case SrationalFunctionSpoly:
2250: warningKan("Koo() has not supported yet these objects.\n");
2251: return(rob);
2252: break;
2253: case SuniversalNumberSrationalFunction:
2254: warningKan("Koo() has not supported yet these objects.\n");
2255: return(rob);
2256: break;
2257: case SrationalFunctionSuniversalNumber:
2258: warningKan("Koo() has not supported yet these objects.\n");
2259: return(rob);
2260: break;
2261: */
2262:
2263: int KisInvalidRational(op)
1.7 takayama 2264: objectp op;
1.1 maekawa 2265: {
2266: extern struct coeff *UniversalZero;
2267: if (op->tag != SrationalFunction) return(0);
2268: if (KisZeroObject(Kdenominator(*op))) {
2269: errorKan1("%s\n","KisInvalidRational(): zero division. You have f/0.");
2270: }
2271: if (KisZeroObject(Knumerator(*op))) {
2272: op->tag = SuniversalNumber;
2273: op->lc.universalNumber = UniversalZero;
2274: }
2275: return(0);
2276: }
2277:
2278: struct object KgbExtension(struct object obj)
2279: {
2280: char *key;
2281: int size;
2282: struct object keyo;
2283: struct object rob = NullObject;
2284: struct object obj1,obj2,obj3;
2285: POLY f1;
2286: POLY f2;
2287: POLY f3;
2288: POLY f;
2289: int m,i;
2290: struct pairOfPOLY pf;
1.16 takayama 2291: struct coeff *cont;
1.1 maekawa 2292:
2293: if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array.");
2294: size = getoaSize(obj);
2295: if (size < 1) errorKan1("%s\n","KgbExtension(): Empty array.");
2296: keyo = getoa(obj,0);
2297: if (keyo.tag != Sdollar) errorKan1("%s\n","KgbExtension(): No key word.");
2298: key = KopString(keyo);
2299:
2300: /* branch by the key word. */
2301: if (strcmp(key,"isReducible")==0) {
2302: if (size != 3) errorKan1("%s\n","[(isReducible) poly1 poly2] gbext.");
2303: obj1 = getoa(obj,1);
2304: obj2 = getoa(obj,2);
2305: if (obj1.tag != Spoly || obj2.tag != Spoly)
2306: errorKan1("%s\n","[(isReducible) poly1 poly2] gb.");
2307: f1 = KopPOLY(obj1);
2308: f2 = KopPOLY(obj2);
2309: rob = KpoInteger((*isReducible)(f1,f2));
2310: }else if (strcmp(key,"lcm") == 0) {
2311: if (size != 3) errorKan1("%s\n","[(lcm) poly1 poly2] gb.");
2312: obj1 = getoa(obj,1);
2313: obj2 = getoa(obj,2);
2314: if (obj1.tag != Spoly || obj2.tag != Spoly)
2315: errorKan1("%s\n","[(lcm) poly1 poly2] gbext.");
2316: f1 = KopPOLY(obj1);
2317: f2 = KopPOLY(obj2);
2318: rob = KpoPOLY((*lcm)(f1,f2));
2319: }else if (strcmp(key,"grade")==0) {
2320: if (size != 2) errorKan1("%s\n","[(grade) poly1 ] gbext.");
2321: obj1 = getoa(obj,1);
2322: if (obj1.tag != Spoly)
2323: errorKan1("%s\n","[(grade) poly1 ] gbext.");
2324: f1 = KopPOLY(obj1);
2325: rob = KpoInteger((*grade)(f1));
2326: }else if (strcmp(key,"mod")==0) {
2327: if (size != 3) errorKan1("%s\n","[(mod) poly num] gbext");
2328: obj1 = getoa(obj,1);
2329: obj2 = getoa(obj,2);
2330: if (obj1.tag != Spoly || obj2.tag != SuniversalNumber) {
2331: errorKan1("%s\n","The datatype of the argument mismatch: [(mod) polynomial universalNumber] gbext");
2332: }
2333: rob = KpoPOLY( modulopZ(KopPOLY(obj1),KopUniversalNumber(obj2)) );
2334: }else if (strcmp(key,"tomodp")==0) {
2335: /* The ring must be a ring of characteristic p. */
2336: if (size != 3) errorKan1("%s\n","[(tomod) poly ring] gbext");
2337: obj1 = getoa(obj,1);
2338: obj2 = getoa(obj,2);
2339: if (obj1.tag != Spoly || obj2.tag != Sring) {
2340: errorKan1("%s\n","The datatype of the argument mismatch: [(tomod) polynomial ring] gbext");
2341: }
2342: rob = KpoPOLY( modulop(KopPOLY(obj1),KopRingp(obj2)) );
2343: }else if (strcmp(key,"tomod0")==0) {
2344: /* Ring must be a ring of characteristic 0. */
2345: if (size != 3) errorKan1("%s\n","[(tomod0) poly ring] gbext");
2346: obj1 = getoa(obj,1);
2347: obj2 = getoa(obj,2);
2348: if (obj1.tag != Spoly || obj2.tag != Sring) {
2349: errorKan1("%s\n","The datatype of the argument mismatch: [(tomod0) polynomial ring] gbext");
2350: }
2351: errorKan1("%s\n","It has not been implemented.");
2352: rob = KpoPOLY( POLYNULL );
2353: }else if (strcmp(key,"divByN")==0) {
2354: if (size != 3) errorKan1("%s\n","[(divByN) poly num] gbext");
2355: obj1 = getoa(obj,1);
2356: obj2 = getoa(obj,2);
2357: if (obj1.tag != Spoly || obj2.tag != SuniversalNumber) {
2358: errorKan1("%s\n","The datatype of the argument mismatch: [(divByN) polynomial universalNumber] gbext");
2359: }
2360: pf = quotientByNumber(KopPOLY(obj1),KopUniversalNumber(obj2));
2361: rob = newObjectArray(2);
2362: putoa(rob,0,KpoPOLY(pf.first));
2363: putoa(rob,1,KpoPOLY(pf.second));
2364: }else if (strcmp(key,"isConstant")==0) {
2365: if (size != 2) errorKan1("%s\n","[(isConstant) poly ] gbext bool");
2366: obj1 = getoa(obj,1);
2367: if (obj1.tag != Spoly) {
2368: errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext");
2369: }
2370: return(KpoInteger(isConstant(KopPOLY(obj1))));
1.18 takayama 2371: }else if (strcmp(key,"isConstantAll")==0) {
2372: if (size != 2) errorKan1("%s\n","[(isConstantAll) poly ] gbext bool");
2373: obj1 = getoa(obj,1);
2374: if (obj1.tag != Spoly) {
2375: errorKan1("%s\n","The datatype of the argument mismatch: [(isConstantAll) polynomial] gbext");
2376: }
2377: return(KpoInteger(isConstantAll(KopPOLY(obj1))));
1.1 maekawa 2378: }else if (strcmp(key,"schreyerSkelton") == 0) {
2379: if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array");
2380: obj1 = getoa(obj,1);
2381: return(KschreyerSkelton(obj1));
2382: }else if (strcmp(key,"lcoeff") == 0) {
2383: if (size != 2) errorKan1("%s\n","[(lcoeff) poly] gbext poly");
2384: obj1 = getoa(obj,1);
2385: if (obj1.tag != Spoly) errorKan1("%s\n","[(lcoeff) poly] gbext poly");
2386: f = KopPOLY(obj1);
2387: if (f == POLYNULL) return(KpoPOLY(f));
2388: return(KpoPOLY( newCell(coeffCopy(f->coeffp),newMonomial(f->m->ringp))));
2389: }else if (strcmp(key,"lmonom") == 0) {
2390: if (size != 2) errorKan1("%s\n","[(lmonom) poly] gbext poly");
2391: obj1 = getoa(obj,1);
2392: if (obj1.tag != Spoly) errorKan1("%s\n","[(lmonom) poly] gbext poly");
2393: f = KopPOLY(obj1);
2394: if (f == POLYNULL) return(KpoPOLY(f));
2395: return(KpoPOLY( newCell(intToCoeff(1,f->m->ringp),monomialCopy(f->m))));
2396: }else if (strcmp(key,"toes") == 0) {
2397: if (size != 2) errorKan1("%s\n","[(toes) array] gbext poly");
2398: obj1 = getoa(obj,1);
2399: if (obj1.tag != Sarray) errorKan1("%s\n","[(toes) array] gbext poly");
2400: return(KvectorToSchreyer_es(obj1));
1.3 takayama 2401: }else if (strcmp(key,"toe_") == 0) {
2402: if (size != 2) errorKan1("%s\n","[(toe_) array] gbext poly");
2403: obj1 = getoa(obj,1);
2404: if (obj1.tag == Spoly) return(obj1);
2405: if (obj1.tag != Sarray) errorKan1("%s\n","[(toe_) array] gbext poly");
2406: return(KpoPOLY(arrayToPOLY(obj1)));
1.1 maekawa 2407: }else if (strcmp(key,"isOrdered") == 0) {
2408: if (size != 2) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
2409: obj1 = getoa(obj,1);
2410: if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
2411: return(KisOrdered(obj1));
1.16 takayama 2412: }else if (strcmp(key,"reduceContent")==0) {
2413: if (size != 2) errorKan1("%s\n","[(reduceContent) poly1 ] gbext.");
2414: obj1 = getoa(obj,1);
2415: if (obj1.tag != Spoly)
2416: errorKan1("%s\n","[(reduceContent) poly1 ] gbext.");
2417: f1 = KopPOLY(obj1);
1.22 ! takayama 2418: rob = newObjectArray(2);
! 2419: f1 = reduceContentOfPoly(f1,&cont);
! 2420: putoa(rob,0,KpoPOLY(f1));
! 2421: if (f1 == POLYNULL) {
! 2422: putoa(rob,1,KpoPOLY(f1));
! 2423: }else{
! 2424: putoa(rob,1,KpoPOLY(newCell(cont,newMonomial(f1->m->ringp))));
! 2425: }
1.17 takayama 2426: }else if (strcmp(key,"ord_ws_all")==0) {
2427: if (size != 3) errorKan1("%s\n","[(ord_ws_all) fv wv] gbext");
2428: obj1 = getoa(obj,1);
2429: obj2 = getoa(obj,2);
2430: rob = KordWsAll(obj1,obj2);
1.1 maekawa 2431: }else {
2432: errorKan1("%s\n","gbext : unknown tag.");
2433: }
2434: return(rob);
2435: }
2436:
2437: struct object KmpzExtension(struct object obj)
2438: {
2439: char *key;
2440: int size;
2441: struct object keyo;
2442: struct object rob = NullObject;
2443: struct object obj0,obj1,obj2,obj3;
2444: MP_INT *f;
2445: MP_INT *g;
2446: MP_INT *h;
2447: MP_INT *r0;
2448: MP_INT *r1;
2449: MP_INT *r2;
2450: int gi;
2451: extern struct ring *SmallRingp;
2452:
2453:
2454: if (obj.tag != Sarray) errorKan1("%s\n","KmpzExtension(): The argument must be an array.");
2455: size = getoaSize(obj);
2456: if (size < 1) errorKan1("%s\n","KmpzExtension(): Empty array.");
2457: keyo = getoa(obj,0);
2458: if (keyo.tag != Sdollar) errorKan1("%s\n","KmpzExtension(): No key word.");
2459: key = KopString(keyo);
2460:
2461: /* branch by the key word. */
2462: if (strcmp(key,"gcd")==0) {
2463: if (size != 3) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2464: obj1 = getoa(obj,1);
2465: obj2 = getoa(obj,2);
2466: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2467: errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2468: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2469: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2470: errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2471: }
2472: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2473: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2474: r1 = newMP_INT();
2475: mpz_gcd(r1,f,g);
2476: rob.tag = SuniversalNumber;
2477: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2478: }else if (strcmp(key,"tdiv_qr")==0) {
2479: if (size != 3) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2480: obj1 = getoa(obj,1);
2481: obj2 = getoa(obj,2);
2482: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2483: errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2484: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2485: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2486: errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2487: }
2488: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2489: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2490: r1 = newMP_INT();
2491: r2 = newMP_INT();
2492: mpz_tdiv_qr(r1,r2,f,g);
2493: obj1.tag = SuniversalNumber;
2494: obj1.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2495: obj2.tag = SuniversalNumber;
2496: obj2.lc.universalNumber = mpintToCoeff(r2,SmallRingp);
2497: rob = newObjectArray(2);
2498: putoa(rob,0,obj1); putoa(rob,1,obj2);
2499: } else if (strcmp(key,"cancel")==0) {
2500: if (size != 2) {
2501: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2502: }
2503: obj0 = getoa(obj,1);
2504: if (obj0.tag == SuniversalNumber) return(obj0);
2505: if (obj0.tag != SrationalFunction) {
2506: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2507: return(obj0);
2508: }
2509: obj1 = *(Knumerator(obj0));
2510: obj2 = *(Kdenominator(obj0));
2511: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) {
2512: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2513: return(obj0);
2514: }
2515: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2516: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2517: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2518: }
2519: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2520: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2521:
2522: r0 = newMP_INT();
2523: r1 = newMP_INT();
2524: r2 = newMP_INT();
2525: mpz_gcd(r0,f,g);
2526: mpz_divexact(r1,f,r0);
2527: mpz_divexact(r2,g,r0);
2528: obj1.tag = SuniversalNumber;
2529: obj1.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2530: obj2.tag = SuniversalNumber;
2531: obj2.lc.universalNumber = mpintToCoeff(r2,SmallRingp);
2532:
2533: rob = KnewRationalFunction0(copyObjectp(&obj1),copyObjectp(&obj2));
2534: KisInvalidRational(&rob);
2535: }else if (strcmp(key,"sqrt")==0 ||
1.7 takayama 2536: strcmp(key,"com")==0) {
1.1 maekawa 2537: /* One arg functions */
2538: if (size != 2) errorKan1("%s\n","[key num] mpzext");
2539: obj1 = getoa(obj,1);
2540: if (obj1.tag != SuniversalNumber)
2541: errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
2542: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber))
2543: errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
2544: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2545: if (strcmp(key,"sqrt")==0) {
2546: r1 = newMP_INT();
2547: mpz_sqrt(r1,f);
2548: }else if (strcmp(key,"com")==0) {
2549: r1 = newMP_INT();
2550: mpz_com(r1,f);
2551: }
2552: rob.tag = SuniversalNumber;
2553: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2554: }else if (strcmp(key,"probab_prime_p")==0 ||
1.7 takayama 2555: strcmp(key,"and") == 0 ||
2556: strcmp(key,"ior")==0) {
1.1 maekawa 2557: /* Two args functions */
2558: if (size != 3) errorKan1("%s\n","[key num1 num2] mpzext.");
2559: obj1 = getoa(obj,1);
2560: obj2 = getoa(obj,2);
2561: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2562: errorKan1("%s\n","[key num1 num2] mpzext.");
2563: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2564: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2565: errorKan1("%s\n","[key num1 num2] mpzext.");
2566: }
2567: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2568: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2569: if (strcmp(key,"probab_prime_p")==0) {
2570: gi = (int) mpz_get_si(g);
2571: if (mpz_probab_prime_p(f,gi)) {
1.7 takayama 2572: rob = KpoInteger(1);
1.1 maekawa 2573: }else {
1.7 takayama 2574: rob = KpoInteger(0);
1.1 maekawa 2575: }
2576: }else if (strcmp(key,"and")==0) {
2577: r1 = newMP_INT();
2578: mpz_and(r1,f,g);
2579: rob.tag = SuniversalNumber;
2580: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2581: }else if (strcmp(key,"ior")==0) {
2582: r1 = newMP_INT();
2583: mpz_ior(r1,f,g);
2584: rob.tag = SuniversalNumber;
2585: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2586: }
2587:
2588: }else if (strcmp(key,"powm")==0) {
2589: /* three args */
2590: if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext");
2591: obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3);
2592: if (obj1.tag != SuniversalNumber ||
2593: obj2.tag != SuniversalNumber ||
2594: obj3.tag != SuniversalNumber ) {
2595: errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
2596: }
2597: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2598: ! is_this_coeff_MP_INT(obj2.lc.universalNumber) ||
2599: ! is_this_coeff_MP_INT(obj3.lc.universalNumber)) {
1.1 maekawa 2600: errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
2601: }
2602: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2603: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2604: h = coeff_to_MP_INT(obj3.lc.universalNumber);
2605: if (mpz_sgn(g) < 0) errorKan1("%s\n","[(powm) base exp mod] mpzext : exp must not be negative.");
2606: r1 = newMP_INT();
2607: mpz_powm(r1,f,g,h);
2608: rob.tag = SuniversalNumber;
2609: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2610: }else {
2611: errorKan1("%s\n","mpzExtension(): Unknown tag.");
2612: }
2613: return(rob);
2614: }
2615:
2616:
2617: /** : context */
2618: struct object KnewContext(struct object superObj,char *name) {
2619: struct context *cp;
2620: struct object ob;
2621: if (superObj.tag != Sclass) {
2622: errorKan1("%s\n","The argument of KnewContext must be a Class.Context");
2623: }
2624: if (superObj.lc.ival != CLASSNAME_CONTEXT) {
2625: errorKan1("%s\n","The argument of KnewContext must be a Class.Context");
2626: }
2627: cp = newContext0((struct context *)(superObj.rc.voidp),name);
2628: ob.tag = Sclass;
2629: ob.lc.ival = CLASSNAME_CONTEXT;
2630: ob.rc.voidp = cp;
2631: return(ob);
2632: }
2633:
2634: struct object KcreateClassIncetance(struct object ob1,
1.7 takayama 2635: struct object ob2,
2636: struct object ob3)
1.1 maekawa 2637: {
2638: /* [class-tag super-obj] size [class-tag] cclass */
2639: struct object ob4;
2640: int size,size2,i;
2641: struct object ob5;
2642: struct object rob;
2643:
2644: if (ob1.tag != Sarray)
2645: errorKan1("%s\n","cclass: The first argument must be an array.");
2646: if (getoaSize(ob1) < 1)
2647: errorKan1("%s\n","cclass: The first argument must be [class-tag ....].");
2648: ob4 = getoa(ob1,0);
2649: if (ectag(ob4) != CLASSNAME_CONTEXT)
2650: errorKan1("%s\n","cclass: The first argument must be [class-tag ....].");
2651:
2652: if (ob2.tag != Sinteger)
2653: errorKan1("%s\n","cclass: The second argument must be an integer.");
2654: size = KopInteger(ob2);
2655: if (size < 1)
2656: errorKan1("%s\n","cclass: The size must be > 0.");
2657:
2658: if (ob3.tag != Sarray)
2659: errorKan1("%s\n","cclass: The third argument must be an array.");
2660: if (getoaSize(ob3) < 1)
2661: errorKan1("%s\n","cclass: The third argument must be [class-tag].");
2662: ob5 = getoa(ob3,0);
2663: if (ectag(ob5) != CLASSNAME_CONTEXT)
2664: errorKan1("%s\n","cclass: The third argument must be [class-tag].");
1.7 takayama 2665:
1.1 maekawa 2666: rob = newObjectArray(size);
2667: putoa(rob,0,ob5);
2668: if (getoaSize(ob1) < size) size2 = getoaSize(ob1);
2669: else size2 = size;
2670: for (i=1; i<size2; i++) {
2671: putoa(rob,i,getoa(ob1,i));
2672: }
2673: for (i=size2; i<size; i++) {
2674: putoa(rob,i,NullObject);
2675: }
2676: return(rob);
2677: }
2678:
2679:
2680: struct object KpoDouble(double a) {
2681: struct object rob;
2682: rob.tag = Sdouble;
2683: /* rob.lc.dbl = (double *)sGC_malloc_atomic(sizeof(double)); */
2684: rob.lc.dbl = (double *)sGC_malloc(sizeof(double));
2685: if (rob.lc.dbl == (double *)NULL) {
2686: fprintf(stderr,"No memory.\n"); exit(10);
2687: }
2688: *(rob.lc.dbl) = a;
2689: return(rob);
2690: }
2691:
2692: double toDouble0(struct object ob) {
2693: double r;
2694: int r3;
2695: struct object ob2;
2696: struct object ob3;
2697: switch(ob.tag) {
2698: case Sinteger:
2699: return( (double) (KopInteger(ob)) );
2700: case SuniversalNumber:
2701: return((double) coeffToInt(ob.lc.universalNumber));
2702: case SrationalFunction:
2703: /* The argument is assumed to be a rational number. */
2704: ob2 = newObjectArray(2); ob3 = KpoString("cancel");
2705: putoa(ob2,0,ob3); putoa(ob2,1,ob);
2706: ob = KmpzExtension(ob2);
2707: ob2 = *Knumerator(ob); ob3 = *Kdenominator(ob);
2708: r3 = coeffToInt(ob3.lc.universalNumber);
2709: if (r3 == 0) {
2710: errorKan1("%s\n","toDouble0(): Division by zero.");
2711: break;
2712: }
2713: r = ((double) coeffToInt(ob2.lc.universalNumber)) / ((double)r3);
2714: return(r);
2715: case Sdouble:
2716: return( KopDouble(ob) );
2717: default:
2718: errorKan1("%s\n","toDouble0(): This type of conversion is not supported.");
2719: break;
2720: }
2721: return(0.0);
2722: }
2723:
2724: struct object KpoGradedPolySet(struct gradedPolySet *grD) {
2725: struct object rob;
2726: rob.tag = Sclass;
2727: rob.lc.ival = CLASSNAME_GradedPolySet;
2728: rob.rc.voidp = (void *) grD;
2729: return(rob);
2730: }
2731:
2732: static char *getspace0(int a) {
2733: char *s;
2734: a = (a > 0? a:-a);
2735: s = (char *) sGC_malloc(a+1);
2736: if (s == (char *)NULL) {
2737: errorKan1("%s\n","no more memory.");
2738: }
2739: return(s);
2740: }
2741: struct object KdefaultPolyRing(struct object ob) {
2742: struct object rob;
2743: int i,j,k,n;
2744: struct object ob1,ob2,ob3,ob4,ob5;
2745: struct object t1;
2746: char *s1;
2747: extern struct ring *CurrentRingp;
2748: static struct ring *a[N0];
2749:
2750: rob = NullObject;
2751: if (ob.tag != Sinteger) {
2752: errorKan1("%s\n","KdefaultPolyRing(): the argument must be integer.");
2753: }
2754: n = KopInteger(ob);
2755: if (n <= 0) {
2756: /* initializing */
2757: for (i=0; i<N0; i++) {
2758: a[i] = (struct ring*) NULL;
2759: }
2760: return(rob);
2761: }
2762:
2763: if ( a[n] != (struct ring*)NULL) return(KpoRingp(a[n]));
2764:
2765: /* Let's construct ring of polynomials of 2n variables */
2766: /* x variables */
2767: ob1 = newObjectArray(n);
2768: for (i=0; i<n; i++) {
2769: s1 = getspace0(1+ ((n-i)/10) + 1);
2770: sprintf(s1,"x%d",n-i);
2771: putoa(ob1,i,KpoString(s1));
2772: }
2773: ob2 = newObjectArray(n);
2774: s1 = getspace0(1);
2775: sprintf(s1,"h");
2776: putoa(ob2,0,KpoString(s1));
2777: for (i=1; i<n; i++) {
2778: s1 = getspace0(1+((n+n-i)/10)+1);
2779: sprintf(s1,"x%d",n+n-i);
2780: putoa(ob2,i,KpoString(s1));
2781: }
2782:
2783: ob3 = newObjectArray(9);
2784: putoa(ob3,0,KpoInteger(0));
2785: for (i=1; i<9; i++) {
2786: putoa(ob3,i,KpoInteger(n));
2787: }
2788:
2789: ob4 = newObjectArray(2*n);
2790: t1 = newObjectArray(2*n);
2791: for (i=0; i<2*n; i++) {
2792: putoa(t1,i,KpoInteger(1));
2793: }
2794: putoa(ob4,0,t1);
2795: for (i=1; i<2*n; i++) {
2796: t1 = newObjectArray(2*n);
2797: for (j=0; j<2*n; j++) {
2798: putoa(t1,j,KpoInteger(0));
2799: if (j == (2*n-i)) {
1.7 takayama 2800: putoa(t1,j,KpoInteger(-1));
1.1 maekawa 2801: }
2802: }
2803: putoa(ob4,i,t1);
2804: }
2805:
2806: ob5 = newObjectArray(2);
2807: putoa(ob5,0,KpoString("mpMult"));
2808: putoa(ob5,1,KpoString("poly"));
2809:
2810: KsetUpRing(ob1,ob2,ob3,ob4,ob5);
2811: a[n] = CurrentRingp;
2812: return(KpoRingp(a[n]));
2813: }
2814:
2815:
2816:
2817:
2818:
2819: /******************************************************************
2820: error handler
2821: ******************************************************************/
2822:
2823: errorKan1(str,message)
1.7 takayama 2824: char *str;
2825: char *message;
1.1 maekawa 2826: {
2827: extern char *GotoLabel;
2828: extern int GotoP;
2829: extern int ErrorMessageMode;
2830: char tmpc[1024];
1.10 takayama 2831: cancelAlarm();
1.1 maekawa 2832: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
2833: sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");
2834: if (strlen(message) < 900) {
2835: strcat(tmpc,message);
2836: }
2837: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
2838: }
2839: if (ErrorMessageMode != 1) {
2840: fprintf(stderr,"\nERROR(kanExport[0|1].c): ");
2841: fprintf(stderr,str,message);
2842: }
2843: /* fprintf(stderr,"Hello "); */
2844: if (GotoP) {
2845: /* fprintf(stderr,"Hello. GOTO "); */
2846: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
2847: GotoP = 0;
2848: }
2849: stdOperandStack(); contextControl(CCRESTORE);
2850: /* fprintf(stderr,"Now. Long jump!\n"); */
1.8 takayama 2851: #if defined(__CYGWIN__)
2852: siglongjmp(EnvOfStackMachine,1);
2853: #else
1.1 maekawa 2854: longjmp(EnvOfStackMachine,1);
1.8 takayama 2855: #endif
1.1 maekawa 2856: }
1.22 ! takayama 2857:
1.1 maekawa 2858:
2859: warningKan(str)
1.7 takayama 2860: char *str;
1.1 maekawa 2861: {
2862: extern int WarningMessageMode;
2863: extern int Strict;
2864: char tmpc[1024];
2865: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
2866: sprintf(tmpc,"\nWARNING(kanExport[0|1].c): ");
2867: if (strlen(str) < 900) {
2868: strcat(tmpc,str);
2869: }
2870: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
2871: }
2872: if (WarningMessageMode != 1) {
2873: fprintf(stderr,"\nWARNING(kanExport[0|1].c): ");
2874: fprintf(stderr,str);
2875: fprintf(stderr,"\n");
2876: }
2877: /* if (Strict) errorKan1("%s\n"," "); */
2878: if (Strict) errorKan1("%s\n",str);
1.4 takayama 2879: return(0);
2880: }
2881:
2882: warningKanNoStrictMode(str)
1.7 takayama 2883: char *str;
1.4 takayama 2884: {
2885: extern int Strict;
2886: int t;
2887: t = Strict;
2888: Strict = 0;
2889: warningKan(str);
2890: Strict = t;
1.1 maekawa 2891: return(0);
2892: }
2893:
2894:
2895:
2896:
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