[BACK]Return to kanExport0.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport0.c between version 1.2 and 1.34

version 1.2, 1999/11/06 10:37:30 version 1.34, 2004/09/13 11:24:11
Line 1 
Line 1 
 /* $OpenXM$  */  /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.33 2004/09/11 01:00:42 takayama Exp $  */
 #include <stdio.h>  #include <stdio.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
Line 19  int SerialCurrent = -1;  /* Current Serial number of t
Line 19  int SerialCurrent = -1;  /* Current Serial number of t
   
 int ReverseOutputOrder = 1;  int ReverseOutputOrder = 1;
 int WarningNoVectorVariable = 1;  int WarningNoVectorVariable = 1;
   extern int QuoteMode;
   
 /** :arithmetic **/  /** :arithmetic **/
 struct object KooAdd(ob1,ob2)  struct object KooAdd(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   extern struct ring *CurrentRingp;    extern struct ring *CurrentRingp;
   struct object rob = NullObject;    struct object rob = NullObject;
Line 142  struct object ob1,ob2;
Line 143  struct object ob1,ob2;
   
   
   default:    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;      break;
   }    }
   return(rob);    return(rob);
 }  }
   
 struct object KooSub(ob1,ob2)  struct object KooSub(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   POLY r;    POLY r;
Line 270  struct object ob1,ob2;
Line 275  struct object ob1,ob2;
     break;      break;
   
   default:    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;      break;
   }    }
   return(rob);    return(rob);
 }  }
   
 struct object KooMult(ob1,ob2)  struct object KooMult(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   POLY r;    POLY r;
Line 412  struct object ob1,ob2;
Line 421  struct object ob1,ob2;
     break;      break;
   
   default:    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;      break;
   }    }
   return(rob);    return(rob);
Line 421  struct object ob1,ob2;
Line 434  struct object ob1,ob2;
   
   
 struct object KoNegate(obj)  struct object KoNegate(obj)
 struct object obj;       struct object obj;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   extern struct ring SmallRing;    extern struct ring SmallRing;
Line 451  struct object obj;
Line 464  struct object obj;
     break;      break;
   
   default:    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;      break;
   }    }
   return(rob);    return(rob);
 }  }
   
 struct object KoInverse(obj)  struct object KoInverse(obj)
 struct object obj;       struct object obj;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   extern struct coeff *UniversalOne;    extern struct coeff *UniversalOne;
