=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/list.c,v retrieving revision 1.3 retrieving revision 1.6 diff -u -p -r1.3 -r1.6 --- OpenXM/src/kan96xx/Kan/list.c 2001/05/04 01:06:24 1.3 +++ OpenXM/src/kan96xx/Kan/list.c 2005/06/16 05:07:23 1.6 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/kan96xx/Kan/list.c,v 1.2 2000/01/16 07:55:39 takayama Exp $ */ +/* $OpenXM: OpenXM/src/kan96xx/Kan/list.c,v 1.5 2004/09/11 01:00:42 takayama Exp $ */ /* list.c */ #include #include "datatype.h" @@ -27,6 +27,7 @@ struct object *newList(objp) /* Warning!! Make a copy of the object. It is important. */ *(op->lc.op) = *(objp); op->rc.op = (struct object *)NULL; + op->attr = NULL; return(op); } @@ -48,7 +49,7 @@ struct object listToArray(objp) /* This function copies only the top level of the list */ { int n; - struct object ans; + struct object ans = OINIT; int i; if (objp->tag != Slist) { warningList("use objectListToObjectArray() for object-list."); @@ -136,20 +137,28 @@ struct object *cdr(list) } -void printObjectList(op) - struct object *op; +static void printObjectList0(op,br) + struct object *op; int br; { if (op == NULL) return; if (isNullList(op)) return; if (op->tag == Slist) { - printObjectList(op->lc.op); + if (br) printf("<"); + printObjectList0(op->lc.op,1); printf(", "); - printObjectList(op->rc.op); + printObjectList0(op->rc.op,0); + if (br) printf(">"); }else { printObject(*op,0,stdout); } } +void printObjectList(op) + struct object *op; +{ + printObjectList0(op,1); +} + memberQ(list1,obj2) struct object *list1; struct object obj2; @@ -180,6 +189,65 @@ static warningList(str) fprintf(stderr,"Warning. list.c: %s\n",str); } +struct object KvJoin(struct object listo1,struct object listo2) { + struct object rob = OINIT; + struct object *op1,*op2; + if (listo1.tag == Snull) return listo2; + if (listo2.tag == Snull) return listo1; + if ((listo1.tag == Slist) && (listo2.tag == Slist)) { + op1 = (struct object *)sGC_malloc(sizeof(struct object)); + op2 = (struct object *)sGC_malloc(sizeof(struct object)); + if ((op1 == NULL) || (op2 == NULL)) errorKan1("%s\n","KvJoin, No more memory."); + *op1 = listo1; *op2 = listo2; + rob = *(vJoin(op1,op2)); + return rob; + }else{ + errorKan1("%s\n","KvJoin(Slist,Slist)"); + } +} +struct object Kcar(struct object listo) { + if (listo.tag == Snull) return listo; + if (listo.tag == Slist) { + return car(&listo); + }else{ + errorKan1("%s\n","Kcar(Slist)"); + } +} +struct object Kcdr(struct object listo) { + struct object *op; + struct object rob = OINIT; + if (listo.tag == Snull) return listo; + if (listo.tag == Slist) { + op = cdr(&listo); + if (isNullList(op)) { + rob = NullObject; + }else{ + rob = *op; + } + return rob; + }else{ + errorKan1("%s\n","Kcar(Slist)"); + } +} +struct object KlistToArray(struct object listo) { + if (listo.tag == Snull) { + return newObjectArray(0); + } + if (listo.tag == Slist) { + return listToArray(&listo); + }else{ + errorKan1("%s\n","KlistToArray(Slist)"); + } +} +struct object KarrayToList(struct object ob) { + struct object *op; + if (ob.tag != Sarray) { + errorKan1("%s\n","KarrayToList(Sarray)"); + } + op = arrayToList(ob); + if (isNullList(op)) return NullObject; + return *op; +} /********************** test codes for Stest: ********************/ /* test of objectArrayToObjectList. in Stest: stackmachine.c