version 1.18, 2003/08/26 12:46:05 |
version 1.32, 2004/09/09 11:42:22 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.17 2003/08/23 02:28:38 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.31 2004/09/09 03:14:46 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 776 struct object KooGreater(obj1,obj2) |
|
Line 797 struct object KooGreater(obj1,obj2) |
|
if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1)); |
if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1)); |
else return(KpoInteger(0)); |
else return(KpoInteger(0)); |
break; |
break; |
|
case Sarray: |
|
{ |
|
int i,m1,m2; |
|
struct object rr; |
|
m1 = getoaSize(obj1); m2 = getoaSize(obj2); |
|
for (i=0; i< (m1>m2?m2:m1); i++) { |
|
rr=KooGreater(getoa(obj1,i),getoa(obj2,i)); |
|
if (KopInteger(rr) == 1) return rr; |
|
rr=KooGreater(getoa(obj2,i),getoa(obj1,i)); |
|
if (KopInteger(rr) == 1) return KpoInteger(0); |
|
} |
|
if (m1 > m2) return KpoInteger(1); |
|
else return KpoInteger(0); |
|
} |
|
break; |
default: |
default: |
errorKan1("%s\n","KooGreater() has not supported these objects yet."); |
errorKan1("%s\n","KooGreater() has not supported these objects yet."); |
break; |
break; |
Line 817 struct object KooLess(obj1,obj2) |
|
Line 853 struct object KooLess(obj1,obj2) |
|
if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1)); |
if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1)); |
else return(KpoInteger(0)); |
else return(KpoInteger(0)); |
break; |
break; |
|
case Sarray: |
|
{ |
|
int i,m1,m2; |
|
struct object rr; |
|
m1 = getoaSize(obj1); m2 = getoaSize(obj2); |
|
for (i=0; i< (m1>m2?m2:m1); i++) { |
|
rr=KooLess(getoa(obj1,i),getoa(obj2,i)); |
|
if (KopInteger(rr) == 1) return rr; |
|
rr=KooLess(getoa(obj2,i),getoa(obj1,i)); |
|
if (KopInteger(rr) == 1) return KpoInteger(0); |
|
} |
|
if (m1 < m2) return KpoInteger(1); |
|
else return KpoInteger(0); |
|
} |
|
break; |
default: |
default: |
errorKan1("%s\n","KooLess() has not supported these objects yet."); |
errorKan1("%s\n","KooLess() has not supported these objects yet."); |
break; |
break; |
Line 868 struct object KdataConversion(obj,key) |
|
Line 919 struct object KdataConversion(obj,key) |
|
return(rob); |
return(rob); |
}else if (strcmp(key,"poly") == 0) { |
}else if (strcmp(key,"poly") == 0) { |
rob = KpoPOLY(ZERO); |
rob = KpoPOLY(ZERO); |
|
return rob; |
|
}else if (strcmp(key,"array") == 0) { |
|
rob = newObjectArray(0); |
|
return rob; |
}else{ |
}else{ |
warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n"); |
warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n"); |
} |
} |
Line 893 struct object KdataConversion(obj,key) |
|
Line 948 struct object KdataConversion(obj,key) |
|
strcpy(rob.lc.str,intstr); |
strcpy(rob.lc.str,intstr); |
return(rob); |
return(rob); |
}else if (strcmp(key,"universalNumber")==0) { |
}else if (strcmp(key,"universalNumber")==0) { |
rob.tag = SuniversalNumber; |
rob = KintToUniversalNumber(obj.lc.ival); |
rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing); |
|
return(rob); |
return(rob); |
}else if (strcmp(key,"double") == 0) { |
}else if (strcmp(key,"double") == 0) { |
rob = KpoDouble((double) (obj.lc.ival)); |
rob = KpoDouble((double) (obj.lc.ival)); |
Line 965 struct object KdataConversion(obj,key) |
|
Line 1019 struct object KdataConversion(obj,key) |
|
if (strcmp(key,"array") == 0) { |
if (strcmp(key,"array") == 0) { |
return(rob); |
return(rob); |
}else if (strcmp(key,"list") == 0) { |
}else if (strcmp(key,"list") == 0) { |
rob = *( arrayToList(obj) ); |
rob = KarrayToList(obj); |
return(rob); |
return(rob); |
}else if (strcmp(key,"arrayOfPOLY")==0) { |
}else if (strcmp(key,"arrayOfPOLY")==0) { |
rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj)); |
rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj)); |
Line 980 struct object KdataConversion(obj,key) |
|
Line 1034 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 1050 struct object KdataConversion(obj,key) |
|
Line 1112 struct object KdataConversion(obj,key) |
|
break; |
break; |
case Slist: |
case Slist: |
if (strcmp(key,"array") == 0) { |
if (strcmp(key,"array") == 0) { |
rob = listToArray(&obj); |
rob = KlistToArray(obj); |
return(rob); |
return(rob); |
} |
} |
break; |
break; |
case SuniversalNumber: |
case SuniversalNumber: |
if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) { |
if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) { |
|
rob = obj; |
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 1073 struct object KdataConversion(obj,key) |
|
Line 1136 struct object KdataConversion(obj,key) |
|
}else if (strcmp(key,"double") == 0) { |
}else if (strcmp(key,"double") == 0) { |
rob = KpoDouble( toDouble0(obj) ); |
rob = KpoDouble( toDouble0(obj) ); |
return(rob); |
return(rob); |
|
}else if (strcmp(key,"denominator") == 0) { |
|
rob = KintToUniversalNumber(1); |
|
return(rob); |
}else{ |
}else{ |
warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n"); |
warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n"); |
} |
} |
Line 1137 struct object KdataConversion(obj,key) |
|
Line 1203 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 1146 struct object KdataConversion(obj,key) |
|
Line 1215 struct object KdataConversion(obj,key) |
|
} |
} |
return(NullObject); |
return(NullObject); |
} |
} |
|
|
|
/* cf. macro to_int32 */ |
|
struct object Kto_int32(struct object ob) { |
|
int n,i; |
|
struct object otmp; |
|
struct object rob; |
|
if (ob.tag == SuniversalNumber) return KdataConversion(ob,"integer"); |
|
if (ob.tag == Sarray) { |
|
n = getoaSize(ob); |
|
rob = newObjectArray(n); |
|
for (i=0; i<n; i++) { |
|
otmp = Kto_int32(getoa(ob,i)); |
|
putoa(rob,i,otmp); |
|
} |
|
return rob; |
|
} |
|
return ob; |
|
} |
/* conversion functions between primitive data and objects. |
/* conversion functions between primitive data and objects. |
If it's not time critical, it is recommended to use these functions */ |
If it's not time critical, it is recommended to use these functions */ |
struct object KpoInteger(k) |
struct object KpoInteger(k) |
Line 1200 struct object KpoRingp(ringp) |
|
Line 1286 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); |
|
} |
|
struct object KintToUniversalNumber(n) |
|
int n; |
|
{ |
|
struct object rob; |
|
extern struct ring SmallRing; |
|
rob.tag = SuniversalNumber; |
|
rob.lc.universalNumber = intToCoeff(n,&SmallRing); |
|
return(rob); |
|
} |
|
|
/*** 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 1496 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1600 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
outputVars[i] = i; |
outputVars[i] = i; |
} |
} |
} |
} |
|
|
|
ob4 = Kto_int32(ob4); /* order matrix */ |
oasize = getoaSize(ob4); |
oasize = getoaSize(ob4); |
order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1)); |
order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1)); |
if (order == (int *)NULL) errorKan1("%s\n","No memory."); |
if (order == (int *)NULL) errorKan1("%s\n","No memory."); |
Line 1621 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1726 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 2173 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 2229 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 2301 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 2369 struct object KgbExtension(struct object obj) |
|
Line 2488 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 2417 struct object KmpzExtension(struct object obj) |
|
Line 2548 struct object KmpzExtension(struct object obj) |
|
if (size != 3) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); |
if (size != 3) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); |
obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
obj2 = getoa(obj,2); |
obj2 = getoa(obj,2); |
|
if (obj1.tag != SuniversalNumber) { |
|
obj1 = KdataConversion(obj1,"universalNumber"); |
|
} |
|
if (obj2.tag != SuniversalNumber) { |
|
obj2 = KdataConversion(obj2,"universalNumber"); |
|
} |
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); |
errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext."); |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
Line 2433 struct object KmpzExtension(struct object obj) |
|
Line 2570 struct object KmpzExtension(struct object obj) |
|
if (size != 3) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); |
if (size != 3) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); |
obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
obj2 = getoa(obj,2); |
obj2 = getoa(obj,2); |
|
if (obj1.tag != SuniversalNumber) { |
|
obj1 = KdataConversion(obj1,"universalNumber"); |
|
} |
|
if (obj2.tag != SuniversalNumber) { |
|
obj2 = KdataConversion(obj2,"universalNumber"); |
|
} |
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); |
errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext."); |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
Line 2491 struct object KmpzExtension(struct object obj) |
|
Line 2634 struct object KmpzExtension(struct object obj) |
|
/* One arg functions */ |
/* One arg functions */ |
if (size != 2) errorKan1("%s\n","[key num] mpzext"); |
if (size != 2) errorKan1("%s\n","[key num] mpzext"); |
obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
|
if (obj1.tag != SuniversalNumber) { |
|
obj1 = KdataConversion(obj1,"universalNumber"); |
|
} |
if (obj1.tag != SuniversalNumber) |
if (obj1.tag != SuniversalNumber) |
errorKan1("%s\n","[key num] mpzext : num must be a universalNumber."); |
errorKan1("%s\n","[key num] mpzext : num must be a universalNumber."); |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber)) |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber)) |
Line 2512 struct object KmpzExtension(struct object obj) |
|
Line 2658 struct object KmpzExtension(struct object obj) |
|
if (size != 3) errorKan1("%s\n","[key num1 num2] mpzext."); |
if (size != 3) errorKan1("%s\n","[key num1 num2] mpzext."); |
obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
obj2 = getoa(obj,2); |
obj2 = getoa(obj,2); |
|
if (obj1.tag != SuniversalNumber) { |
|
obj1 = KdataConversion(obj1,"universalNumber"); |
|
} |
|
if (obj2.tag != SuniversalNumber) { |
|
obj2 = KdataConversion(obj2,"universalNumber"); |
|
} |
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
errorKan1("%s\n","[key num1 num2] mpzext."); |
errorKan1("%s\n","[key num1 num2] mpzext."); |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
Line 2543 struct object KmpzExtension(struct object obj) |
|
Line 2695 struct object KmpzExtension(struct object obj) |
|
/* three args */ |
/* three args */ |
if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext"); |
if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext"); |
obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3); |
obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3); |
|
if (obj1.tag != SuniversalNumber) { |
|
obj1 = KdataConversion(obj1,"universalNumber"); |
|
} |
|
if (obj2.tag != SuniversalNumber) { |
|
obj2 = KdataConversion(obj2,"universalNumber"); |
|
} |
|
if (obj3.tag != SuniversalNumber) { |
|
obj3 = KdataConversion(obj3,"universalNumber"); |
|
} |
if (obj1.tag != SuniversalNumber || |
if (obj1.tag != SuniversalNumber || |
obj2.tag != SuniversalNumber || |
obj2.tag != SuniversalNumber || |
obj3.tag != SuniversalNumber ) { |
obj3.tag != SuniversalNumber ) { |
Line 2561 struct object KmpzExtension(struct object obj) |
|
Line 2722 struct object KmpzExtension(struct object obj) |
|
mpz_powm(r1,f,g,h); |
mpz_powm(r1,f,g,h); |
rob.tag = SuniversalNumber; |
rob.tag = SuniversalNumber; |
rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp); |
rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp); |
|
} else if (strcmp(key,"lcm")==0) { |
|
if (size != 3) errorKan1("%s\n","[(lcm) universalNumber universalNumber] mpzext."); |
|
obj1 = getoa(obj,1); |
|
obj2 = getoa(obj,2); |
|
if (obj1.tag != SuniversalNumber) { |
|
obj1 = KdataConversion(obj1,"universalNumber"); |
|
} |
|
if (obj2.tag != SuniversalNumber) { |
|
obj2 = KdataConversion(obj2,"universalNumber"); |
|
} |
|
if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) |
|
errorKan1("%s\n","[lcm num1 num2] mpzext."); |
|
if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) || |
|
! is_this_coeff_MP_INT(obj2.lc.universalNumber)) { |
|
errorKan1("%s\n","[(lcm) universalNumber universalNumber] mpzext."); |
|
} |
|
f = coeff_to_MP_INT(obj1.lc.universalNumber); |
|
g = coeff_to_MP_INT(obj2.lc.universalNumber); |
|
r1 = newMP_INT(); |
|
mpz_lcm(r1,f,g); |
|
rob.tag = SuniversalNumber; |
|
rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp); |
}else { |
}else { |
errorKan1("%s\n","mpzExtension(): Unknown tag."); |
errorKan1("%s\n","mpzExtension(): Unknown tag."); |
} |
} |
Line 2767 struct object KdefaultPolyRing(struct object ob) { |
|
Line 2950 struct object KdefaultPolyRing(struct object ob) { |
|
} |
} |
|
|
|
|
|
struct object Krest(struct object ob) { |
|
struct object rob; |
|
struct object *op; |
|
int n,i; |
|
if (ob.tag == Sarray) { |
|
n = getoaSize(ob); |
|
if (n == 0) return ob; |
|
rob = newObjectArray(n-1); |
|
for (i=1; i<n; i++) { |
|
putoa(rob,i-1,getoa(ob,i)); |
|
} |
|
return rob; |
|
}else if ((ob.tag == Slist) || (ob.tag == Snull)) { |
|
return Kcdr(ob); |
|
}else{ |
|
errorKan1("%s\n","Krest(ob): ob must be an array or a list."); |
|
} |
|
} |
|
struct object Kjoin(struct object ob1, struct object ob2) { |
|
struct object rob; |
|
int n1,n2,i; |
|
if ((ob1.tag == Sarray) && (ob2.tag == Sarray)) { |
|
n1 = getoaSize(ob1); n2 = getoaSize(ob2); |
|
rob = newObjectArray(n1+n2); |
|
for (i=0; i<n1; i++) { |
|
putoa(rob,i,getoa(ob1,i)); |
|
} |
|
for (i=n1; i<n1+n2; i++) { |
|
putoa(rob,i,getoa(ob2,i-n1)); |
|
} |
|
return rob; |
|
}else if ((ob1.tag == Slist) || (ob1.tag == Snull)) { |
|
if ((ob2.tag == Slist) || (ob2.tag == Snull)) { |
|
return KvJoin(ob1,ob2); |
|
}else{ |
|
errorKan1("%s\n","Kjoin: both argument must be a list."); |
|
} |
|
}else{ |
|
errorKan1("%s\n","Kjoin: arguments must be arrays."); |
|
} |
|
} |
|
|
|
|
|
|
Line 2793 errorKan1(str,message) |
|
Line 3017 errorKan1(str,message) |
|
if (ErrorMessageMode != 1) { |
if (ErrorMessageMode != 1) { |
fprintf(stderr,"\nERROR(kanExport[0|1].c): "); |
fprintf(stderr,"\nERROR(kanExport[0|1].c): "); |
fprintf(stderr,str,message); |
fprintf(stderr,str,message); |
|
(void) traceShowStack(); traceClearStack(); |
} |
} |
/* fprintf(stderr,"Hello "); */ |
/* fprintf(stderr,"Hello "); */ |
if (GotoP) { |
if (GotoP) { |
Line 2808 errorKan1(str,message) |
|
Line 3033 errorKan1(str,message) |
|
longjmp(EnvOfStackMachine,1); |
longjmp(EnvOfStackMachine,1); |
#endif |
#endif |
} |
} |
|
|
|
|
warningKan(str) |
warningKan(str) |
char *str; |
char *str; |