Annotation of OpenXM/src/kan96xx/Kan/Kclass/tree.c, Revision 1.1
1.1 ! takayama 1: /* $OpenXM$ */
! 2: #include <stdio.h>
! 3: #include "../datatype.h"
! 4: #include "../stackm.h"
! 5: #include "../extern.h"
! 6: #include "../gradedset.h"
! 7: #include "../extern2.h"
! 8: #include "../kclass.h"
! 9:
! 10:
! 11:
! 12: /* Data conversion function : see KclassDataConversion*/
! 13: struct object KpoTree(struct object ob) {
! 14: struct object rob;
! 15: struct object ob1,ob2,ob3;
! 16: struct object *newobp;
! 17: rob.tag = Sclass;
! 18: rob.lc.ival = CLASSNAME_tree;
! 19: newobp = (struct object *) sGC_malloc(sizeof(struct object));
! 20: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
! 21: if (ob.tag != Sarray) {
! 22: errorKan1("%s\n","Kclass/indeterminate.c, only properly formatted list object can be transformed into tree. [name, cdname, arglist].");
! 23: }
! 24: if (getoaSize(ob) < 3) {
! 25: errorKan1("%s\n","Kclass/indeterminate.c, the length must 3 or more than 3. [name, cdname, arglist].");
! 26: }
! 27: ob1 = getoa(ob,0); ob2 = getoa(ob,1); ob3 = getoa(ob,2);
! 28: if (ob1.tag != Sdollar || ob2.tag != Sarray || ob3.tag != Sarray) {
! 29: errorKan1("%s\n","Kclass/indeterminate.c, [string name, list attributes, list arglist].");
! 30: }
! 31: *newobp = ob;
! 32: rob.rc.voidp = newobp;
! 33: return(rob);
! 34: }
! 35:
! 36:
! 37: /* Printing function : see fprintClass */
! 38: void fprintTree(FILE *fp,struct object op)
! 39: {
! 40: printObject(KopTree(op),0,fp);
! 41: }
! 42:
! 43: int isTreeAdd(struct object ob) {
! 44: struct object name;
! 45: if (ob.tag != Sclass) {
! 46: return(0);
! 47: }
! 48: if (ectag(ob) != CLASSNAME_tree) {
! 49: return(0);
! 50: }
! 51: ob = KopTree(ob);
! 52: if (ob.tag != Sarray) {
! 53: errorKan1("%s\n","CLASSNAME_tree is broken. Should be array.");
! 54: }
! 55: name = getoa(ob,0);
! 56: if (name.tag != Sdollar) {
! 57: errorKan1("%s\n","CLASSNAME_tree is broken. Should be string.");
! 58: }
! 59: if (strcmp(KopString(name),"add") == 0) {
! 60: return(1);
! 61: }else{
! 62: return(0);
! 63: }
! 64: }
! 65:
! 66: struct object addTree(struct object ob1, struct object ob2)
! 67: {
! 68: struct object rob,aob;
! 69: struct object ob3,ob4;
! 70: int i;
! 71: if (isTreeAdd(ob1) && !isTreeAdd(ob2)) {
! 72: ob1 = KopTree(ob1);
! 73: ob3 = getoa(ob1,2);
! 74: aob = newObjectArray(getoaSize(ob3)+1);
! 75: for (i=0; i<getoaSize(ob3); i++) {
! 76: putoa(aob,i,getoa(ob3,i));
! 77: }
! 78: putoa(aob,getoaSize(ob3),ob2);
! 79: }else if (!isTreeAdd(ob1) && isTreeAdd(ob2)) {
! 80: ob2 = KopTree(ob2);
! 81: ob3 = getoa(ob2,2);
! 82: aob = newObjectArray(getoaSize(ob3)+1);
! 83: putoa(aob,0,ob1);
! 84: for (i=0; i<getoaSize(ob3); i++) {
! 85: putoa(aob,1+i,getoa(ob3,i));
! 86: }
! 87: }else if (isTreeAdd(ob1) && isTreeAdd(ob2)) {
! 88: ob1 = KopTree(ob1);
! 89: ob2 = KopTree(ob2);
! 90: ob3 = getoa(ob1,2);
! 91: ob4 = getoa(ob2,2);
! 92: aob = newObjectArray(getoaSize(ob3)+getoaSize(ob4));
! 93: for (i=0; i<getoaSize(ob3); i++) {
! 94: putoa(aob,i,getoa(ob3,i));
! 95: }
! 96: for (i=0; i<getoaSize(ob4); i++) {
! 97: putoa(aob,getoaSize(ob3)+i,getoa(ob4,i));
! 98: }
! 99: }else{
! 100: aob = newObjectArray(2);
! 101: putoa(aob,0,ob1);
! 102: putoa(aob,1,ob2);
! 103: }
! 104: rob = newObjectArray(3);
! 105: putoa(rob,0,KpoString("add"));
! 106: putoa(rob,1,KpoString("basic"));
! 107: putoa(rob,2,aob);
! 108: return(KpoTree(rob));
! 109: }
! 110:
! 111:
! 112: /*------------------------------------------*/
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>