Annotation of OpenXM/src/kan96xx/Kan/kclass.c, Revision 1.1.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>