| version 1.11, 2003/06/26 08:14:46 |
version 1.14, 2003/07/14 12:49:52 |
|
|
| /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.10 2002/11/04 10:53:55 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.13 2003/07/05 01:53:33 takayama Exp $ */ |
| #include <stdio.h> |
#include <stdio.h> |
| #include "datatype.h" |
#include "datatype.h" |
| #include "stackm.h" |
#include "stackm.h" |
| Line 1539 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
| Line 1539 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
| newRingp->outputOrder = outputVars; |
newRingp->outputOrder = outputVars; |
| newRingp->weightedHomogenization = 0; |
newRingp->weightedHomogenization = 0; |
| newRingp->degreeShiftSize = 0; |
newRingp->degreeShiftSize = 0; |
| |
newRingp->degreeShiftN = 0; |
| |
newRingp->degreeShift = 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 1592 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
| Line 1594 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
| newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1)); |
newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1)); |
| } else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) { |
} else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) { |
| if (getoa(ob5,i+1).tag != Sarray) { |
if (getoa(ob5,i+1).tag != Sarray) { |
| errorKan1("%s\n","An array should be given. (degreeShift)"); |
errorKan1("%s\n","An array of array should be given. (degreeShift)"); |
| } |
} |
| { |
{ |
| struct object ods; |
struct object ods; |
| int dssize,k; |
struct object ods2; |
| |
int dssize,k,j,nn; |
| ods=getoa(ob5,i+1); |
ods=getoa(ob5,i+1); |
| dssize = getoaSize(ods); |
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->degreeShiftSize = dssize; |
| newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize+1)); |
newRingp->degreeShiftN = nn; |
| |
newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize*nn+1)); |
| if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory."); |
if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory."); |
| for (k=0; k<dssize; k++) { |
for (j=0; j<nn; j++) { |
| if (getoa(ods,k).tag == SuniversalNumber) { |
ods2 = getoa(ods,j); |
| (newRingp->degreeShift)[k] = coeffToInt(getoa(ods,k).lc.universalNumber); |
for (k=0; k<dssize; k++) { |
| }else{ |
if (getoa(ods2,k).tag == SuniversalNumber) { |
| (newRingp->degreeShift)[k] = KopInteger(getoa(ods,k)); |
(newRingp->degreeShift)[j*dssize+k] = coeffToInt(getoa(ods2,k).lc.universalNumber); |
| |
}else{ |
| |
(newRingp->degreeShift)[j*dssize+k] = KopInteger(getoa(ods2,k)); |
| |
} |
| } |
} |
| } |
} |
| } |
} |
| |
switch_function("grade","module1v"); |
| |
/* Warning: grading is changed to module1v!! */ |
| } else { |
} else { |
| errorKan1("%s\n","Unknown keyword to set_up_ring@"); |
errorKan1("%s\n","Unknown keyword to set_up_ring@"); |
| } |
} |
| Line 2049 int KtoArgvbyCurryBrace(str,argv,limit) |
|
| Line 2062 int KtoArgvbyCurryBrace(str,argv,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[]; |