OpenXM/src/kan96xx/Kan/kanExport0.c - diff

Return to kanExport0.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport0.c between version 1.10 and 1.44

version 1.10, 2002/11/04 10:53:55

version 1.44, 2005/06/16 06:21:21

Line 1

/* $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.43 2005/06/16 05:07:23 takayama Exp $ */

#include <stdio.h>

#include "datatype.h"

#include "stackm.h"

Line 19 int SerialCurrent = -1; /* Current Serial number of t

int ReverseOutputOrder = 1;

int WarningNoVectorVariable = 1;

extern int QuoteMode;

/** :arithmetic **/

struct object KooAdd(ob1,ob2)

Line 29 struct object KooAdd(ob1,ob2)

Line 30 struct object KooAdd(ob1,ob2)

POLY r;

int s,i;

objectp f1,f2,g1,g2;

struct object nn,dd;

struct object nn = OINIT;

struct object dd = OINIT;

switch (Lookup[ob1.tag][ob2.tag]) {

case SintegerSinteger:

Line 142 struct object KooAdd(ob1,ob2)

Line 144 struct object KooAdd(ob1,ob2)

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;

}

return(rob);

Line 156 struct object KooSub(ob1,ob2)

Line 162 struct object KooSub(ob1,ob2)

int s,i;

objectp f1,f2,g1,g2;

extern struct coeff *UniversalZero;

struct object nn,dd;

struct object nn = OINIT;

struct object dd = OINIT;

switch (Lookup[ob1.tag][ob2.tag]) {

case SintegerSinteger:

Line 270 struct object KooSub(ob1,ob2)

Line 277 struct object KooSub(ob1,ob2)

break;

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;

}

return(rob);

Line 283 struct object KooMult(ob1,ob2)

Line 294 struct object KooMult(ob1,ob2)

POLY r;

int i,s;

objectp f1,f2,g1,g2;

struct object dd,nn;

struct object dd = OINIT;

struct object nn = OINIT;

switch (Lookup[ob1.tag][ob2.tag]) {

Line 412 struct object KooMult(ob1,ob2)

Line 424 struct object KooMult(ob1,ob2)

break;

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;

}

return(rob);

Line 425 struct object KoNegate(obj)

Line 441 struct object KoNegate(obj)

