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