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