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