=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport0.c,v retrieving revision 1.9 retrieving revision 1.36 diff -u -p -r1.9 -r1.36 --- OpenXM/src/kan96xx/Kan/kanExport0.c 2002/09/08 10:49:49 1.9 +++ OpenXM/src/kan96xx/Kan/kanExport0.c 2004/09/16 02:22:03 1.36 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.8 2002/02/24 10:27:18 takayama Exp $ */ +/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.35 2004/09/15 06:40:26 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); @@ -666,8 +687,16 @@ KooEqualQ(obj1,obj2) { struct object ob; int i; + extern int Verbose; if (obj1.tag != obj2.tag) { warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n"); + if (Verbose & 0x10) { + fprintf(stderr,"obj1(tag:%d)=",obj1.tag); + printObject(obj1,0,stderr); + fprintf(stderr,", obj2(tag:%d)=",obj2.tag); + printObject(obj2,0,stderr); + fprintf(stderr,"\n"); fflush(stderr); + } return(0); } switch(obj1.tag) { @@ -776,6 +805,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 +861,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; @@ -868,6 +927,10 @@ struct object KdataConversion(obj,key) return(rob); }else if (strcmp(key,"poly") == 0) { rob = KpoPOLY(ZERO); + return rob; + }else if (strcmp(key,"array") == 0) { + rob = newObjectArray(0); + return rob; }else{ warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n"); } @@ -893,8 +956,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)); @@ -965,7 +1027,7 @@ struct object KdataConversion(obj,key) if (strcmp(key,"array") == 0) { return(rob); }else if (strcmp(key,"list") == 0) { - rob = *( arrayToList(obj) ); + rob = KarrayToList(obj); return(rob); }else if (strcmp(key,"arrayOfPOLY")==0) { rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj)); @@ -980,11 +1042,19 @@ 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; igbListTower = NULL; newRingp->outputOrder = outputVars; newRingp->weightedHomogenization = 0; + newRingp->degreeShiftSize = 0; + newRingp->degreeShiftN = 0; + newRingp->degreeShift = NULL; + newRingp->partialEcart = 0; + newRingp->partialEcartGlobalVarX = NULL; if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) { errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given."); @@ -1588,7 +1706,68 @@ int KsetUpRing(ob1,ob2,ob3,ob4,ob5) if (getoa(ob5,i+1).tag != Sinteger) { errorKan1("%s\n","A integer should be given. (weightedHomogenization)"); } - newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1)); + newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1)); + } else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) { + if (getoa(ob5,i+1).tag != Sarray) { + errorKan1("%s\n","An array of array should be given. (degreeShift)"); + } + { + struct object ods; + struct object ods2; + int dssize,k,j,nn; + ods=getoa(ob5,i+1); + if ((getoaSize(ods) < 1) || (getoa(ods,0).tag != Sarray)) { + errorKan1("%s\n", "An array of array should be given. (degreeShift)"); + } + nn = getoaSize(ods); + dssize = getoaSize(getoa(ods,0)); + newRingp->degreeShiftSize = dssize; + newRingp->degreeShiftN = nn; + newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize*nn+1)); + if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory."); + for (j=0; jdegreeShift)[j*dssize+k] = coeffToInt(getoa(ods2,k).lc.universalNumber); + }else{ + (newRingp->degreeShift)[j*dssize+k] = KopInteger(getoa(ods2,k)); + } + } + } + } + } else if (strcmp(KopString(getoa(ob5,i)),"partialEcartGlobalVarX") == 0) { + if (getoa(ob5,i+1).tag != Sarray) { + errorKan1("%s\n","An array of array should be given. (partialEcart)"); + } + { + struct object odv; + struct object ovv; + int k,j,nn; + char *vname; + odv=getoa(ob5,i+1); + nn = getoaSize(odv); + newRingp->partialEcart = nn; + newRingp->partialEcartGlobalVarX = (int *) sGC_malloc(sizeof(int)*nn+1); + if (newRingp->partialEcartGlobalVarX == NULL) errorKan1("%s\n","No more memory."); + for (j=0; jpartialEcartGlobalVarX)[j] = -1; + for (j=0; jpartialEcartGlobalVarX)[j] = k; break; + }else{ + if (k == n-1) errorKan1("%s\n","partialEcartGlobalVarX: no such variable."); + } + } + } + } + + switch_function("grade","module1v"); + /* Warning: grading is changed to module1v!! */ } else { errorKan1("%s\n","Unknown keyword to set_up_ring@"); } @@ -2028,7 +2207,47 @@ int KtoArgvbyCurryBrace(str,argv,limit) return(argc); } +struct object KstringToArgv(struct object ob) { + struct object rob; + char *s; + int n,wc,i,inblank; + char **argv; + if (ob.tag != Sdollar) + errorKan1("%s\n","KstringToArgv(): the argument must be a string."); + n = strlen(KopString(ob)); + s = (char *) sGC_malloc(sizeof(char)*(n+2)); + if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory."); + strcpy(s,KopString(ob)); + inblank = 1; wc = 0; + for (i=0; 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; + } + } + rob = newObjectArray(wc); + for (i=0; im->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."); } @@ -2316,6 +2588,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) || @@ -2332,6 +2610,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) || @@ -2390,6 +2674,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)) @@ -2411,6 +2698,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) || @@ -2442,6 +2735,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 ) { @@ -2460,6 +2762,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."); } @@ -2666,8 +2990,85 @@ struct object KdefaultPolyRing(struct object ob) { } +struct object Krest(struct object ob) { + struct object rob; + struct object *op; + int n,i; + if (ob.tag == Sarray) { + n = getoaSize(ob); + if (n == 0) return ob; + rob = newObjectArray(n-1); + for (i=1; i