[BACK]Return to quote.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / parse

Annotation of OpenXM_contrib2/asir2000/parse/quote.c, Revision 1.27

1.27    ! noro        1: /* $OpenXM: OpenXM_contrib2/asir2000/parse/quote.c,v 1.26 2005/12/10 14:14:16 noro Exp $ */
1.3       noro        2:
1.1       noro        3: #include "ca.h"
                      4: #include "parse.h"
                      5:
1.6       noro        6: void addquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1       noro        7: {
1.27    ! noro        8:   FNODE fn;
        !             9:   QUOTE t;
1.1       noro       10:
1.27    ! noro       11:   objtoquote((Obj)a,&t); a = t; objtoquote((Obj)b,&t); b = t;
        !            12:   fn = mkfnode(3,I_BOP,addfs,BDY(a),BDY(b));
        !            13:   MKQUOTE(*c,fn);
1.1       noro       14: }
                     15:
1.6       noro       16: void subquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1       noro       17: {
1.27    ! noro       18:   FNODE fn;
        !            19:   QUOTE t;
1.1       noro       20:
1.27    ! noro       21:   objtoquote((Obj)a,&t); a = t; objtoquote((Obj)b,&t); b = t;
        !            22:   fn = mkfnode(3,I_BOP,subfs,BDY(a),BDY(b));
        !            23:   MKQUOTE(*c,fn);
1.1       noro       24: }
                     25:
1.6       noro       26: void mulquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1       noro       27: {
1.27    ! noro       28:   FNODE fn;
        !            29:   QUOTE t;
1.1       noro       30:
1.27    ! noro       31:   objtoquote((Obj)a,&t); a = t; objtoquote((Obj)b,&t); b = t;
        !            32:   fn = mkfnode(3,I_BOP,mulfs,BDY(a),BDY(b));
        !            33:   MKQUOTE(*c,fn);
1.1       noro       34: }
                     35:
1.6       noro       36: void divquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1       noro       37: {
1.27    ! noro       38:   FNODE fn;
        !            39:   QUOTE t;
1.1       noro       40:
1.27    ! noro       41:   objtoquote((Obj)a,&t); a = t; objtoquote((Obj)b,&t); b = t;
        !            42:   fn = mkfnode(3,I_BOP,divfs,BDY(a),BDY(b));
        !            43:   MKQUOTE(*c,fn);
1.1       noro       44: }
                     45:
1.6       noro       46: void pwrquote(VL vl,QUOTE a,QUOTE b,QUOTE *c)
1.1       noro       47: {
1.27    ! noro       48:   FNODE fn;
        !            49:   QUOTE t;
1.1       noro       50:
1.27    ! noro       51:   objtoquote((Obj)a,&t); a = t; objtoquote((Obj)b,&t); b = t;
        !            52:   fn = mkfnode(3,I_BOP,pwrfs,BDY(a),BDY(b));
        !            53:   MKQUOTE(*c,fn);
1.1       noro       54: }
                     55:
1.6       noro       56: void chsgnquote(QUOTE a,QUOTE *c)
1.1       noro       57: {
1.27    ! noro       58:   FNODE fn;
        !            59:   QUOTE t;
1.1       noro       60:
1.27    ! noro       61:   objtoquote((Obj)a,&t); a = t;
        !            62:   fn = mkfnode(1,I_MINUS,BDY(a));
        !            63:   MKQUOTE(*c,fn);
1.1       noro       64: }
1.2       noro       65:
1.6       noro       66: void objtoquote(Obj a,QUOTE *c)
1.2       noro       67: {
1.27    ! noro       68:   QUOTE nm,dn;
        !            69:   NODE arg,t0,t,t1,t2,t3;
        !            70:   FNODE fn;
        !            71:   Obj obj;
        !            72:   Obj *b;
        !            73:   Obj **m;
        !            74:   int i,j,len,row,col;
        !            75:   Q q,qrow,qcol;
        !            76:   FUNC f;
        !            77:
        !            78:   if ( !a ) {
        !            79:     MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
        !            80:     return;
        !            81:   }
        !            82:   switch ( OID(a) ) {
        !            83:     case O_N:
        !            84:       if ( negative_number((Num)a) ) {
        !            85:         arf_chsgn(a,&obj);
        !            86:         MKQUOTE(*c,mkfnode(1,I_MINUS,
        !            87:           mkfnode(1,I_FORMULA,(pointer)obj)));
        !            88:       } else {
        !            89:         MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
        !            90:       }
        !            91:       break;
        !            92:     case O_STR:
        !            93:       MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
        !            94:       break;
        !            95:     case O_P:
        !            96:       polytoquote((P)a,c);
        !            97:       break;
        !            98:     case O_R:
        !            99:       polytoquote(NM((R)a),&nm);
        !           100:       polytoquote(DN((R)a),&dn);
        !           101:       divquote(CO,nm,dn,c);
        !           102:       break;
        !           103:     case O_LIST:
        !           104:       t0 = 0;
        !           105:       for ( arg = BDY((LIST)a); arg; arg = NEXT(arg) ) {
        !           106:         NEXTNODE(t0,t);
        !           107:         objtoquote(BDY(arg),&nm);
        !           108:         BDY(t) = BDY(nm);
        !           109:       }
        !           110:       if ( t0 )
        !           111:         NEXT(t) = 0;
        !           112:       MKQUOTE(*c,mkfnode(1,I_LIST,t0));
        !           113:       break;
        !           114:     case O_VECT:
        !           115:       len = ((VECT)a)->len;
        !           116:       b = (Obj *)BDY(((VECT)a));
        !           117:       t = 0;
        !           118:       for ( i = len-1; i >= 0; i-- ) {
        !           119:         objtoquote(b[i],&nm);
        !           120:         MKNODE(t1,BDY(nm),t);
        !           121:         t = t1;
        !           122:       }
        !           123:       STOQ(len,q);
        !           124:       t = mknode(2,mkfnode(1,I_FORMULA,q),mkfnode(1,I_LIST,t));
        !           125:       gen_searchf("vector",&f);
        !           126:       MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
        !           127:       break;
        !           128:     case O_MAT:
        !           129:       row = ((MAT)a)->row;
        !           130:       col = ((MAT)a)->row;
        !           131:       m = (Obj **)BDY(((MAT)a));
        !           132:       t2 = 0;
        !           133:       for ( i = row-1; i >= 0; i-- ) {
        !           134:         t = 0;
        !           135:         for ( j = col-1; j >= 0; j-- ) {
        !           136:           objtoquote(m[i][j],&nm);
        !           137:           MKNODE(t1,BDY(nm),t);
        !           138:           t = t1;
        !           139:         }
        !           140:         fn = mkfnode(1,I_LIST,t);
        !           141:         MKNODE(t3,fn,t2);
        !           142:         t2 = t3;
        !           143:       }
        !           144:       fn = mkfnode(1,I_LIST,t2);
        !           145:
        !           146:       STOQ(row,qrow);
        !           147:       STOQ(col,qcol);
        !           148:       t = mknode(3,
        !           149:         mkfnode(1,I_FORMULA,qrow),mkfnode(1,I_FORMULA,qcol),fn);
        !           150:       gen_searchf("matrix",&f);
        !           151:       MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
        !           152:       break;
        !           153:     case O_DP:
        !           154:       dptoquote((DP)a,c);
        !           155:       break;
        !           156:     case O_QUOTE:
        !           157:       *c = (QUOTE)a;
        !           158:       break;
        !           159:     default:
        !           160:       error("objtoquote : not implemented");
        !           161:   }
1.2       noro      162: }
                    163:
1.6       noro      164: void polytoquote(P a,QUOTE *c)
1.2       noro      165: {
1.27    ! noro      166:   DCP dc,t;
        !           167:   DCP *dca;
        !           168:   int n,i,sgn;
        !           169:   QUOTE v,r,s,u;
        !           170:
        !           171:   if ( !a ) {
        !           172:     MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
        !           173:     return;
        !           174:   } else if ( OID(a) == O_N ) {
        !           175:     MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
        !           176:     return;
        !           177:   }
        !           178:   vartoquote(VR((P)a),&v);
        !           179:   dc = DC((P)a);
        !           180:   dctoquote(dc,v,&r,&sgn);
        !           181:   if ( sgn == -1 ) {
        !           182:     MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r)));
        !           183:     r = u;
        !           184:   }
        !           185:   for (dc = NEXT(dc); dc; dc = NEXT(dc) ) {
        !           186:     dctoquote(dc,v,&s,&sgn);
        !           187:     if ( sgn == -1 )
        !           188:       subquote(CO,r,s,&u);
        !           189:     else
        !           190:       addquote(CO,r,s,&u);
        !           191:     r = u;
        !           192:   }
        !           193:   *c = r;
1.2       noro      194: }
                    195:
1.6       noro      196: void dptoquote(DP a,QUOTE *c)
1.4       noro      197: {
1.27    ! noro      198:   MP t;
        !           199:   MP m;
        !           200:   int i,n,nv,sgn;
        !           201:   QUOTE s,r,u;
        !           202:
        !           203:   if ( !a ) {
        !           204:     MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)a));
        !           205:     return;
        !           206:   }
        !           207:   nv = NV(a);
        !           208:   m = BDY(a);
        !           209:   mptoquote(m,nv,&r,&sgn);
        !           210:   if ( sgn == -1 ) {
        !           211:     MKQUOTE(u,mkfnode(1,I_MINUS,BDY(r)));
        !           212:     r = u;
        !           213:   }
        !           214:   for ( m = NEXT(m); m; m = NEXT(m) ) {
        !           215:     mptoquote(m,nv,&s,&sgn);
        !           216:     if ( sgn < 0 )
        !           217:       subquote(CO,r,s,&u);
        !           218:     else
        !           219:       addquote(CO,r,s,&u);
        !           220:     r = u;
        !           221:   }
        !           222:   *c = r;
1.4       noro      223: }
                    224:
1.7       noro      225: void dctoquote(DCP dc,QUOTE v,QUOTE *q,int *sgn)
1.2       noro      226: {
1.27    ! noro      227:   QUOTE t,s,u,r;
        !           228:   P c;
        !           229:   Q d;
        !           230:
        !           231:   if ( mmono(COEF(dc)) ) {
        !           232:     /* -xyz... */
        !           233:     chsgnp(COEF(dc),&c);
        !           234:     *sgn = -1;
        !           235:   } else {
        !           236:     c = COEF(dc);
        !           237:     *sgn = 1;
        !           238:   }
        !           239:   d = DEG(dc);
        !           240:   if ( UNIQ(c) ) {
        !           241:     if ( d ) {
        !           242:       if ( UNIQ(d) )
        !           243:         r = v;
        !           244:       else {
        !           245:         objtoquote((Obj)d,&t);
        !           246:         pwrquote(CO,v,t,&r);
        !           247:       }
        !           248:     } else
        !           249:       objtoquote((Obj)ONE,&r);
        !           250:   } else {
        !           251:     objtoquote((Obj)c,&u);
        !           252:     if ( !NUM(c) && NEXT(DC(c)) && d ) {
        !           253:       MKQUOTE(t,mkfnode(1,I_PAREN,BDY(u)));
        !           254:       u = t;
        !           255:     }
        !           256:     if ( d ) {
        !           257:       if ( UNIQ(d) )
        !           258:         s = v;
        !           259:       else {
        !           260:         objtoquote((Obj)d,&t);
        !           261:         pwrquote(CO,v,t,&s);
        !           262:       }
        !           263:       mulquote(CO,u,s,&r);
        !           264:     } else
        !           265:       r = u;
        !           266:   }
        !           267:   *q = r;
1.4       noro      268: }
                    269:
