Annotation of OpenXM/src/kan96xx/Kan/list.c, Revision 1.1
1.1 ! maekawa 1: /* list.c */
! 2: #include <stdio.h>
! 3: #include "datatype.h"
! 4: #include "stackm.h"
! 5: #include "extern.h"
! 6:
! 7: static errorList(char *s);
! 8: static warningList(char *s);
! 9:
! 10: /* The basic data structure for list is
! 11: struct object *,
! 12: which is used as arguments and return values.
! 13: NullList should be expressed by (struct object *)NULL = NULLLIST ;
! 14: The null test is isNullList(struct object *).
! 15: */
! 16:
! 17: struct object *newList(objp)
! 18: struct object *objp;
! 19: {
! 20: struct object *op;
! 21: op = (struct object *)sGC_malloc(sizeof(struct object));
! 22: if (op == (struct object *)NULL) errorList("no more memory.");
! 23: op->tag = Slist;
! 24: op->lc.op = (struct object *)sGC_malloc(sizeof(struct object));
! 25: if (op->lc.op == (struct object *)NULL) errorList("no more memory.");
! 26: /* Warning!! Make a copy of the object. It is important. */
! 27: *(op->lc.op) = *(objp);
! 28: op->rc.op = (struct object *)NULL;
! 29: return(op);
! 30: }
! 31:
! 32: int klength(objp)
! 33: struct object *objp;
! 34: {
! 35: if (objp->tag != Slist) {
! 36: warningList("use klength() for object-list.");
! 37: return(-1);
! 38: }
! 39: if (isNullList(objp->rc.op)) return(1);
! 40: else {
! 41: return(klength(objp->rc.op) + 1);
! 42: }
! 43: }
! 44:
! 45: struct object listToArray(objp)
! 46: struct object *objp;
! 47: /* This function copies only the top level of the list */
! 48: {
! 49: int n;
! 50: struct object ans;
! 51: int i;
! 52: if (objp->tag != Slist) {
! 53: warningList("use objectListToObjectArray() for object-list.");
! 54: return(NullObject);
! 55: }
! 56:
! 57: n = klength(objp);
! 58:
! 59: ans = newObjectArray(n);
! 60: for (i=0; i<n; i++) {
! 61: putoa(ans,i,*(objp->lc.op)); /* Warning!! we do not make a copy. */
! 62: objp = objp->rc.op;
! 63: }
! 64: return(ans);
! 65: }
! 66:
! 67: struct object *arrayToList(obj)
! 68: struct object obj;
! 69: /* obj.tag must be Sarray */
! 70: {
! 71: struct object *op;
! 72: struct object *list;
! 73: struct object elem;
! 74: int i,n;
! 75: op = NULLLIST;
! 76: n = getoaSize(obj);
! 77: for (i=0; i<n; i++) {
! 78: /*printf("\n%d: ",i); printObjectList(op);*/
! 79: elem = getoa(obj,i);
! 80: list = newList(&elem);
! 81: op = vJoin(op,list);
! 82: }
! 83: return(op);
! 84: }
! 85:
! 86: struct object *vJoin(list1,list2)
! 87: struct object *list1,*list2;
! 88: /* Join[(a b), (c d)] ---> (a b c d) */
! 89: /* Join [(),(a b)] ---> (a b) */
! 90: /* We do not copy. NullList is express by (struct object *)NULL.
! 91: cf. isNullList()
! 92: */
! 93: {
! 94: /*
! 95: printf("list1="); printObjectList(list1);
! 96: printf("\nlist2="); printObjectList(list2); printf("\n");
! 97: */
! 98:
! 99: if (isNullList(list1)) return(list2);
! 100: if (isNullList(list2)) return(list1);
! 101: if (list1->tag != Slist || list2->tag != Slist) {
! 102: warningList("use vJoin() for object-list.");
! 103: return((struct object *)NULL);
! 104: }
! 105: if (list1->rc.op == (struct object *)NULL) {
! 106: list1->rc.op = list2;
! 107: return(list1);
! 108: }else{
! 109: vJoin(list1->rc.op,list2);
! 110: return(list1);
! 111: }
! 112: }
! 113:
! 114: struct object car(list)
! 115: struct object *list;
! 116: {
! 117: if (list->tag != Slist) {
! 118: warningList("car() is called for a non-list object.");
! 119: return(NullObject);
! 120: }
! 121: if (isNullList(list)) return(NullObject);
! 122: /* We do not copy the object */
! 123: return(*(list->lc.op));
! 124: }
! 125:
! 126: struct object *cdr(list)
! 127: struct object *list;
! 128: {
! 129: if (list->tag != Slist) {
! 130: warningList("cdr() is called for a non-list object.");
! 131: return((struct object *)NULL);
! 132: }
! 133: /* We do not copy the object */
! 134: return( list->rc.op );
! 135: }
! 136:
! 137:
! 138: void printObjectList(op)
! 139: struct object *op;
! 140: {
! 141: if (op == NULL) return;
! 142: if (isNullList(op)) return;
! 143: if (op->tag == Slist) {
! 144: printObjectList(op->lc.op);
! 145: printf(", ");
! 146: printObjectList(op->rc.op);
! 147: }else {
! 148: printObject(*op,0,stdout);
! 149: }
! 150: }
! 151:
! 152: memberQ(list1,obj2)
! 153: struct object *list1;
! 154: struct object obj2;
! 155: /* If obj2 is an member of list1, the functions the position.
! 156: memberQ( (1 (2 3) 4), 4) ----> 3.
! 157: */
! 158: {
! 159: int n,pos;
! 160: if (isNullList(list1)) return(0);
! 161: n = klength(list1);
! 162: for (pos=1; pos<=n; pos++) {
! 163: if (KooEqualQ(car(list1),obj2)) return(pos);
! 164: else list1 = cdr(list1);
! 165: }
! 166: return(0);
! 167: }
! 168:
! 169: static errorList(str)
! 170: char *str;
! 171: {
! 172: fprintf(stderr,"list.c: %s\n",str);
! 173: exit(10);
! 174: }
! 175:
! 176: static warningList(str)
! 177: char *str;
! 178: {
! 179: fprintf(stderr,"Warning. list.c: %s\n",str);
! 180: }
! 181:
! 182:
! 183: /********************** test codes for Stest: ********************/
! 184: /* test of objectArrayToObjectList. in Stest: stackmachine.c
! 185: {
! 186: struct object *list;
! 187: list = arrayToList(ob1);
! 188: ob1 = listToArray(list);
! 189: push(ob1);
! 190: }
! 191: test for memberQ().
! 192: {
! 193: struct object *list;
! 194: list = objectArrayToObjectList(pop());
! 195: printf("\nmemberQ()=%d\n",memberQ(list,ob1));
! 196: }
! 197:
! 198: */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to list.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan