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

Diff for /OpenXM_contrib2/asir2000/builtin/var.c between version 1.4 and 1.10

version 1.4, 2001/10/09 01:36:07 version 1.10, 2018/03/29 01:32:50
Line 45 
Line 45 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *   *
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/var.c,v 1.3 2000/08/22 05:04:00 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/var.c,v 1.9 2018/03/27 06:29:19 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
   
 void Pvar(), Pvars(), Puc(), Pvars_recursive();  void Pvar(), Pvars(), Puc(), Pvars_recursive(),Psimple_is_eq();
   void Pdelete_uc();
   
 struct ftab var_tab[] = {  struct ftab var_tab[] = {
         {"var",Pvar,1},    {"var",Pvar,1},
         {"vars",Pvars,1},    {"vars",Pvars,1},
         {"vars_recursive",Pvars_recursive,1},    {"vars_recursive",Pvars_recursive,1},
         {"uc",Puc,0},    {"uc",Puc,0},
         {0,0,0},    {"delete_uc",Pdelete_uc,-1},
     {"simple_is_eq",Psimple_is_eq,2},
     {0,0,0},
 };  };
   
   void Psimple_is_eq(NODE arg,Q *rp)
   {
     int ret;
   
     ret = is_eq(ARG0(arg),ARG1(arg));
     STOQ(ret,*rp);
   }
   
   int is_eq(Obj a0,Obj a1)
   {
     P p0,p1;
     DCP dc0,dc1;
   
     if ( !a0 ) return a1?0:1;
     else if ( !a1 ) return 0;
     else if ( OID(a0) != OID(a1) ) return 0;
     else {
       switch ( OID(a0) ) {
         case O_P:
           p0 = (P)a0; p1 = (P)a1;
           if ( VR(p0) == VR(p1) ) {
             for ( dc0 = DC(p0), dc1 = DC(p1); dc0 && dc1; dc0 = NEXT(dc0), dc1 = NEXT(dc1) ) {
               if ( cmpq(DEG(dc0),DEG(dc1)) ) return 0;
               if ( !is_eq((Obj)COEF(dc0),(Obj)COEF(dc1)) ) return 0;
             }
             return (dc0||dc1)?0:1;
           } else return 0;
           break;
         default:
           return !arf_comp(CO,a0,a1);
           break;
       }
     }
   }
   
 void Pvar(NODE arg,Obj *rp)  void Pvar(NODE arg,Obj *rp)
 {  {
         Obj t;    Obj t;
         P p;    P p;
         V vn,vd,v;    V vn,vd,v;
         VL vl;    VL vl;
   
         if ( !(t = (Obj)ARG0(arg)) )    if ( !(t = (Obj)ARG0(arg)) )
                 v = 0;      v = 0;
         else    else
                 switch ( OID(t) ) {      switch ( OID(t) ) {
                         case O_P:        case O_P:
                                 v = VR((P)t); break;          v = VR((P)t); break;
                         case O_R:        case O_R:
                                 vn = VR(NM((R)t)); vd = VR(DN((R)t));          vn = VR(NM((R)t)); vd = VR(DN((R)t));
                                 for ( vl = CO; (vl->v != vn) && (vl->v != vd); vl = NEXT(vl) );          for ( vl = CO; (vl->v != vn) && (vl->v != vd); vl = NEXT(vl) );
                                 v = vl->v; break;          v = vl->v; break;
                         default:        default:
                                 v = 0; break;          v = 0; break;
                 }      }
         if ( v ) {    if ( v ) {
                 MKV(v,p); *rp = (Obj)p;      MKV(v,p); *rp = (Obj)p;
         } else    } else
                 *rp = 0;      *rp = 0;
 }  }
   
 void Pvars(NODE arg,LIST *rp)  void Pvars(NODE arg,LIST *rp)
 {  {
         VL vl;    VL vl;
         NODE n,n0;    NODE n,n0;
         P p;    P p;
   
         get_vars((Obj)ARG0(arg),&vl);    get_vars((Obj)ARG0(arg),&vl);
         for ( n0 = 0; vl; vl = NEXT(vl) ) {    for ( n0 = 0; vl; vl = NEXT(vl) ) {
                 NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;      NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;
         }    }
         if ( n0 )    if ( n0 )
                 NEXT(n) = 0;      NEXT(n) = 0;
         MKLIST(*rp,n0);    MKLIST(*rp,n0);
 }  }
   
 void Pvars_recursive(NODE arg,LIST *rp)  void Pvars_recursive(NODE arg,LIST *rp)
 {  {
         VL vl;    VL vl;
         NODE n,n0;    NODE n,n0;
         P p;    P p;
   
         get_vars_recursive((Obj)ARG0(arg),&vl);    get_vars_recursive((Obj)ARG0(arg),&vl);
         for ( n0 = 0; vl; vl = NEXT(vl) ) {    for ( n0 = 0; vl; vl = NEXT(vl) ) {
                 NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;      NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;
         }    }
         if ( n0 )    if ( n0 )
                 NEXT(n) = 0;      NEXT(n) = 0;
         MKLIST(*rp,n0);    MKLIST(*rp,n0);
 }  }
   
 void get_vars_recursive(Obj obj,VL *vlp)  void get_vars_recursive(Obj obj,VL *vlp)
 {  {
         VL vl,vl0,vl1,vl2,t;    VL vl,vl0,vl1,vl2,t;
         PFINS ins;    PFINS ins;
         int argc,i;    int argc,i;
         PFAD ad;    PFAD ad;
   
         get_vars(obj,&vl);    get_vars(obj,&vl);
         vl0 = 0;    vl0 = 0;
         for ( t = vl; t; t = NEXT(t) )    for ( t = vl; t; t = NEXT(t) )
                 if ( t->v->attr == (pointer)V_PF ) {      if ( t->v->attr == (pointer)V_PF ) {
                         ins = (PFINS)t->v->priv;        ins = (PFINS)t->v->priv;
                         argc = ins->pf->argc;        argc = ins->pf->argc;
                         ad = ins->ad;        ad = ins->ad;
                         for ( i = 0; i < argc; i++ ) {        for ( i = 0; i < argc; i++ ) {
                                 get_vars_recursive(ad[i].arg,&vl1);          get_vars_recursive(ad[i].arg,&vl1);
                                 mergev(CO,vl0,vl1,&vl2); vl0 = vl2;          mergev(CO,vl0,vl1,&vl2); vl0 = vl2;
                         }        }
                 }      }
         mergev(CO,vl,vl0,vlp);    mergev(CO,vl,vl0,vlp);
 }  }
   
 void get_vars(Obj t,VL *vlp)  void get_vars(Obj t,VL *vlp)
 {  {
         pointer *vb;    pointer *vb;
         pointer **mb;    pointer **mb;
         VL vl,vl1,vl2;    VL vl,vl1,vl2;
         NODE n;    NODE n;
         MP mp;    MP mp;
         int i,j,row,col,len;    int i,j,row,col,len;
   
         if ( !t )    if ( !t )
                 vl = 0;      vl = 0;
         else    else
                 switch ( OID(t) ) {      switch ( OID(t) ) {
                         case O_P: case O_R:        case O_P: case O_R:
                                 clctvr(CO,t,&vl); break;          clctvr(CO,t,&vl); break;
                         case O_VECT:        case O_VECT:
                                 len = ((VECT)t)->len; vb = BDY((VECT)t);          len = ((VECT)t)->len; vb = BDY((VECT)t);
                                 for ( i = 0, vl = 0; i < len; i++ ) {          for ( i = 0, vl = 0; i < len; i++ ) {
                                         get_vars((Obj)vb[i],&vl1); mergev(CO,vl,vl1,&vl2);            get_vars((Obj)vb[i],&vl1); mergev(CO,vl,vl1,&vl2);
                                         vl = vl2;            vl = vl2;
                                 }          }
                                 break;          break;
                         case O_MAT:        case O_MAT:
                                 row = ((MAT)t)->row; col = ((MAT)t)->col; mb = BDY((MAT)t);          row = ((MAT)t)->row; col = ((MAT)t)->col; mb = BDY((MAT)t);
                                 for ( i = 0, vl = 0; i < row; i++ )          for ( i = 0, vl = 0; i < row; i++ )
                                         for ( j = 0; j < col; j++ ) {            for ( j = 0; j < col; j++ ) {
                                                 get_vars((Obj)mb[i][j],&vl1); mergev(CO,vl,vl1,&vl2);              get_vars((Obj)mb[i][j],&vl1); mergev(CO,vl,vl1,&vl2);
                                                 vl = vl2;              vl = vl2;
                                         }            }
                                 break;          break;
                         case O_LIST:        case O_LIST:
                                 n = BDY((LIST)t);          n = BDY((LIST)t);
                                 for ( vl = 0; n; n = NEXT(n) ) {          for ( vl = 0; n; n = NEXT(n) ) {
                                         get_vars((Obj)BDY(n),&vl1); mergev(CO,vl,vl1,&vl2);            get_vars((Obj)BDY(n),&vl1); mergev(CO,vl,vl1,&vl2);
                                         vl = vl2;            vl = vl2;
                                 }          }
                                 break;          break;
                         case O_DP:        case O_DP:
                                 mp = ((DP)t)->body;          mp = ((DP)t)->body;
                                 for ( vl = 0; mp; mp = NEXT(mp) ) {          for ( vl = 0; mp; mp = NEXT(mp) ) {
                                         get_vars((Obj)mp->c,&vl1); mergev(CO,vl,vl1,&vl2);            get_vars((Obj)mp->c,&vl1); mergev(CO,vl,vl1,&vl2);
                                         vl = vl2;            vl = vl2;
                                 }          }
                                 break;          break;
                         default:        case O_NBP:
                                 vl = 0; break;          n = BDY((NBP)t);
                 }          for ( vl = 0; n; n = NEXT(n) ) {
         *vlp = vl;            get_vars((Obj)(((NBM)BDY(n))->c),&vl1);
             mergev(CO,vl,vl1,&vl2);
             vl = vl2;
           }
           break;
         default:
           vl = 0; break;
       }
     *vlp = vl;
 }  }
   
 void Puc(Obj *p)  void Puc(Obj *p)
 {  {
         VL vl;    VL vl;
         V v;    V v;
         P t;    P t;
         char buf[BUFSIZ];    char buf[BUFSIZ];
         static int UCN;    char *n,*nv;
     static int UCN;
   
         NEWV(v); v->attr = (pointer)V_UC;    NEWV(v); v->attr = (pointer)V_UC;
         sprintf(buf,"_%d",UCN++);    sprintf(buf,"_%d",UCN++);
         NAME(v) = (char *)CALLOC(strlen(buf)+1,sizeof(char));    nv = NAME(v) = (char *)CALLOC(strlen(buf)+1,sizeof(char));
         strcpy(NAME(v),buf);    strcpy(NAME(v),buf);
         for ( vl = CO; NEXT(vl); vl = NEXT(vl) );    for ( vl = CO; vl; vl = NEXT(vl) )
         NEWVL(NEXT(vl)); VR(NEXT(vl)) = v; NEXT(NEXT(vl)) = 0;      if ( (n=NAME(VR(vl))) && !strcmp(n,nv) ) break;
         MKV(v,t); *p = (Obj)t;      else if ( !NEXT(vl) ) {
         NEWVL(NEXT(vl)); VR(NEXT(vl)) = v; NEXT(NEXT(vl)) = 0;
         LASTCO = NEXT(vl);
         break;
       }
     MKV(v,t); *p = (Obj)t;
   }
   
   void Pdelete_uc(NODE arg,Obj *p)
   {
     VL vl,prev;
     V v;
   
     if ( argc(arg) == 1 ) {
       asir_assert(ARG0(arg),O_P,"delete_uc");
       v = VR((P)ARG0(arg));
     } else
       v = 0;
   
     for ( prev = 0, vl = CO; vl; vl = NEXT(vl) ) {
       if ( (!v || v == vl->v) && vl->v->attr == (pointer)V_UC ) {
         if ( prev == 0 )
           CO = NEXT(vl);
         else
           NEXT(prev) = NEXT(vl);
       } else
         prev = vl;
     }
     update_LASTCO();
     *p = 0;
 }  }
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.10
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>