1.8       noro      270: void mptoquote(MP m,int n,QUOTE *r,int *sgn)
1.4       noro      271: {
1.27    ! noro      272:   QUOTE s,u;
        !           273:   P c;
        !           274:   NODE t,t1;
        !           275:   FNODE f;
        !           276:   Q q;
        !           277:   DL dl;
        !           278:   int i;
        !           279:
        !           280:   if ( mmono(C(m)) ) {
        !           281:     chsgnp(C(m),&c);
        !           282:     *sgn = -1;
        !           283:   } else {
        !           284:     c = C(m);
        !           285:     *sgn = 1;
        !           286:   }
        !           287:   objtoquote((Obj)c,&s);
        !           288:   if ( !NUM(c) && NEXT(DC(c)) ) {
        !           289:     MKQUOTE(u,mkfnode(1,I_PAREN,BDY(s)));
        !           290:     s = u;
        !           291:   }
        !           292:   dl = m->dl;
        !           293:   for ( i = n-1, t = 0; i >= 0; i-- ) {
        !           294:     STOQ(dl->d[i],q);
        !           295:     f = mkfnode(1,I_FORMULA,q);
        !           296:     MKNODE(t1,f,t);
        !           297:     t = t1;
        !           298:   }
        !           299:   MKQUOTE(u,mkfnode(1,I_EV,t));
        !           300:   if ( UNIQ(c) )
        !           301:     *r = u;
        !           302:   else
        !           303:     mulquote(CO,s,u,r);
1.2       noro      304: }
                    305:
1.6       noro      306: void vartoquote(V v,QUOTE *c)
1.2       noro      307: {
1.27    ! noro      308:   P x;
        !           309:   PF pf;
        !           310:   PFAD ad;
        !           311:   QUOTE a,b,u;
        !           312:   int i;
        !           313:   FUNC f;
        !           314:   NODE t,t1;
        !           315:
        !           316:   if ( NAME(v) ) {
        !           317:     MKV(v,x);
        !           318:     MKQUOTE(*c,mkfnode(1,I_FORMULA,(pointer)x));
        !           319:   } else if ( (vid)v->attr == V_PF ) {
        !           320:     /* pure function */
        !           321:     pf = ((PFINS)v->priv)->pf;
        !           322:     ad = ((PFINS)v->priv)->ad;
        !           323:     if ( !strcmp(NAME(pf),"pow") ) {
        !           324:       /* pow(a,b) = a^b */
        !           325:       objtoquote(ad[0].arg,&a);
        !           326:       x = (P)ad[0].arg;
        !           327:       /* check whether x is a variable */
        !           328:       if ( x && OID(x)==O_P && !NEXT(DC(x))
        !           329:         && UNIQ(DEG(DC(x))) && UNIQ(COEF(DC(x))) ) {
        !           330:         /* use a as is */
        !           331:       } else {
        !           332:         /* a => (a) */
        !           333:         MKQUOTE(u,mkfnode(1,I_PAREN,BDY(a))); a = u;
        !           334:       }
        !           335:       objtoquote(ad[1].arg,&b);
        !           336:       pwrquote(CO,a,b,c);
        !           337:     } else {
        !           338:       for ( i = 0; i < pf->argc; i++ )
        !           339:         if ( ad[i].d )
        !           340:           break;
        !           341:       if ( i < pf->argc )
        !           342:         error("vartoquote : not implemented");
        !           343:       gen_searchf(NAME(pf),&f);
        !           344:       t = 0;
        !           345:       for ( i = pf->argc-1; i >= 0; i-- ) {
        !           346:         objtoquote(ad[i].arg,&a);
        !           347:         MKNODE(t1,BDY(a),t);
        !           348:         t = t1;
        !           349:       }
        !           350:       MKQUOTE(*c,mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,t)));
        !           351:     }
        !           352:   }