{

struct object rob = NullObject;

extern struct ring SmallRing;

struct object tob;

struct object tob = OINIT;

switch(obj.tag) {

case Sinteger:

rob = obj;

Line 451 struct object KoNegate(obj)

Line 467 struct object KoNegate(obj)

break;

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;

}

return(rob);

Line 463 struct object KoInverse(obj)

Line 483 struct object KoInverse(obj)

struct object rob = NullObject;

extern struct coeff *UniversalOne;

objectp onep;

struct object tob;

struct object tob = OINIT;

switch(obj.tag) {

case Spoly:

tob.tag = SuniversalNumber;

Line 529 struct object KaoMult(aa,bb)

Line 549 struct object KaoMult(aa,bb)

POLY tmp;

POLY fik;

POLY gkj;

struct object rob;

struct object rob = OINIT;

int r1,r2;

int rsize;

struct object tob;

struct object tob = OINIT;

struct object ob1;

struct object ob1 = OINIT;

extern struct ring SmallRing;

m = getoaSize(aa); m2 = getoaSize(bb);

Line 593 struct object KaoMult(aa,bb)

Line 613 struct object KaoMult(aa,bb)

r1 = isMatrix(aa,m,n); r2 = isMatrix(bb,m2,n2);

if (r1 == -1 || r2 == -1) {

/* Object multiplication. Elements are not polynomials. */

struct object ofik,ogkj,otmp;

struct object ofik = OINIT;

struct object ogkj = OINIT;

struct object otmp = OINIT;

rob = newObjectArray(m);

for (i=0; i<m; i++) {

getoa(rob,i) = newObjectArray(n2);

Line 653 struct object KooDiv(ob1,ob2)

Line 675 struct object KooDiv(ob1,ob2)

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;

}

return(rob);

Line 664 KooEqualQ(obj1,obj2)

Line 690 KooEqualQ(obj1,obj2)

struct object obj1;

struct object obj2;

{

struct object ob;

struct object ob = OINIT;

int i;

extern int Verbose;

if (obj1.tag != obj2.tag) {

warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n");

if (Verbose & 0x10) {

fprintf(stderr,"obj1(tag:%d)=",obj1.tag);

printObject(obj1,0,stderr);

fprintf(stderr,", obj2(tag:%d)=",obj2.tag);

printObject(obj2,0,stderr);

fprintf(stderr,"\n"); fflush(stderr);

}

return(0);

}

switch(obj1.tag) {

Line 745 struct object KooGreater(obj1,obj2)

Line 779 struct object KooGreater(obj1,obj2)

struct object obj1;

struct object obj2;

{

struct object ob;

struct object ob = OINIT;

int tt;

if (obj1.tag != obj2.tag) {

errorKan1("%s\n","You cannot compare different kinds of objects.");

Line 776 struct object KooGreater(obj1,obj2)

Line 810 struct object KooGreater(obj1,obj2)

if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1));

else return(KpoInteger(0));

break;

case Sarray:

{

int i,m1,m2;

struct object rr = OINIT;

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:

errorKan1("%s\n","KooGreater() has not supported these objects yet.");

break;

Line 817 struct object KooLess(obj1,obj2)

Line 866 struct object KooLess(obj1,obj2)

if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1));

else return(KpoInteger(0));

break;

case Sarray:

{

int i,m1,m2;

struct object rr = OINIT;

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:

errorKan1("%s\n","KooLess() has not supported these objects yet.");

break;

Line 831 struct object KdataConversion(obj,key)

Line 895 struct object KdataConversion(obj,key)

{

char tmps[128]; /* Assume that double is not more than 128 digits */

char intstr[100]; /* Assume that int is not more than 100 digits */

struct object rob;

struct object rob = OINIT;

extern struct ring *CurrentRingp;

extern struct ring SmallRing;

int flag;

struct object rob1,rob2;

struct object rob1 = OINIT;

struct object rob2 = OINIT;

char *s;

int i;

double f;

Line 868 struct object KdataConversion(obj,key)

Line 933 struct object KdataConversion(obj,key)

return(rob);

}else if (strcmp(key,"poly") == 0) {

rob = KpoPOLY(ZERO);

return rob;

}else if (strcmp(key,"array") == 0) {

rob = newObjectArray(0);

return rob;

}else{

warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");

}

Line 893 struct object KdataConversion(obj,key)

Line 962 struct object KdataConversion(obj,key)

strcpy(rob.lc.str,intstr);

return(rob);

}else if (strcmp(key,"universalNumber")==0) {

rob.tag = SuniversalNumber;

rob = KintToUniversalNumber(obj.lc.ival);

rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);

return(rob);

}else if (strcmp(key,"double") == 0) {

rob = KpoDouble((double) (obj.lc.ival));

Line 965 struct object KdataConversion(obj,key)

Line 1033 struct object KdataConversion(obj,key)

if (strcmp(key,"array") == 0) {

return(rob);

}else if (strcmp(key,"list") == 0) {

rob = *( arrayToList(obj) );

rob = KarrayToList(obj);

return(rob);

}else if (strcmp(key,"arrayOfPOLY")==0) {

rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));

Line 979 struct object KdataConversion(obj,key)

Line 1047 struct object KdataConversion(obj,key)

}else if (strcmp(key,"null") == 0) {

rob = NullObject;

return(rob);

}else if (strcmp(key,"byteArray") == 0) {

rob = newByteArray(getoaSize(obj),obj);

return(rob);

}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;

case Spoly:

if (strcmp(key,"poly")==0) {

if ((strcmp(key,"poly")==0) || (strcmp(key,"numerator")==0)) {

rob = obj;

return(rob);

}else if (strcmp(key,"integer")==0) {

Line 1050 struct object KdataConversion(obj,key)

Line 1129 struct object KdataConversion(obj,key)

break;

case Slist:

if (strcmp(key,"array") == 0) {

rob = listToArray(&obj);

rob = KlistToArray(obj);

return(rob);

}

break;

case SuniversalNumber:

if (strcmp(key,"universalNumber")==0) {

if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) {

rob = obj;

return(rob);

}else if (strcmp(key,"integer")==0) {

rob = KpoInteger(coeffToInt(obj.lc.universalNumber));

Line 1073 struct object KdataConversion(obj,key)

Line 1153 struct object KdataConversion(obj,key)

}else if (strcmp(key,"double") == 0) {

rob = KpoDouble( toDouble0(obj) );

return(rob);

}else if (strcmp(key,"denominator") == 0) {

rob = KintToUniversalNumber(1);

return(rob);

}else{

warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n");

}

Line 1137 struct object KdataConversion(obj,key)

Line 1220 struct object KdataConversion(obj,key)

if (strcmp(key,"orderMatrix")==0) {

rob = oGetOrderMatrix(KopRingp(obj));

return(rob);

}else if (strcmp(key,"oxRingStructure")==0) {

rob = oRingToOXringStructure(KopRingp(obj));

return(rob);

}else{

warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");

}

break;

case SbyteArray:

if (strcmp(key,"array") == 0) {

rob = byteArrayToArray(obj);

return(rob);

} else {

warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");

}

break;

default:

warningKan("Sorry. This type of data conversion has not supported yet.\n");

}

return(NullObject);

}

/* cf. macro to_int32 */

struct object Kto_int32(struct object ob) {

int n,i;

struct object otmp = OINIT;

struct object rob = OINIT;

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.

If it's not time critical, it is recommended to use these functions */

struct object KpoInteger(k)

int k;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Sinteger;

obj.lc.ival = k; obj.rc.ival = 0;

return(obj);

Line 1160 struct object KpoInteger(k)

Line 1271 struct object KpoInteger(k)

struct object KpoString(s)

char *s;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Sdollar;

obj.lc.str = s; obj.rc.ival = 0;

return(obj);

Line 1168 struct object KpoString(s)

Line 1279 struct object KpoString(s)

struct object KpoPOLY(f)

POLY f;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Spoly;

obj.lc.poly = f; obj.rc.ival = 0;

return(obj);

Line 1176 struct object KpoPOLY(f)

Line 1287 struct object KpoPOLY(f)

struct object KpoArrayOfPOLY(ap)

struct arrayOfPOLY *ap ;

{

struct object obj;

struct object obj = OINIT;

obj.tag = SarrayOfPOLY;

obj.lc.arrayp = ap; obj.rc.ival = 0;

return(obj);

Line 1185 struct object KpoArrayOfPOLY(ap)

Line 1296 struct object KpoArrayOfPOLY(ap)

struct object KpoMatrixOfPOLY(mp)

struct matrixOfPOLY *mp ;

{

struct object obj;

struct object obj = OINIT;

obj.tag = SmatrixOfPOLY;

obj.lc.matrixp = mp; obj.rc.ival = 0;

return(obj);

Line 1194 struct object KpoMatrixOfPOLY(mp)

Line 1305 struct object KpoMatrixOfPOLY(mp)

struct object KpoRingp(ringp)

struct ring *ringp;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Sring;

obj.lc.ringp = ringp;

return(obj);

}

struct object KpoUniversalNumber(u)

struct coeff *u;

{

struct object obj = OINIT;

obj.tag = SuniversalNumber;

obj.lc.universalNumber = u;

return(obj);

}

struct object KintToUniversalNumber(n)

int n;

{

struct object rob = OINIT;

extern struct ring SmallRing;

rob.tag = SuniversalNumber;

rob.lc.universalNumber = intToCoeff(n,&SmallRing);

return(rob);

}

/*** conversion 2. Data conversions on arrays and matrices. ****/

struct object arrayOfPOLYToArray(aa)

struct arrayOfPOLY *aa;

{

POLY *a;

int size;

struct object r;

struct object r = OINIT;

int j;

struct object tmp;

struct object tmp = OINIT;

size = aa->n; a = aa->array;

r = newObjectArray(size);

Line 1223 struct object arrayOfPOLYToArray(aa)

Line 1352 struct object arrayOfPOLYToArray(aa)

struct object matrixOfPOLYToArray(pmat)

struct matrixOfPOLY *pmat;

{

struct object r;

struct object r = OINIT;

struct object tmp;

struct object tmp = OINIT;

int i,j;

int m,n;

POLY *mat;

Line 1247 struct arrayOfPOLY *arrayToArrayOfPOLY(oa)

Line 1376 struct arrayOfPOLY *arrayToArrayOfPOLY(oa)

POLY *a;

int size;

int i;

struct object tmp;

struct object tmp = OINIT;

struct arrayOfPOLY *ap;

if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",

Line 1275 struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)

Line 1404 struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)

int i,j;

struct matrixOfPOLY *ma;

struct object tmp,tmp2;

struct object tmp = OINIT;

struct object tmp2 = OINIT;

if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",

"Argument is not array\n");

m = getoaSize(oa);

Line 1313 int objArrayToOrderMatrix(oA,order,n,oasize)

Line 1443 int objArrayToOrderMatrix(oA,order,n,oasize)

{

int size;

int k,j;

struct object tmpOa;

struct object tmpOa = OINIT;

struct object obj;

struct object obj = OINIT;

if (oA.tag != Sarray) {

warningKan("The argument should be of the form [ [...] [...] ... [...]].");

return(-1);

Line 1399 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1529 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

ob4 = Order matrix

ob5 = [(keyword) value (keyword) value ....]

#define RP_LIMIT 500

#define RP_LIMIT 5000

{

int i;

struct object ob;

struct object ob = OINIT;

int c,l,m,n;

int cc,ll,mm,nn;

int p;

Line 1425 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1555 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

extern char *F_mpMult;

char *fmp_mult_saved;

char *mpMultName = NULL;

struct object rob;

struct object rob = OINIT;

struct ring *savedCurrentRingp;

/* To get the ring structure. */

Line 1496 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1626 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

outputVars[i] = i;

}

ob4 = Kto_int32(ob4); /* order matrix */

oasize = getoaSize(ob4);

order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));

if (order == (int *)NULL) errorKan1("%s\n","No memory.");

Line 1538 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1669 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

newRingp->gbListTower = NULL;

newRingp->outputOrder = outputVars;

newRingp->weightedHomogenization = 0;

newRingp->degreeShiftSize = 0;

newRingp->degreeShiftN = 0;

newRingp->degreeShift = NULL;

newRingp->partialEcart = 0;

newRingp->partialEcartGlobalVarX = NULL;

if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {

errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");

Line 1588 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1724 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

if (getoa(ob5,i+1).tag != Sinteger) {

errorKan1("%s\n","A integer should be given. (weightedHomogenization)");

}

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 = OINIT;

struct object ods2 = OINIT;

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));

}

} else if (strcmp(KopString(getoa(ob5,i)),"partialEcartGlobalVarX") == 0) {

if (getoa(ob5,i+1).tag != Sarray) {

errorKan1("%s\n","An array of array should be given. (partialEcart)");

}

{

struct object odv = OINIT;

struct object ovv = OINIT;

int k,j,nn;

char *vname;

odv=getoa(ob5,i+1);

nn = getoaSize(odv);

newRingp->partialEcart = nn;

newRingp->partialEcartGlobalVarX = (int *) sGC_malloc(sizeof(int)*nn+1);

if (newRingp->partialEcartGlobalVarX == NULL) errorKan1("%s\n","No more memory.");

for (j=0; j<nn; j++)

(newRingp->partialEcartGlobalVarX)[j] = -1;

for (j=0; j<nn; j++) {

ovv = getoa(odv,j);

if (ovv.tag != Sdollar) errorKan1("%s\n","partialEcartGlobalVarX: string is expected.");

vname = KopString(ovv);

for (k=0; k<n; k++) {

if (strcmp(vname,xvars[k]) == 0) {

(newRingp->partialEcartGlobalVarX)[j] = k; break;

}else{

if (k == n-1) errorKan1("%s\n","partialEcartGlobalVarX: no such variable.");

}

switch_function("grade","module1v");

/* Warning: grading is changed to module1v!! */

} else {

errorKan1("%s\n","Unknown keyword to set_up_ring@");

}

Line 1641 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1838 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

struct object KsetVariableNames(struct object ob,struct ring *rp)

{

int n,i;

struct object ox;

struct object ox = OINIT;

struct object otmp;

struct object otmp = OINIT;

char **xvars;

char **dvars;

if (ob.tag != Sarray) {

Line 1687 struct object KswitchFunction(ob1,ob2)

Line 1884 struct object KswitchFunction(ob1,ob2)

struct object ob1,ob2;

{

char *ans ;

struct object rob;

struct object rob = OINIT;

int needWarningForAvoidTheSameRing = 0;

extern int AvoidTheSameRing;

if ((ob1.tag != Sdollar) || (ob2.tag != Sdollar)) {

Line 1729 struct object KoReplace(of,rule)

Line 1926 struct object KoReplace(of,rule)

struct object of;

struct object rule;

{

struct object rob;

struct object rob = OINIT;

POLY f;

POLY lRule[N0*2];

POLY rRule[N0*2];

POLY r;

int i;

int n;

struct object trule;

struct object trule = OINIT;

if (rule.tag != Sarray) {

Line 1792 struct object Kparts(f,v)

Line 1989 struct object Kparts(f,v)

{

POLY ff;

POLY vv;

struct object obj;

struct object obj = OINIT;

struct matrixOfPOLY *co;

/* check the data type */

if (f.tag != Spoly || v.tag != Spoly)

Line 1809 struct object Kparts2(f,v)

Line 2006 struct object Kparts2(f,v)

{

POLY ff;

POLY vv;

struct object obj;

struct object obj = OINIT;

struct matrixOfPOLY *co;

/* check the data type */

if (f.tag != Spoly || v.tag != Spoly)

Line 1857 struct object Ksp(ob1,ob2)

Line 2054 struct object Ksp(ob1,ob2)

struct object ob1,ob2;

{

struct spValue sv;

struct object rob,cob;

struct object rob = OINIT;

struct object cob = OINIT;

POLY f;

if (ob1.tag != Spoly || ob2.tag != Spoly)

errorKan1("%s\n","Ksp(): The arguments must be polynomials.");

Line 1887 struct object Keval(obj)

Line 2085 struct object Keval(obj)

{

char *key;

int size;

struct object rob;

struct object rob = OINIT;

rob = NullObject;

if (obj.tag != Sarray)

Line 1932 char *KremoveSpace(str)

Line 2130 char *KremoveSpace(str)

struct object KtoRecords(ob)

struct object ob;

{

struct object obj;

struct object obj = OINIT;

struct object tmp;

struct object tmp = OINIT;

int i;

int size;

char **argv;

Line 2028 int KtoArgvbyCurryBrace(str,argv,limit)

Line 2226 int KtoArgvbyCurryBrace(str,argv,limit)

return(argc);

}

struct object KstringToArgv(struct object ob) {

struct object rob = OINIT;

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)

char *xvars[];

char *dvars[];

Line 2050 static void checkDuplicateName(xvars,dvars,n)

Line 2288 static void checkDuplicateName(xvars,dvars,n)

}

struct object KooPower(struct object ob1,struct object ob2) {

struct object rob = OINIT;

/* 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 2112 struct object KooDiv2(ob1,ob2)

Line 2360 struct object KooDiv2(ob1,ob2)

break;

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;

}

return(rob);

Line 2159 struct object KgbExtension(struct object obj)

Line 2411 struct object KgbExtension(struct object obj)

{

char *key;

int size;

struct object keyo;

struct object keyo = OINIT;

struct object rob = NullObject;

struct object obj1,obj2,obj3;

struct object obj1 = OINIT;

struct object obj2 = OINIT;

struct object obj3 = OINIT;

POLY f1;

POLY f2;

POLY f3;

POLY f;

int m,i;

struct pairOfPOLY pf;

struct coeff *cont;

if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array.");

size = getoaSize(obj);

Line 2247 struct object KgbExtension(struct object obj)

Line 2502 struct object KgbExtension(struct object obj)

errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext");

}

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) {

if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array");

obj1 = getoa(obj,1);

Line 2281 struct object KgbExtension(struct object obj)

Line 2543 struct object KgbExtension(struct object obj)

obj1 = getoa(obj,1);

if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly");

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 {

errorKan1("%s\n","gbext : unknown tag.");

}

Line 2291 struct object KmpzExtension(struct object obj)

Line 2584 struct object KmpzExtension(struct object obj)

{

char *key;

int size;

struct object keyo;

struct object keyo = OINIT;

struct object rob = NullObject;

struct object obj0,obj1,obj2,obj3;

struct object obj0 = OINIT;

struct object obj1 = OINIT;

struct object obj2 = OINIT;

struct object obj3 = OINIT;

MP_INT *f;

MP_INT *g;

MP_INT *h;

Line 2316 struct object KmpzExtension(struct object obj)

Line 2612 struct object KmpzExtension(struct object obj)

if (size != 3) errorKan1("%s\n","[(gcd) 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","[(gcd) universalNumber universalNumber] mpzext.");

if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||

Line 2332 struct object KmpzExtension(struct object obj)

Line 2634 struct object KmpzExtension(struct object obj)

if (size != 3) errorKan1("%s\n","[(tdiv_qr) 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","[(tdiv_qr) universalNumber universalNumber] mpzext.");

if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||

Line 2390 struct object KmpzExtension(struct object obj)

Line 2698 struct object KmpzExtension(struct object obj)

/* One arg functions */

if (size != 2) errorKan1("%s\n","[key num] mpzext");

obj1 = getoa(obj,1);

if (obj1.tag != SuniversalNumber) {

obj1 = KdataConversion(obj1,"universalNumber");

}

if (obj1.tag != SuniversalNumber)

errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");

if (! is_this_coeff_MP_INT(obj1.lc.universalNumber))

Line 2411 struct object KmpzExtension(struct object obj)

Line 2722 struct object KmpzExtension(struct object obj)

if (size != 3) errorKan1("%s\n","[key num1 num2] 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","[key num1 num2] mpzext.");

if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||

Line 2442 struct object KmpzExtension(struct object obj)

Line 2759 struct object KmpzExtension(struct object obj)

/* three args */

if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext");

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 ||

obj2.tag != SuniversalNumber ||

obj3.tag != SuniversalNumber ) {

Line 2460 struct object KmpzExtension(struct object obj)

Line 2786 struct object KmpzExtension(struct object obj)

mpz_powm(r1,f,g,h);

rob.tag = SuniversalNumber;

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 {

errorKan1("%s\n","mpzExtension(): Unknown tag.");

}

Line 2470 struct object KmpzExtension(struct object obj)

Line 2818 struct object KmpzExtension(struct object obj)

/** : context */

struct object KnewContext(struct object superObj,char *name) {

struct context *cp;

struct object ob;

struct object ob = OINIT;

if (superObj.tag != Sclass) {

errorKan1("%s\n","The argument of KnewContext must be a Class.Context");

}

Line 2489 struct object KcreateClassIncetance(struct object ob1,

Line 2837 struct object KcreateClassIncetance(struct object ob1,

struct object ob3)

{

/* [class-tag super-obj] size [class-tag] cclass */

struct object ob4;

struct object ob4 = OINIT;

int size,size2,i;

struct object ob5;

struct object ob5 = OINIT;

struct object rob;

struct object rob = OINIT;

if (ob1.tag != Sarray)

errorKan1("%s\n","cclass: The first argument must be an array.");

Line 2545 struct object KpoDouble(double a) {

Line 2893 struct object KpoDouble(double a) {

double toDouble0(struct object ob) {

double r;

int r3;

struct object ob2;

struct object ob2 = OINIT;

struct object ob3;

struct object ob3 = OINIT;

switch(ob.tag) {

case Sinteger:

return( (double) (KopInteger(ob)) );

Line 2575 double toDouble0(struct object ob) {

Line 2923 double toDouble0(struct object ob) {

}

struct object KpoGradedPolySet(struct gradedPolySet *grD) {

struct object rob;

struct object rob = OINIT;

rob.tag = Sclass;

rob.lc.ival = CLASSNAME_GradedPolySet;

rob.rc.voidp = (void *) grD;

Line 2592 static char *getspace0(int a) {

Line 2940 static char *getspace0(int a) {

return(s);

}

struct object KdefaultPolyRing(struct object ob) {

struct object rob;

struct object rob = OINIT;

int i,j,k,n;

struct object ob1,ob2,ob3,ob4,ob5;

struct object ob1 = OINIT;

struct object t1;

struct object ob2 = OINIT;

struct object ob3 = OINIT;

struct object ob4 = OINIT;

struct object ob5 = OINIT;

struct object t1 = OINIT;

char *s1;

extern struct ring *CurrentRingp;

static struct ring *a[N0];

Line 2666 struct object KdefaultPolyRing(struct object ob) {

Line 3018 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 = OINIT;

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.");

}

struct object Kget(struct object ob1, struct object ob2) {

struct object rob = OINIT;

struct object tob = OINIT;

int i,j,size,n;

if (ob2.tag == Sinteger) {

i =ob2.lc.ival;

}else if (ob2.tag == SuniversalNumber) {

i = KopInteger(KdataConversion(ob2,"integer"));

}else if (ob2.tag == Sarray) {

n = getoaSize(ob2);

if (n == 0) return ob1;

rob = ob1;

for (i=0; i<n; i++) {

rob=Kget(rob,getoa(ob2,i));

}

return rob;

}

if (ob1.tag == Sarray) {

size = getoaSize(ob1);

if ((0 <= i) && (i<size)) {

return(getoa(ob1,i));

}else{

errorKan1("%s\n","Kget: Index is out of bound. (get)\n");

}

}else if (ob1.tag == Slist) {

rob = NullObject;

if (i < 0) errorKan1("%s\n","Kget: Index is negative. (get)");

for (j=0; j<i; j++) {

rob = Kcdr(ob1);

if ((ob1.tag == Snull) && (rob.tag == Snull)) {

errorKan1("%s\n","Kget: Index is out of bound. (get) cdr of null list.\n");

}

ob1 = rob;

}

return Kcar(ob1);

} else if (ob1.tag == SbyteArray) {

size = getByteArraySize(ob1);

if ((0 <= i) && (i<size)) {

return(KpoInteger(KopByteArray(ob1)[i]));

}else{

errorKan1("%s\n","Kget: Index is out of bound. (get)\n");

}

} else if (ob1.tag == Sdollar) {

unsigned char *sss;

sss = (unsigned char *) KopString(ob1);

size = strlen(sss);

if ((0 <= i) && (i<size)) {

return(KpoInteger(sss[i]));

}else{

errorKan1("%s\n","Kget: Index is out of bound. (get)\n");

}

}else errorKan1("%s\n","Kget: argument must be an array or a list.");

}

/* Constructor of byteArray */

struct object newByteArray(int size,struct object obj) {

unsigned char *ba;

unsigned char *ba2;

struct object rob = OINIT;

struct object tob = OINIT;

int i,n;

ba = NULL;

if (size > 0) {

ba = (unsigned char *) sGC_malloc(size);

if (ba == NULL) errorKan1("%s\n","No more memory.");

}

rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size;

if (obj.tag == SbyteArray) {

n = getByteArraySize(obj);

ba2 = KopByteArray(obj);

for (i=0; i<(n<size?n:size); i++) {

ba[i] = ba2[i];

}

for (i=n; i<size; i++) ba[i] = 0;

return rob;

}else if (obj.tag == Sarray) {

n = getoaSize(obj);

for (i=0; i<n; i++) {

tob = getoa(obj,i);

tob = Kto_int32(tob);

if (tob.tag != Sinteger) errorKan1("%s\n","newByteArray: array is not an array of integer or universalNumber.");

ba[i] = (unsigned char) KopInteger(tob);

}

for (i=n; i<size; i++) ba[i] = 0;

return rob;

}else{

for (i=0; i<size; i++) ba[i] = 0;

return rob;

}

struct object newByteArrayFromStr(char *s,int size) {

unsigned char *ba;

struct object rob = OINIT;

int i;

ba = NULL;

if (size > 0) {

ba = (unsigned char *) sGC_malloc(size);

if (ba == NULL) errorKan1("%s\n","No more memory.");

}

rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size;

for (i=0; i<size; i++) {

ba[i] = (char) s[i];

}

return(rob);

}

struct object byteArrayToArray(struct object obj) {

int n,i; unsigned char *ba;

struct object rob = OINIT;

if (obj.tag != SbyteArray) errorKan1("%s\n","byteArrayToArray: argument is not an byteArray.");

n = getByteArraySize(obj);

rob = newObjectArray(n);

ba = KopByteArray(obj);

for (i=0; i<n; i++) putoa(rob,i,KpoInteger((int) ba[i]));

return rob;

}

struct object KgetAttributeList(struct object ob){

struct object rob = OINIT;

if (ob.attr != NULL) rob = *(ob.attr);

else rob = NullObject;

return rob;

}

struct object KsetAttributeList(struct object ob,struct object attr) {

ob.attr = newObject();

*(ob.attr) = attr;

return ob;

}

struct object KgetAttribute(struct object ob,struct object key) {

struct object rob = OINIT;

struct object alist = OINIT;

int n,i;

struct object tob = OINIT;

char *s;

rob = NullObject;

if (ob.attr == NULL) return rob;

alist = *(ob.attr);

if (alist.tag != Sarray) return rob;

if (key.tag != Sdollar) return rob;

s = KopString(key);

n = getoaSize(alist);

for (i = 0; i < n; i += 2) {

tob = getoa(alist,i);

if (tob.tag == Sdollar) {

if (strcmp(KopString(tob),s) == 0) {

if (i+1 < n) rob = getoa(alist,i+1);

return rob;

}

return rob;

}

/* ob (key) (value) setAttribute /ob set. They are not destructive. */

struct object KsetAttribute(struct object ob,struct object key,struct object value) {

struct object rob = OINIT;

struct object alist = OINIT;

int n,i;

char *s = "";

struct object tob = OINIT;

rob = ob;

if (ob.attr == NULL) {

rob.attr = newObject();

*(rob.attr) = newObjectArray(2);

putoa((*(rob.attr)),0,key);

putoa((*(rob.attr)),1,value);

return rob;

}

alist = *(ob.attr);

if (alist.tag != Sarray) return rob;

if (key.tag != Sdollar) {

s = KopString(key);

}

n = getoaSize(alist);

for (i = 0; i < n; i += 2) {

tob = getoa(alist,i);

if (tob.tag == Sdollar) {

if (strcmp(KopString(tob),s) == 0) {

if (i+1 < n) putoa(alist,i+1,value);

return rob;

}

rob.attr = newObject();

*(rob.attr) = newObjectArray(n+2);

for (i=0; i<n; i++) {

putoa((*(rob.attr)),i,getoa((*(ob.attr)),i));

}

putoa((*(rob.attr)),n,key);

putoa((*(rob.attr)),n+1,value);

return rob;

}

/******************************************************************

error handler

Error handler

******************************************************************/

errorKan1(str,message)

Line 2680 errorKan1(str,message)

Line 3265 errorKan1(str,message)

extern char *GotoLabel;

extern int GotoP;

extern int ErrorMessageMode;

extern int RestrictedMode, RestrictedMode_saved;

char tmpc[1024];

RestrictedMode = RestrictedMode_saved;

cancelAlarm();

if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {

sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");

Line 2692 errorKan1(str,message)

Line 3279 errorKan1(str,message)

if (ErrorMessageMode != 1) {

fprintf(stderr,"\nERROR(kanExport[0|1].c): ");

fprintf(stderr,str,message);

(void) traceShowStack(); traceClearStack();

}

/* fprintf(stderr,"Hello "); */

if (GotoP) {

Line 2707 errorKan1(str,message)

Line 3295 errorKan1(str,message)

longjmp(EnvOfStackMachine,1);

#endif

}

warningKan(str)

char *str;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>