OpenXM/src/kan96xx/Kan/kanExport0.c - diff

Return to kanExport0.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

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

-version 1.32, 2004/09/09 11:42:22
+version 1.34, 2004/09/13 11:24:11
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.31 2004/09/09 03:14:46 takayama Exp $  */
+ /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.33 2004/09/11 01:00:42 takayama Exp $  */
  #include <stdio.h>
  #include "datatype.h"
  #include "stackm.h"
 Line 1646  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 Line 1646  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 Line 1646  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
    newRingp->degreeShiftSize = 0;
    newRingp->degreeShiftN = 0;
    newRingp->degreeShift = NULL;
+   newRingp->partialEcart = 0;
+   newRingp->partialEcartGlobalVarX = NULL;
    if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {
      errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");
-Line 1726  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
+Line 1728  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 Line 1726  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 Line 1728  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
              }
            }
          }
+       } 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 {
-Line 2992  struct object Kjoin(struct object ob1, struct object o
+Line 3024  struct object Kjoin(struct object ob1, struct object o
 Line 2992  struct object Kjoin(struct object ob1, struct object o
 Line 3024  struct object Kjoin(struct object ob1, struct object o
    }
  }
+ 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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>