=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport0.c,v retrieving revision 1.18 retrieving revision 1.28 diff -u -p -r1.18 -r1.28 --- OpenXM/src/kan96xx/Kan/kanExport0.c 2003/08/26 12:46:05 1.18 +++ OpenXM/src/kan96xx/Kan/kanExport0.c 2004/08/31 04:45:42 1.28 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.17 2003/08/23 02:28:38 takayama Exp $ */ +/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.27 2004/08/28 07:28:54 takayama Exp $ */ #include #include "datatype.h" #include "stackm.h" @@ -19,6 +19,7 @@ int SerialCurrent = -1; /* Current Serial number of t int ReverseOutputOrder = 1; int WarningNoVectorVariable = 1; +extern int QuoteMode; /** :arithmetic **/ struct object KooAdd(ob1,ob2) @@ -142,7 +143,11 @@ struct object KooAdd(ob1,ob2) default: - warningKan("KooAdd() has not supported yet these objects.\n"); + if (QuoteMode) { + rob = addTree(ob1,ob2); + }else{ + warningKan("KooAdd() has not supported yet these objects.\n"); + } break; } return(rob); @@ -270,7 +275,11 @@ struct object KooSub(ob1,ob2) break; default: - warningKan("KooSub() has not supported yet these objects.\n"); + if (QuoteMode) { + rob = minusTree(ob1,ob2); + }else{ + warningKan("KooSub() has not supported yet these objects.\n"); + } break; } return(rob); @@ -412,7 +421,11 @@ struct object KooMult(ob1,ob2) break; default: - warningKan("KooMult() has not supported yet these objects.\n"); + if (QuoteMode) { + rob = timesTree(ob1,ob2); + }else{ + warningKan("KooMult() has not supported yet these objects.\n"); + } break; } return(rob); @@ -451,7 +464,11 @@ struct object KoNegate(obj) break; default: - warningKan("KoNegate() has not supported yet these objects.\n"); + if (QuoteMode) { + rob = unaryminusTree(obj); + }else{ + warningKan("KoNegate() has not supported yet these objects.\n"); + } break; } return(rob); @@ -653,7 +670,11 @@ struct object KooDiv(ob1,ob2) default: - warningKan("KooDiv() has not supported yet these objects.\n"); + if (QuoteMode) { + rob = divideTree(ob1,ob2); + }else{ + warningKan("KooDiv() has not supported yet these objects.\n"); + } break; } return(rob); @@ -776,6 +797,21 @@ struct object KooGreater(obj1,obj2) if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1)); else return(KpoInteger(0)); break; + case Sarray: + { + int i,m1,m2; + struct object rr; + m1 = getoaSize(obj1); m2 = getoaSize(obj2); + for (i=0; i< (m1>m2?m2:m1); i++) { + rr=KooGreater(getoa(obj1,i),getoa(obj2,i)); + if (KopInteger(rr) == 1) return rr; + rr=KooGreater(getoa(obj2,i),getoa(obj1,i)); + if (KopInteger(rr) == 1) return KpoInteger(0); + } + if (m1 > m2) return KpoInteger(1); + else return KpoInteger(0); + } + break; default: errorKan1("%s\n","KooGreater() has not supported these objects yet."); break; @@ -817,6 +853,21 @@ struct object KooLess(obj1,obj2) if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1)); else return(KpoInteger(0)); break; + case Sarray: + { + int i,m1,m2; + struct object rr; + m1 = getoaSize(obj1); m2 = getoaSize(obj2); + for (i=0; i< (m1>m2?m2:m1); i++) { + rr=KooLess(getoa(obj1,i),getoa(obj2,i)); + if (KopInteger(rr) == 1) return rr; + rr=KooLess(getoa(obj2,i),getoa(obj1,i)); + if (KopInteger(rr) == 1) return KpoInteger(0); + } + if (m1 < m2) return KpoInteger(1); + else return KpoInteger(0); + } + break; default: errorKan1("%s\n","KooLess() has not supported these objects yet."); break; @@ -893,8 +944,7 @@ struct object KdataConversion(obj,key) strcpy(rob.lc.str,intstr); return(rob); }else if (strcmp(key,"universalNumber")==0) { - rob.tag = SuniversalNumber; - rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing); + rob = KintToUniversalNumber(obj.lc.ival); return(rob); }else if (strcmp(key,"double") == 0) { rob = KpoDouble((double) (obj.lc.ival)); @@ -980,7 +1030,15 @@ struct object KdataConversion(obj,key) rob = NullObject; return(rob); }else { - warningKan("Sorry. This type of data conversion has not supported yet.\n"); + { /* Automatically maps the elements. */ + int n,i; + n = getoaSize(obj); + rob = newObjectArray(n); + for (i=0; i ' ')) { - wc++; inblank = 0; - }else if ((!inblank) && (s[i] <= ' ')) { - inblank = 1; - } + if (inblank && (s[i] > ' ')) { + wc++; inblank = 0; + }else if ((!inblank) && (s[i] <= ' ')) { + inblank = 1; + } } argv = (char **) sGC_malloc(sizeof(char *)*(wc+2)); argv[0] = NULL; inblank = 1; wc = 0; for (i=0; i ' ')) { - argv[wc] = &(s[i]); argv[wc+1]=NULL; - wc++; inblank = 0; - }else if ((inblank == 0) && (s[i] <= ' ')) { - inblank = 1; s[i] = 0; - }else if (inblank && (s[i] <= ' ')) { - s[i] = 0; - } + if (inblank && (s[i] > ' ')) { + argv[wc] = &(s[i]); argv[wc+1]=NULL; + wc++; inblank = 0; + }else if ((inblank == 0) && (s[i] <= ' ')) { + inblank = 1; s[i] = 0; + }else if (inblank && (s[i] <= ' ')) { + s[i] = 0; + } } rob = newObjectArray(wc); for (i=0; im->ringp)))); - } + rob = newObjectArray(2); + f1 = reduceContentOfPoly(f1,&cont); + putoa(rob,0,KpoPOLY(f1)); + if (f1 == POLYNULL) { + putoa(rob,1,KpoPOLY(f1)); + }else{ + putoa(rob,1,KpoPOLY(newCell(cont,newMonomial(f1->m->ringp)))); + } }else if (strcmp(key,"ord_ws_all")==0) { if (size != 3) errorKan1("%s\n","[(ord_ws_all) fv wv] gbext"); obj1 = getoa(obj,1); obj2 = getoa(obj,2); rob = KordWsAll(obj1,obj2); + }else if (strcmp(key,"exponents")==0) { + if (size == 3) { + obj1 = getoa(obj,1); + obj2 = getoa(obj,2); + rob = KgetExponents(obj1,obj2); + }else if (size == 2) { + obj1 = getoa(obj,1); + obj2 = KpoInteger(2); + rob = KgetExponents(obj1,obj2); + }else{ + errorKan1("%s\n","[(exponents) f type] gbext"); + } }else { errorKan1("%s\n","gbext : unknown tag."); } @@ -2417,6 +2544,12 @@ struct object KmpzExtension(struct object obj) if (size != 3) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); obj1 = getoa(obj,1); obj2 = getoa(obj,2); + if (obj1.tag != SuniversalNumber) { + obj1 = KdataConversion(obj1,"universalNumber"); + } + if (obj2.tag != SuniversalNumber) { + obj2 = KdataConversion(obj2,"universalNumber"); + } if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || @@ -2433,6 +2566,12 @@ struct object KmpzExtension(struct object obj) if (size != 3) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); obj1 = getoa(obj,1); obj2 = getoa(obj,2); + if (obj1.tag != SuniversalNumber) { + obj1 = KdataConversion(obj1,"universalNumber"); + } + if (obj2.tag != SuniversalNumber) { + obj2 = KdataConversion(obj2,"universalNumber"); + } if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || @@ -2491,6 +2630,9 @@ struct object KmpzExtension(struct object obj) /* One arg functions */ if (size != 2) errorKan1("%s\n","[key num] mpzext"); obj1 = getoa(obj,1); + if (obj1.tag != SuniversalNumber) { + obj1 = KdataConversion(obj1,"universalNumber"); + } if (obj1.tag != SuniversalNumber) errorKan1("%s\n","[key num] mpzext : num must be a universalNumber."); if (! is_this_coeff_MP_INT(obj1.lc.universalNumber)) @@ -2512,6 +2654,12 @@ struct object KmpzExtension(struct object obj) if (size != 3) errorKan1("%s\n","[key num1 num2] mpzext."); obj1 = getoa(obj,1); obj2 = getoa(obj,2); + if (obj1.tag != SuniversalNumber) { + obj1 = KdataConversion(obj1,"universalNumber"); + } + if (obj2.tag != SuniversalNumber) { + obj2 = KdataConversion(obj2,"universalNumber"); + } if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) errorKan1("%s\n","[key num1 num2] mpzext."); if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || @@ -2543,6 +2691,15 @@ struct object KmpzExtension(struct object obj) /* three args */ if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext"); obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3); + if (obj1.tag != SuniversalNumber) { + obj1 = KdataConversion(obj1,"universalNumber"); + } + if (obj2.tag != SuniversalNumber) { + obj2 = KdataConversion(obj2,"universalNumber"); + } + if (obj3.tag != SuniversalNumber) { + obj3 = KdataConversion(obj3,"universalNumber"); + } if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber || obj3.tag != SuniversalNumber ) { @@ -2561,6 +2718,28 @@ struct object KmpzExtension(struct object obj) mpz_powm(r1,f,g,h); rob.tag = SuniversalNumber; rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp); + } else if (strcmp(key,"lcm")==0) { + if (size != 3) errorKan1("%s\n","[(lcm) universalNumber universalNumber] mpzext."); + obj1 = getoa(obj,1); + obj2 = getoa(obj,2); + if (obj1.tag != SuniversalNumber) { + obj1 = KdataConversion(obj1,"universalNumber"); + } + if (obj2.tag != SuniversalNumber) { + obj2 = KdataConversion(obj2,"universalNumber"); + } + if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) + errorKan1("%s\n","[lcm num1 num2] mpzext."); + if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || + ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { + errorKan1("%s\n","[(lcm) universalNumber universalNumber] mpzext."); + } + f = coeff_to_MP_INT(obj1.lc.universalNumber); + g = coeff_to_MP_INT(obj2.lc.universalNumber); + r1 = newMP_INT(); + mpz_lcm(r1,f,g); + rob.tag = SuniversalNumber; + rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp); }else { errorKan1("%s\n","mpzExtension(): Unknown tag."); } @@ -2808,6 +2987,7 @@ errorKan1(str,message) longjmp(EnvOfStackMachine,1); #endif } + warningKan(str) char *str;