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

Diff for /OpenXM_contrib2/asir2000/parse/puref.c between version 1.1 and 1.14

version 1.1, 1999/12/03 07:39:12 version 1.14, 2018/03/28 05:27:22
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir99/parse/puref.c,v 1.1.1.1 1999/11/10 08:12:34 noro Exp $ */  /*
    * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
    * All rights reserved.
    *
    * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
    * non-exclusive and royalty-free license to use, copy, modify and
    * redistribute, solely for non-commercial and non-profit purposes, the
    * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
    * conditions of this Agreement. For the avoidance of doubt, you acquire
    * only a limited right to use the SOFTWARE hereunder, and FLL or any
    * third party developer retains all rights, including but not limited to
    * copyrights, in and to the SOFTWARE.
    *
    * (1) FLL does not grant you a license in any way for commercial
    * purposes. You may use the SOFTWARE only for non-commercial and
    * non-profit purposes only, such as academic, research and internal
    * business use.
    * (2) The SOFTWARE is protected by the Copyright Law of Japan and
    * international copyright treaties. If you make copies of the SOFTWARE,
    * with or without modification, as permitted hereunder, you shall affix
    * to all such copies of the SOFTWARE the above copyright notice.
    * (3) An explicit reference to this SOFTWARE and its copyright owner
    * shall be made on your publication or presentation in any form of the
    * results obtained by use of the SOFTWARE.
    * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
    * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
    * for such modification or the source code of the modified part of the
    * SOFTWARE.
    *
    * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
    * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
    * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
    * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
    * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
    * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
    * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
    * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
    * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
    * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
    * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
    * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
    * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
    * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
    * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
    * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
    * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
    *
    * $OpenXM: OpenXM_contrib2/asir2000/parse/puref.c,v 1.13 2018/03/27 06:29:19 noro Exp $
   */
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
   
   void instoobj(PFINS ins,Obj *rp);
   
 NODE pflist;  NODE pflist;
   
 void searchpf(name,fp)  void searchpf(char *name,FUNC *fp)
 char *name;  
 FUNC *fp;  
 {  {
         NODE node;          NODE node;
         PF pf;          PF pf;
Line 17  FUNC *fp;
Line 65  FUNC *fp;
                         pf = (PF)node->body;                          pf = (PF)node->body;
                         *fp = t = (FUNC)MALLOC(sizeof(struct oFUNC));                          *fp = t = (FUNC)MALLOC(sizeof(struct oFUNC));
                         t->name = name; t->id = A_PURE; t->argc = pf->argc;                          t->name = name; t->id = A_PURE; t->argc = pf->argc;
                         t->f.puref = pf;                          t->f.puref = pf; t->fullname = name;
                         return;                          return;
                 }                  }
         *fp = 0;          *fp = 0;
 }  }
   
 void searchc(name,fp)  void searchc(char *name,FUNC *fp)
 char *name;  
 FUNC *fp;  
 {  {
         NODE node;          NODE node;
         PF pf;          PF pf;
Line 37  FUNC *fp;
Line 83  FUNC *fp;
                         pf = (PF)node->body;                          pf = (PF)node->body;
                         *fp = t = (FUNC)MALLOC(sizeof(struct oFUNC));                          *fp = t = (FUNC)MALLOC(sizeof(struct oFUNC));
                         t->name = name; t->id = A_PURE; t->argc = pf->argc;                          t->name = name; t->id = A_PURE; t->argc = pf->argc;
                         t->f.puref = pf;                          t->f.puref = pf; t->fullname = name;
                         return;                          return;
                 }                  }
         *fp = 0;          *fp = 0;
 }  }
   
 void mkpf(name,body,argc,args,parif,libmf,simp,pfp)  void mkpf(char *name,Obj body,int argc,V *args,
 char *name;          int (*parif)(),double (*libmf)(), int (*simp)(),PF *pfp)
 Obj body;  
 int argc;  
 V *args;  
 int (*parif)(),(*simp)();  
 double (*libmf)();  
 PF *pfp;  
 {  {
         PF pf;          PF pf;
         NODE node;          NODE node;
Line 75  PF *pfp;
Line 115  PF *pfp;
    each arg.     each arg.
  */   */
   
 void mkpfins(pf,args,vp)  void mkpfins(PF pf,V *args,V *vp)
 PF pf;  
 V *args;  
 V *vp;  
 {  {
         V v;          V v;
         PFINS ins;          PFINS ins;
Line 99  V *vp;
Line 136  V *vp;
   
 /* the same as above. Argements are given as an array of Obj */  /* the same as above. Argements are given as an array of Obj */
   
 void _mkpfins(pf,args,vp)  void _mkpfins(PF pf,Obj *args,V *vp)
 PF pf;  
 Obj *args;  
 V *vp;  
 {  {
         V v;          V v;
         PFINS ins;          PFINS ins;
Line 122  V *vp;
Line 156  V *vp;
   
 /* the same as above. darray is also given */  /* the same as above. darray is also given */
   
 void _mkpfins_with_darray(pf,args,darray,vp)  void _mkpfins_with_darray(PF pf,Obj *args,int *darray,V *vp)
 PF pf;  
 Obj *args;  
 int *darray;  
 V *vp;  
 {  {
         V v;          V v;
         PFINS ins;          PFINS ins;
Line 144  V *vp;
Line 174  V *vp;
         appendpfins(v,vp);          appendpfins(v,vp);
 }  }
   
 void appendpfins(v,vp)  void appendpfins(V v,V *vp)
 V v;  
 V *vp;  
 {  {
         PF fdef;          PF fdef;
         PFAD ad,tad;          PFAD ad,tad;
Line 157  V *vp;
Line 185  V *vp;
         for ( node = fdef->ins; node; node = NEXT(node) ) {          for ( node = fdef->ins; node; node = NEXT(node) ) {
                 for ( i = 0, tad = ((PFINS)((V)node->body)->priv)->ad;                  for ( i = 0, tad = ((PFINS)((V)node->body)->priv)->ad;
                         i < fdef->argc; i++ )                          i < fdef->argc; i++ )
                         if ( (ad[i].d != tad[i].d) || compr(CO,ad[i].arg,tad[i].arg) )                          if ( (ad[i].d != tad[i].d) || !equalr(CO,ad[i].arg,tad[i].arg) )
                                 break;                                  break;
                 if ( i == fdef->argc ) {                  if ( i == fdef->argc ) {
                         *vp = (V)node->body;                          *vp = (V)node->body;
Line 168  V *vp;
Line 196  V *vp;
         fdef->ins = node; appendvar(CO,v); *vp = v;          fdef->ins = node; appendvar(CO,v); *vp = v;
 }  }
   
 void duppfins(v,vp)  void duppfins(V v,V *vp)
 V v;  
 V *vp;  
 {  {
         V tv;          V tv;
         PFINS tins;          PFINS tins;
Line 183  V *vp;
Line 209  V *vp;
         *vp = tv;          *vp = tv;
 }  }
   
 void derivvar(vl,pf,v,a)  void derivvar(VL vl,V pf,V v,Obj *a)
 VL vl;  
 V pf,v;  
 Obj *a;  
 {  {
         Obj t,s,u,w,u1;          Obj t,s,u,w,u1;
         P p;          P p;
Line 216  Obj *a;
Line 239  Obj *a;
         }          }
 }  }
   
 void derivr(vl,a,v,b)  void derivr(VL vl,Obj a,V v,Obj *b)
 VL vl;  
 V v;  
 Obj a,*b;  
 {  {
         VL tvl,svl;          VL tvl,svl;
         Obj r,s,t,u,nm,dn,dnm,ddn,m;          Obj r,s,t,u,nm,dn,dnm,ddn,m;
Line 266  Obj a,*b;
Line 286  Obj a,*b;
         }          }
 }  }
   
 void substr(vl,partial,a,v,b,c)  void simple_derivr(VL vl,Obj a,V v,Obj *b)
 VL vl;  
 int partial;  
 Obj a;  
 V v;  
 Obj b;  
 Obj *c;  
 {  {
           Obj r,s,t,u,nm,dn;
   
           if ( !a || NUM(a) )
                   *b = 0;
           else
                   switch ( OID(a) ) {
                           case O_P:
                                   pderivr(vl,a,v,b); break;
                           case O_R:
                                   nm = (Obj)NM((R)a); dn = (Obj)DN((R)a);
                                   /* (nm/dn)' = nm'/dn - dn'/dn*nm/dn */
                                   pderivr(vl,nm,v,&s); divr(vl,s,dn,&u); reductr(vl,u,&t);
                                   pderivr(vl,dn,v,&s); divr(vl,s,dn,&u); reductr(vl,u,&s); mulr(vl,s,a,&u);
                                   subr(vl,t,u,&s); reductr(vl,s,b);
                                   break;
                           default:
                                   error("simple_derivr : invalid argument");
           }
   }
   
   int obj_is_dependent(Obj a,V v)
   {
           if ( !a || OID(a) <= O_N ) return 0;
           else if ( OID(a) == O_P ) return poly_is_dependent((P)a,v);
           else if ( OID(a) == O_R ) return poly_is_dependent(NM((R)a),v)
                   || poly_is_dependent(DN((R)a),v);
           else
                   error("obj_is_dependent : not implemented");
   }
   
   int poly_is_dependent(P p,V v)
   {
           DCP dc;
   
           if ( !p || OID(p) <= O_N ) return 0;
           else if ( v == VR(p) ) return 1;
           else {
                   for ( dc = DC(p); dc; dc = NEXT(dc) )
                           if ( poly_is_dependent(COEF(dc),v) ) return 1;
                   return 0;
           }
   }
   
   void gen_pwrr(VL vl,Obj a,Obj d,Obj *r)
   {
           if ( INT(d) )
                   pwrr(vl,a,d,r);
           else
                   mkpow(vl,a,d,r);
   }
   
   void substr(VL vl,int partial,Obj a,V v,Obj b,Obj *c)
   {
         Obj nm,dn,t;          Obj nm,dn,t;
   
         if ( !a )          if ( !a )
Line 295  Obj *c;
Line 362  Obj *c;
         }          }
 }  }
   
 void substpr(vl,partial,p,v0,p0,pr)  void substpr(VL vl,int partial,Obj p,V v0,Obj p0,Obj *pr)
 VL vl;  
 int partial;  
 V v0;  
 Obj p;  
 Obj p0;  
 Obj *pr;  
 {  {
         P x;          P x;
         Obj t,m,c,s,a;          Obj t,m,c,s,a;
Line 332  Obj *pr;
Line 393  Obj *pr;
                 for ( c = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {                  for ( c = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
                         substpr(vl,partial,(Obj)COEF(dc),v0,p0,&t);                          substpr(vl,partial,(Obj)COEF(dc),v0,p0,&t);
                         if ( DEG(dc) ) {                          if ( DEG(dc) ) {
                                 pwrp(vl,x,DEG(dc),(P *)&s); mulr(vl,s,t,&m);                                  gen_pwrr(vl,(Obj)x,(Obj)DEG(dc),&s);
                                   mulr(vl,s,t,&m);
                                 addr(vl,m,c,&a); c = a;                                  addr(vl,m,c,&a); c = a;
                         } else {                          } else {
                                 addr(vl,t,c,&a); c = a;                                  addr(vl,t,c,&a); c = a;
Line 346  Obj *pr;
Line 408  Obj *pr;
                 else                  else
                         c = (Obj)COEF(dc);                          c = (Obj)COEF(dc);
                 for ( d = DEG(dc), dc = NEXT(dc); dc; d = DEG(dc), dc = NEXT(dc) ) {                  for ( d = DEG(dc), dc = NEXT(dc); dc; d = DEG(dc), dc = NEXT(dc) ) {
                                 subq(d,DEG(dc),(Q *)&t); pwrr(vl,p0,t,&s); mulr(vl,s,c,&m);                                  subq(d,DEG(dc),(Q *)&t);
                                   gen_pwrr(vl,p0,t,&s); mulr(vl,s,c,&m);
                                 if ( !partial )                                  if ( !partial )
                                         substpr(vl,partial,(Obj)COEF(dc),v0,p0,&t);                                          substpr(vl,partial,(Obj)COEF(dc),v0,p0,&t);
                                 else                                  else
Line 354  Obj *pr;
Line 417  Obj *pr;
                                 addr(vl,m,t,&c);                                  addr(vl,m,t,&c);
                 }                  }
                 if ( d ) {                  if ( d ) {
                         pwrr(vl,p0,(Obj)d,&t); mulr(vl,t,c,&m);                          gen_pwrr(vl,p0,(Obj)d,&t);
                           mulr(vl,t,c,&m);
                         c = m;                          c = m;
                 }                  }
                 *pr = c;                  *pr = c;
         }          }
 }  }
   
 void evalr(vl,a,prec,c)  void evalr(VL vl,Obj a,int prec,Obj *c)
 VL vl;  
 Obj a;  
 int prec;  
 Obj *c;  
 {  {
         Obj nm,dn;          Obj nm,dn;
   
Line 387  Obj *c;
Line 447  Obj *c;
         }          }
 }  }
   
 void evalp(vl,p,prec,pr)  void evalp(VL vl,P p,int prec,P *pr)
 VL vl;  
 P p;  
 int prec;  
 P *pr;  
 {  {
         P t;          P t;
         DCP dc,dcr0,dcr;          DCP dc,dcr0,dcr;
Line 419  P *pr;
Line 475  P *pr;
         }          }
 }  }
   
 void evalv(vl,v,prec,rp)  void evalv(VL vl,V v,int prec,Obj *rp)
 VL vl;  
 V v;  
 int prec;  
 Obj *rp;  
 {  {
         PFINS ins,tins;          PFINS ins,tins;
         PFAD ad,tad;          PFAD ad,tad;
Line 444  Obj *rp;
Line 496  Obj *rp;
         }          }
 }  }
   
 void evalins(ins,prec,rp)  void evalins(PFINS ins,int prec,Obj *rp)
 PFINS ins;  
 int prec;  
 Obj *rp;  
 {  {
         PF pf;          PF pf;
         PFAD ad;          PFINS tins;
           PFAD ad,tad;
         int i;          int i;
         Q q;          Q q;
         V v;          V v;
Line 458  Obj *rp;
Line 508  Obj *rp;
         NODE n0,n;          NODE n0,n;
   
         pf = ins->pf; ad = ins->ad;          pf = ins->pf; ad = ins->ad;
           tins = (PFINS)CALLOC(1,sizeof(PF)+pf->argc*sizeof(struct oPFAD));
           tins->pf = pf; tad = tins->ad;
           for ( i = 0; i < pf->argc; i++ ) {
                   tad[i].d = ad[i].d; evalr(CO,ad[i].arg,prec,&tad[i].arg);
           }
         for ( i = 0; i < pf->argc; i++ )          for ( i = 0; i < pf->argc; i++ )
                 if ( ad[i].d || (ad[i].arg && !NUM(ad[i].arg)) )                  if ( tad[i].d || (tad[i].arg && !NUM(tad[i].arg)) ) break;
                         break;  
         if ( (i != pf->argc) || !pf->pari ) {          if ( (i != pf->argc) || !pf->pari ) {
                 instov(ins,&v); MKV(v,x); *rp = (Obj)x;                  instoobj(tins,rp);
         } else {          } else {
                 for ( n0 = 0, i = 0; i < pf->argc; i++ ) {                  for ( n0 = 0, i = 0; i < pf->argc; i++ ) {
                         NEXTNODE(n0,n); BDY(n) = (pointer)ad[i].arg;                          NEXTNODE(n0,n); BDY(n) = (pointer)tad[i].arg;
                 }                  }
                 if ( prec ) {                  if ( prec ) {
                         NEXTNODE(n0,n); STOQ(prec,q); BDY(n) = (pointer)q;                          NEXTNODE(n0,n); STOQ(prec,q); BDY(n) = (pointer)q;
Line 476  Obj *rp;
Line 530  Obj *rp;
         }          }
 }  }
   
 void devalins(PFINS,Obj *);  void devalr(VL vl,Obj a,Obj *c)
 void devalv(VL,V,Obj *);  
 void devalp(VL,P,P *);  
 void devalr(VL,Obj,Obj *);  
   
 void devalr(vl,a,c)  
 VL vl;  
 Obj a;  
 Obj *c;  
 {  {
         Obj nm,dn;          Obj nm,dn;
         double d;          double d;
         Real r;          Real r,re,im;
           C z;
           int nid;
   
         if ( !a )          if ( !a )
                 *c = 0;                  *c = 0;
         else {          else {
                 switch ( OID(a) ) {                  switch ( OID(a) ) {
                         case O_N:                          case O_N:
                                 d = ToReal(a);                                  nid = NID((Num)a);
                                 MKReal(d,r);                                  if ( nid == N_C ) {
                                 *c = (Obj)r;                                    d = ToReal(((C)a)->r); MKReal(d,re);
                                     d = ToReal(((C)a)->i); MKReal(d,im);
                                     reimtocplx(re,im,&z);
                                     *c = (Obj)z;
                                   } else if ( nid == N_Q || nid == N_R || nid == N_B ) {
                                     d = ToReal(a);
                                     MKReal(d,r);
                                     *c = (Obj)r;
                                   } else
                                     error("devalr : unsupported");
                                 break;                                  break;
                         case O_P:                          case O_P:
                                 devalp(vl,(P)a,(P *)c); break;                                  devalp(vl,(P)a,(P *)c); break;
Line 512  Obj *c;
Line 569  Obj *c;
         }          }
 }  }
   
 void devalp(vl,p,pr)  void devalp(VL vl,P p,P *pr)
 VL vl;  
 P p;  
 P *pr;  
 {  {
         P t;          P t;
         DCP dc,dcr0,dcr;          DCP dc,dcr0,dcr;
Line 558  P *pr;
Line 612  P *pr;
         }          }
 }  }
   
 void devalv(vl,v,rp)  void devalv(VL vl,V v,Obj *rp)
 VL vl;  
 V v;  
 Obj *rp;  
 {  {
         PFINS ins,tins;          PFINS ins,tins;
         PFAD ad,tad;          PFAD ad,tad;
         PF pf;          PF pf;
         P t;          P t;
         Obj s;  
         int i;          int i;
   
         if ( (vid)v->attr != V_PF ) {          if ( (vid)v->attr != V_PF ) {
Line 583  Obj *rp;
Line 633  Obj *rp;
         }          }
 }  }
   
 void devalins(ins,rp)  void devalins(PFINS ins,Obj *rp)
 PFINS ins;  
 Obj *rp;  
 {  {
           PFINS tins;
         PF pf;          PF pf;
         PFAD ad;          PFAD ad,tad;
         int i;          int i;
         Real r;          Real r;
         double d;          double d;
         Q q;  
         V v;          V v;
         P x;          P x;
   
         pf = ins->pf; ad = ins->ad;          pf = ins->pf; ad = ins->ad;
           tins = (PFINS)CALLOC(1,sizeof(PF)+pf->argc*sizeof(struct oPFAD));
           tins->pf = pf; tad = tins->ad;
           for ( i = 0; i < pf->argc; i++ ) {
                   tad[i].d = ad[i].d; devalr(CO,ad[i].arg,&tad[i].arg);
           }
         for ( i = 0; i < pf->argc; i++ )          for ( i = 0; i < pf->argc; i++ )
                 if ( ad[i].d || (ad[i].arg && !NUM(ad[i].arg)) )                  if ( tad[i].d || (tad[i].arg && !NUM(tad[i].arg)) ) break;
                         break;  
         if ( (i != pf->argc) || !pf->libm ) {          if ( (i != pf->argc) || !pf->libm ) {
                 instov(ins,&v); MKV(v,x); *rp = (Obj)x;                  instoobj(tins,rp);
         } else {          } else {
                   for ( i = 0; i < pf->argc; i++ )
                           if ( tad[i].arg && NID((Num)tad[i].arg) == N_C )
                                   error("devalins : not supported");
                 switch ( pf->argc ) {                  switch ( pf->argc ) {
                         case 0:                          case 0:
                                 d = (*pf->libm)(); break;                                  d = (*pf->libm)(); break;
                         case 1:                          case 1:
                                 d = (*pf->libm)(ToReal(ad[0].arg)); break;                                  d = (*pf->libm)(ToReal(tad[0].arg)); break;
                         case 2:                          case 2:
                                 d = (*pf->libm)(ToReal(ad[0].arg),ToReal(ad[1].arg)); break;                                  d = (*pf->libm)(ToReal(tad[0].arg),ToReal(tad[1].arg)); break;
                         case 3:                          case 3:
                                 d = (*pf->libm)(ToReal(ad[0].arg),ToReal(ad[1].arg),                                  d = (*pf->libm)(ToReal(tad[0].arg),ToReal(tad[1].arg),
                                         ToReal(ad[2].arg)); break;                                          ToReal(tad[2].arg)); break;
                         case 4:                          case 4:
                                 d = (*pf->libm)(ToReal(ad[0].arg),ToReal(ad[1].arg),                                  d = (*pf->libm)(ToReal(tad[0].arg),ToReal(tad[1].arg),
                                         ToReal(ad[2].arg),ToReal(ad[3].arg)); break;                                          ToReal(tad[2].arg),ToReal(tad[3].arg)); break;
                         default:                          default:
                                 error("devalv : not supported");                                  error("devalins : not supported");
                 }                  }
                 MKReal(d,r); *rp = (Obj)r;                  MKReal(d,r); *rp = (Obj)r;
         }          }
 }  }
   
 void simplify_ins(ins,rp)  extern int evalef,bigfloat;
 PFINS ins;  
 Obj *rp;  void simplify_elemfunc_ins(PFINS ins,Obj *rp)
 {  {
     if ( evalef ) {
       if ( bigfloat ) evalins(ins,0,rp);
       else devalins(ins,rp);
     } else instoobj(ins,rp);
   }
   
   void simplify_factorial_ins(PFINS ins,Obj *rp)
   {
     PFAD ad;
     Obj a;
     Q q;
   
     ad = ins->ad;
     a = ad[0].arg;
     if ( !ad[0].d && INT(a) && ( !a || (PL(NM((Q)a)) == 1 && SGN((Q)a) > 0) ) ) {
       factorial(QTOS((Q)a),&q);
       *rp = (Obj)q;
     } else simplify_elemfunc_ins(ins,rp);
   }
   
   void simplify_abs_ins(PFINS ins,Obj *rp)
   {
     PFAD ad;
     Obj a;
     Q q;
     double t;
     Real r;
     struct oNODE arg0;
   
     ad = ins->ad;
     a = ad[0].arg;
     if ( !ad[0].d && NUM(a) && (!a || RATN(a)) ) {
       if ( !a || SGN((Q)a) > 0 ) *rp = (Obj)a;
       else {
         chsgnq((Q)a,&q); *rp = (Obj)q;
       }
     } else if ( !ad[0].d && REAL(a) ) {
       t = fabs(((Real)a)->body);
       MKReal(t,r); *rp = (Obj)r;
     } else if ( !ad[0].d && BIGFLOAT(a) ) {
       arg0.body = (pointer)a; arg0.next = 0;
       mp_abs(&arg0,rp);
     } else simplify_elemfunc_ins(ins,rp);
   }
   
   void simplify_ins(PFINS ins,Obj *rp)
   {
         V v;          V v;
         P t;          P t;
   
         if ( ins->pf->simplify )          if ( ins->pf->simplify )
                 (*ins->pf->simplify)(ins,rp);                  (*ins->pf->simplify)(ins,rp);
         else {          else {
                 instov(ins,&v); MKV(v,t); *rp = (Obj)t;                  instoobj(ins,rp);
         }          }
 }  }
   
 void instov(ins,vp)  void instoobj(PFINS ins,Obj *rp)
 PFINS ins;  
 V *vp;  
 {  {
         V v;          V v,newv;
           P t;
   
         NEWV(v); NAME(v) = 0;          NEWV(v); NAME(v) = 0;
         v->attr = (pointer)V_PF; v->priv = (pointer)ins;          v->attr = (pointer)V_PF; v->priv = (pointer)ins;
         appendpfins(v,vp);          appendpfins(v,&newv);
           MKV(newv,t);
           *rp = (Obj)t;
 }  }
   
 void substfr(vl,a,u,f,c)  void substfr(VL vl,Obj a,PF u,PF f,Obj *c)
 VL vl;  
 Obj a;  
 PF u,f;  
 Obj *c;  
 {  {
         Obj nm,dn;          Obj nm,dn;
   
Line 674  Obj *c;
Line 773  Obj *c;
         }          }
 }  }
   
 void substfp(vl,p,u,f,pr)  void substfp(VL vl,Obj p,PF u,PF f,Obj *pr)
 VL vl;  
 Obj p;  
 PF u,f;  
 Obj *pr;  
 {  {
         V v;          V v;
         DCP dc;          DCP dc;
Line 697  Obj *pr;
Line 792  Obj *pr;
                         for ( c = 0; dc; dc = NEXT(dc) ) {                          for ( c = 0; dc; dc = NEXT(dc) ) {
                                 substfp(vl,(Obj)COEF(dc),u,f,&t);                                  substfp(vl,(Obj)COEF(dc),u,f,&t);
                                 if ( DEG(dc) ) {                                  if ( DEG(dc) ) {
                                         pwrp(vl,x,DEG(dc),(P *)&s); mulr(vl,s,t,&m);                                          gen_pwrr(vl,(Obj)x,(Obj)DEG(dc),&s);
                                           mulr(vl,s,t,&m);
                                         addr(vl,m,c,&a); c = a;                                          addr(vl,m,c,&a); c = a;
                                 } else {                                  } else {
                                         addr(vl,t,c,&a); c = a;                                          addr(vl,t,c,&a); c = a;
Line 707  Obj *pr;
Line 803  Obj *pr;
                         substfv(vl,v,u,f,&p0);                          substfv(vl,v,u,f,&p0);
                         substfp(vl,(Obj)COEF(dc),u,f,&c);                          substfp(vl,(Obj)COEF(dc),u,f,&c);
                         for ( d = DEG(dc), dc = NEXT(dc); dc; d = DEG(dc), dc = NEXT(dc) ) {                          for ( d = DEG(dc), dc = NEXT(dc); dc; d = DEG(dc), dc = NEXT(dc) ) {
                                         subq(d,DEG(dc),(Q *)&t); pwrr(vl,p0,t,&s); mulr(vl,s,c,&m);                                          subq(d,DEG(dc),(Q *)&t);
                                           gen_pwrr(vl,p0,t,&s); mulr(vl,s,c,&m);
                                         substfp(vl,(Obj)COEF(dc),u,f,&t); addr(vl,m,t,&c);                                          substfp(vl,(Obj)COEF(dc),u,f,&t); addr(vl,m,t,&c);
                         }                          }
                         if ( d ) {                          if ( d ) {
                                 pwrr(vl,p0,(Obj)d,&t); mulr(vl,t,c,&m);                                  gen_pwrr(vl,p0,(Obj)d,&t); mulr(vl,t,c,&m);
                                 c = m;                                  c = m;
                         }                          }
                 }                  }
Line 719  Obj *pr;
Line 816  Obj *pr;
         }          }
 }  }
   
 void substfv(vl,v,u,f,c)  void substfv(VL vl,V v,PF u,PF f,Obj *c)
 VL vl;  
 V v;  
 PF u,f;  
 Obj *c;  
 {  {
         P t;          P t;
         Obj r,s,w;          Obj r,s,w;
Line 754  Obj *c;
Line 847  Obj *c;
                 for ( i = 0; i < f->argc; i++ ) {                  for ( i = 0; i < f->argc; i++ ) {
                         tad[i].d = ad[i].d; substfr(vl,ad[i].arg,u,f,&tad[i].arg);                          tad[i].d = ad[i].d; substfr(vl,ad[i].arg,u,f,&tad[i].arg);
                 }                  }
                 instov(tins,&v); MKV(v,t); *c = (Obj)t;                  instoobj(tins,c);
         }          }
 }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.14
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>