Annotation of OpenXM/src/kan96xx/Kan/kclass.c, Revision 1.1
1.1 ! maekawa 1:
! 2: /* kclass.c, 1997, 3/1
! 3: This module handles class data base.
! 4: This is a top level and provides an interface for sm1 for Sclass objects.
! 5: Main processing is done in Kclass/*
! 6: See, Kclass/sample.h, Kclass/sample.c ;
! 7: grep the keyword CLASSNAME_sampleClass
! 8: */
! 9: #include <stdio.h>
! 10: #include "datatype.h"
! 11: #include "stackm.h"
! 12: #include "extern.h"
! 13: #include "gradedset.h"
! 14: #include "extern2.h"
! 15: #include "kclass.h"
! 16:
! 17: #define CLASSTABLE_SIZE 4096
! 18:
! 19:
! 20: struct object * ClassDictionaries[CLASSTABLE_SIZE];
! 21: char *ClassNames[CLASSTABLE_SIZE];
! 22: int ClassTypes[CLASSTABLE_SIZE];
! 23:
! 24: initClassDataBase() {
! 25: int i;
! 26: for (i=0; i<CLASSTABLE_SIZE; i++) {
! 27: ClassTypes[i] = CLASS_NOT_USED;
! 28: }
! 29: /* Initialize CLASS_INTERNAL */
! 30: ClassTypes[CLASSNAME_OPERANDSTACK] = CLASS_INTERNAL;
! 31: ClassNames[CLASSNAME_OPERANDSTACK] = "Class.OperandStack";
! 32: ClassDictionaries[CLASSNAME_OPERANDSTACK] = (struct object *)NULL;
! 33: /* We have to creat new dictionary in a future. */
! 34:
! 35: ClassTypes[CLASSNAME_ERROR_PACKET] = CLASS_OBJ;
! 36: ClassNames[CLASSNAME_ERROR_PACKET] = "Class.ErrorPacket";
! 37: ClassDictionaries[CLASSNAME_ERROR_PACKET] = (struct object *)NULL;
! 38: /* We have to creat new dictionary in a future. */
! 39:
! 40: ClassTypes[CLASSNAME_CONTEXT] = CLASS_INTERNAL;
! 41: ClassNames[CLASSNAME_CONTEXT] = "Class.Context";
! 42: ClassDictionaries[CLASSNAME_CONTEXT] = (struct object *)NULL;
! 43: /* We have to creat new dictionary in a future. */
! 44:
! 45: ClassTypes[CLASSNAME_GradedPolySet] = CLASS_INTERNAL;
! 46: ClassNames[CLASSNAME_GradedPolySet] = "Class.GradedPolySet";
! 47: ClassDictionaries[CLASSNAME_GradedPolySet] = (struct object *)NULL;
! 48: /* We have to creat new dictionary in a future. */
! 49:
! 50: ClassTypes[CLASSNAME_mathcap] = CLASS_OBJ;
! 51: ClassNames[CLASSNAME_mathcap] = "Class.mathcap";
! 52: ClassDictionaries[CLASSNAME_mathcap] = (struct object *)NULL;
! 53: /* We have to creat new dictionary in a future. */
! 54:
! 55: ClassTypes[CLASSNAME_CMO] = CLASS_OBJ;
! 56: ClassNames[CLASSNAME_CMO] = "Class.CMO";
! 57: ClassDictionaries[CLASSNAME_CMO] = (struct object *)NULL;
! 58: /* We have to creat new dictionary in a future. */
! 59:
! 60: ClassTypes[CLASSNAME_indeterminate] = CLASS_OBJ;
! 61: ClassNames[CLASSNAME_indeterminate] = "Class.indeterminate";
! 62: ClassDictionaries[CLASSNAME_indeterminate] = (struct object *)NULL;
! 63:
! 64: ClassTypes[CLASSNAME_tree] = CLASS_OBJ;
! 65: ClassNames[CLASSNAME_tree] = "Class.tree";
! 66: ClassDictionaries[CLASSNAME_tree] = (struct object *)NULL;
! 67:
! 68: ClassTypes[CLASSNAME_recursivePolynomial] = CLASS_OBJ;
! 69: ClassNames[CLASSNAME_recursivePolynomial] = "Class.recursivePolynomial";
! 70: ClassDictionaries[CLASSNAME_recursivePolynomial] = (struct object *)NULL;
! 71:
! 72: ClassTypes[CLASSNAME_polynomialInOneVariable] = CLASS_OBJ;
! 73: ClassNames[CLASSNAME_polynomialInOneVariable] = "Class.polynomialInOneVariable";
! 74: ClassDictionaries[CLASSNAME_polynomialInOneVariable] = (struct object *)NULL;
! 75:
! 76: ClassTypes[CLASSNAME_sampleClass] = CLASS_OBJ;
! 77: ClassNames[CLASSNAME_sampleClass] = "Class.sampleClass";
! 78: ClassDictionaries[CLASSNAME_sampleClass] = (struct object *)NULL;
! 79: /* We have to creat new dictionary in a future. */
! 80:
! 81: }
! 82:
! 83:
! 84: void fprintClass(FILE *fp,struct object obj) {
! 85: int tag;
! 86: tag = ectag(obj);
! 87: if (tag == -1) {
! 88: return ;
! 89: }
! 90: if (ClassTypes[tag] != CLASS_NOT_USED) {
! 91: fprintf(fp,"%s ",ClassNames[tag]);
! 92: }
! 93: switch(tag) {
! 94: case CLASSNAME_OPERANDSTACK:
! 95: break;
! 96: case CLASSNAME_ERROR_PACKET:
! 97: fprintErrorPacket(fp,KopErrorPacket(obj));
! 98: break;
! 99: case CLASSNAME_CONTEXT:
! 100: fprintContext(fp,KopContext(obj));
! 101: break;
! 102: case CLASSNAME_GradedPolySet:
! 103: outputGradedPolySet(KopGradedPolySet(obj),0);
! 104: break;
! 105: case CLASSNAME_mathcap:
! 106: fprintMathCap(fp,KopMathCap(obj));
! 107: break;
! 108: case CLASSNAME_CMO:
! 109: fprintCMOClass(fp,obj);
! 110: break;
! 111: case CLASSNAME_indeterminate:
! 112: fprintIndeterminate(fp,obj);
! 113: break;
! 114: case CLASSNAME_tree:
! 115: fprintTree(fp,obj);
! 116: break;
! 117: case CLASSNAME_recursivePolynomial:
! 118: fprintRecursivePolynomial(fp,obj);
! 119: break;
! 120: case CLASSNAME_polynomialInOneVariable:
! 121: fprintPolynomialInOneVariable(fp,obj);
! 122: break;
! 123: case CLASSNAME_sampleClass:
! 124: fprintSampleClass(fp,KopSampleClass(obj));
! 125: break;
! 126: default:
! 127: fprintf(fp,"Unknown class tag=%d.\n",tag);
! 128: break;
! 129: }
! 130: }
! 131:
! 132: int KclassEqualQ(struct object ob1,struct object ob2) {
! 133: if (ectag(ob1) != ectag(ob2)) return(0);
! 134: switch(ectag(ob1)) {
! 135: case CLASSNAME_OPERANDSTACK:
! 136: case CLASSNAME_CONTEXT:
! 137: if (ecbody(ob1) == ecbody(ob2)) return(1);
! 138: else return(0);
! 139: break;
! 140: case CLASSNAME_sampleClass:
! 141: return(eqSampleClass(KopSampleClass(ob1),KopSampleClass(ob2)));
! 142: break;
! 143: default:
! 144: errorKan1("%s\n","kclass.c (KclassEqualQ cannot compare these objects.)");
! 145: break;
! 146: }
! 147: }
! 148:
! 149: void fprintErrorPacket(FILE *fp,struct object *op)
! 150: {
! 151: printObject(*op,0,fp);
! 152: }
! 153:
! 154: void fprintMathCap(FILE *fp,struct object *op)
! 155: {
! 156: printObject(*op,0,fp);
! 157: }
! 158:
! 159: struct object KpoMathCap(struct object *obp) {
! 160: struct object rob;
! 161: struct object *newobp;
! 162:
! 163: newobp = (struct object *) sGC_malloc(sizeof(struct object));
! 164: /* Yes! You can call KpoMathCap(&localVar) */
! 165: if (newobp == NULL) errorKan1("%s\n","kclass.c, no more memory.");
! 166: *newobp = *obp;
! 167:
! 168: rob.tag = Sclass;
! 169: rob.lc.ival = CLASSNAME_mathcap;
! 170: rob.rc.voidp = newobp;
! 171: return(rob);
! 172: }
! 173:
! 174: /* try
! 175: [ 1 2 3] [(class) (sampleClass)] dc ::
! 176: */
! 177: struct object KclassDataConversion(struct object ob1,struct object ob2)
! 178: { /* It is called from primitive.c data_conversion. */
! 179: /* This function handles the following situnation.
! 180: (This is not yet documented.)
! 181: ob1 [(class) (class-name)] dc : method=1
! 182: ob1(with class tag) [(class) (class-name)] dc : method=2
! 183: ob1(with class tag) (usual flag) dc : method=3
! 184: It also create a new class object.
! 185: */
! 186: struct object rob = NullObject;
! 187: int method ;
! 188: struct object ff0;
! 189: struct object ff1;
! 190: struct object ob3; /* for work.*/
! 191: struct object ob4;
! 192: char *ccc;
! 193: char *key;
! 194:
! 195: if (ob1.tag == Sclass && ob2.tag == Sarray) {
! 196: method = 2;
! 197: }else if (ob1.tag == Sclass && ob2.tag == Sdollar) {
! 198: method = 3;
! 199: }else if (ob1.tag != Sclass && ob2.tag == Sarray) {
! 200: method = 1;
! 201: }else{
! 202: errorKan1("%s\n","kclass.c : KclassDataConversion() cannot make this data conversion.");
! 203: }
! 204: switch(method) {
! 205: case 1:
! 206: if (getoaSize(ob2) != 2) errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
! 207: ff0 = getoa(ob2,0); ff1 = getoa(ob2,1);
! 208: if (ff0.tag != Sdollar || ff1.tag != Sdollar)
! 209: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
! 210: if (strcmp("class",KopString(ff0)) != 0)
! 211: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)] (class)!!!");
! 212:
! 213: ccc = KopString(ff1); /* target data type */
! 214:
! 215: /* From primitive to Class object */
! 216:
! 217: if (strcmp(ccc,"sampleClass") == 0) {
! 218: rob = KpoSampleClass(&ob1);
! 219: }else if (strcmp(ccc,"errorPacket") == 0) {
! 220: if (ob1.tag != Sarray) errorKan1("%s\n","kclass.c : KclassDataConversion , !array --> errorPacket is not supported.");
! 221: if (getoaSize(ob1) != 3) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
! 222: if (getoa(ob1,0).tag != Sinteger) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
! 223: if (getoa(ob1,1).tag != Sinteger) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
! 224: if (getoa(ob1,2).tag != Sdollar) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
! 225: rob = KnewErrorPacketObj(ob1);
! 226: }else if (strcmp(ccc,"indeterminate") == 0) {
! 227: if (ob1.tag != Sdollar) errorKan1("%s\n","kclass.c : KclassDataConversion , !String --> indeterminate is not supported.");
! 228: rob = KpoIndeterminate(ob1);
! 229: }else if (strcmp(ccc,"mathcap") == 0) {
! 230: /* You should check ob1 contains mathcap data or not.
! 231: I've not yet written them.
! 232: */
! 233: rob = KpoMathCap(&ob1);
! 234: }else if (strcmp(ccc,"tree") == 0) {
! 235: if (ob1.tag != Sarray) errorKan1("%s\n","kclass.c : KclassDataConversion , !array --> indeterminate is not supported.");
! 236: rob = KpoTree(ob1);
! 237: }else if (strcmp(ccc,"recursivePolynomial") == 0) {
! 238: if (ob1.tag != Spoly) errorKan1("%s\n","kclass.c : KclassDataConversion , !poly --> recursivePoly is not supported.");
! 239: rob = polyToRecursivePoly(ob1);
! 240: }else{
! 241: errorKan1("%s\n","KclassDataConversion: this type of data conversion from primitive object to class object is not supported.");
! 242: }
! 243: break;
! 244: case 2:
! 245: if (getoaSize(ob2) != 2) errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
! 246: ff0 = getoa(ob2,0); ff1 = getoa(ob2,1);
! 247: if (ff0.tag != Sdollar || ff1.tag != Sdollar)
! 248: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
! 249: if (strcmp("class",KopString(ff0)) != 0)
! 250: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)] (class)!!!");
! 251:
! 252: ccc = KopString(ff1); /* target data type. */
! 253: switch(ectag(ob1)) {
! 254: case CLASSNAME_sampleClass:
! 255: if (strcmp(ccc,"sampleClass") == 0) {
! 256: rob = KpoSampleClass(&ob1);
! 257: }else{
! 258: errorKan1("%s\n","KclassDataCOnversion: this type of data conversion from class object to class object is not supported.");
! 259: }
! 260: break;
! 261: default:
! 262: errorKan1("%s\n","KclassDataConversion: this type of data conversion from class object to class object is not supported.");
! 263: }
! 264: break;
! 265: case 3:
! 266: key = KopString(ob2); /* target data type */
! 267: if (key[0] == 't' || key[0] =='e') {
! 268: if (strcmp(key,"type?")==0) {
! 269: rob = KpoInteger(ob1.tag);
! 270: return(rob);
! 271: }else if (strcmp(key,"type??")==0) {
! 272: if (ob1.tag != Sclass) {
! 273: rob = KpoInteger(ob1.tag);
! 274: }else {
! 275: rob = KpoInteger(ectag(ob1));
! 276: }
! 277: return(rob);
! 278: }else if (strcmp(key,"error")==0) {
! 279: rob = KnewErrorPacketObj(ob1);
! 280: return(rob);
! 281: }
! 282: }
! 283:
! 284: /* Class object to primtive Object */
! 285: switch(ectag(ob1)) {
! 286: case CLASSNAME_sampleClass:
! 287: if (strcmp(key,"array") == 0) {
! 288: rob = *(KopSampleClass(ob1));
! 289: }else{
! 290: errorKan1("%s\n","KclassDataCOnversion: this type of data conversion from class object to primitive object is not supported.");
! 291: }
! 292: break;
! 293: case CLASSNAME_mathcap:
! 294: if (strcmp(key,"array") == 0) {
! 295: rob = newObjectArray(2);
! 296: ob3 = KpoString("mathcap-object");
! 297: putoa(rob,0,ob3);
! 298: putoa(rob,1,*(KopMathCap(ob1)));
! 299: }else{
! 300: errorKan1("%s\n","KclassDataConversion: this type of data conversion from class object mathcap to primitive object is not supported.");
! 301: }
! 302: break;
! 303: case CLASSNAME_indeterminate:
! 304: if (strcmp(key,"string") == 0) {
! 305: rob = KopIndeterminate(ob1);
! 306: }else {
! 307: errorKan1("%s\n","KclassDataConversion: interminate-->?? is not supported..");
! 308: }
! 309: break;
! 310: case CLASSNAME_tree:
! 311: if (strcmp(key,"array") == 0) {
! 312: rob = KopTree(ob1);
! 313: }else {
! 314: errorKan1("%s\n","KclassDataConversion: tree-->?? is not supported..");
! 315: }
! 316: break;
! 317: case CLASSNAME_recursivePolynomial:
! 318: if (strcmp(key,"string") == 0) {
! 319: errorKan1("%s\n","Translation of recursive polynomial to a string should be implemented.");
! 320: }else if (strcmp(key,"poly") == 0) {
! 321: rob = recursivePolyToPoly(ob1);
! 322: }else if (strcmp(key,"array") == 0) {
! 323: rob = KopRecursivePolynomial(ob1);
! 324: }else {
! 325: errorKan1("%s\n","KclassDataConversion: recursivePoly-->?? is not supported..");
! 326: }
! 327: break;
! 328: default:
! 329: errorKan1("%s\n","KclassDataConversion: this type of data conversion from class object to primitive object is not supported.");
! 330: }
! 331: break;
! 332: }
! 333: return(rob);
! 334: }
! 335:
! 336: /* Arithmetic operations for class objects. */
! 337: struct object Kclass_ooAdd(struct object ob1, struct object ob2)
! 338: {
! 339: /* It is called from ooAdd(). */
! 340: /* ob1 or ob2 must have the class tag. */
! 341: struct object rob = NullObject;
! 342:
! 343: /* Default action */
! 344: rob = addTree(ob2,ob1);
! 345: return(rob);
! 346: }
! 347:
! 348:
! 349:
! 350:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to kclass.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan