version 1.14, 2003/07/14 12:49:52 |
version 1.22, 2004/05/13 04:38:28 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.13 2003/07/05 01:53:33 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.21 2004/02/28 13:39: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) |
Line 142 struct object KooAdd(ob1,ob2) |
|
Line 143 struct object KooAdd(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); |
Line 270 struct object KooSub(ob1,ob2) |
|
Line 275 struct object KooSub(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); |
Line 412 struct object KooMult(ob1,ob2) |
|
Line 421 struct object KooMult(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 451 struct object KoNegate(obj) |
|
Line 464 struct object KoNegate(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); |
Line 653 struct object KooDiv(ob1,ob2) |
|
Line 670 struct object KooDiv(ob1,ob2) |
|
|
|
|
|
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 984 struct object KdataConversion(obj,key) |
|
Line 1005 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 1076 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 1137 struct object KdataConversion(obj,key) |
|
Line 1158 struct object KdataConversion(obj,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 1200 struct object KpoRingp(ringp) |
|
Line 1224 struct object KpoRingp(ringp) |
|
return(obj); |
return(obj); |
} |
} |
|
|
|
struct object KpoUniversalNumber(u) |
|
struct coeff *u; |
|
{ |
|
struct object obj; |
|
obj.tag = SuniversalNumber; |
|
obj.lc.universalNumber = u; |
|
return(obj); |
|
} |
/*** 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; |
Line 1621 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1653 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
} |
} |
} |
} |
} |
} |
switch_function("grade","module1v"); |
switch_function("grade","module1v"); |
/* Warning: grading is changed to 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 2068 struct object KstringToArgv(struct object ob) { |
|
Line 2100 struct object KstringToArgv(struct object ob) { |
|
int n,wc,i,inblank; |
int n,wc,i,inblank; |
char **argv; |
char **argv; |
if (ob.tag != Sdollar) |
if (ob.tag != Sdollar) |
errorKan1("%s\n","KstringToArgv(): the argument must be a string."); |
errorKan1("%s\n","KstringToArgv(): the argument must be a string."); |
n = strlen(KopString(ob)); |
n = strlen(KopString(ob)); |
s = (char *) sGC_malloc(sizeof(char)*(n+2)); |
s = (char *) sGC_malloc(sizeof(char)*(n+2)); |
if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory."); |
if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory."); |
strcpy(s,KopString(ob)); |
strcpy(s,KopString(ob)); |
inblank = 1; wc = 0; |
inblank = 1; wc = 0; |
for (i=0; i<n; i++) { |
for (i=0; i<n; i++) { |
if (inblank && (s[i] > ' ')) { |
if (inblank && (s[i] > ' ')) { |
wc++; inblank = 0; |
wc++; inblank = 0; |
}else if ((!inblank) && (s[i] <= ' ')) { |
}else if ((!inblank) && (s[i] <= ' ')) { |
inblank = 1; |
inblank = 1; |
} |
} |
} |
} |
argv = (char **) sGC_malloc(sizeof(char *)*(wc+2)); |
argv = (char **) sGC_malloc(sizeof(char *)*(wc+2)); |
argv[0] = NULL; |
argv[0] = NULL; |
inblank = 1; wc = 0; |
inblank = 1; wc = 0; |
for (i=0; i<n; i++) { |
for (i=0; i<n; i++) { |
if (inblank && (s[i] > ' ')) { |
if (inblank && (s[i] > ' ')) { |
argv[wc] = &(s[i]); argv[wc+1]=NULL; |
argv[wc] = &(s[i]); argv[wc+1]=NULL; |
wc++; inblank = 0; |
wc++; inblank = 0; |
}else if ((inblank == 0) && (s[i] <= ' ')) { |
}else if ((inblank == 0) && (s[i] <= ' ')) { |
inblank = 1; s[i] = 0; |
inblank = 1; s[i] = 0; |
}else if (inblank && (s[i] <= ' ')) { |
}else if (inblank && (s[i] <= ' ')) { |
s[i] = 0; |
s[i] = 0; |
} |
} |
} |
} |
|
|
rob = newObjectArray(wc); |
rob = newObjectArray(wc); |
for (i=0; i<wc; i++) { |
for (i=0; i<wc; i++) { |
putoa(rob,i,KpoString(argv[i])); |
putoa(rob,i,KpoString(argv[i])); |
printf("%s\n",argv[i]); |
/* printf("%s\n",argv[i]); */ |
} |
} |
return(rob); |
return(rob); |
} |
} |
Line 2124 static void checkDuplicateName(xvars,dvars,n) |
|
Line 2156 static void checkDuplicateName(xvars,dvars,n) |
|
} |
} |
} |
} |
|
|
|
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); |
|
} |
|
|
|
|
|
|
Line 2186 struct object KooDiv2(ob1,ob2) |
|
Line 2228 struct object KooDiv2(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 2242 struct object KgbExtension(struct object obj) |
|
Line 2288 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 2321 struct object KgbExtension(struct object obj) |
|
Line 2368 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 2355 struct object KgbExtension(struct object obj) |
|
Line 2409 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."); |
} |
} |
Line 2781 errorKan1(str,message) |
|
Line 2854 errorKan1(str,message) |
|
longjmp(EnvOfStackMachine,1); |
longjmp(EnvOfStackMachine,1); |
#endif |
#endif |
} |
} |
|
|
|
|
warningKan(str) |
warningKan(str) |
char *str; |
char *str; |