Return to list.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Annotation of OpenXM/src/kan96xx/Kan/list.c, Revision 1.1.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: */