Line 494  struct object obj;
Line 511  struct object obj;
   
   
 static int isVector(ob)  static int isVector(ob)
 struct object ob;       struct object ob;
 {  {
   int i,n;    int i,n;
   n = getoaSize(ob);    n = getoaSize(ob);
Line 505  struct object ob;
Line 522  struct object ob;
 }  }
   
 static int isMatrix(ob,m,n)  static int isMatrix(ob,m,n)
 struct object ob;       struct object ob;
 int m,n;       int m,n;
 {  {
   int i,j;    int i,j;
   for (i=0; i<m; i++) {    for (i=0; i<m; i++) {
Line 521  int m,n;
Line 538  int m,n;
   
   
 struct object KaoMult(aa,bb)  struct object KaoMult(aa,bb)
 struct object aa,bb;       struct object aa,bb;
 /* aa and bb is assumed to be array. */       /* aa and bb is assumed to be array. */
 {  {
   int m,n,m2,n2;    int m,n,m2,n2;
   int i,j,k;    int i,j,k;
Line 549  struct object aa,bb;
Line 566  struct object aa,bb;
     if (r1 != 0) {      if (r1 != 0) {
       ob1 = getoa(aa,0);        ob1 = getoa(aa,0);
       if (ob1.tag == Spoly) {        if (ob1.tag == Spoly) {
         rob.tag = Spoly; rob.lc.poly = ZERO;          rob.tag = Spoly; rob.lc.poly = ZERO;
       }else if (ob1.tag == Sinteger) {        }else if (ob1.tag == Sinteger) {
         rob.tag = Sinteger; rob.lc.ival = 0;          rob.tag = Sinteger; rob.lc.ival = 0;
       }else {        }else {
         rob.tag = SuniversalNumber;          rob.tag = SuniversalNumber;
         rob.lc.universalNumber = intToCoeff(0,&SmallRing);          rob.lc.universalNumber = intToCoeff(0,&SmallRing);
       }        }
     }else{      }else{
       rob.tag = Spoly; rob.lc.poly = ZERO;        rob.tag = Spoly; rob.lc.poly = ZERO;
Line 564  struct object aa,bb;
Line 581  struct object aa,bb;
     }      }
     return(rob);      return(rob);
   } else if (r1 == 0 && r2 ) { /* matrix X vector ---> vector */    } else if (r1 == 0 && r2 ) { /* matrix X vector ---> vector */
                                /* (m n) (m2=n) */      /* (m n) (m2=n) */
     n = getoaSize(getoa(aa,0));      n = getoaSize(getoa(aa,0));
     if (isMatrix(aa,m,n) == 0) {      if (isMatrix(aa,m,n) == 0) {
       errorKan1("%s\n","KaoMult(matrix,vector). The left object is not matrix.");        errorKan1("%s\n","KaoMult(matrix,vector). The left object is not matrix.");
Line 600  struct object aa,bb;
Line 617  struct object aa,bb;
     }      }
     for (i=0; i<m; i++) {      for (i=0; i<m; i++) {
       for (j=0; j<n2; j++) {        for (j=0; j<n2; j++) {
         ofik = getoa(getoa(aa,i),0);          ofik = getoa(getoa(aa,i),0);
         ogkj = getoa(getoa(bb,0),j);          ogkj = getoa(getoa(bb,0),j);
         otmp = KooMult( ofik, ogkj);          otmp = KooMult( ofik, ogkj);
         for (k=1; k<n; k++) {          for (k=1; k<n; k++) {
           ofik = getoa(getoa(aa,i),k);            ofik = getoa(getoa(aa,i),k);
           ogkj = getoa(getoa(bb,k),j);            ogkj = getoa(getoa(bb,k),j);
           otmp = KooAdd(otmp, KooMult( ofik, ogkj));            otmp = KooAdd(otmp, KooMult( ofik, ogkj));
         }          }
         getoa(getoa(rob,i),j) = otmp;          getoa(getoa(rob,i),j) = otmp;
       }        }
     }      }
     return(rob);      return(rob);
Line 625  struct object aa,bb;
Line 642  struct object aa,bb;
     for (j=0; j<n2; j++) {      for (j=0; j<n2; j++) {
       tmp = ZERO;        tmp = ZERO;
       for (k=0; k<n; k++) {        for (k=0; k<n; k++) {
         fik = KopPOLY(getoa(getoa(aa,i),k));          fik = KopPOLY(getoa(getoa(aa,i),k));
         gkj = KopPOLY(getoa(getoa(bb,k),j));          gkj = KopPOLY(getoa(getoa(bb,k),j));
         tmp = ppAdd(tmp, ppMult( fik, gkj));          tmp = ppAdd(tmp, ppMult( fik, gkj));
       }        }
       getoa(getoa(rob,i),j) = KpoPOLY(tmp);        getoa(getoa(rob,i),j) = KpoPOLY(tmp);
     }      }
Line 636  struct object aa,bb;
Line 653  struct object aa,bb;
 }  }
   
 struct object KooDiv(ob1,ob2)  struct object KooDiv(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   switch (Lookup[ob1.tag][ob2.tag]) {    switch (Lookup[ob1.tag][ob2.tag]) {
Line 647  struct object ob1,ob2;
Line 664  struct object ob1,ob2;
     rob.tag = SuniversalNumber;      rob.tag = SuniversalNumber;
     rob.lc.universalNumber = newUniversalNumber(0);      rob.lc.universalNumber = newUniversalNumber(0);
     universalNumberDiv(rob.lc.universalNumber,ob1.lc.universalNumber,      universalNumberDiv(rob.lc.universalNumber,ob1.lc.universalNumber,
                        ob2.lc.universalNumber);                         ob2.lc.universalNumber);
     return(rob);      return(rob);
     break;      break;
   
   
   default:    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;      break;
   }    }
   return(rob);    return(rob);
Line 661  struct object ob1,ob2;
Line 682  struct object ob1,ob2;
   
 /* :relation */  /* :relation */
 KooEqualQ(obj1,obj2)  KooEqualQ(obj1,obj2)
 struct object obj1;       struct object obj1;
 struct object obj2;       struct object obj2;
 {  {
   struct object ob;    struct object ob;
   int i;    int i;
Line 671  struct object obj2;
Line 692  struct object obj2;
     return(0);      return(0);
   }    }
   switch(obj1.tag) {    switch(obj1.tag) {
     case 0:    case 0:
       return(1); /* case of NullObject */      return(1); /* case of NullObject */
       break;      break;
     case Sinteger:    case Sinteger:
       if (obj1.lc.ival == obj2.lc.ival) return(1);      if (obj1.lc.ival == obj2.lc.ival) return(1);
       else return(0);      else return(0);
       break;      break;
     case Sstring:    case Sstring:
     case Sdollar:    case Sdollar:
       if (strcmp(obj1.lc.str, obj2.lc.str)==0) return(1);      if (strcmp(obj1.lc.str, obj2.lc.str)==0) return(1);
       else return(0);      else return(0);
       break;      break;
     case Spoly:    case Spoly:
       ob = KooSub(obj1,obj2);      ob = KooSub(obj1,obj2);
       if (KopPOLY(ob) == ZERO) return(1);      if (KopPOLY(ob) == ZERO) return(1);
       else return(0);      else return(0);
     case Sarray:    case Sarray:
       if (getoaSize(obj1) != getoaSize(obj2)) return(0);      if (getoaSize(obj1) != getoaSize(obj2)) return(0);
       for (i=0; i< getoaSize(obj1); i++) {      for (i=0; i< getoaSize(obj1); i++) {
         if (KooEqualQ(getoa(obj1,i),getoa(obj2,i))) { ; }        if (KooEqualQ(getoa(obj1,i),getoa(obj2,i))) { ; }
         else { return(0); }        else { return(0); }
       }      }
       return(1);      return(1);
     case Slist:    case Slist:
       if (KooEqualQ(*(obj1.lc.op),*(obj2.lc.op))) {      if (KooEqualQ(*(obj1.lc.op),*(obj2.lc.op))) {
         if (isNullList(obj1.rc.op)) {        if (isNullList(obj1.rc.op)) {
           if (isNullList(obj2.rc.op)) return(1);          if (isNullList(obj2.rc.op)) return(1);
           else return(0);          else return(0);
         }else{  
           if (isNullList(obj2.rc.op)) return(0);  
           return(KooEqualQ(*(obj1.rc.op),*(obj2.rc.op)));  
         }  
       }else{        }else{
         return(0);          if (isNullList(obj2.rc.op)) return(0);
           return(KooEqualQ(*(obj1.rc.op),*(obj2.rc.op)));
       }        }
       break;      }else{
     case SuniversalNumber:        return(0);
       return(coeffEqual(obj1.lc.universalNumber,obj2.lc.universalNumber));  
       break;  
     case Sring:  
       return(KopRingp(obj1) == KopRingp(obj2));  
       break;  
     case Sclass:  
       return(KclassEqualQ(obj1,obj2));  
       break;  
     case Sdouble:  
       return(KopDouble(obj1) == KopDouble(obj2));  
       break;  
     default:  
       errorKan1("%s\n","KooEqualQ() has not supported these objects yet.");  
       break;  
     }      }
       break;
     case SuniversalNumber:
       return(coeffEqual(obj1.lc.universalNumber,obj2.lc.universalNumber));
       break;
     case Sring:
       return(KopRingp(obj1) == KopRingp(obj2));
       break;
     case Sclass:
       return(KclassEqualQ(obj1,obj2));
       break;
     case Sdouble:
       return(KopDouble(obj1) == KopDouble(obj2));
       break;
     default:
       errorKan1("%s\n","KooEqualQ() has not supported these objects yet.");
       break;
     }
 }  }
   
   
 struct object KoIsPositive(ob1)  struct object KoIsPositive(ob1)
 struct object ob1;       struct object ob1;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   switch (ob1.tag) {    switch (ob1.tag) {
Line 742  struct object ob1;
Line 763  struct object ob1;
 }  }
   
 struct object KooGreater(obj1,obj2)  struct object KooGreater(obj1,obj2)
 struct object obj1;       struct object obj1;
 struct object obj2;       struct object obj2;
 {  {
   struct object ob;    struct object ob;
   int tt;    int tt;
Line 751  struct object obj2;
Line 772  struct object obj2;
     errorKan1("%s\n","You cannot compare different kinds of objects.");      errorKan1("%s\n","You cannot compare different kinds of objects.");
   }    }
   switch(obj1.tag) {    switch(obj1.tag) {
     case 0:    case 0:
       return(KpoInteger(1)); /* case of NullObject */      return(KpoInteger(1)); /* case of NullObject */
       break;      break;
     case Sinteger:    case Sinteger:
       if (obj1.lc.ival > obj2.lc.ival) return(KpoInteger(1));      if (obj1.lc.ival > obj2.lc.ival) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case Sstring:    case Sstring:
     case Sdollar:    case Sdollar:
       if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1));      if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case Spoly:    case Spoly:
       if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1));      if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case SuniversalNumber:    case SuniversalNumber:
       tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);      tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
       if (tt > 0) return(KpoInteger(1));      if (tt > 0) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case Sdouble:    case Sdouble:
       if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1));      if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     default:    case Sarray:
       errorKan1("%s\n","KooGreater() has not supported these objects yet.");    {
       break;      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 KooLess(obj1,obj2)
 struct object obj1;       struct object obj1;
 struct object obj2;       struct object obj2;
 {  {
   struct object ob;    struct object ob;
   int tt;    int tt;
Line 792  struct object obj2;
Line 828  struct object obj2;
     errorKan1("%s\n","You cannot compare different kinds of objects.");      errorKan1("%s\n","You cannot compare different kinds of objects.");
   }    }
   switch(obj1.tag) {    switch(obj1.tag) {
     case 0:    case 0:
       return(KpoInteger(1)); /* case of NullObject */      return(KpoInteger(1)); /* case of NullObject */
       break;      break;
     case Sinteger:    case Sinteger:
       if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1));      if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case Sstring:    case Sstring:
     case Sdollar:    case Sdollar:
       if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1));      if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case Spoly:    case Spoly:
       if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1));      if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case SuniversalNumber:    case SuniversalNumber:
       tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);      tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
       if (tt < 0) return(KpoInteger(1));      if (tt < 0) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     case Sdouble:    case Sdouble:
       if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1));      if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1));
       else return(KpoInteger(0));      else return(KpoInteger(0));
       break;      break;
     default:    case Sarray:
       errorKan1("%s\n","KooLess() has not supported these objects yet.");    {
       break;      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 */  /* :conversion */
   
 struct object KdataConversion(obj,key)  struct object KdataConversion(obj,key)
 struct object obj;       struct object obj;
 char *key;       char *key;
 {  {
   char tmps[128]; /* Assume that double is not more than 128 digits */    char tmps[128]; /* Assume that double is not more than 128 digits */
   char intstr[100]; /* Assume that int is not more than 100 digits */    char intstr[100]; /* Assume that int is not more than 100 digits */
Line 847  char *key;
Line 898  char *key;
       return(rob);        return(rob);
     }else if (strcmp(key,"type??")==0) {      }else if (strcmp(key,"type??")==0) {
       if (obj.tag != Sclass) {        if (obj.tag != Sclass) {
         rob = KpoInteger(obj.tag);          rob = KpoInteger(obj.tag);
       }else {        }else {
         rob = KpoInteger(ectag(obj));          rob = KpoInteger(ectag(obj));
       }        }
       return(rob);        return(rob);
     }else if (strcmp(key,"error")==0) {      }else if (strcmp(key,"error")==0) {
Line 868  char *key;
Line 919  char *key;
       return(rob);        return(rob);
     }else if (strcmp(key,"poly") == 0) {      }else if (strcmp(key,"poly") == 0) {
       rob = KpoPOLY(ZERO);        rob = KpoPOLY(ZERO);
         return rob;
       }else if (strcmp(key,"array") == 0) {
         rob = newObjectArray(0);
         return rob;
     }else{      }else{
       warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");        warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");
     }      }
