| version 1.17, 2003/08/23 02:28:38 |
version 1.23, 2004/07/30 11:21:55 |
|
|
| /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.16 2003/08/20 01:39:17 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: |
| 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"); |
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 2108 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 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 2186 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 2322 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 2362 struct object KgbExtension(struct object obj) |
|
| Line 2423 struct object KgbExtension(struct object obj) |
|
| if (obj1.tag != Spoly) |
if (obj1.tag != Spoly) |
| errorKan1("%s\n","[(reduceContent) poly1 ] gbext."); |
errorKan1("%s\n","[(reduceContent) poly1 ] gbext."); |
| f1 = KopPOLY(obj1); |
f1 = KopPOLY(obj1); |
| rob = newObjectArray(2); |
rob = newObjectArray(2); |
| f1 = reduceContentOfPoly(f1,&cont); |
f1 = reduceContentOfPoly(f1,&cont); |
| putoa(rob,0,KpoPOLY(f1)); |
putoa(rob,0,KpoPOLY(f1)); |
| if (f1 == POLYNULL) { |
if (f1 == POLYNULL) { |
| putoa(rob,1,KpoPOLY(f1)); |
putoa(rob,1,KpoPOLY(f1)); |
| }else{ |
}else{ |
| putoa(rob,1,KpoPOLY(newCell(cont,newMonomial(f1->m->ringp)))); |
putoa(rob,1,KpoPOLY(newCell(cont,newMonomial(f1->m->ringp)))); |
| } |
} |
| }else if (strcmp(key,"ord_ws_all")==0) { |
}else if (strcmp(key,"ord_ws_all")==0) { |
| if (size != 3) errorKan1("%s\n","[(ord_ws_all) fv wv] gbext"); |
if (size != 3) errorKan1("%s\n","[(ord_ws_all) fv wv] gbext"); |
| obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
| obj2 = getoa(obj,2); |
obj2 = getoa(obj,2); |
| rob = KordWsAll(obj1,obj2); |
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 2801 errorKan1(str,message) |
|
| Line 2874 errorKan1(str,message) |
|
| longjmp(EnvOfStackMachine,1); |
longjmp(EnvOfStackMachine,1); |
| #endif |
#endif |
| } |
} |
| |
|
| |
|
| warningKan(str) |
warningKan(str) |
| char *str; |
char *str; |