version 1.12, 2003/06/26 13:00:10 |
version 1.23, 2004/07/30 11:21:55 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.11 2003/06/26 08:14:46 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.22 2004/05/13 04:38:28 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 980 struct object KdataConversion(obj,key) |
|
Line 1001 struct object KdataConversion(obj,key) |
|
rob = NullObject; |
rob = NullObject; |
return(rob); |
return(rob); |
}else { |
}else { |
warningKan("Sorry. This type of data conversion has not supported yet.\n"); |
{ /* Automatically maps the elements. */ |
|
int n,i; |
|
n = getoaSize(obj); |
|
rob = newObjectArray(n); |
|
for (i=0; i<n; i++) { |
|
putoa(rob,i,KdataConversion(getoa(obj,i),key)); |
|
} |
|
return(rob); |
|
} |
} |
} |
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 1084 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 1166 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 1232 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 1661 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
} |
} |
} |
} |
} |
} |
|
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 2060 int KtoArgvbyCurryBrace(str,argv,limit) |
|
Line 2102 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 2082 static void checkDuplicateName(xvars,dvars,n) |
|
Line 2164 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 2144 struct object KooDiv2(ob1,ob2) |
|
Line 2236 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 2200 struct object KgbExtension(struct object obj) |
|
Line 2296 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 2279 struct object KgbExtension(struct object obj) |
|
Line 2376 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 2313 struct object KgbExtension(struct object obj) |
|
Line 2417 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 if (strcmp(key,"exponents")==0) { |
|
if (size == 3) { |
|
obj1 = getoa(obj,1); |
|
obj2 = getoa(obj,2); |
|
rob = KgetExponents(obj1,obj2); |
|
}else if (size == 2) { |
|
obj1 = getoa(obj,1); |
|
obj2 = KpoInteger(2); |
|
rob = KgetExponents(obj1,obj2); |
|
}else{ |
|
errorKan1("%s\n","[(exponents) f type] gbext"); |
|
} |
}else { |
}else { |
errorKan1("%s\n","gbext : unknown tag."); |
errorKan1("%s\n","gbext : unknown tag."); |
} |
} |
Line 2739 errorKan1(str,message) |
|
Line 2874 errorKan1(str,message) |
|
longjmp(EnvOfStackMachine,1); |
longjmp(EnvOfStackMachine,1); |
#endif |
#endif |
} |
} |
|
|
|
|
warningKan(str) |
warningKan(str) |
char *str; |
char *str; |