1.14      noro      353: }
                    354:
1.21      noro      355: /*
                    356:  * A_arf : arithmetic function
                    357:  * A_int : machine integer
                    358:  * A_fnode : FNODE
                    359:  * A_node : NODE with FNODE bodies
                    360:  * A_internal : internal object
                    361:  * A_str : string
                    362:  * A_end : terminal
                    363:  * A_func : FUNC
                    364:  * A_notimpl : not implemented
                    365:  */
                    366:
1.14      noro      367: struct fid_spec fid_spec_tab[] = {
1.27    ! noro      368:   {I_BOP,A_arf,A_fnode,A_fnode,A_end},
        !           369:   {I_COP,A_int,A_fnode,A_fnode,A_end},
        !           370:   {I_AND,A_fnode,A_fnode,A_end},
        !           371:   {I_OR,A_fnode,A_fnode,A_end},
        !           372:   {I_NOT,A_fnode,A_end},
        !           373:   {I_CE,A_fnode,A_fnode,A_end},
        !           374:   {I_PRESELF,A_arf,A_fnode,A_end},
        !           375:   {I_POSTSELF,A_arf,A_fnode,A_end},
        !           376:   {I_FUNC,A_func,A_fnode,A_end},
        !           377:   {I_FUNC_OPT,A_func,A_fnode,A_fnode,A_end},
        !           378:   {I_IFUNC,A_fnode,A_fnode,A_end},
        !           379:   {I_MAP,A_func,A_fnode,A_end},
        !           380:   {I_RECMAP,A_func,A_fnode,A_end},
        !           381:   {I_PFDERIV,A_notimpl,A_end},
        !           382:   {I_ANS,A_int,A_end},
        !           383:   {I_PVAR,A_int,A_node,A_end},
        !           384:   {I_ASSPVAR,A_fnode,A_fnode,A_end},
        !           385:   {I_FORMULA,A_internal,A_end},
        !           386:   {I_LIST,A_node,A_end},
        !           387:   {I_STR,A_str,A_end},
        !           388:   {I_NEWCOMP,A_int,A_end},
        !           389:   {I_CAR,A_fnode,A_end},
        !           390:   {I_CDR,A_fnode,A_end},
        !           391:   {I_CAST,A_notimpl,A_end},
        !           392:   {I_INDEX,A_fnode,A_node,A_end},
        !           393:   {I_EV,A_node,A_end},
        !           394:   {I_TIMER,A_fnode,A_fnode,A_fnode,A_end},
        !           395:   {I_GF2NGEN,A_end},
        !           396:   {I_GFPNGEN,A_end},
        !           397:   {I_GFSNGEN,A_end},
        !           398:   {I_LOP,A_int,A_fnode,A_fnode,A_end},
        !           399:   {I_OPT,A_str,A_fnode,A_end},
        !           400:   {I_GETOPT,A_str,A_end},
        !           401:   {I_POINT,A_fnode,A_str,A_end},
        !           402:   {I_PAREN,A_fnode,A_end},
        !           403:   {I_MINUS,A_fnode,A_end},
        !           404:   {I_NARYOP,A_arf,A_node,A_end},
        !           405:   {I_CONS,A_node,A_fnode,A_end},
        !           406:   {I_FUNC_QARG,A_func,A_fnode,A_end},
        !           407:   {I_FUNC_HEAD,A_func,A_end},
1.14      noro      408: };
                    409:
                    410: #define N_FID_SPEC (sizeof(fid_spec_tab)/sizeof(struct fid_spec))
                    411:
                    412: void get_fid_spec(fid id,fid_spec_p *spec)
                    413: {
1.27    ! noro      414:   int i;
1.14      noro      415:
1.27    ! noro      416:   for ( i = 0; i < N_FID_SPEC; i++ )
        !           417:     if ( fid_spec_tab[i].id == id ) {
        !           418:       *spec = &fid_spec_tab[i];
        !           419:       return;
        !           420:     }
        !           421:   *spec = 0;
1.14      noro      422: }
                    423:
1.15      noro      424: FNODE strip_paren(FNODE f)
                    425: {
1.27    ! noro      426:   if ( !f || f->id != I_PAREN ) return f;
        !           427:   else {
        !           428:     return strip_paren((FNODE)FA0(f));
        !           429:   }
1.15      noro      430: }
                    431:
1.18      noro      432: NODE flatten_fnodenode(NODE n,char *opname);
                    433: FNODE flatten_fnode(FNODE f,char *opname);
                    434:
                    435: NODE flatten_fnodenode(NODE n,char *opname)
                    436: {
1.27    ! noro      437:   NODE r0,r,t;
1.18      noro      438:
1.27    ! noro      439:   r0 = 0;
        !           440:   for ( t = n; t; t = NEXT(t) ) {
        !           441:     NEXTNODE(r0,r);
        !           442:     BDY(r) = (pointer)flatten_fnode((FNODE)BDY(t),opname);
        !           443:   }
        !           444:   if ( r0 ) NEXT(r) = 0;
        !           445:   return r0;
1.18      noro      446: }
                    447:
1.14      noro      448: FNODE flatten_fnode(FNODE f,char *opname)
                    449: {
1.27    ! noro      450:   fid_spec_p spec;
        !           451:   farg_type *type;
        !           452:   fid id;
        !           453:   FNODE f1,f2,r;
        !           454:   int i;
        !           455:
        !           456:   if ( !f ) return f;
        !           457:   id = f->id;
        !           458:   get_fid_spec(id,&spec);
        !           459:   /* unknown fid */
        !           460:   if ( !spec ) return f;
        !           461:   if ( id == I_BOP && !strcmp(((ARF)FA0(f))->name,opname) ) {
        !           462:     f1 = (pointer)flatten_fnode(FA1(f),opname);
        !           463:     f1 = strip_paren(f1);
        !           464:     f2 = (pointer)flatten_fnode(FA2(f),opname);
        !           465:     f2 = strip_paren(f2);
        !           466:     if ( f1->id == I_BOP && !strcmp(((ARF)FA0(f1))->name,opname) ) {
        !           467:       /* [op [op A B] C] => [op A [op B C]] */
        !           468:       f2 = flatten_fnode(mkfnode(3,I_BOP,(ARF)FA0(f),FA2(f1),f2),opname);
        !           469:       return mkfnode(3,I_BOP,(ARF)FA0(f),FA1(f1),f2);
        !           470:     } else
        !           471:       return mkfnode(3,I_BOP,(ARF)FA0(f),f1,f2);
        !           472:   } else {
        !           473:     type = spec->type;
        !           474:     for ( i = 0; type[i] != A_end; i++ );
        !           475:     NEWFNODE(r,i); ID(r) = f->id;
        !           476:     for ( i = 0; type[i] != A_end; i++ ) {
        !           477:       if ( type[i] == A_fnode )
        !           478:         r->arg[i] = (pointer)flatten_fnode(f->arg[i],opname);
        !           479:       else if ( type[i] == A_node )
        !           480:         r->arg[i] = (pointer)flatten_fnodenode(f->arg[i],opname);
        !           481:       else
        !           482:         r->arg[i] = f->arg[i];
        !           483:     }
        !           484:     return r;
        !           485:   }
1.21      noro      486: }
                    487:
                    488: /* comparison of QUOTE */
                    489:
                    490: int compquote(VL vl,QUOTE q1,QUOTE q2)
                    491: {
1.27    ! noro      492:   return compfnode(BDY(q1),BDY(q2));
1.21      noro      493: }
                    494:
                    495: /* comparison of QUOTEARG */
                    496: /* XXX : executes a non-sense comparison for bodies */
                    497:
                    498: int compqa(VL vl,QUOTEARG q1,QUOTEARG q2)
                    499: {
1.27    ! noro      500:   if ( !q1 ) return q2?-1:0;
        !           501:   else if ( !q2 ) return 1;
        !           502:   else if ( OID(q1) > OID(q2) ) return 1;
        !           503:   else if ( OID(q1) < OID(q2) ) return -1;
        !           504:   else if ( q1->type > q2->type ) return 1;
        !           505:   else if ( q1->type < q2->type ) return -1;
        !           506:   else switch ( q1->type ) {
        !           507:     case A_func:
        !           508:       return strcmp(((FUNC)q1->body)->name,((FUNC)q2->body)->name);
        !           509:     case A_arf:
        !           510:       return strcmp(((ARF)q1->body)->name,((ARF)q2->body)->name);
        !           511:     default:
        !           512:       if ( (unsigned)q1->body  > (unsigned)q2->body ) return 1;
        !           513:       else if ( (unsigned)q1->body  < (unsigned)q2->body ) return -1;
        !           514:       else return 0;
        !           515:   }
1.21      noro      516: }
                    517:
                    518: int compfnode(FNODE f1,FNODE f2)
                    519: {
1.27    ! noro      520:   fid_spec_p spec;
        !           521:   int t,s1,s2,i;
        !           522:   NODE n1,n2;
1.21      noro      523:
1.27    ! noro      524:   if ( !f1 ) return f2 ? -1 : 1;
        !           525:   else if ( !f2 ) return 1;
1.21      noro      526:     else if ( f1->id > f2->id ) return 1;
1.27    ! noro      527:   else if ( f1->id < f2->id ) return -1;
        !           528:   spec = fid_spec_tab+f1->id;
        !           529:   for ( i = 0; spec->type[i] != A_end; i++ ) {
        !           530:     switch ( spec->type[i] ) {
        !           531:       case A_fnode:
        !           532:         t = compfnode((FNODE)f1->arg[i],(FNODE)f2->arg[i]);
        !           533:         if ( t ) return t;
        !           534:         break;
        !           535:       case A_int:
        !           536:         s1 = (int)f1->arg[i];
        !           537:         s2 = (int)f2->arg[i];
        !           538:         if ( s1 > s2 ) return 1;
        !           539:         else if ( s1 < s2 ) return -1;
        !           540:         break;
        !           541:       case A_str:
        !           542:         t = strcmp((char *)f1->arg[i],(char *)f2->arg[i]);
        !           543:         if ( t ) return t;
        !           544:         break;
        !           545:       case A_internal:
        !           546:         t = arf_comp(CO,(Obj)f1->arg[i],(Obj)f2->arg[i]);
        !           547:         if ( t ) return t;
        !           548:         break;
        !           549:       case A_node:
        !           550:         n1 = (NODE)f1->arg[i];
        !           551:         n2 = (NODE)f2->arg[i];
        !           552:         for ( ; n1 && n2; n1 = NEXT(n1), n2 = NEXT(n2) ) {
        !           553:           t = compfnode(BDY(n1),BDY(n2));
        !           554:           if ( t ) return t;
        !           555:         }
        !           556:         if ( n1 ) return 1;
        !           557:         else if ( n2 ) return -1;
        !           558:         break;
        !           559:       case A_arf:
        !           560:          t = strcmp(((ARF)f1->arg[i])->name,((ARF)f2->arg[i])->name);
        !           561:         if ( t ) return t;
        !           562:         break;
        !           563:       case A_func:
        !           564:          t = strcmp(((FUNC)f1->arg[i])->name,((FUNC)f2->arg[i])->name);
        !           565:         if ( t ) return t;
        !           566:         break;
        !           567:       case A_notimpl:
        !           568:       default:
        !           569:         error("compfnode : not implemented");
        !           570:         break;
        !           571:     }
        !           572:   }
        !           573:   return 0;
1.2       noro      574: }

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