Annotation of OpenXM/src/kan96xx/Kan/list.c, Revision 1.5
1.5 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/list.c,v 1.4 2004/09/09 11:42:22 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:
1.5 ! takayama 139: static void printObjectList0(op,br)
! 140: struct object *op; int br;
1.1 maekawa 141: {
142: if (op == NULL) return;
143: if (isNullList(op)) return;
144: if (op->tag == Slist) {
1.5 ! takayama 145: if (br) printf("<");
! 146: printObjectList0(op->lc.op,1);
1.1 maekawa 147: printf(", ");
1.5 ! takayama 148: printObjectList0(op->rc.op,0);
! 149: if (br) printf(">");
1.1 maekawa 150: }else {
151: printObject(*op,0,stdout);
152: }
1.5 ! takayama 153: }
! 154:
! 155: void printObjectList(op)
! 156: struct object *op;
! 157: {
! 158: printObjectList0(op,1);
1.1 maekawa 159: }
160:
161: memberQ(list1,obj2)
1.3 takayama 162: struct object *list1;
163: struct object obj2;
164: /* If obj2 is an member of list1, the functions the position.
1.1 maekawa 165: memberQ( (1 (2 3) 4), 4) ----> 3.
166: */
167: {
168: int n,pos;
169: if (isNullList(list1)) return(0);
170: n = klength(list1);
171: for (pos=1; pos<=n; pos++) {
172: if (KooEqualQ(car(list1),obj2)) return(pos);
173: else list1 = cdr(list1);
174: }
175: return(0);
176: }
177:
178: static errorList(str)
1.3 takayama 179: char *str;
1.1 maekawa 180: {
181: fprintf(stderr,"list.c: %s\n",str);
182: exit(10);
183: }
184:
185: static warningList(str)
1.3 takayama 186: char *str;
1.1 maekawa 187: {
188: fprintf(stderr,"Warning. list.c: %s\n",str);
189: }
190:
1.4 takayama 191: struct object KvJoin(struct object listo1,struct object listo2) {
192: struct object rob;
193: struct object *op1,*op2;
194: if (listo1.tag == Snull) return listo2;
195: if (listo2.tag == Snull) return listo1;
196: if ((listo1.tag == Slist) && (listo2.tag == Slist)) {
197: op1 = (struct object *)sGC_malloc(sizeof(struct object));
198: op2 = (struct object *)sGC_malloc(sizeof(struct object));
199: if ((op1 == NULL) || (op2 == NULL)) errorKan1("%s\n","KvJoin, No more memory.");
200: *op1 = listo1; *op2 = listo2;
201: rob = *(vJoin(op1,op2));
202: return rob;
203: }else{
204: errorKan1("%s\n","KvJoin(Slist,Slist)");
205: }
206: }
207: struct object Kcar(struct object listo) {
208: if (listo.tag == Snull) return listo;
209: if (listo.tag == Slist) {
210: return car(&listo);
211: }else{
212: errorKan1("%s\n","Kcar(Slist)");
213: }
214: }
215: struct object Kcdr(struct object listo) {
216: struct object *op;
217: struct object rob;
218: if (listo.tag == Snull) return listo;
219: if (listo.tag == Slist) {
220: op = cdr(&listo);
221: if (isNullList(op)) {
222: rob = NullObject;
223: }else{
224: rob = *op;
225: }
226: return rob;
227: }else{
228: errorKan1("%s\n","Kcar(Slist)");
229: }
230: }
231: struct object KlistToArray(struct object listo) {
232: if (listo.tag == Snull) {
233: return newObjectArray(0);
234: }
235: if (listo.tag == Slist) {
236: return listToArray(&listo);
237: }else{
238: errorKan1("%s\n","KlistToArray(Slist)");
239: }
240: }
241: struct object KarrayToList(struct object ob) {
242: struct object *op;
243: if (ob.tag != Sarray) {
244: errorKan1("%s\n","KarrayToList(Sarray)");
245: }
246: op = arrayToList(ob);
247: if (isNullList(op)) return NullObject;
248: return *op;
249: }
1.1 maekawa 250:
251: /********************** test codes for Stest: ********************/
252: /* test of objectArrayToObjectList. in Stest: stackmachine.c
1.3 takayama 253: {
254: struct object *list;
255: list = arrayToList(ob1);
256: ob1 = listToArray(list);
257: push(ob1);
258: }
259: test for memberQ().
260: {
261: struct object *list;
262: list = objectArrayToObjectList(pop());
263: printf("\nmemberQ()=%d\n",memberQ(list,ob1));
264: }
1.1 maekawa 265:
266: */
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