=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/list.c,v retrieving revision 1.1.1.1 retrieving revision 1.6 diff -u -p -r1.1.1.1 -r1.6 --- OpenXM/src/kan96xx/Kan/list.c 1999/10/08 02:12:01 1.1.1.1 +++ OpenXM/src/kan96xx/Kan/list.c 2005/06/16 05:07:23 1.6 @@ -1,3 +1,4 @@ +/* $OpenXM: OpenXM/src/kan96xx/Kan/list.c,v 1.5 2004/09/11 01:00:42 takayama Exp $ */ /* list.c */ #include #include "datatype.h" @@ -15,7 +16,7 @@ static warningList(char *s); */ struct object *newList(objp) -struct object *objp; + struct object *objp; { struct object *op; op = (struct object *)sGC_malloc(sizeof(struct object)); @@ -26,11 +27,12 @@ struct object *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); } int klength(objp) -struct object *objp; + struct object *objp; { if (objp->tag != Slist) { warningList("use klength() for object-list."); @@ -43,11 +45,11 @@ struct object *objp; } struct object listToArray(objp) -struct object *objp; -/* This function copies only the top level of the list */ + struct object *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."); @@ -65,8 +67,8 @@ struct object *objp; } struct object *arrayToList(obj) -struct object obj; -/* obj.tag must be Sarray */ + struct object obj; + /* obj.tag must be Sarray */ { struct object *op; struct object *list; @@ -84,16 +86,16 @@ struct object obj; } struct object *vJoin(list1,list2) -struct object *list1,*list2; -/* Join[(a b), (c d)] ---> (a b c d) */ -/* Join [(),(a b)] ---> (a b) */ -/* We do not copy. NullList is express by (struct object *)NULL. - cf. isNullList() -*/ + struct object *list1,*list2; + /* Join[(a b), (c d)] ---> (a b c d) */ + /* Join [(),(a b)] ---> (a b) */ + /* We do not copy. NullList is express by (struct object *)NULL. + cf. isNullList() + */ { /* - printf("list1="); printObjectList(list1); - printf("\nlist2="); printObjectList(list2); printf("\n"); + printf("list1="); printObjectList(list1); + printf("\nlist2="); printObjectList(list2); printf("\n"); */ if (isNullList(list1)) return(list2); @@ -112,7 +114,7 @@ struct object *list1,*list2; } struct object car(list) -struct object *list; + struct object *list; { if (list->tag != Slist) { warningList("car() is called for a non-list object."); @@ -124,7 +126,7 @@ struct object *list; } struct object *cdr(list) -struct object *list; + struct object *list; { if (list->tag != Slist) { warningList("cdr() is called for a non-list object."); @@ -135,24 +137,32 @@ struct object *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; -/* If obj2 is an member of list1, the functions the position. + struct object *list1; + struct object obj2; + /* If obj2 is an member of list1, the functions the position. memberQ( (1 (2 3) 4), 4) ----> 3. */ { @@ -167,32 +177,91 @@ struct object obj2; } static errorList(str) -char *str; + char *str; { fprintf(stderr,"list.c: %s\n",str); exit(10); } static warningList(str) -char *str; + char *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 - { - struct object *list; - list = arrayToList(ob1); - ob1 = listToArray(list); - push(ob1); - } - test for memberQ(). - { - struct object *list; - list = objectArrayToObjectList(pop()); - printf("\nmemberQ()=%d\n",memberQ(list,ob1)); - } + { + struct object *list; + list = arrayToList(ob1); + ob1 = listToArray(list); + push(ob1); + } + test for memberQ(). + { + struct object *list; + list = objectArrayToObjectList(pop()); + printf("\nmemberQ()=%d\n",memberQ(list,ob1)); + } */