[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.6

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>