Line 893  char *key;
Line 948  char *key;
       strcpy(rob.lc.str,intstr);        strcpy(rob.lc.str,intstr);
       return(rob);        return(rob);
     }else if (strcmp(key,"universalNumber")==0) {      }else if (strcmp(key,"universalNumber")==0) {
       rob.tag = SuniversalNumber;        rob = KintToUniversalNumber(obj.lc.ival);
       rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);  
       return(rob);        return(rob);
     }else if (strcmp(key,"double") == 0) {      }else if (strcmp(key,"double") == 0) {
       rob = KpoDouble((double) (obj.lc.ival));        rob = KpoDouble((double) (obj.lc.ival));
Line 914  char *key;
Line 968  char *key;
       rob.tag = Sstring;        rob.tag = Sstring;
       s = (char *) sGC_malloc(sizeof(char)*(strlen(obj.lc.str)+3));        s = (char *) sGC_malloc(sizeof(char)*(strlen(obj.lc.str)+3));
       if (s == (char *) NULL)   {        if (s == (char *) NULL)   {
         errorKan1("%s\n","No memory.");          errorKan1("%s\n","No memory.");
       }        }
       s[0] = '/';        s[0] = '/';
       strcpy(&(s[1]),obj.lc.str);        strcpy(&(s[1]),obj.lc.str);
Line 930  char *key;
Line 984  char *key;
     }else if (strcmp(key,"array")==0) {      }else if (strcmp(key,"array")==0) {
       rob = newObjectArray(strlen(obj.lc.str));        rob = newObjectArray(strlen(obj.lc.str));
       for (i=0; i<strlen(obj.lc.str); i++) {        for (i=0; i<strlen(obj.lc.str); i++) {
         putoa(rob,i,KpoInteger((obj.lc.str)[i]));          putoa(rob,i,KpoInteger((obj.lc.str)[i]));
       }        }
       return(rob);        return(rob);
     }else if (strcmp(key,"universalNumber") == 0) {      }else if (strcmp(key,"universalNumber") == 0) {
       rob.tag = SuniversalNumber;        rob.tag = SuniversalNumber;
       rob.lc.universalNumber = stringToUniversalNumber(obj.lc.str,&flag);        rob.lc.universalNumber = stringToUniversalNumber(obj.lc.str,&flag);
       if (flag == -1) errorKan1("KdataConversion(): %s",        if (flag == -1) errorKan1("KdataConversion(): %s",
                                   "It's not number.\n");                                  "It's not number.\n");
       return(rob);        return(rob);
     }else if (strcmp(key,"double") == 0) {      }else if (strcmp(key,"double") == 0) {
       /* Check the format.  2.3432 e2 is not allowed. It should be 2.3232e2.*/        /* Check the format.  2.3432 e2 is not allowed. It should be 2.3232e2.*/
       flag = 0;        flag = 0;
       for (i=0; (obj.lc.str)[i] != '\0'; i++) {        for (i=0; (obj.lc.str)[i] != '\0'; i++) {
         if ((obj.lc.str)[i] > ' ' && flag == 0) flag=1;          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 == 1) flag = 2;
         else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3;          else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3;
       }        }
       if (flag == 3) errorKan1("KdataConversion(): %s","The data for the double contains blanck(s)");        if (flag == 3) errorKan1("KdataConversion(): %s","The data for the double contains blanck(s)");
       /* Read the double. */        /* Read the double. */
       if (sscanf(obj.lc.str,"%lf",&f) <= 0) {        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);        rob = KpoDouble(f);
       return(rob);        return(rob);
Line 965  char *key;
Line 1019  char *key;
     if (strcmp(key,"array") == 0) {      if (strcmp(key,"array") == 0) {
       return(rob);        return(rob);
     }else if (strcmp(key,"list") == 0) {      }else if (strcmp(key,"list") == 0) {
       rob = *( arrayToList(obj) );        rob = KarrayToList(obj);
       return(rob);        return(rob);
     }else if (strcmp(key,"arrayOfPOLY")==0) {      }else if (strcmp(key,"arrayOfPOLY")==0) {
       rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));        rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));
Line 980  char *key;
Line 1034  char *key;
       rob = NullObject;        rob = NullObject;
       return(rob);        return(rob);
     }else {      }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<n; i++) {
                     putoa(rob,i,KdataConversion(getoa(obj,i),key));
                   }
                   return(rob);
             }
     }      }
     break;      break;
   case Spoly:    case Spoly:
     if (strcmp(key,"poly")==0) {      if ((strcmp(key,"poly")==0) || (strcmp(key,"numerator")==0)) {
         rob = obj;
       return(rob);        return(rob);
     }else if (strcmp(key,"integer")==0) {      }else if (strcmp(key,"integer")==0) {
       if (obj.lc.poly == ZERO) return(KpoInteger(0));        if (obj.lc.poly == ZERO) return(KpoInteger(0));
       else {        else {
         return(KpoInteger(coeffToInt(obj.lc.poly->coeffp)));          return(KpoInteger(coeffToInt(obj.lc.poly->coeffp)));
       }        }
     }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {      }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
       rob.tag = Sdollar;        rob.tag = Sdollar;
Line 1001  char *key;
Line 1064  char *key;
       return(KringMap(obj));        return(KringMap(obj));
     }else if (strcmp(key,"universalNumber")==0) {      }else if (strcmp(key,"universalNumber")==0) {
       if (obj.lc.poly == ZERO) {        if (obj.lc.poly == ZERO) {
         rob.tag = SuniversalNumber;          rob.tag = SuniversalNumber;
         rob.lc.universalNumber = newUniversalNumber(0);          rob.lc.universalNumber = newUniversalNumber(0);
       } else {        } else {
         if (obj.lc.poly->coeffp->tag == MP_INTEGER) {          if (obj.lc.poly->coeffp->tag == MP_INTEGER) {
           rob.tag = SuniversalNumber;            rob.tag = SuniversalNumber;
           rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp);            rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp);
         }else {          }else {
           rob = NullObject;            rob = NullObject;
           warningKan("Coefficient is not MP_INT.");            warningKan("Coefficient is not MP_INT.");
         }          }
       }        }
       return(rob);        return(rob);
     }else if (strcmp(key,"ring")==0) {      }else if (strcmp(key,"ring")==0) {
       if (obj.lc.poly ISZERO) {        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{        }else{
         rob.tag = Sring;          rob.tag = Sring;
         rob.lc.ringp = (obj.lc.poly)->m->ringp;          rob.lc.ringp = (obj.lc.poly)->m->ringp;
         return(rob);          return(rob);
       }        }
     }else if (strcmp(key,"null") == 0) {      }else if (strcmp(key,"null") == 0) {
       rob = NullObject;        rob = NullObject;
Line 1049  char *key;
Line 1112  char *key;
     break;      break;
   case Slist:    case Slist:
     if (strcmp(key,"array") == 0) {      if (strcmp(key,"array") == 0) {
       rob = listToArray(&obj);        rob = KlistToArray(obj);
       return(rob);        return(rob);
     }      }
     break;      break;
   case SuniversalNumber:    case SuniversalNumber:
     if (strcmp(key,"universalNumber")==0) {      if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) {
         rob = obj;
       return(rob);        return(rob);
     }else if (strcmp(key,"integer")==0) {      }else if (strcmp(key,"integer")==0) {
       rob = KpoInteger(coeffToInt(obj.lc.universalNumber));        rob = KpoInteger(coeffToInt(obj.lc.universalNumber));
Line 1072  char *key;
Line 1136  char *key;
     }else if (strcmp(key,"double") == 0) {      }else if (strcmp(key,"double") == 0) {
       rob = KpoDouble( toDouble0(obj) );        rob = KpoDouble( toDouble0(obj) );
       return(rob);        return(rob);
       }else if (strcmp(key,"denominator") == 0) {
         rob = KintToUniversalNumber(1);
         return(rob);
     }else{      }else{
       warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n");        warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n");
     }      }
Line 1136  char *key;
Line 1203  char *key;
     if (strcmp(key,"orderMatrix")==0) {      if (strcmp(key,"orderMatrix")==0) {
       rob = oGetOrderMatrix(KopRingp(obj));        rob = oGetOrderMatrix(KopRingp(obj));
       return(rob);        return(rob);
       }else if (strcmp(key,"oxRingStructure")==0) {
         rob = oRingToOXringStructure(KopRingp(obj));
         return(rob);
     }else{      }else{
       warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");        warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");
     }      }
