[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.1 and 1.7

version 1.1, 1999/10/08 02:12:01 version 1.7, 2001/05/04 01:06:23
Line 1 
Line 1 
   /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.6 2001/04/12 06:48:25 takayama Exp $  */
 #include <stdio.h>  #include <stdio.h>
 #include "datatype.h"  #include "datatype.h"
 #include "stackm.h"  #include "stackm.h"
Line 21  int WarningNoVectorVariable = 1;
Line 22  int WarningNoVectorVariable = 1;
   
 /** :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 148  struct object ob1,ob2;
Line 149  struct object ob1,ob2;
 }  }
   
 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 276  struct object ob1,ob2;
Line 277  struct object ob1,ob2;
 }  }
   
 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 420  struct object ob1,ob2;
Line 421  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 457  struct object obj;
Line 458  struct object obj;
 }  }
   
 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 493  struct object obj;
Line 494  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 504  struct object ob;
Line 505  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 520  int m,n;
Line 521  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 548  struct object aa,bb;
Line 549  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 563  struct object aa,bb;
Line 564  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 599  struct object aa,bb;
Line 600  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 624  struct object aa,bb;
Line 625  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 635  struct object aa,bb;
Line 636  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 646  struct object ob1,ob2;
Line 647  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;
   
Line 660  struct object ob1,ob2;
Line 661  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 670  struct object obj2;
Line 671  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 741  struct object ob1;
Line 742  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 750  struct object obj2;
Line 751  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:    default:
       errorKan1("%s\n","KooGreater() has not supported these objects yet.");      errorKan1("%s\n","KooGreater() has not supported these objects yet.");
       break;      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 791  struct object obj2;
Line 792  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:    default:
       errorKan1("%s\n","KooLess() has not supported these objects yet.");      errorKan1("%s\n","KooLess() has not supported these objects yet.");
       break;      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 837  char *key;
Line 838  char *key;
   struct object rob1,rob2;    struct object rob1,rob2;
   char *s;    char *s;
   int i;    int i;
     double f;
     double f2;
   /* reports the data type */    /* reports the data type */
   if (key[0] == 't' || key[0] =='e') {    if (key[0] == 't' || key[0] =='e') {
     if (strcmp(key,"type?")==0) {      if (strcmp(key,"type?")==0) {
Line 844  char *key;
Line 847  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 911  char *key;
Line 914  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 927  char *key;
Line 930  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) {
         /* Check the format.  2.3432 e2 is not allowed. It should be 2.3232e2.*/
         flag = 0;
         for (i=0; (obj.lc.str)[i] != '\0'; i++) {
           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.");
         }
         rob = KpoDouble(f);
         return(rob);
     }else if (strcmp(key,"null") == 0) {      }else if (strcmp(key,"null") == 0) {
       rob = NullObject;        rob = NullObject;
       return(rob);        return(rob);
Line 967  char *key;
Line 985  char *key;
     break;      break;
   case Spoly:    case Spoly:
     if (strcmp(key,"poly")==0) {      if (strcmp(key,"poly")==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 983  char *key;
Line 1002  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 1131  char *key;
Line 1150  char *key;
 /* 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 1139  int k;
Line 1158  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 1147  char *s;
Line 1166  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 1155  POLY f;
Line 1174  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 1164  struct arrayOfPOLY *ap ;
Line 1183  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 1173  struct matrixOfPOLY *mp ;
Line 1192  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 1183  struct ring *ringp;
Line 1202  struct ring *ringp;
   
 /*** 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 1202  struct arrayOfPOLY *aa;
Line 1221  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 1223  struct matrixOfPOLY *pmat;
Line 1242  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 1232  struct object oa;
Line 1251  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 1248  struct object oa;
Line 1267  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 1258  struct object oa;
Line 1277  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 1287  struct object oa;
Line 1306  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 1324  int oasize;
Line 1343  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 1352  struct object oA;
Line 1371  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 1373  struct object KgetOrderMatrixOfCurrentRing() 
Line 1392  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 1525  struct object ob1,ob2,ob3,ob4,ob5;
Line 1544  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 {        } 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 1582  struct object ob1,ob2,ob3,ob4,ob5;
Line 1601  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 1653  struct object KsetVariableNames(struct object ob,struc
Line 1672  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 1679  struct object ob1,ob2;
Line 1698  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 1701  void KprintSwitchStatus(void)
Line 1720  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 1719  struct object rule;
Line 1738  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 1759  struct object rule;
Line 1781  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 1776  struct object v;
Line 1798  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 1793  struct object v;
Line 1815  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 1802  struct object ob1,ob2;
Line 1824  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 1826  struct object obj;
Line 1848  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 1835  struct object ob1,ob2;
Line 1857  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 1846  struct object ob1,ob2;
Line 1868  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 1855  struct object ob;
Line 1877  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 1877  struct object obj;
Line 1899  struct object obj;
   
 /* :Utilities */  /* :Utilities */
 char *KremoveSpace(str)  char *KremoveSpace(str)
 char str[];       char str[];
 {  {
   int size;    int size;
   int start;    int start;
Line 1902  char str[];
Line 1924  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 1935  struct object ob;
Line 1957  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 2002  int limit;
Line 2024  int limit;
   
   
 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 2015  int n;
Line 2037  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().");
       }        }
     }      }
   }    }
Line 2026  int n;
Line 2048  int n;
   
   
 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 2113  struct object ob1,ob2;
Line 2135  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 2242  struct object KgbExtension(struct object obj)
Line 2264  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);
Line 2285  struct object KmpzExtension(struct object obj)
Line 2313  struct object KmpzExtension(struct object obj)
     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 2301  struct object KmpzExtension(struct object obj)
Line 2329  struct object KmpzExtension(struct object obj)
     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 2332  struct object KmpzExtension(struct object obj)
Line 2360  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 2352  struct object KmpzExtension(struct object obj)
Line 2380  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);
Line 2371  struct object KmpzExtension(struct object obj)
Line 2399  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);
Line 2380  struct object KmpzExtension(struct object obj)
Line 2408  struct object KmpzExtension(struct object obj)
     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 2388  struct object KmpzExtension(struct object obj)
Line 2416  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 2414  struct object KmpzExtension(struct object obj)
Line 2442  struct object KmpzExtension(struct object obj)
       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 2451  struct object KnewContext(struct object superObj,char 
Line 2479  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 2481  struct object KcreateClassIncetance(struct object ob1,
Line 2509  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 2616  struct object KdefaultPolyRing(struct object ob) {
Line 2644  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 2640  struct object KdefaultPolyRing(struct object ob) {
Line 2668  struct object KdefaultPolyRing(struct object ob) {
 ******************************************************************/  ******************************************************************/
   
 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;
Line 2670  char *message;
Line 2698  char *message;
 }  }
   
 warningKan(str)  warningKan(str)
 char *str;       char *str;
 {  {
   extern int WarningMessageMode;    extern int WarningMessageMode;
   extern int Strict;    extern int Strict;
Line 2689  char *str;
Line 2717  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.1  
changed lines
  Added in v.1.7
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>