Annotation of OpenXM/src/kan96xx/Kan/list.c, Revision 1.4
1.4 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/list.c,v 1.3 2001/05/04 01:06:24 takayama Exp $ */
1.1 maekawa 2: /* list.c */
3: #include <stdio.h>
4: #include "datatype.h"
5: #include "stackm.h"
6: #include "extern.h"
7:
8: static errorList(char *s);
9: static warningList(char *s);
10:
11: /* The basic data structure for list is
12: struct object *,
13: which is used as arguments and return values.
14: NullList should be expressed by (struct object *)NULL = NULLLIST ;
15: The null test is isNullList(struct object *).
16: */
17:
18: struct object *newList(objp)
1.3 takayama 19: struct object *objp;
1.1 maekawa 20: {
21: struct object *op;
22: op = (struct object *)sGC_malloc(sizeof(struct object));
23: if (op == (struct object *)NULL) errorList("no more memory.");
24: op->tag = Slist;
25: op->lc.op = (struct object *)sGC_malloc(sizeof(struct object));
26: if (op->lc.op == (struct object *)NULL) errorList("no more memory.");
27: /* Warning!! Make a copy of the object. It is important. */
28: *(op->lc.op) = *(objp);
29: op->rc.op = (struct object *)NULL;
30: return(op);
31: }
32:
33: int klength(objp)
1.3 takayama 34: struct object *objp;
1.1 maekawa 35: {
36: if (objp->tag != Slist) {
37: warningList("use klength() for object-list.");
38: return(-1);
39: }
40: if (isNullList(objp->rc.op)) return(1);
41: else {
42: return(klength(objp->rc.op) + 1);
43: }
44: }
45:
46: struct object listToArray(objp)
1.3 takayama 47: struct object *objp;
48: /* This function copies only the top level of the list */
1.1 maekawa 49: {
50: int n;
51: struct object ans;
52: int i;
53: if (objp->tag != Slist) {
54: warningList("use objectListToObjectArray() for object-list.");
55: return(NullObject);
56: }
57:
58: n = klength(objp);
59:
60: ans = newObjectArray(n);
61: for (i=0; i<n; i++) {
62: putoa(ans,i,*(objp->lc.op)); /* Warning!! we do not make a copy. */
63: objp = objp->rc.op;
64: }
65: return(ans);
66: }
67:
68: struct object *arrayToList(obj)
1.3 takayama 69: struct object obj;
70: /* obj.tag must be Sarray */
1.1 maekawa 71: {
72: struct object *op;
73: struct object *list;
74: struct object elem;
75: int i,n;
76: op = NULLLIST;
77: n = getoaSize(obj);
78: for (i=0; i<n; i++) {
79: /*printf("\n%d: ",i); printObjectList(op);*/
80: elem = getoa(obj,i);
81: list = newList(&elem);
82: op = vJoin(op,list);
83: }
84: return(op);
85: }
86:
87: struct object *vJoin(list1,list2)
1.3 takayama 88: struct object *list1,*list2;
89: /* Join[(a b), (c d)] ---> (a b c d) */
90: /* Join [(),(a b)] ---> (a b) */
91: /* We do not copy. NullList is express by (struct object *)NULL.
92: cf. isNullList()
93: */
1.1 maekawa 94: {
95: /*
1.3 takayama 96: printf("list1="); printObjectList(list1);
97: printf("\nlist2="); printObjectList(list2); printf("\n");
1.1 maekawa 98: */
99:
100: if (isNullList(list1)) return(list2);
101: if (isNullList(list2)) return(list1);
102: if (list1->tag != Slist || list2->tag != Slist) {
103: warningList("use vJoin() for object-list.");
104: return((struct object *)NULL);
105: }
106: if (list1->rc.op == (struct object *)NULL) {
107: list1->rc.op = list2;
108: return(list1);
109: }else{
110: vJoin(list1->rc.op,list2);
111: return(list1);
112: }
113: }
114:
115: struct object car(list)
1.3 takayama 116: struct object *list;
1.1 maekawa 117: {
118: if (list->tag != Slist) {
119: warningList("car() is called for a non-list object.");
120: return(NullObject);
121: }
122: if (isNullList(list)) return(NullObject);
123: /* We do not copy the object */
124: return(*(list->lc.op));
125: }
126:
127: struct object *cdr(list)
1.3 takayama 128: struct object *list;
1.1 maekawa 129: {
130: if (list->tag != Slist) {
131: warningList("cdr() is called for a non-list object.");
132: return((struct object *)NULL);
133: }
134: /* We do not copy the object */
135: return( list->rc.op );
136: }
137:
138:
139: void printObjectList(op)
1.3 takayama 140: struct object *op;
1.1 maekawa 141: {
142: if (op == NULL) return;
143: if (isNullList(op)) return;
144: if (op->tag == Slist) {
145: printObjectList(op->lc.op);
146: printf(", ");
147: printObjectList(op->rc.op);
148: }else {
149: printObject(*op,0,stdout);
150: }
151: }
152:
153: memberQ(list1,obj2)
1.3 takayama 154: struct object *list1;
155: struct object obj2;
156: /* If obj2 is an member of list1, the functions the position.
1.1 maekawa 157: memberQ( (1 (2 3) 4), 4) ----> 3.
158: */
159: {
160: int n,pos;
161: if (isNullList(list1)) return(0);
162: n = klength(list1);
163: for (pos=1; pos<=n; pos++) {
164: if (KooEqualQ(car(list1),obj2)) return(pos);
165: else list1 = cdr(list1);
166: }
167: return(0);
168: }
169:
170: static errorList(str)
1.3 takayama 171: char *str;
1.1 maekawa 172: {
173: fprintf(stderr,"list.c: %s\n",str);
174: exit(10);
175: }
176:
177: static warningList(str)
1.3 takayama 178: char *str;
1.1 maekawa 179: {
180: fprintf(stderr,"Warning. list.c: %s\n",str);
181: }
182:
1.4 ! takayama 183: struct object KvJoin(struct object listo1,struct object listo2) {
! 184: struct object rob;
! 185: struct object *op1,*op2;
! 186: if (listo1.tag == Snull) return listo2;
! 187: if (listo2.tag == Snull) return listo1;
! 188: if ((listo1.tag == Slist) && (listo2.tag == Slist)) {
! 189: op1 = (struct object *)sGC_malloc(sizeof(struct object));
! 190: op2 = (struct object *)sGC_malloc(sizeof(struct object));
! 191: if ((op1 == NULL) || (op2 == NULL)) errorKan1("%s\n","KvJoin, No more memory.");
! 192: *op1 = listo1; *op2 = listo2;
! 193: rob = *(vJoin(op1,op2));
! 194: return rob;
! 195: }else{
! 196: errorKan1("%s\n","KvJoin(Slist,Slist)");
! 197: }
! 198: }
! 199: struct object Kcar(struct object listo) {
! 200: if (listo.tag == Snull) return listo;
! 201: if (listo.tag == Slist) {
! 202: return car(&listo);
! 203: }else{
! 204: errorKan1("%s\n","Kcar(Slist)");
! 205: }
! 206: }
! 207: struct object Kcdr(struct object listo) {
! 208: struct object *op;
! 209: struct object rob;
! 210: if (listo.tag == Snull) return listo;
! 211: if (listo.tag == Slist) {
! 212: op = cdr(&listo);
! 213: if (isNullList(op)) {
! 214: rob = NullObject;
! 215: }else{
! 216: rob = *op;
! 217: }
! 218: return rob;
! 219: }else{
! 220: errorKan1("%s\n","Kcar(Slist)");
! 221: }
! 222: }
! 223: struct object KlistToArray(struct object listo) {
! 224: if (listo.tag == Snull) {
! 225: return newObjectArray(0);
! 226: }
! 227: if (listo.tag == Slist) {
! 228: return listToArray(&listo);
! 229: }else{
! 230: errorKan1("%s\n","KlistToArray(Slist)");
! 231: }
! 232: }
! 233: struct object KarrayToList(struct object ob) {
! 234: struct object *op;
! 235: if (ob.tag != Sarray) {
! 236: errorKan1("%s\n","KarrayToList(Sarray)");
! 237: }
! 238: op = arrayToList(ob);
! 239: if (isNullList(op)) return NullObject;
! 240: return *op;
! 241: }
1.1 maekawa 242:
243: /********************** test codes for Stest: ********************/
244: /* test of objectArrayToObjectList. in Stest: stackmachine.c
1.3 takayama 245: {
246: struct object *list;
247: list = arrayToList(ob1);
248: ob1 = listToArray(list);
249: push(ob1);
250: }
251: test for memberQ().
252: {
253: struct object *list;
254: list = objectArrayToObjectList(pop());
255: printf("\nmemberQ()=%d\n",memberQ(list,ob1));
256: }
1.1 maekawa 257:
258: */
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