Line 1145  char *key;
Line 1215  char *key;
   }    }
   return(NullObject);    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; i<n; i++) {
             otmp = Kto_int32(getoa(ob,i));
             putoa(rob,i,otmp);
           }
           return rob;
     }
     return ob;
   }
 /* conversion functions between primitive data and objects.  /* conversion functions between primitive data and objects.
    If it's not time critical, it is recommended to use these functions */     If it's not time critical, it is recommended to use these functions */
 struct object KpoInteger(k)  struct object KpoInteger(k)
 int k;       int k;
 {  {
   struct object obj;    struct object obj;
   obj.tag = Sinteger;    obj.tag = Sinteger;
Line 1157  int k;
Line 1244  int k;
   return(obj);    return(obj);
 }  }
 struct object KpoString(s)  struct object KpoString(s)
 char *s;       char *s;
 {  {
   struct object obj;    struct object obj;
   obj.tag = Sdollar;    obj.tag = Sdollar;
Line 1165  char *s;
Line 1252  char *s;
   return(obj);    return(obj);
 }  }
 struct object KpoPOLY(f)  struct object KpoPOLY(f)
 POLY f;       POLY f;
 {  {
   struct object obj;    struct object obj;
   obj.tag = Spoly;    obj.tag = Spoly;
Line 1173  POLY f;
Line 1260  POLY f;
   return(obj);    return(obj);
 }  }
 struct object KpoArrayOfPOLY(ap)  struct object KpoArrayOfPOLY(ap)
 struct arrayOfPOLY *ap ;       struct arrayOfPOLY *ap ;
 {  {
   struct object obj;    struct object obj;
   obj.tag = SarrayOfPOLY;    obj.tag = SarrayOfPOLY;
Line 1182  struct arrayOfPOLY *ap ;
Line 1269  struct arrayOfPOLY *ap ;
 }  }
   
 struct object KpoMatrixOfPOLY(mp)  struct object KpoMatrixOfPOLY(mp)
 struct matrixOfPOLY *mp ;       struct matrixOfPOLY *mp ;
 {  {
   struct object obj;    struct object obj;
   obj.tag = SmatrixOfPOLY;    obj.tag = SmatrixOfPOLY;
Line 1191  struct matrixOfPOLY *mp ;
Line 1278  struct matrixOfPOLY *mp ;
 }  }
   
 struct object KpoRingp(ringp)  struct object KpoRingp(ringp)
 struct ring *ringp;       struct ring *ringp;
 {  {
   struct object obj;    struct object obj;
   obj.tag = Sring;    obj.tag = Sring;
Line 1199  struct ring *ringp;
Line 1286  struct ring *ringp;
   return(obj);    return(obj);
 }  }
   
   struct object KpoUniversalNumber(u)
        struct coeff *u;
   {
     struct object obj;
     obj.tag = SuniversalNumber;
     obj.lc.universalNumber = u;
     return(obj);
   }
   struct object KintToUniversalNumber(n)
            int n;
   {
     struct object rob;
     extern struct ring SmallRing;
     rob.tag = SuniversalNumber;
     rob.lc.universalNumber = intToCoeff(n,&SmallRing);
     return(rob);
   }
   
 /*** conversion 2. Data conversions on arrays and matrices. ****/  /*** conversion 2. Data conversions on arrays and matrices. ****/
 struct object arrayOfPOLYToArray(aa)  struct object arrayOfPOLYToArray(aa)
 struct arrayOfPOLY *aa;       struct arrayOfPOLY *aa;
 {  {
   POLY *a;    POLY *a;
   int size;    int size;
Line 1220  struct arrayOfPOLY *aa;
Line 1325  struct arrayOfPOLY *aa;
 }  }
   
 struct object matrixOfPOLYToArray(pmat)  struct object matrixOfPOLYToArray(pmat)
 struct matrixOfPOLY *pmat;       struct matrixOfPOLY *pmat;
 {  {
   struct object r;    struct object r;
   struct object tmp;    struct object tmp;
Line 1241  struct matrixOfPOLY *pmat;
Line 1346  struct matrixOfPOLY *pmat;
 }  }
   
 struct arrayOfPOLY *arrayToArrayOfPOLY(oa)  struct arrayOfPOLY *arrayToArrayOfPOLY(oa)
 struct object oa;       struct object oa;
 {  {
   POLY *a;    POLY *a;
   int size;    int size;
Line 1250  struct object oa;
Line 1355  struct object oa;
   struct arrayOfPOLY *ap;    struct arrayOfPOLY *ap;
   
   if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",    if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",
                                   "Argument is not array\n");                                    "Argument is not array\n");
   size = getoaSize(oa);    size = getoaSize(oa);
   a = (POLY *)sGC_malloc(sizeof(POLY)*size);    a = (POLY *)sGC_malloc(sizeof(POLY)*size);
   for (i=0; i<size; i++) {    for (i=0; i<size; i++) {
     tmp = getoa(oa,i);      tmp = getoa(oa,i);
     if (tmp.tag != Spoly) errorKan1("KarrayToArrayOfPOLY():%s ",      if (tmp.tag != Spoly) errorKan1("KarrayToArrayOfPOLY():%s ",
                                     "element must be polynomial.\n");                                      "element must be polynomial.\n");
     a[i] = tmp.lc.poly;      a[i] = tmp.lc.poly;
   }    }
   ap = (struct arrayOfPOLY *)sGC_malloc(sizeof(struct arrayOfPOLY));    ap = (struct arrayOfPOLY *)sGC_malloc(sizeof(struct arrayOfPOLY));
Line 1266  struct object oa;
Line 1371  struct object oa;
 }  }
   
 struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)  struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)
 struct object oa;       struct object oa;
 {  {
   POLY *a;    POLY *a;
   int m;    int m;
Line 1276  struct object oa;
Line 1381  struct object oa;
   
   struct object tmp,tmp2;    struct object tmp,tmp2;
   if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",    if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",
                                   "Argument is not array\n");                                    "Argument is not array\n");
   m = getoaSize(oa);    m = getoaSize(oa);
   tmp = getoa(oa,0);    tmp = getoa(oa,0);
   if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY():%s ",    if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY():%s ",
                                   "Argument is not array\n");                                     "Argument is not array\n");
   n = getoaSize(tmp);    n = getoaSize(tmp);
   a = (POLY *)sGC_malloc(sizeof(POLY)*(m*n));    a = (POLY *)sGC_malloc(sizeof(POLY)*(m*n));
   for (i=0; i<m; i++) {    for (i=0; i<m; i++) {
     tmp = getoa(oa,i);      tmp = getoa(oa,i);
     if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY(): %s",      if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY(): %s",
                                      "element must be array.\n");                                       "element must be array.\n");
     for (j=0; j<n; j++) {      for (j=0; j<n; j++) {
       tmp2 = getoa(tmp,j);        tmp2 = getoa(tmp,j);
       if (tmp2.tag != Spoly) errorKan1("arrayToMatrixOfPOLY(): %s",        if (tmp2.tag != Spoly) errorKan1("arrayToMatrixOfPOLY(): %s",
                                        "element must be a polynomial.\n");                                         "element must be a polynomial.\n");
       a[ind(i,j)] = tmp2.lc.poly;        a[ind(i,j)] = tmp2.lc.poly;
       /* we use the macro ind here.  Be careful of using m and n. */        /* we use the macro ind here.  Be careful of using m and n. */
     }      }
