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