=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/kanExport0.c,v retrieving revision 1.6 retrieving revision 1.32 diff -u -p -r1.6 -r1.32 --- OpenXM/src/kan96xx/Kan/kanExport0.c 2001/04/12 06:48:25 1.6 +++ OpenXM/src/kan96xx/Kan/kanExport0.c 2004/09/09 11:42:22 1.32 @@ -1,4 +1,4 @@ -/* $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.31 2004/09/09 03:14:46 takayama Exp $ */ #include #include "datatype.h" #include "stackm.h" @@ -19,10 +19,11 @@ 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; @@ -142,14 +143,18 @@ 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; @@ -270,14 +275,18 @@ 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; @@ -412,7 +421,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,7 +434,7 @@ struct object ob1,ob2; struct object KoNegate(obj) -struct object obj; + struct object obj; { struct object rob = NullObject; extern struct ring SmallRing; @@ -451,14 +464,18 @@ 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; @@ -494,7 +511,7 @@ struct object obj; static int isVector(ob) -struct object ob; + struct object ob; { int i,n; n = getoaSize(ob); @@ -505,8 +522,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."); @@ -600,15 +617,15 @@ struct object aa,bb; } 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; + 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,42 +828,57 @@ 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; + 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 */ @@ -847,9 +898,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,6 +919,10 @@ 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{ warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n"); } @@ -893,8 +948,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 +968,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 +984,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 +1019,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)); @@ -980,17 +1034,25 @@ char *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; icoeffp))); + return(KpoInteger(coeffToInt(obj.lc.poly->coeffp))); } }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) { rob.tag = Sdollar; @@ -1002,25 +1064,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 +1112,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 +1136,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,6 +1203,9 @@ 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"); } @@ -1146,11 +1215,28 @@ char *key; } return(NullObject); } - + +/* cf. macro to_int32 */ +struct object Kto_int32(struct object ob) { + int n,i; + struct object otmp; + struct object rob; + if (ob.tag == SuniversalNumber) return KdataConversion(ob,"integer"); + if (ob.tag == Sarray) { + n = getoaSize(ob); + rob = newObjectArray(n); + for (i=0; ischreyer = 0; newRingp->gbListTower = NULL; newRingp->outputOrder = outputVars; + newRingp->weightedHomogenization = 0; + newRingp->degreeShiftSize = 0; + newRingp->degreeShiftN = 0; + newRingp->degreeShift = NULL; if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) { errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given."); @@ -1544,47 +1653,83 @@ 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; + 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)); + } + } + } + } + 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 +1746,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 +2167,51 @@ int 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; itag != SrationalFunction) return(0); @@ -2162,6 +2361,7 @@ struct object KgbExtension(struct object obj) 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 +2441,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 +2482,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."); } @@ -2310,10 +2548,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 +2570,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 +2610,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 +2630,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 +2652,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 +2675,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 +2695,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 +2722,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."); } @@ -2479,8 +2769,8 @@ 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; @@ -2509,7 +2799,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); @@ -2644,7 +2934,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,6 +2950,47 @@ 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