Line 1305  struct object oa;
Line 1410  struct object oa;
   
 /* :ring    :kan */  /* :ring    :kan */
 int objArrayToOrderMatrix(oA,order,n,oasize)  int objArrayToOrderMatrix(oA,order,n,oasize)
 struct object oA;       struct object oA;
 int order[];       int order[];
 int n;       int n;
 int oasize;       int oasize;
 {  {
   int size;    int size;
   int k,j;    int k,j;
Line 1342  int oasize;
Line 1447  int oasize;
 }  }
   
 int KsetOrderByObjArray(oA)  int KsetOrderByObjArray(oA)
 struct object oA;       struct object oA;
 {  {
   int *order;    int *order;
   int n,c,l, oasize;    int n,c,l, oasize;
Line 1370  struct object oA;
Line 1475  struct object oA;
 }  }
   
 static int checkRelations(c,l,m,n,cc,ll,mm,nn)  static int checkRelations(c,l,m,n,cc,ll,mm,nn)
 int c,l,m,n,cc,ll,mm,nn;       int c,l,m,n,cc,ll,mm,nn;
 {  {
   if (!(1<=c && c<=l && l<=m && m<=n)) return(1);    if (!(1<=c && c<=l && l<=m && m<=n)) return(1);
   if (!(cc<=ll && ll<=mm && mm<=nn && nn <= n)) return(1);    if (!(cc<=ll && ll<=mm && mm<=nn && nn <= n)) return(1);
   if (!(cc<c || ll < l || mm < m || nn < n)) {    if (!(cc<c || ll < l || mm < m || nn < n)) {
     if (WarningNoVectorVariable) {      if (WarningNoVectorVariable) {
       warningKan("Ring definition: there is no variable to represent vectors.\n");        warningKanNoStrictMode("Ring definition: there is no variable to represent vectors.\n");
     }      }
   }    }
   if (!(cc<=c && ll <= l && mm <= m && nn <= n)) return(1);    if (!(cc<=c && ll <= l && mm <= m && nn <= n)) return(1);
Line 1391  struct object KgetOrderMatrixOfCurrentRing() 
Line 1496  struct object KgetOrderMatrixOfCurrentRing() 
   
   
 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 struct object ob1,ob2,ob3,ob4,ob5;       struct object ob1,ob2,ob3,ob4,ob5;
 /* ob1 = [x(0), ..., x(n-1)];       /* ob1 = [x(0), ..., x(n-1)];
    ob2 = [D(0), ..., D(n-1)];          ob2 = [D(0), ..., D(n-1)];
    ob3 = [p,c,l,m,n,cc,ll,mm,nn,next];          ob3 = [p,c,l,m,n,cc,ll,mm,nn,next];
    ob4 = Order matrix          ob4 = Order matrix
    ob5 = [(keyword) value (keyword) value ....]          ob5 = [(keyword) value (keyword) value ....]
 */       */
 #define RP_LIMIT 500  #define RP_LIMIT 500
 {  {
   int i;    int i;
Line 1495  struct object ob1,ob2,ob3,ob4,ob5;
Line 1600  struct object ob1,ob2,ob3,ob4,ob5;
       outputVars[i] = i;        outputVars[i] = i;
     }      }
   }    }
   
     ob4 = Kto_int32(ob4); /* order matrix */
   oasize = getoaSize(ob4);    oasize = getoaSize(ob4);
   order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));    order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
   if (order == (int *)NULL) errorKan1("%s\n","No memory.");    if (order == (int *)NULL) errorKan1("%s\n","No memory.");
