[BACK]Return to list.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

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

1.7     ! ohara       1: /* $OpenXM: OpenXM/src/kan96xx/Kan/list.c,v 1.6 2005/06/16 05:07:23 takayama 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:
                      9: static errorList(char *s);
                     10: static warningList(char *s);
                     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:
                    163: 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:
                    180: static 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:
                    187: static 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>