Return to list.c CVS log

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

Annotation of OpenXM/src/kan96xx/Kan/list.c, Revision 1.2

1.2     ! takayama    1: /* $OpenXM$ */
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)
                     19: struct object *objp;
                     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)
                     34: struct object *objp;
                     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)
                     47: struct object *objp;
                     48: /* This function copies only the top level of the list */
                     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)
                     69: struct object obj;
                     70: /* obj.tag must be Sarray */
                     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)
                     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: */
                     94: {
                     95:   /*
                     96:   printf("list1=");  printObjectList(list1);
                     97:   printf("\nlist2=");  printObjectList(list2);  printf("\n");
                     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)
                    116: struct object *list;
                    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)
                    128: struct object *list;
                    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)
                    140: struct object *op;
                    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)
                    154: struct object *list1;
                    155: struct object obj2;
                    156: /* If obj2 is an member of list1, the functions the position.
                    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)
                    171: char *str;
                    172: {
                    173:   fprintf(stderr,"list.c: %s\n",str);
                    174:   exit(10);
                    175: }
                    176:
                    177: static warningList(str)
                    178: char *str;
                    179: {
                    180:   fprintf(stderr,"Warning. list.c: %s\n",str);
                    181: }
                    182:
                    183:
                    184: /********************** test codes for Stest: ********************/
                    185: /* test of objectArrayToObjectList. in Stest: stackmachine.c
                    186:     {
                    187:       struct object *list;
                    188:       list = arrayToList(ob1);
                    189:       ob1 = listToArray(list);
                    190:       push(ob1);
                    191:     }
                    192:     test for memberQ().
                    193:     {
                    194:       struct object *list;
                    195:       list = objectArrayToObjectList(pop());
                    196:       printf("\nmemberQ()=%d\n",memberQ(list,ob1));
                    197:     }
                    198:
                    199: */