Line 1536  struct object ob1,ob2,ob3,ob4,ob5;
Line 1642  struct object ob1,ob2,ob3,ob4,ob5;
   newRingp->schreyer = 0;    newRingp->schreyer = 0;
   newRingp->gbListTower = NULL;    newRingp->gbListTower = NULL;
   newRingp->outputOrder = outputVars;    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) {    if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {
     errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");      errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");
Line 1543  struct object ob1,ob2,ob3,ob4,ob5;
Line 1655  struct object ob1,ob2,ob3,ob4,ob5;
   for (i=0; i < getoaSize(ob5); i += 2) {    for (i=0; i < getoaSize(ob5); i += 2) {
     if (getoa(ob5,i).tag == Sdollar) {      if (getoa(ob5,i).tag == Sdollar) {
       if (strcmp(KopString(getoa(ob5,i)),"mpMult") == 0) {        if (strcmp(KopString(getoa(ob5,i)),"mpMult") == 0) {
         if (getoa(ob5,i+1).tag != Sdollar) {          if (getoa(ob5,i+1).tag != Sdollar) {
           errorKan1("%s\n","A keyword should be given. (mpMult)");            errorKan1("%s\n","A keyword should be given. (mpMult)");
         }          }
         fmp_mult_saved = F_mpMult;          fmp_mult_saved = F_mpMult;
         mpMultName = KopString(getoa(ob5,i+1));          mpMultName = KopString(getoa(ob5,i+1));
         switch_function("mpMult",mpMultName);          switch_function("mpMult",mpMultName);
         /* Note that this cause a global effect. It will be done again. */          /* Note that this cause a global effect. It will be done again. */
         newRingp->multiplication = mpMult;          newRingp->multiplication = mpMult;
         switch_function("mpMult",fmp_mult_saved);          switch_function("mpMult",fmp_mult_saved);
       } else if (strcmp(KopString(getoa(ob5,i)),"coefficient ring") == 0) {        } else if (strcmp(KopString(getoa(ob5,i)),"coefficient ring") == 0) {
         if (getoa(ob5,i+1).tag != Sring) {          if (getoa(ob5,i+1).tag != Sring) {
           errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)");            errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)");
         }          }
         nextRing = KopRingp(getoa(ob5,i+1));          nextRing = KopRingp(getoa(ob5,i+1));
         newRingp->next = nextRing;          newRingp->next = nextRing;
       } else if (strcmp(KopString(getoa(ob5,i)),"valuation") == 0) {        } 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) {        } else if (strcmp(KopString(getoa(ob5,i)),"characteristic") == 0) {
         if (getoa(ob5,i+1).tag != Sinteger) {          if (getoa(ob5,i+1).tag != Sinteger) {
           errorKan1("%s\n","A integer should be given. (characteristic)");            errorKan1("%s\n","A integer should be given. (characteristic)");
         }          }
         p = KopInteger(getoa(ob5,i+1));          p = KopInteger(getoa(ob5,i+1));
         newRingp->p = p;          newRingp->p = p;
       } else if (strcmp(KopString(getoa(ob5,i)),"schreyer") == 0) {        } else if (strcmp(KopString(getoa(ob5,i)),"schreyer") == 0) {
         if (getoa(ob5,i+1).tag != Sinteger) {          if (getoa(ob5,i+1).tag != Sinteger) {
           errorKan1("%s\n","A integer should be given. (schreyer)");            errorKan1("%s\n","A integer should be given. (schreyer)");
         }          }
         newRingp->schreyer = KopInteger(getoa(ob5,i+1));          newRingp->schreyer = KopInteger(getoa(ob5,i+1));
       } else if (strcmp(KopString(getoa(ob5,i)),"gbListTower") == 0) {        } else if (strcmp(KopString(getoa(ob5,i)),"gbListTower") == 0) {
         if (getoa(ob5,i+1).tag != Slist) {          if (getoa(ob5,i+1).tag != Slist) {
           errorKan1("%s\n","A list should be given (gbListTower).");            errorKan1("%s\n","A list should be given (gbListTower).");
         }          }
         newRingp->gbListTower = newObject();          newRingp->gbListTower = newObject();
         *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1);          *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1);
       } else if (strcmp(KopString(getoa(ob5,i)),"ringName") == 0) {        } else if (strcmp(KopString(getoa(ob5,i)),"ringName") == 0) {
         if (getoa(ob5,i+1).tag != Sdollar) {          if (getoa(ob5,i+1).tag != Sdollar) {
           errorKan1("%s\n","A name should be given. (ringName)");            errorKan1("%s\n","A name should be given. (ringName)");
         }          }
         ringName = KopString(getoa(ob5,i+1));          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; j<nn; j++) {
               ods2 = getoa(ods,j);
               for (k=0; k<dssize; k++) {
                 if (getoa(ods2,k).tag == SuniversalNumber) {
                   (newRingp->degreeShift)[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; j<nn; j++)
               (newRingp->partialEcartGlobalVarX)[j] = -1;
             for (j=0; j<nn; j++) {
               ovv = getoa(odv,j);
               if (ovv.tag != Sdollar) errorKan1("%s\n","partialEcartGlobalVarX: string is expected.");
               vname = KopString(ovv);
               for (k=0; k<n; k++) {
                 if (strcmp(vname,xvars[k]) == 0) {
                   (newRingp->partialEcartGlobalVarX)[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 {        } else {
         errorKan1("%s\n","Unknown keyword to set_up_ring@");          errorKan1("%s\n","Unknown keyword to set_up_ring@");
       }        }
     }else{      }else{
       errorKan1("%s\n","A keyword enclosed by braces have to be given.");        errorKan1("%s\n","A keyword enclosed by braces have to be given.");
Line 1600  struct object ob1,ob2,ob3,ob4,ob5;
Line 1778  struct object ob1,ob2,ob3,ob4,ob5;
       CurrentRingp = newRingp;        CurrentRingp = newRingp;
       /* Install it to the RingStack */        /* Install it to the RingStack */
       if (rp <RP_LIMIT) {        if (rp <RP_LIMIT) {
         rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */          rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
       }else{        }else{
         rp = 0;          rp = 0;
         errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");          errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
       }        }
     }else{      }else{
       /* This ring has been defined. */        /* This ring has been defined. */
Line 1671  struct object KsetVariableNames(struct object ob,struc
Line 1849  struct object KsetVariableNames(struct object ob,struc
   
   
 void KshowRing(ringp)  void KshowRing(ringp)
 struct ring *ringp;       struct ring *ringp;
 {  {
   showRing(1,ringp);    showRing(1,ringp);
 }  }
   
 struct object KswitchFunction(ob1,ob2)  struct object KswitchFunction(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   char *ans ;    char *ans ;
   struct object rob;    struct object rob;
Line 1697  struct object ob1,ob2;
Line 1875  struct object ob1,ob2;
   }    }
   if (AvoidTheSameRing) {    if (AvoidTheSameRing) {
     if (strcmp(KopString(ob1),"mmLarger") == 0 &&      if (strcmp(KopString(ob1),"mmLarger") == 0 &&
         strcmp(KopString(ob2),"matrix") != 0) {          strcmp(KopString(ob2),"matrix") != 0) {
       fprintf(stderr,"mmLarger = %s",KopString(ob2));        fprintf(stderr,"mmLarger = %s",KopString(ob2));
       errorKan1("%s\n","mmLarger can set only to matrix under AvoidTheSameRing == 1.");        errorKan1("%s\n","mmLarger can set only to matrix under AvoidTheSameRing == 1.");
     }      }
Line 1719  void KprintSwitchStatus(void)
Line 1897  void KprintSwitchStatus(void)
 }  }
   
 struct object KoReplace(of,rule)  struct object KoReplace(of,rule)
 struct object of;       struct object of;
 struct object rule;       struct object rule;
 {  {
   struct object rob;    struct object rob;
   POLY f;    POLY f;
Line 1737  struct object rule;
Line 1915  struct object rule;
   }    }
   n = getoaSize(rule);    n = getoaSize(rule);
   
   if (of.tag != Spoly) {    if (of.tag == Spoly) {
     }else if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
       return(KreplaceRecursivePolynomial(of,rule));
     }else{
     errorKan1("%s\n"," KoReplace(): The first argument must be a polynomial.");      errorKan1("%s\n"," KoReplace(): The first argument must be a polynomial.");
   }    }
   f = KopPOLY(of);    f = KopPOLY(of);
Line 1777  struct object rule;
Line 1958  struct object rule;
   
   
 struct object Kparts(f,v)  struct object Kparts(f,v)
 struct object f;       struct object f;
 struct object v;       struct object v;
 {  {
   POLY ff;    POLY ff;
   POLY vv;    POLY vv;
Line 1794  struct object v;
Line 1975  struct object v;
 }  }
   
 struct object Kparts2(f,v)  struct object Kparts2(f,v)
 struct object f;       struct object f;
 struct object v;       struct object v;
 {  {
   POLY ff;    POLY ff;
   POLY vv;    POLY vv;
Line 1811  struct object v;
Line 1992  struct object v;
   
   
 struct object Kdegree(ob1,ob2)  struct object Kdegree(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   if (ob1.tag != Spoly || ob2.tag != Spoly)    if (ob1.tag != Spoly || ob2.tag != Spoly)
     errorKan1("%s\n","The arguments must be polynomials.");      errorKan1("%s\n","The arguments must be polynomials.");
Line 1820  struct object ob1,ob2;
Line 2001  struct object ob1,ob2;
 }  }
   
 struct object KringMap(obj)  struct object KringMap(obj)
 struct object obj;       struct object obj;
 {  {
   extern struct ring *CurrentRingp;    extern struct ring *CurrentRingp;
   extern struct ring *SyzRingp;    extern struct ring *SyzRingp;
Line 1844  struct object obj;
Line 2025  struct object obj;
   
   
 struct object Ksp(ob1,ob2)  struct object Ksp(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   struct spValue sv;    struct spValue sv;
   struct object rob,cob;    struct object rob,cob;
Line 1853  struct object ob1,ob2;
Line 2034  struct object ob1,ob2;
     errorKan1("%s\n","Ksp(): The arguments must be polynomials.");      errorKan1("%s\n","Ksp(): The arguments must be polynomials.");
   sv = (*sp)(ob1.lc.poly,ob2.lc.poly);    sv = (*sp)(ob1.lc.poly,ob2.lc.poly);
   f = ppAddv(ppMult(sv.a,KopPOLY(ob1)),    f = ppAddv(ppMult(sv.a,KopPOLY(ob1)),
              ppMult(sv.b,KopPOLY(ob2)));               ppMult(sv.b,KopPOLY(ob2)));
   rob = newObjectArray(2);    rob = newObjectArray(2);
   cob = newObjectArray(2);    cob = newObjectArray(2);
   putoa(rob,1,KpoPOLY(f));    putoa(rob,1,KpoPOLY(f));
Line 1864  struct object ob1,ob2;
Line 2045  struct object ob1,ob2;
 }  }
   
 struct object Khead(ob)  struct object Khead(ob)
 struct object ob;       struct object ob;
 {  {
   if (ob.tag != Spoly) errorKan1("%s\n","Khead(): The argument should be a polynomial.");    if (ob.tag != Spoly) errorKan1("%s\n","Khead(): The argument should be a polynomial.");
   return(KpoPOLY(head( KopPOLY(ob))));    return(KpoPOLY(head( KopPOLY(ob))));
Line 1873  struct object ob;
Line 2054  struct object ob;
   
 /* :eval */  /* :eval */
 struct object Keval(obj)  struct object Keval(obj)
 struct object obj;       struct object obj;
 {  {
   char *key;    char *key;
   int size;    int size;
Line 1895  struct object obj;
Line 2076  struct object obj;
   
 /* :Utilities */  /* :Utilities */
 char *KremoveSpace(str)  char *KremoveSpace(str)
 char str[];       char str[];
 {  {
   int size;    int size;
   int start;    int start;
Line 1920  char str[];
Line 2101  char str[];
 }  }
   
 struct object KtoRecords(ob)  struct object KtoRecords(ob)
 struct object ob;       struct object ob;
 {  {
   struct object obj;    struct object obj;
   struct object tmp;    struct object tmp;
Line 1953  struct object ob;
Line 2134  struct object ob;
 }  }
   
 int KtoArgvbyCurryBrace(str,argv,limit)  int KtoArgvbyCurryBrace(str,argv,limit)
 char *str;       char *str;
 char *argv[];       char *argv[];
 int limit;       int limit;
 /* This function returns argc */       /* This function returns argc */
 /* decompose into tokens by the separators       /* decompose into tokens by the separators
    { }, [ ], and characters of which code is less than SPACE.     { }, [ ], and characters of which code is less than SPACE.
    Example.   { }  ---> nothing            (argc=0)     Example.   { }  ---> nothing            (argc=0)
               {x}----> x                   (argc=1)                {x}----> x                   (argc=1)
               {x,y} --> x   y              (argc=2)                {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                [[ab],c,d]  --> [ab] c   d
 */  */
 {  {
Line 2018  int limit;
Line 2199  int limit;
   return(argc);    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<n; i++) {
       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<n; i++) {
       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; i<wc; i++) {
       putoa(rob,i,KpoString(argv[i]));
       /* printf("%s\n",argv[i]); */
     }
     return(rob);
   }
   
 static void checkDuplicateName(xvars,dvars,n)  static void checkDuplicateName(xvars,dvars,n)
 char *xvars[];       char *xvars[];
 char *dvars[];       char *dvars[];
 int n;       int n;
 {  {
   int i,j;    int i,j;
   char *names[N0*2];    char *names[N0*2];
Line 2033  int n;
Line 2254  int n;
   for (i=0; i<n; i++) {    for (i=0; i<n; i++) {
     for (j=i+1; j<n; j++) {      for (j=i+1; j<n; j++) {
       if (strcmp(names[i],names[j]) == 0) {        if (strcmp(names[i],names[j]) == 0) {
         fprintf(stderr,"\n%d=%s, %d=%s\n",i,names[i],j,names[j]);          fprintf(stderr,"\n%d=%s, %d=%s\n",i,names[i],j,names[j]);
         errorKan1("%s\n","Duplicate definition of the name above in SetUpRing().");          errorKan1("%s\n","Duplicate definition of the name above in SetUpRing().");
       }        }
     }      }
   }    }
 }  }
   
   struct object KooPower(struct object ob1,struct object ob2) {
     struct object rob;
     /* Bug. It has not yet been implemented. */
     if (QuoteMode) {
       rob = powerTree(ob1,ob2);
     }else{
       warningKan("KooDiv2() has not supported yet these objects.\n");
     }
     return(rob);
   }
   
   
   
 struct object KooDiv2(ob1,ob2)  struct object KooDiv2(ob1,ob2)
 struct object ob1,ob2;       struct object ob1,ob2;
 {  {
   struct object rob = NullObject;    struct object rob = NullObject;
   POLY f;    POLY f;
Line 2102  struct object ob1,ob2;
Line 2333  struct object ob1,ob2;
     break;      break;
   
   default:    default:
     warningKan("KooDiv2() has not supported yet these objects.\n");      if (QuoteMode) {
         rob = divideTree(ob1,ob2);
       }else{
         warningKan("KooDiv2() has not supported yet these objects.\n");
       }
     break;      break;
   }    }
   return(rob);    return(rob);
Line 2131  struct object ob1,ob2;
Line 2366  struct object ob1,ob2;
 */  */
   
 int KisInvalidRational(op)  int KisInvalidRational(op)
 objectp op;       objectp op;
 {  {
   extern struct coeff *UniversalZero;    extern struct coeff *UniversalZero;
   if (op->tag != SrationalFunction) return(0);    if (op->tag != SrationalFunction) return(0);
Line 2158  struct object KgbExtension(struct object obj)
Line 2393  struct object KgbExtension(struct object obj)
   POLY f;    POLY f;
   int m,i;    int m,i;
   struct pairOfPOLY pf;    struct pairOfPOLY pf;
     struct coeff *cont;
   
   if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array.");    if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array.");
   size = getoaSize(obj);    size = getoaSize(obj);
Line 2237  struct object KgbExtension(struct object obj)
Line 2473  struct object KgbExtension(struct object obj)
       errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext");        errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext");
     }      }
     return(KpoInteger(isConstant(KopPOLY(obj1))));      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) {    }else if (strcmp(key,"schreyerSkelton") == 0) {
     if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array");      if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array");
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
Line 2260  struct object KgbExtension(struct object obj)
Line 2503  struct object KgbExtension(struct object obj)
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
     if (obj1.tag != Sarray) errorKan1("%s\n","[(toes) array] gbext poly");      if (obj1.tag != Sarray) errorKan1("%s\n","[(toes) array] gbext poly");
     return(KvectorToSchreyer_es(obj1));      return(KvectorToSchreyer_es(obj1));
     }else if (strcmp(key,"toe_") == 0) {
       if (size != 2) errorKan1("%s\n","[(toe_) array] gbext poly");
       obj1 = getoa(obj,1);
       if (obj1.tag == Spoly) return(obj1);
       if (obj1.tag != Sarray) errorKan1("%s\n","[(toe_) array] gbext poly");
       return(KpoPOLY(arrayToPOLY(obj1)));
   }else if (strcmp(key,"isOrdered") == 0) {    }else if (strcmp(key,"isOrdered") == 0) {
     if (size != 2) errorKan1("%s\n","[(isOrdered) poly] gbext poly");      if (size != 2) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
     if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly");      if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
     return(KisOrdered(obj1));      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 {    }else {
     errorKan1("%s\n","gbext : unknown tag.");      errorKan1("%s\n","gbext : unknown tag.");
   }    }
Line 2300  struct object KmpzExtension(struct object obj)
Line 2580  struct object KmpzExtension(struct object obj)
     if (size != 3) errorKan1("%s\n","[(gcd)  universalNumber universalNumber] mpzext.");      if (size != 3) errorKan1("%s\n","[(gcd)  universalNumber universalNumber] mpzext.");
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
     obj2 = getoa(obj,2);      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)      if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
       errorKan1("%s\n","[(gcd)  universalNumber universalNumber] mpzext.");        errorKan1("%s\n","[(gcd)  universalNumber universalNumber] mpzext.");
     if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||      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.");        errorKan1("%s\n","[(gcd)  universalNumber universalNumber] mpzext.");
     }      }
     f = coeff_to_MP_INT(obj1.lc.universalNumber);      f = coeff_to_MP_INT(obj1.lc.universalNumber);
Line 2316  struct object KmpzExtension(struct object obj)
Line 2602  struct object KmpzExtension(struct object obj)
     if (size != 3) errorKan1("%s\n","[(tdiv_qr)  universalNumber universalNumber] mpzext.");      if (size != 3) errorKan1("%s\n","[(tdiv_qr)  universalNumber universalNumber] mpzext.");
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
     obj2 = getoa(obj,2);      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)      if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
       errorKan1("%s\n","[(tdiv_qr)  universalNumber universalNumber] mpzext.");        errorKan1("%s\n","[(tdiv_qr)  universalNumber universalNumber] mpzext.");
     if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||      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.");        errorKan1("%s\n","[(tdiv_qr)  universalNumber universalNumber] mpzext.");
     }      }
     f = coeff_to_MP_INT(obj1.lc.universalNumber);      f = coeff_to_MP_INT(obj1.lc.universalNumber);
Line 2350  struct object KmpzExtension(struct object obj)
Line 2642  struct object KmpzExtension(struct object obj)
       return(obj0);        return(obj0);
     }      }
     if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||      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.");        errorKan1("%s\n","[(cancel)  universalNumber/universalNumber] mpzext.");
     }      }
     f = coeff_to_MP_INT(obj1.lc.universalNumber);      f = coeff_to_MP_INT(obj1.lc.universalNumber);
