version 1.10, 2002/11/04 10:53:55 |
version 1.17, 2003/08/23 02:28:38 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.9 2002/09/08 10:49:49 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.16 2003/08/20 01:39:17 takayama Exp $ */ |
#include <stdio.h> |
#include <stdio.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
Line 984 struct object KdataConversion(obj,key) |
|
Line 984 struct object KdataConversion(obj,key) |
|
} |
} |
break; |
break; |
case Spoly: |
case Spoly: |
if (strcmp(key,"poly")==0) { |
if ((strcmp(key,"poly")==0) || (strcmp(key,"numerator")==0)) { |
rob = obj; |
rob = obj; |
return(rob); |
return(rob); |
}else if (strcmp(key,"integer")==0) { |
}else if (strcmp(key,"integer")==0) { |
Line 1055 struct object KdataConversion(obj,key) |
|
Line 1055 struct object KdataConversion(obj,key) |
|
} |
} |
break; |
break; |
case SuniversalNumber: |
case SuniversalNumber: |
if (strcmp(key,"universalNumber")==0) { |
if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) { |
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 1538 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1538 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
newRingp->gbListTower = NULL; |
newRingp->gbListTower = NULL; |
newRingp->outputOrder = outputVars; |
newRingp->outputOrder = outputVars; |
newRingp->weightedHomogenization = 0; |
newRingp->weightedHomogenization = 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 1588 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1591 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
if (getoa(ob5,i+1).tag != Sinteger) { |
if (getoa(ob5,i+1).tag != Sinteger) { |
errorKan1("%s\n","A integer should be given. (weightedHomogenization)"); |
errorKan1("%s\n","A integer should be given. (weightedHomogenization)"); |
} |
} |
newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1)); |
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)); |
|
} |
|
} |
|
} |
|
} |
|
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 2028 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[]; |
char *dvars[]; |
char *dvars[]; |
Line 2168 struct object KgbExtension(struct object obj) |
|
Line 2242 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 2281 struct object KgbExtension(struct object obj) |
|
Line 2356 struct object KgbExtension(struct object obj) |
|
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 { |
}else { |
errorKan1("%s\n","gbext : unknown tag."); |
errorKan1("%s\n","gbext : unknown tag."); |
} |
} |