Annotation of OpenXM/src/kan96xx/Kan/kclass.c, Revision 1.6
1.6 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/kclass.c,v 1.5 2005/06/16 05:07:23 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>
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;
1.4 takayama 33: /* We have to creat new dictionary in a future. */
1.1 maekawa 34:
35: ClassTypes[CLASSNAME_ERROR_PACKET] = CLASS_OBJ;
36: ClassNames[CLASSNAME_ERROR_PACKET] = "Class.ErrorPacket";
37: ClassDictionaries[CLASSNAME_ERROR_PACKET] = (struct object *)NULL;
1.4 takayama 38: /* We have to creat new dictionary in a future. */
1.1 maekawa 39:
40: ClassTypes[CLASSNAME_CONTEXT] = CLASS_INTERNAL;
41: ClassNames[CLASSNAME_CONTEXT] = "Class.Context";
42: ClassDictionaries[CLASSNAME_CONTEXT] = (struct object *)NULL;
1.4 takayama 43: /* We have to creat new dictionary in a future. */
1.1 maekawa 44:
45: ClassTypes[CLASSNAME_GradedPolySet] = CLASS_INTERNAL;
46: ClassNames[CLASSNAME_GradedPolySet] = "Class.GradedPolySet";
47: ClassDictionaries[CLASSNAME_GradedPolySet] = (struct object *)NULL;
1.4 takayama 48: /* We have to creat new dictionary in a future. */
1.1 maekawa 49:
50: ClassTypes[CLASSNAME_mathcap] = CLASS_OBJ;
51: ClassNames[CLASSNAME_mathcap] = "Class.mathcap";
52: ClassDictionaries[CLASSNAME_mathcap] = (struct object *)NULL;
1.4 takayama 53: /* We have to creat new dictionary in a future. */
1.1 maekawa 54:
55: ClassTypes[CLASSNAME_CMO] = CLASS_OBJ;
56: ClassNames[CLASSNAME_CMO] = "Class.CMO";
57: ClassDictionaries[CLASSNAME_CMO] = (struct object *)NULL;
1.4 takayama 58: /* We have to creat new dictionary in a future. */
1.1 maekawa 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;
1.4 takayama 79: /* We have to creat new dictionary in a future. */
1.1 maekawa 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;
1.3 takayama 143: case CLASSNAME_indeterminate:
1.4 takayama 144: return(KooEqualQ(KopIndeterminate(ob1),KopIndeterminate(ob2)));
145: break;
1.1 maekawa 146: default:
147: errorKan1("%s\n","kclass.c (KclassEqualQ cannot compare these objects.)");
148: break;
149: }
150: }
151:
152: void fprintErrorPacket(FILE *fp,struct object *op)
153: {
154: printObject(*op,0,fp);
155: }
156:
157: void fprintMathCap(FILE *fp,struct object *op)
158: {
159: printObject(*op,0,fp);
160: }
161:
162: struct object KpoMathCap(struct object *obp) {
1.5 takayama 163: struct object rob = OINIT;
1.1 maekawa 164: struct object *newobp;
165:
166: newobp = (struct object *) sGC_malloc(sizeof(struct object));
167: /* Yes! You can call KpoMathCap(&localVar) */
168: if (newobp == NULL) errorKan1("%s\n","kclass.c, no more memory.");
169: *newobp = *obp;
170:
171: rob.tag = Sclass;
172: rob.lc.ival = CLASSNAME_mathcap;
173: rob.rc.voidp = newobp;
174: return(rob);
175: }
176:
177: /* try
178: [ 1 2 3] [(class) (sampleClass)] dc ::
179: */
180: struct object KclassDataConversion(struct object ob1,struct object ob2)
181: { /* It is called from primitive.c data_conversion. */
182: /* This function handles the following situnation.
183: (This is not yet documented.)
184: ob1 [(class) (class-name)] dc : method=1
185: ob1(with class tag) [(class) (class-name)] dc : method=2
186: ob1(with class tag) (usual flag) dc : method=3
187: It also create a new class object.
1.6 ! takayama 188: ob1 (error) dc --> ErrorObject with the contents ob1
! 189:
! 190: ob1(with class tag) (body) dc --> [left tag, right body of ob1.]
1.1 maekawa 191: */
192: struct object rob = NullObject;
193: int method ;
1.5 takayama 194: struct object ff0 = OINIT;
195: struct object ff1 = OINIT;
196: struct object ob3 = OINIT; /* for work.*/
197: struct object ob4 = OINIT;
1.1 maekawa 198: char *ccc;
199: char *key;
200:
201: if (ob1.tag == Sclass && ob2.tag == Sarray) {
202: method = 2;
203: }else if (ob1.tag == Sclass && ob2.tag == Sdollar) {
204: method = 3;
205: }else if (ob1.tag != Sclass && ob2.tag == Sarray) {
206: method = 1;
207: }else{
208: errorKan1("%s\n","kclass.c : KclassDataConversion() cannot make this data conversion.");
209: }
210: switch(method) {
211: case 1:
212: if (getoaSize(ob2) != 2) errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
213: ff0 = getoa(ob2,0); ff1 = getoa(ob2,1);
214: if (ff0.tag != Sdollar || ff1.tag != Sdollar)
215: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
216: if (strcmp("class",KopString(ff0)) != 0)
217: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)] (class)!!!");
218:
219: ccc = KopString(ff1); /* target data type */
220:
221: /* From primitive to Class object */
222:
223: if (strcmp(ccc,"sampleClass") == 0) {
224: rob = KpoSampleClass(&ob1);
225: }else if (strcmp(ccc,"errorPacket") == 0) {
226: if (ob1.tag != Sarray) errorKan1("%s\n","kclass.c : KclassDataConversion , !array --> errorPacket is not supported.");
227: if (getoaSize(ob1) != 3) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
228: if (getoa(ob1,0).tag != Sinteger) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
229: if (getoa(ob1,1).tag != Sinteger) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
230: if (getoa(ob1,2).tag != Sdollar) errorKan1("%s\n","kclass.c : KclassDataConversion , only [integer, integer, string] --> errorPacket is supported.");
231: rob = KnewErrorPacketObj(ob1);
232: }else if (strcmp(ccc,"indeterminate") == 0) {
233: if (ob1.tag != Sdollar) errorKan1("%s\n","kclass.c : KclassDataConversion , !String --> indeterminate is not supported.");
234: rob = KpoIndeterminate(ob1);
235: }else if (strcmp(ccc,"mathcap") == 0) {
236: /* You should check ob1 contains mathcap data or not.
1.4 takayama 237: I've not yet written them.
1.1 maekawa 238: */
239: rob = KpoMathCap(&ob1);
240: }else if (strcmp(ccc,"tree") == 0) {
1.3 takayama 241: if (ob1.tag != Sarray) errorKan1("%s\n","kclass.c : KclassDataConversion , !array --> tree is not supported.");
1.1 maekawa 242: rob = KpoTree(ob1);
243: }else if (strcmp(ccc,"recursivePolynomial") == 0) {
244: if (ob1.tag != Spoly) errorKan1("%s\n","kclass.c : KclassDataConversion , !poly --> recursivePoly is not supported.");
245: rob = polyToRecursivePoly(ob1);
246: }else{
247: errorKan1("%s\n","KclassDataConversion: this type of data conversion from primitive object to class object is not supported.");
248: }
249: break;
250: case 2:
251: if (getoaSize(ob2) != 2) errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
252: ff0 = getoa(ob2,0); ff1 = getoa(ob2,1);
253: if (ff0.tag != Sdollar || ff1.tag != Sdollar)
254: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)]");
255: if (strcmp("class",KopString(ff0)) != 0)
256: errorKan1("%s\n","kclass.c : KclassDataConversion() the second argument should be [(class) (class-name)] (class)!!!");
257:
258: ccc = KopString(ff1); /* target data type. */
259: switch(ectag(ob1)) {
260: case CLASSNAME_sampleClass:
261: if (strcmp(ccc,"sampleClass") == 0) {
1.4 takayama 262: rob = KpoSampleClass(&ob1);
1.1 maekawa 263: }else{
1.4 takayama 264: errorKan1("%s\n","KclassDataCOnversion: this type of data conversion from class object to class object is not supported.");
1.1 maekawa 265: }
266: break;
267: default:
1.4 takayama 268: errorKan1("%s\n","KclassDataConversion: this type of data conversion from class object to class object is not supported.");
1.1 maekawa 269: }
270: break;
271: case 3:
272: key = KopString(ob2); /* target data type */
273: if (key[0] == 't' || key[0] =='e') {
274: if (strcmp(key,"type?")==0) {
1.4 takayama 275: rob = KpoInteger(ob1.tag);
276: return(rob);
1.1 maekawa 277: }else if (strcmp(key,"type??")==0) {
1.4 takayama 278: if (ob1.tag != Sclass) {
279: rob = KpoInteger(ob1.tag);
280: }else {
281: rob = KpoInteger(ectag(ob1));
282: }
283: return(rob);
1.1 maekawa 284: }else if (strcmp(key,"error")==0) {
1.4 takayama 285: rob = KnewErrorPacketObj(ob1);
286: return(rob);
1.6 ! takayama 287: }
! 288: }else if (key[0] == 'b') {
! 289: if (strcmp(key,"body") == 0) {
! 290: rob = newObjectArray(2);
! 291: putoa(rob,0,KpoInteger(ectag(ob1)));
! 292: putoa(rob,1,*((struct object *)(ecbody(ob1))));
! 293: return rob;
1.1 maekawa 294: }
295: }
296:
297: /* Class object to primtive Object */
298: switch(ectag(ob1)) {
299: case CLASSNAME_sampleClass:
300: if (strcmp(key,"array") == 0) {
1.4 takayama 301: rob = *(KopSampleClass(ob1));
1.1 maekawa 302: }else{
1.4 takayama 303: errorKan1("%s\n","KclassDataCOnversion: this type of data conversion from class object to primitive object is not supported.");
1.1 maekawa 304: }
305: break;
306: case CLASSNAME_mathcap:
307: if (strcmp(key,"array") == 0) {
1.4 takayama 308: rob = newObjectArray(2);
309: ob3 = KpoString("mathcap-object");
310: putoa(rob,0,ob3);
311: putoa(rob,1,*(KopMathCap(ob1)));
1.1 maekawa 312: }else{
1.4 takayama 313: errorKan1("%s\n","KclassDataConversion: this type of data conversion from class object mathcap to primitive object is not supported.");
1.1 maekawa 314: }
315: break;
316: case CLASSNAME_indeterminate:
317: if (strcmp(key,"string") == 0) {
1.4 takayama 318: rob = KopIndeterminate(ob1);
1.1 maekawa 319: }else {
1.4 takayama 320: errorKan1("%s\n","KclassDataConversion: interminate-->?? is not supported..");
1.1 maekawa 321: }
322: break;
323: case CLASSNAME_tree:
324: if (strcmp(key,"array") == 0) {
1.4 takayama 325: rob = KopTree(ob1);
1.1 maekawa 326: }else {
1.4 takayama 327: errorKan1("%s\n","KclassDataConversion: tree-->?? is not supported..");
1.1 maekawa 328: }
329: break;
330: case CLASSNAME_recursivePolynomial:
331: if (strcmp(key,"string") == 0) {
1.4 takayama 332: errorKan1("%s\n","Translation of recursive polynomial to a string should be implemented.");
1.1 maekawa 333: }else if (strcmp(key,"poly") == 0) {
1.4 takayama 334: rob = recursivePolyToPoly(ob1);
1.1 maekawa 335: }else if (strcmp(key,"array") == 0) {
1.4 takayama 336: rob = KopRecursivePolynomial(ob1);
1.1 maekawa 337: }else {
1.4 takayama 338: errorKan1("%s\n","KclassDataConversion: recursivePoly-->?? is not supported..");
1.1 maekawa 339: }
340: break;
341: default:
1.4 takayama 342: errorKan1("%s\n","KclassDataConversion: this type of data conversion from class object to primitive object is not supported.");
1.1 maekawa 343: }
344: break;
345: }
346: return(rob);
347: }
348:
349: /* Arithmetic operations for class objects. */
350: struct object Kclass_ooAdd(struct object ob1, struct object ob2)
351: {
352: /* It is called from ooAdd(). */
353: /* ob1 or ob2 must have the class tag. */
354: struct object rob = NullObject;
355:
356: /* Default action */
357: rob = addTree(ob2,ob1);
358: return(rob);
359: }
360:
361:
362:
363:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>