Line 2370  struct object KmpzExtension(struct object obj)
Line 2662  struct object KmpzExtension(struct object obj)
     rob = KnewRationalFunction0(copyObjectp(&obj1),copyObjectp(&obj2));      rob = KnewRationalFunction0(copyObjectp(&obj1),copyObjectp(&obj2));
     KisInvalidRational(&rob);      KisInvalidRational(&rob);
   }else if (strcmp(key,"sqrt")==0 ||    }else if (strcmp(key,"sqrt")==0 ||
             strcmp(key,"com")==0) {              strcmp(key,"com")==0) {
     /*  One arg functions  */      /*  One arg functions  */
     if (size != 2) errorKan1("%s\n","[key num] mpzext");      if (size != 2) errorKan1("%s\n","[key num] mpzext");
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
       if (obj1.tag != SuniversalNumber) {
         obj1 = KdataConversion(obj1,"universalNumber");
           }
     if (obj1.tag != SuniversalNumber)      if (obj1.tag != SuniversalNumber)
       errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");        errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
     if (! is_this_coeff_MP_INT(obj1.lc.universalNumber))      if (! is_this_coeff_MP_INT(obj1.lc.universalNumber))
Line 2389  struct object KmpzExtension(struct object obj)
Line 2684  struct object KmpzExtension(struct object obj)
     rob.tag = SuniversalNumber;      rob.tag = SuniversalNumber;
     rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);      rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
   }else if (strcmp(key,"probab_prime_p")==0 ||    }else if (strcmp(key,"probab_prime_p")==0 ||
             strcmp(key,"and") == 0 ||              strcmp(key,"and") == 0 ||
             strcmp(key,"ior")==0) {              strcmp(key,"ior")==0) {
     /* Two args functions */      /* Two args functions */
     if (size != 3) errorKan1("%s\n","[key  num1 num2] mpzext.");      if (size != 3) errorKan1("%s\n","[key  num1 num2] mpzext.");
     obj1 = getoa(obj,1);      obj1 = getoa(obj,1);
     obj2 = getoa(obj,2);      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)      if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
       errorKan1("%s\n","[key num1 num2] mpzext.");        errorKan1("%s\n","[key num1 num2] mpzext.");
     if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||      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.");        errorKan1("%s\n","[key  num1 num2] mpzext.");
     }      }
     f = coeff_to_MP_INT(obj1.lc.universalNumber);      f = coeff_to_MP_INT(obj1.lc.universalNumber);
