OpenXM_contrib2/asir2000/builtin/subst.c - diff

Return to subst.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/subst.c between version 1.8 and 1.11

-version 1.8, 2010/01/28 08:56:26
+version 1.11, 2017/09/06 06:25:26
 Line 45
 Line 45
 Line 45
   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
   *
-  * $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.7 2004/06/22 09:17:21 noro Exp $
+  * $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.10 2015/09/24 04:43:13 noro Exp $
  */
  #include "ca.h"
  #include "parse.h"
 Line 55  void Psubstr2np();
 Line 55  void Psubstr2np();
 Line 55  void Psubstr2np();
  struct ftab subst_tab[] = {
          {"subst",Psubst,-99999999},
-         {"substr2np",Psubstr2np,2},
+         {"substr2np",Psubstr2np,-3},
          {"subst_quote",Psubst_quote,-99999999},
          {"psubst",Ppsubst,-99999999},
          {"substf",Psubstf,-99999999},
 Line 64  struct ftab subst_tab[] = {
 Line 64  struct ftab subst_tab[] = {
 Line 64  struct ftab subst_tab[] = {
  extern Obj VOIDobj;
+ /* substr2np(P,[[v,a],...]) or substr2np(P,[v1,...],[a1,...]) */
  void Psubstr2np(NODE arg,Obj *rp)
  {
-         Obj a;
+   Obj a,b;
-         P nm,dn,p;
+   P nm,dn,p,q;
-         R r;
+   R r;
-         VL vl,tvl;
+   VL vl,tvl;
-         int nv,i;
+   int nv,i,ac,j;
-         NODE slist,t,ps;
+   NODE slist,t,ps,u,vlist;
-         P s;
+   P s;
-         P *svect;
+   P *svect;
-         V v;
+   V v;
-         V *vvect;
+   V *vvect;
-         a = (Obj)ARG0(arg);
+   a = (Obj)ARG0(arg);
-         if ( !a || NUM(a) ) {
+   if ( !a || NUM(a) ) {
-                 *rp = a;
+     *rp = a;
-                 return;
+     return;
-         }
+   }
-         asir_assert(ARG0(arg),O_R,"substr2np");
+   asir_assert(ARG0(arg),O_R,"substr2np");
-         asir_assert(ARG1(arg),O_LIST,"substr2np");
+   asir_assert(ARG1(arg),O_LIST,"substr2np");
-         get_vars(a,&vl);
+   get_vars(a,&vl);
-         for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ );
+   for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ );
-         nv = i;
+   nv = i;
-         vvect = (V *)MALLOC(nv*sizeof(V));
+   vvect = (V *)MALLOC((nv)*sizeof(V));
-         for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ) vvect[i] = tvl->v;
+   for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ) vvect[i] = tvl->v;
-         svect = (P *)MALLOC(nv*sizeof(P));
+   svect = (P *)MALLOC((nv)*sizeof(P));
-         slist = BDY((LIST)ARG1(arg));
+   ac = argc(arg);
-         for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj;
+   if ( ac == 2 ) {
-         for ( t = slist; t; t = NEXT(t) ) {
+     slist = BDY((LIST)ARG1(arg));
-                 ps = BDY((LIST)BDY(t)); p = (P)BDY(ps); s = (P)BDY(NEXT(ps));
+     for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj;
-                 asir_assert(p,O_P,"substr2np"); asir_assert(s,O_N,"substr2np");
+     for ( t = slist; t; t = NEXT(t) ) {
-                 v = VR(p);
+       ps = BDY((LIST)BDY(t)); p = (P)BDY(ps); s = (P)BDY(NEXT(ps));
-                 for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break;
+       asir_assert(p,O_P,"substr2np"); asir_assert(s,O_P,"substr2np");
-                 svect[i] = s;
+       v = VR(p);
-         }
+       for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break;
+       svect[i] = s;
-         switch ( OID(a) ) {
+     }
-                 case O_P:
+   } else if ( ac == 3 ) {
-                         substpp(vl,(P)a,vvect,svect,nv,&nm); *rp = (Obj)nm;
+     asir_assert(ARG2(arg),O_LIST,"substr2np");
-                         return;
+     vlist = BDY((LIST)ARG1(arg));
-                 case O_R:
+     slist = BDY((LIST)ARG2(arg));
-                         substpp(vl,(P)NM((R)a),vvect,svect,nv,&nm);
+     for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj;
-                         substpp(vl,(P)DN((R)a),vvect,svect,nv,&dn);
+       for ( u = vlist, t = slist; u && t; u = NEXT(u), t = NEXT(t) ) {
-                         if ( !dn )
+         v = VR((P)BDY(u));
-                                 error("substr2np: division by 0");
+         for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break;
-                         else if ( NUM(dn) ) {
+         svect[i] = (P)BDY(t);
-                                 divsp(vl,nm,dn,&p);
+       }
-                                 *rp = (Obj)p;
+     } else
-                         } else {
+       error("substr2np : argument mismatch");
-                                 MKRAT(nm,dn,0,r);
+   for ( i = 0; i < nv; i++ ) {
-                                 *rp = (Obj)r;
+     if ( (int)(vvect[i]->attr) == V_PF ) {
-                         }
+       MKV(vvect[i],p);
-                         return;
+       for ( j = 0; j < nv; j++ )
-                 default:
+         if ( j != i ) {
-                         error("substr2np: invalid argument");
+           substr(CO,0,(Obj)p,vvect[j],(Obj)svect[j],&b); p = (P)b;
          }
+       if ( OID(svect[i]) == O_VOID ) svect[i] = p;
+       else if ( arf_comp(CO,(Obj)p,(Obj)svect[i]) )
+         error("substr2np : inconsistent values for substitution");
+     }
+   }
+   switch ( OID(a) ) {
+     case O_P:
+       substpp(CO,(P)a,vvect,svect,nv,&nm); *rp = (Obj)nm;
+       return;
+     case O_R:
+       substpp(CO,(P)NM((R)a),vvect,svect,nv,&nm);
+       substpp(CO,(P)DN((R)a),vvect,svect,nv,&dn);
+       if ( !dn )
+         error("substr2np: division by 0");
+       else if ( !nm )
+         *rp = 0;
+       else if ( NUM(dn) ) {
+         divsp(CO,nm,dn,&p);
+         *rp = (Obj)p;
+       } else {
+         MKRAT(nm,dn,0,r);
+         *rp = (Obj)r;
+       }
+       return;
+     default:
+       error("substr2np: invalid argument");
+   }
  }
  void Psubst(arg,rp)

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