=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport0.c,v retrieving revision 1.6 retrieving revision 1.48 diff -u -p -r1.6 -r1.48 --- OpenXM/src/kan96xx/Kan/kanExport0.c 2001/04/12 06:48:25 1.6 +++ OpenXM/src/kan96xx/Kan/kanExport0.c 2012/09/16 01:53:08 1.48 @@ -1,5 +1,7 @@ -/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.5 2000/12/28 00:07:14 takayama Exp $ */ +/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.47 2006/12/21 05:29:49 takayama Exp $ */ #include +#include +#include #include "datatype.h" #include "stackm.h" #include "extern.h" @@ -19,17 +21,19 @@ int SerialCurrent = -1; /* Current Serial number of t int ReverseOutputOrder = 1; int WarningNoVectorVariable = 1; +extern int QuoteMode; /** :arithmetic **/ struct object KooAdd(ob1,ob2) -struct object ob1,ob2; + struct object ob1,ob2; { extern struct ring *CurrentRingp; struct object rob = NullObject; POLY r; int s,i; objectp f1,f2,g1,g2; - struct object nn,dd; + struct object nn = OINIT; + struct object dd = OINIT; switch (Lookup[ob1.tag][ob2.tag]) { case SintegerSinteger: @@ -142,21 +146,26 @@ struct object 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); } struct object KooSub(ob1,ob2) -struct object ob1,ob2; + struct object ob1,ob2; { struct object rob = NullObject; POLY r; int s,i; objectp f1,f2,g1,g2; extern struct coeff *UniversalZero; - struct object nn,dd; + struct object nn = OINIT; + struct object dd = OINIT; switch (Lookup[ob1.tag][ob2.tag]) { case SintegerSinteger: @@ -270,20 +279,25 @@ struct object 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); } struct object KooMult(ob1,ob2) -struct object ob1,ob2; + struct object ob1,ob2; { struct object rob = NullObject; POLY r; int i,s; objectp f1,f2,g1,g2; - struct object dd,nn; + struct object dd = OINIT; + struct object nn = OINIT; switch (Lookup[ob1.tag][ob2.tag]) { @@ -412,7 +426,11 @@ struct object 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); @@ -421,11 +439,11 @@ struct object ob1,ob2; struct object KoNegate(obj) -struct object obj; + struct object obj; { struct object rob = NullObject; extern struct ring SmallRing; - struct object tob; + struct object tob = OINIT; switch(obj.tag) { case Sinteger: rob = obj; @@ -451,19 +469,23 @@ struct object 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); } struct object KoInverse(obj) -struct object obj; + struct object obj; { struct object rob = NullObject; extern struct coeff *UniversalOne; objectp onep; - struct object tob; + struct object tob = OINIT; switch(obj.tag) { case Spoly: tob.tag = SuniversalNumber; @@ -494,7 +516,7 @@ struct object obj; static int isVector(ob) -struct object ob; + struct object ob; { int i,n; n = getoaSize(ob); @@ -505,8 +527,8 @@ struct object ob; } static int isMatrix(ob,m,n) -struct object ob; -int m,n; + struct object ob; + int m,n; { int i,j; for (i=0; i vector */ - /* (m n) (m2=n) */ + /* (m n) (m2=n) */ n = getoaSize(getoa(aa,0)); if (isMatrix(aa,m,n) == 0) { errorKan1("%s\n","KaoMult(matrix,vector). The left object is not matrix."); @@ -593,22 +615,24 @@ struct object aa,bb; r1 = isMatrix(aa,m,n); r2 = isMatrix(bb,m2,n2); if (r1 == -1 || r2 == -1) { /* Object multiplication. Elements are not polynomials. */ - struct object ofik,ogkj,otmp; + struct object ofik = OINIT; + struct object ogkj = OINIT; + struct object otmp = OINIT; rob = newObjectArray(m); for (i=0; i obj2.lc.ival) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case Sstring: - case Sdollar: - if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case Spoly: - if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case SuniversalNumber: - tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber); - if (tt > 0) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case Sdouble: - if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - default: - errorKan1("%s\n","KooGreater() has not supported these objects yet."); - break; + case 0: + return(KpoInteger(1)); /* case of NullObject */ + break; + case Sinteger: + if (obj1.lc.ival > obj2.lc.ival) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Sstring: + case Sdollar: + if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Spoly: + if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case SuniversalNumber: + tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber); + if (tt > 0) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Sdouble: + if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Sarray: + { + int i,m1,m2; + struct object rr = OINIT; + 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; + } } struct object KooLess(obj1,obj2) -struct object obj1; -struct object obj2; + struct object obj1; + struct object obj2; { struct object ob; int tt; @@ -792,50 +843,66 @@ struct object obj2; errorKan1("%s\n","You cannot compare different kinds of objects."); } switch(obj1.tag) { - case 0: - return(KpoInteger(1)); /* case of NullObject */ - break; - case Sinteger: - if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case Sstring: - case Sdollar: - if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case Spoly: - if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case SuniversalNumber: - tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber); - if (tt < 0) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - case Sdouble: - if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1)); - else return(KpoInteger(0)); - break; - default: - errorKan1("%s\n","KooLess() has not supported these objects yet."); - break; + case 0: + return(KpoInteger(1)); /* case of NullObject */ + break; + case Sinteger: + if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Sstring: + case Sdollar: + if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Spoly: + if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case SuniversalNumber: + tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber); + if (tt < 0) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Sdouble: + if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1)); + else return(KpoInteger(0)); + break; + case Sarray: + { + int i,m1,m2; + struct object rr = OINIT; + 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; + } } /* :conversion */ struct object KdataConversion(obj,key) -struct object obj; -char *key; + struct object obj; + char *key; { char tmps[128]; /* Assume that double is not more than 128 digits */ char intstr[100]; /* Assume that int is not more than 100 digits */ - struct object rob; + struct object rob = OINIT; extern struct ring *CurrentRingp; extern struct ring SmallRing; int flag; - struct object rob1,rob2; + struct object rob1 = OINIT; + struct object rob2 = OINIT; char *s; int i; double f; @@ -847,9 +914,9 @@ char *key; return(rob); }else if (strcmp(key,"type??")==0) { if (obj.tag != Sclass) { - rob = KpoInteger(obj.tag); + rob = KpoInteger(obj.tag); }else { - rob = KpoInteger(ectag(obj)); + rob = KpoInteger(ectag(obj)); } return(rob); }else if (strcmp(key,"error")==0) { @@ -868,7 +935,12 @@ char *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{ + /* fprintf(stderr,"key=%s\n",key); */ warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n"); } break; @@ -893,8 +965,7 @@ char *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)); @@ -914,7 +985,7 @@ char *key; rob.tag = Sstring; s = (char *) sGC_malloc(sizeof(char)*(strlen(obj.lc.str)+3)); if (s == (char *) NULL) { - errorKan1("%s\n","No memory."); + errorKan1("%s\n","No memory."); } s[0] = '/'; strcpy(&(s[1]),obj.lc.str); @@ -930,27 +1001,27 @@ char *key; }else if (strcmp(key,"array")==0) { rob = newObjectArray(strlen(obj.lc.str)); for (i=0; i ' ' && flag == 0) flag=1; - else if ((obj.lc.str)[i] <= ' ' && flag == 1) flag = 2; - else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3; + if ((obj.lc.str)[i] > ' ' && flag == 0) flag=1; + else if ((obj.lc.str)[i] <= ' ' && flag == 1) flag = 2; + else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3; } if (flag == 3) errorKan1("KdataConversion(): %s","The data for the double contains blanck(s)"); /* Read the double. */ if (sscanf(obj.lc.str,"%lf",&f) <= 0) { - errorKan1("KdataConversion(): %s","It cannot be translated to double."); + errorKan1("KdataConversion(): %s","It cannot be translated to double."); } rob = KpoDouble(f); return(rob); @@ -965,7 +1036,7 @@ char *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)); @@ -979,18 +1050,29 @@ char *key; }else if (strcmp(key,"null") == 0) { rob = NullObject; return(rob); + }else if (strcmp(key,"byteArray") == 0) { + rob = newByteArray(getoaSize(obj),obj); + 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; icoeffp))); + return(KpoInteger(coeffToInt(obj.lc.poly->coeffp))); } }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) { rob.tag = Sdollar; @@ -1002,25 +1084,25 @@ char *key; return(KringMap(obj)); }else if (strcmp(key,"universalNumber")==0) { if (obj.lc.poly == ZERO) { - rob.tag = SuniversalNumber; - rob.lc.universalNumber = newUniversalNumber(0); + rob.tag = SuniversalNumber; + rob.lc.universalNumber = newUniversalNumber(0); } else { - if (obj.lc.poly->coeffp->tag == MP_INTEGER) { - rob.tag = SuniversalNumber; - rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp); - }else { - rob = NullObject; - warningKan("Coefficient is not MP_INT."); - } + if (obj.lc.poly->coeffp->tag == MP_INTEGER) { + rob.tag = SuniversalNumber; + rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp); + }else { + rob = NullObject; + warningKan("Coefficient is not MP_INT."); + } } return(rob); }else if (strcmp(key,"ring")==0) { if (obj.lc.poly ISZERO) { - warningKan("Zero polynomial does not have the ring structure field.\n"); + warningKan("Zero polynomial does not have the ring structure field.\n"); }else{ - rob.tag = Sring; - rob.lc.ringp = (obj.lc.poly)->m->ringp; - return(rob); + rob.tag = Sring; + rob.lc.ringp = (obj.lc.poly)->m->ringp; + return(rob); } }else if (strcmp(key,"null") == 0) { rob = NullObject; @@ -1050,12 +1132,13 @@ char *key; break; case Slist: if (strcmp(key,"array") == 0) { - rob = listToArray(&obj); + rob = KlistToArray(obj); return(rob); } break; case SuniversalNumber: - if (strcmp(key,"universalNumber")==0) { + if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) { + rob = obj; return(rob); }else if (strcmp(key,"integer")==0) { rob = KpoInteger(coeffToInt(obj.lc.universalNumber)); @@ -1073,6 +1156,9 @@ char *key; }else if (strcmp(key,"double") == 0) { rob = KpoDouble( toDouble0(obj) ); return(rob); + }else if (strcmp(key,"denominator") == 0) { + rob = KintToUniversalNumber(1); + return(rob); }else{ warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n"); } @@ -1137,78 +1223,124 @@ char *key; if (strcmp(key,"orderMatrix")==0) { rob = oGetOrderMatrix(KopRingp(obj)); return(rob); + }else if (strcmp(key,"oxRingStructure")==0) { + rob = oRingToOXringStructure(KopRingp(obj)); + return(rob); }else{ warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n"); } break; + case SbyteArray: + if (strcmp(key,"array") == 0) { + rob = byteArrayToArray(obj); + return(rob); + } else { + warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n"); + } + break; default: warningKan("Sorry. This type of data conversion has not supported yet.\n"); } return(NullObject); } - + +/* cf. macro to_int32 */ +struct object Kto_int32(struct object ob) { + int n,i; + struct object otmp = OINIT; + struct object rob = OINIT; + if (ob.tag == SuniversalNumber) return KdataConversion(ob,"integer"); + if (ob.tag == Sarray) { + n = getoaSize(ob); + rob = newObjectArray(n); + for (i=0; in; a = aa->array; r = newObjectArray(size); @@ -1221,10 +1353,10 @@ struct arrayOfPOLY *aa; } struct object matrixOfPOLYToArray(pmat) -struct matrixOfPOLY *pmat; + struct matrixOfPOLY *pmat; { - struct object r; - struct object tmp; + struct object r = OINIT; + struct object tmp = OINIT; int i,j; int m,n; POLY *mat; @@ -1242,22 +1374,22 @@ struct matrixOfPOLY *pmat; } struct arrayOfPOLY *arrayToArrayOfPOLY(oa) -struct object oa; + struct object oa; { POLY *a; int size; int i; - struct object tmp; + struct object tmp = OINIT; struct arrayOfPOLY *ap; if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s", - "Argument is not array\n"); + "Argument is not array\n"); size = getoaSize(oa); a = (POLY *)sGC_malloc(sizeof(POLY)*size); for (i=0; icc = cc; newRingp->x = xvars; newRingp->D = dvars; + newRingp->Dsmall = makeDsmall(dvars,n); /* You don't need to set order and orderMatrixSize here. It was set by setOrder(). */ setFromTo(newRingp); @@ -1537,6 +1672,12 @@ struct object ob1,ob2,ob3,ob4,ob5; newRingp->schreyer = 0; newRingp->gbListTower = 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."); @@ -1544,47 +1685,113 @@ struct object ob1,ob2,ob3,ob4,ob5; for (i=0; i < getoaSize(ob5); i += 2) { if (getoa(ob5,i).tag == Sdollar) { if (strcmp(KopString(getoa(ob5,i)),"mpMult") == 0) { - if (getoa(ob5,i+1).tag != Sdollar) { - errorKan1("%s\n","A keyword should be given. (mpMult)"); - } - fmp_mult_saved = F_mpMult; - mpMultName = KopString(getoa(ob5,i+1)); - switch_function("mpMult",mpMultName); - /* Note that this cause a global effect. It will be done again. */ - newRingp->multiplication = mpMult; - switch_function("mpMult",fmp_mult_saved); + if (getoa(ob5,i+1).tag != Sdollar) { + errorKan1("%s\n","A keyword should be given. (mpMult)"); + } + fmp_mult_saved = F_mpMult; + mpMultName = KopString(getoa(ob5,i+1)); + switch_function("mpMult",mpMultName); + /* Note that this cause a global effect. It will be done again. */ + newRingp->multiplication = mpMult; + switch_function("mpMult",fmp_mult_saved); } else if (strcmp(KopString(getoa(ob5,i)),"coefficient ring") == 0) { - if (getoa(ob5,i+1).tag != Sring) { - errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)"); - } - nextRing = KopRingp(getoa(ob5,i+1)); - newRingp->next = nextRing; + if (getoa(ob5,i+1).tag != Sring) { + errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)"); + } + nextRing = KopRingp(getoa(ob5,i+1)); + newRingp->next = nextRing; } else if (strcmp(KopString(getoa(ob5,i)),"valuation") == 0) { - errorKan1("%s\n","Not implemented. (valuation)"); + errorKan1("%s\n","Not implemented. (valuation)"); } else if (strcmp(KopString(getoa(ob5,i)),"characteristic") == 0) { - if (getoa(ob5,i+1).tag != Sinteger) { - errorKan1("%s\n","A integer should be given. (characteristic)"); - } - p = KopInteger(getoa(ob5,i+1)); - newRingp->p = p; + if (getoa(ob5,i+1).tag != Sinteger) { + errorKan1("%s\n","A integer should be given. (characteristic)"); + } + p = KopInteger(getoa(ob5,i+1)); + newRingp->p = p; } else if (strcmp(KopString(getoa(ob5,i)),"schreyer") == 0) { - if (getoa(ob5,i+1).tag != Sinteger) { - errorKan1("%s\n","A integer should be given. (schreyer)"); - } - newRingp->schreyer = KopInteger(getoa(ob5,i+1)); + if (getoa(ob5,i+1).tag != Sinteger) { + errorKan1("%s\n","A integer should be given. (schreyer)"); + } + newRingp->schreyer = KopInteger(getoa(ob5,i+1)); } else if (strcmp(KopString(getoa(ob5,i)),"gbListTower") == 0) { - if (getoa(ob5,i+1).tag != Slist) { - errorKan1("%s\n","A list should be given (gbListTower)."); - } - newRingp->gbListTower = newObject(); - *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1); + if (getoa(ob5,i+1).tag != Slist) { + errorKan1("%s\n","A list should be given (gbListTower)."); + } + newRingp->gbListTower = newObject(); + *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1); } else if (strcmp(KopString(getoa(ob5,i)),"ringName") == 0) { - if (getoa(ob5,i+1).tag != Sdollar) { - errorKan1("%s\n","A name should be given. (ringName)"); - } - ringName = KopString(getoa(ob5,i+1)); + if (getoa(ob5,i+1).tag != Sdollar) { + errorKan1("%s\n","A name should be given. (ringName)"); + } + ringName = KopString(getoa(ob5,i+1)); + } else if (strcmp(KopString(getoa(ob5,i)),"weightedHomogenization") == 0) { + if (getoa(ob5,i+1).tag != Sinteger) { + errorKan1("%s\n","A integer should be given. (weightedHomogenization)"); + } + 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 = OINIT; + struct object ods2 = OINIT; + 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 = OINIT; + struct object ovv = OINIT; + 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@"); + errorKan1("%s\n","Unknown keyword to set_up_ring@"); } }else{ errorKan1("%s\n","A keyword enclosed by braces have to be given."); @@ -1601,10 +1808,10 @@ struct object ob1,ob2,ob3,ob4,ob5; CurrentRingp = newRingp; /* Install it to the RingStack */ if (rp nothing (argc=0) {x}----> x (argc=1) {x,y} --> x y (argc=2) - {ab, y, z } --> ab y z (argc=3) + {ab, y, z } --> ab y z (argc=3) [[ab],c,d] --> [ab] c d */ { @@ -2022,11 +2230,101 @@ int limit; return(argc); } +struct object KstringToArgv(struct object ob) { + struct object rob = OINIT; + 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; itag != SrationalFunction) return(0); @@ -2153,15 +2465,18 @@ struct object KgbExtension(struct object obj) { char *key; int size; - struct object keyo; + struct object keyo = OINIT; struct object rob = NullObject; - struct object obj1,obj2,obj3; + struct object obj1 = OINIT; + struct object obj2 = OINIT; + struct object obj3 = OINIT; POLY f1; POLY f2; POLY f3; POLY f; int m,i; struct pairOfPOLY pf; + struct coeff *cont; if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array."); size = getoaSize(obj); @@ -2241,6 +2556,13 @@ struct object KgbExtension(struct object obj) errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext"); } return(KpoInteger(isConstant(KopPOLY(obj1)))); + }else if (strcmp(key,"isConstantAll")==0) { + if (size != 2) errorKan1("%s\n","[(isConstantAll) poly ] gbext bool"); + obj1 = getoa(obj,1); + if (obj1.tag != Spoly) { + errorKan1("%s\n","The datatype of the argument mismatch: [(isConstantAll) polynomial] gbext"); + } + return(KpoInteger(isConstantAll(KopPOLY(obj1)))); }else if (strcmp(key,"schreyerSkelton") == 0) { if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array"); obj1 = getoa(obj,1); @@ -2275,6 +2597,37 @@ struct object KgbExtension(struct object obj) obj1 = getoa(obj,1); if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly"); return(KisOrdered(obj1)); + }else if (strcmp(key,"reduceContent")==0) { + if (size != 2) errorKan1("%s\n","[(reduceContent) poly1 ] gbext."); + obj1 = getoa(obj,1); + if (obj1.tag != Spoly) + errorKan1("%s\n","[(reduceContent) poly1 ] gbext."); + f1 = KopPOLY(obj1); + 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."); } @@ -2285,9 +2638,12 @@ struct object KmpzExtension(struct object obj) { char *key; int size; - struct object keyo; + struct object keyo = OINIT; struct object rob = NullObject; - struct object obj0,obj1,obj2,obj3; + struct object obj0 = OINIT; + struct object obj1 = OINIT; + struct object obj2 = OINIT; + struct object obj3 = OINIT; MP_INT *f; MP_INT *g; MP_INT *h; @@ -2310,10 +2666,16 @@ 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) || - ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { + ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); } f = coeff_to_MP_INT(obj1.lc.universalNumber); @@ -2326,10 +2688,16 @@ 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) || - ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { + ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); } f = coeff_to_MP_INT(obj1.lc.universalNumber); @@ -2360,7 +2728,7 @@ struct object KmpzExtension(struct object obj) return(obj0); } if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || - ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { + ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext."); } f = coeff_to_MP_INT(obj1.lc.universalNumber); @@ -2380,10 +2748,13 @@ struct object KmpzExtension(struct object obj) rob = KnewRationalFunction0(copyObjectp(&obj1),copyObjectp(&obj2)); KisInvalidRational(&rob); }else if (strcmp(key,"sqrt")==0 || - strcmp(key,"com")==0) { + strcmp(key,"com")==0) { /* 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)) @@ -2399,16 +2770,22 @@ struct object KmpzExtension(struct object obj) rob.tag = SuniversalNumber; rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp); }else if (strcmp(key,"probab_prime_p")==0 || - strcmp(key,"and") == 0 || - strcmp(key,"ior")==0) { + strcmp(key,"and") == 0 || + strcmp(key,"ior")==0) { /* Two args functions */ 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) || - ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { + ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { errorKan1("%s\n","[key num1 num2] mpzext."); } f = coeff_to_MP_INT(obj1.lc.universalNumber); @@ -2416,9 +2793,9 @@ struct object KmpzExtension(struct object obj) if (strcmp(key,"probab_prime_p")==0) { gi = (int) mpz_get_si(g); if (mpz_probab_prime_p(f,gi)) { - rob = KpoInteger(1); + rob = KpoInteger(1); }else { - rob = KpoInteger(0); + rob = KpoInteger(0); } }else if (strcmp(key,"and")==0) { r1 = newMP_INT(); @@ -2436,14 +2813,23 @@ 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 ) { errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers."); } if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || - ! is_this_coeff_MP_INT(obj2.lc.universalNumber) || - ! is_this_coeff_MP_INT(obj3.lc.universalNumber)) { + ! is_this_coeff_MP_INT(obj2.lc.universalNumber) || + ! is_this_coeff_MP_INT(obj3.lc.universalNumber)) { errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers."); } f = coeff_to_MP_INT(obj1.lc.universalNumber); @@ -2454,6 +2840,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."); } @@ -2464,7 +2872,7 @@ struct object KmpzExtension(struct object obj) /** : context */ struct object KnewContext(struct object superObj,char *name) { struct context *cp; - struct object ob; + struct object ob = OINIT; if (superObj.tag != Sclass) { errorKan1("%s\n","The argument of KnewContext must be a Class.Context"); } @@ -2479,14 +2887,14 @@ struct object KnewContext(struct object superObj,char } struct object KcreateClassIncetance(struct object ob1, - struct object ob2, - struct object ob3) + struct object ob2, + struct object ob3) { /* [class-tag super-obj] size [class-tag] cclass */ - struct object ob4; + struct object ob4 = OINIT; int size,size2,i; - struct object ob5; - struct object rob; + struct object ob5 = OINIT; + struct object rob = OINIT; if (ob1.tag != Sarray) errorKan1("%s\n","cclass: The first argument must be an array."); @@ -2509,7 +2917,7 @@ struct object KcreateClassIncetance(struct object ob1, ob5 = getoa(ob3,0); if (ectag(ob5) != CLASSNAME_CONTEXT) errorKan1("%s\n","cclass: The third argument must be [class-tag]."); - + rob = newObjectArray(size); putoa(rob,0,ob5); if (getoaSize(ob1) < size) size2 = getoaSize(ob1); @@ -2539,8 +2947,8 @@ struct object KpoDouble(double a) { double toDouble0(struct object ob) { double r; int r3; - struct object ob2; - struct object ob3; + struct object ob2 = OINIT; + struct object ob3 = OINIT; switch(ob.tag) { case Sinteger: return( (double) (KopInteger(ob)) ); @@ -2569,7 +2977,7 @@ double toDouble0(struct object ob) { } struct object KpoGradedPolySet(struct gradedPolySet *grD) { - struct object rob; + struct object rob = OINIT; rob.tag = Sclass; rob.lc.ival = CLASSNAME_GradedPolySet; rob.rc.voidp = (void *) grD; @@ -2586,10 +2994,14 @@ static char *getspace0(int a) { return(s); } struct object KdefaultPolyRing(struct object ob) { - struct object rob; + struct object rob = OINIT; int i,j,k,n; - struct object ob1,ob2,ob3,ob4,ob5; - struct object t1; + struct object ob1 = OINIT; + struct object ob2 = OINIT; + struct object ob3 = OINIT; + struct object ob4 = OINIT; + struct object ob5 = OINIT; + struct object t1 = OINIT; char *s1; extern struct ring *CurrentRingp; static struct ring *a[N0]; @@ -2644,7 +3056,7 @@ struct object KdefaultPolyRing(struct object ob) { for (j=0; j<2*n; j++) { putoa(t1,j,KpoInteger(0)); if (j == (2*n-i)) { - putoa(t1,j,KpoInteger(-1)); + putoa(t1,j,KpoInteger(-1)); } } putoa(ob4,i,t1); @@ -2660,21 +3072,257 @@ 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 0) { + ba = (unsigned char *) sGC_malloc(size); + if (ba == NULL) errorKan1("%s\n","No more memory."); + } + rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size; + if (obj.tag == SbyteArray) { + n = getByteArraySize(obj); + ba2 = KopByteArray(obj); + for (i=0; i<(n 0) { + ba = (unsigned char *) sGC_malloc(size); + if (ba == NULL) errorKan1("%s\n","No more memory."); + } + rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size; + for (i=0; i