Line 2406  struct object KmpzExtension(struct object obj)
Line 2707  struct object KmpzExtension(struct object obj)
     if (strcmp(key,"probab_prime_p")==0) {      if (strcmp(key,"probab_prime_p")==0) {
       gi = (int) mpz_get_si(g);        gi = (int) mpz_get_si(g);
       if (mpz_probab_prime_p(f,gi)) {        if (mpz_probab_prime_p(f,gi)) {
         rob = KpoInteger(1);          rob = KpoInteger(1);
       }else {        }else {
         rob = KpoInteger(0);          rob = KpoInteger(0);
       }        }
     }else if (strcmp(key,"and")==0) {      }else if (strcmp(key,"and")==0) {
       r1 = newMP_INT();        r1 = newMP_INT();
Line 2426  struct object KmpzExtension(struct object obj)
Line 2727  struct object KmpzExtension(struct object obj)
     /* three args */      /* three args */
     if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext");      if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext");
     obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3);      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 ||      if (obj1.tag != SuniversalNumber ||
         obj2.tag != SuniversalNumber ||          obj2.tag != SuniversalNumber ||
         obj3.tag != SuniversalNumber ) {          obj3.tag != SuniversalNumber ) {
       errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");        errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
     }      }
     if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||      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) ||
         ! is_this_coeff_MP_INT(obj3.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.");        errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
     }      }
     f = coeff_to_MP_INT(obj1.lc.universalNumber);      f = coeff_to_MP_INT(obj1.lc.universalNumber);
Line 2444  struct object KmpzExtension(struct object obj)
Line 2754  struct object KmpzExtension(struct object obj)
     mpz_powm(r1,f,g,h);      mpz_powm(r1,f,g,h);
     rob.tag = SuniversalNumber;      rob.tag = SuniversalNumber;
     rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);      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 {    }else {
     errorKan1("%s\n","mpzExtension(): Unknown tag.");      errorKan1("%s\n","mpzExtension(): Unknown tag.");
   }    }
Line 2469  struct object KnewContext(struct object superObj,char 
Line 2801  struct object KnewContext(struct object superObj,char 
 }  }
   
 struct object KcreateClassIncetance(struct object ob1,  struct object KcreateClassIncetance(struct object ob1,
                                     struct object ob2,                                      struct object ob2,
                                     struct object ob3)                                      struct object ob3)
 {  {
   /* [class-tag super-obj] size [class-tag]  cclass */    /* [class-tag super-obj] size [class-tag]  cclass */
   struct object ob4;    struct object ob4;
Line 2499  struct object KcreateClassIncetance(struct object ob1,
Line 2831  struct object KcreateClassIncetance(struct object ob1,
   ob5 = getoa(ob3,0);    ob5 = getoa(ob3,0);
   if (ectag(ob5) != CLASSNAME_CONTEXT)    if (ectag(ob5) != CLASSNAME_CONTEXT)
     errorKan1("%s\n","cclass: The third argument must be [class-tag].");      errorKan1("%s\n","cclass: The third argument must be [class-tag].");
   
   rob = newObjectArray(size);    rob = newObjectArray(size);
   putoa(rob,0,ob5);    putoa(rob,0,ob5);
   if (getoaSize(ob1) < size) size2 = getoaSize(ob1);    if (getoaSize(ob1) < size) size2 = getoaSize(ob1);
Line 2634  struct object KdefaultPolyRing(struct object ob) {
Line 2966  struct object KdefaultPolyRing(struct object ob) {
     for (j=0; j<2*n; j++) {      for (j=0; j<2*n; j++) {
       putoa(t1,j,KpoInteger(0));        putoa(t1,j,KpoInteger(0));
       if (j == (2*n-i)) {        if (j == (2*n-i)) {
         putoa(t1,j,KpoInteger(-1));          putoa(t1,j,KpoInteger(-1));
       }        }
     }      }
     putoa(ob4,i,t1);      putoa(ob4,i,t1);
Line 2650  struct object KdefaultPolyRing(struct object ob) {
Line 2982  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<n; i++) {
         putoa(rob,i-1,getoa(ob,i));
       }
       return rob;
     }else if ((ob.tag == Slist) || (ob.tag == Snull)) {
       return Kcdr(ob);
     }else{
       errorKan1("%s\n","Krest(ob): ob must be an array or a list.");
     }
   }
   struct object Kjoin(struct object ob1, struct object ob2) {
     struct object rob;
     int n1,n2,i;
     if ((ob1.tag == Sarray) &&  (ob2.tag == Sarray)) {
       n1 = getoaSize(ob1); n2 = getoaSize(ob2);
       rob = newObjectArray(n1+n2);
       for (i=0; i<n1; i++) {
         putoa(rob,i,getoa(ob1,i));
       }
       for (i=n1; i<n1+n2; i++) {
         putoa(rob,i,getoa(ob2,i-n1));
       }
       return rob;
     }else if ((ob1.tag == Slist) || (ob1.tag == Snull)) {
           if ((ob2.tag == Slist) || (ob2.tag == Snull)) {
             return KvJoin(ob1,ob2);
           }else{
             errorKan1("%s\n","Kjoin: both argument must be a list.");
           }
     }else{
       errorKan1("%s\n","Kjoin: arguments must be arrays.");
     }
   }
   
   struct object Kget(struct object ob1, struct object ob2) {
     struct object rob;
     struct object tob;
     int i,j,size,n;
     if (ob2.tag == Sinteger) {
       i =ob2.lc.ival;
     }else if (ob2.tag == SuniversalNumber) {
       i = KopInteger(KdataConversion(ob2,"integer"));
     }else if (ob2.tag == Sarray) {
       n = getoaSize(ob2);
       if (n == 0) return ob1;
       rob = ob1;
       for (i=0; i<n; i++) {
         rob=Kget(rob,getoa(ob2,i));
       }
       return rob;
     }
     if (ob1.tag == Sarray) {
       size = getoaSize(ob1);
       if ((0 <= i) && (i<size)) {
         return(getoa(ob1,i));
       }else{
         errorKan1("%s\n","Kget: Index is out of bound. (get)\n");
       }
     }else if (ob1.tag == Slist) {
       rob = NullObject;
       if (i < 0) errorKan1("%s\n","Kget: Index is negative. (get)");
       for (j=0; j<i; j++) {
         rob = Kcdr(ob1);
         if ((ob1.tag == Snull) && (rob.tag == Snull)) {
           errorKan1("%s\n","Kget: Index is out of bound. (get) cdr of null list.\n");
         }
         ob1 = rob;
       }
       return Kcar(ob1);
     }else errorKan1("%s\n","Kget: argument must be an array or a list.");
   }
   
 /******************************************************************  /******************************************************************
      error handler       error handler
 ******************************************************************/  ******************************************************************/
   
 errorKan1(str,message)  errorKan1(str,message)
 char *str;       char *str;
 char *message;       char *message;
 {  {
   extern char *GotoLabel;    extern char *GotoLabel;
   extern int GotoP;    extern int GotoP;
   extern int ErrorMessageMode;    extern int ErrorMessageMode;
   char tmpc[1024];    char tmpc[1024];
     cancelAlarm();
   if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {    if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
     sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");      sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");
     if (strlen(message) < 900) {      if (strlen(message) < 900) {
Line 2675  char *message;
Line 3085  char *message;
   if (ErrorMessageMode != 1) {    if (ErrorMessageMode != 1) {
     fprintf(stderr,"\nERROR(kanExport[0|1].c): ");      fprintf(stderr,"\nERROR(kanExport[0|1].c): ");
     fprintf(stderr,str,message);      fprintf(stderr,str,message);
       (void) traceShowStack(); traceClearStack();
   }    }
   /* fprintf(stderr,"Hello "); */    /* fprintf(stderr,"Hello "); */
   if (GotoP) {    if (GotoP) {
Line 2684  char *message;
Line 3095  char *message;
   }    }
   stdOperandStack(); contextControl(CCRESTORE);    stdOperandStack(); contextControl(CCRESTORE);
   /* fprintf(stderr,"Now. Long jump!\n"); */    /* fprintf(stderr,"Now. Long jump!\n"); */
   #if defined(__CYGWIN__)
     siglongjmp(EnvOfStackMachine,1);
   #else
   longjmp(EnvOfStackMachine,1);    longjmp(EnvOfStackMachine,1);
   #endif
 }  }
   
   
 warningKan(str)  warningKan(str)
 char *str;       char *str;
 {  {
   extern int WarningMessageMode;    extern int WarningMessageMode;
   extern int Strict;    extern int Strict;
Line 2707  char *str;
Line 3123  char *str;
   }    }
   /* if (Strict) errorKan1("%s\n"," "); */    /* if (Strict) errorKan1("%s\n"," "); */
   if (Strict) errorKan1("%s\n",str);    if (Strict) errorKan1("%s\n",str);
     return(0);
   }
   
   warningKanNoStrictMode(str)
        char *str;
   {
     extern int Strict;
     int t;
     t = Strict;
     Strict = 0;
     warningKan(str);
     Strict = t;
   return(0);    return(0);
 }  }
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.34
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>