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