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

Diff for /OpenXM_contrib2/asir2000/builtin/pf.c between version 1.13 and 1.23

version 1.13, 2008/09/01 07:53:59 version 1.23, 2018/03/27 06:29:19
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/pf.c,v 1.12 2005/10/05 07:38:08 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.22 2015/08/14 13:51:54 fujimoto Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "math.h"  #include "math.h"
Line 62  void make_itri(void);
Line 62  void make_itri(void);
 void make_tri(void);  void make_tri(void);
 void make_exp(void);  void make_exp(void);
 void simplify_pow(PFINS,Obj *);  void simplify_pow(PFINS,Obj *);
   FNODE partial_eval(FNODE f);
   
 void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval(),Pfunargs_ext();  void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval(),Pfunargs_ext();
 void Pregister_handler();  void Pregister_handler();
Line 89  struct ftab puref_tab[] = {
Line 90  struct ftab puref_tab[] = {
         {0,0,0},          {0,0,0},
 };  };
   
 #if defined(PARI)  int mp_pi(),mp_e();
 int p_pi(),p_e();  int mp_exp(), mp_log(), mp_pow();
 int p_log(),p_exp(),p_pow();  int mp_sin(),mp_cos(),mp_tan(),mp_asin(),mp_acos(),mp_atan();
 int p_sin(),p_cos(),p_tan(),p_asin(),p_acos(),p_atan();  int mp_sinh(),mp_cosh(),mp_tanh(),mp_asinh(),mp_acosh(),mp_atanh();
 int p_sinh(),p_cosh(),p_tanh(),p_asinh(),p_acosh(),p_atanh();  
 #else  
 int p_pi,p_e;  
 int p_log,p_exp,p_pow;  
 int p_sin,p_cos,p_tan,p_asin,p_acos,p_atan;  
 int p_sinh,p_cosh,p_tanh,p_asinh,p_acosh,p_atanh;  
 #endif  
   
   
 static V *uarg,*darg;  static V *uarg,*darg;
 static P x,y;  static P x,y;
 static PF pidef,edef;  static PF pidef,edef;
Line 115  static PF asinhdef,acoshdef,atanhdef;
Line 110  static PF asinhdef,acoshdef,atanhdef;
 double const_pi() { return 3.14159265358979323846264338327950288; }  double const_pi() { return 3.14159265358979323846264338327950288; }
 double const_e() { return 2.718281828459045235360287471352662497; }  double const_e() { return 2.718281828459045235360287471352662497; }
   
   int simplify_elemfunc_ins();
   
 void pf_init() {  void pf_init() {
         uarg = (V *)CALLOC(1,sizeof(V));          uarg = (V *)CALLOC(1,sizeof(V));
         uarg[0] = &oVAR[26]; MKV(uarg[0],x);          uarg[0] = &oVAR[26]; MKV(uarg[0],x);
Line 123  void pf_init() {
Line 120  void pf_init() {
         darg[0] = &oVAR[26];          darg[0] = &oVAR[26];
         darg[1] = &oVAR[27]; MKV(darg[1],y);          darg[1] = &oVAR[27]; MKV(darg[1],y);
   
         mkpf("@pi",0,0,0,(int (*)())p_pi,const_pi,0,&pidef);          mkpf("@pi",0,0,0,(int (*)())mp_pi,const_pi,simplify_elemfunc_ins,&pidef);
         mkpf("@e",0,0,0,(int (*)())p_e,const_e,0,&edef);          mkpf("@e",0,0,0,(int (*)())mp_e,const_e,simplify_elemfunc_ins,&edef);
   
         mkpf("log",0,1,uarg,(int (*)())p_log,log,0,&logdef);          mkpf("log",0,1,uarg,(int (*)())mp_log,log,simplify_elemfunc_ins,&logdef);
         mkpf("exp",0,1,uarg,(int (*)())p_exp,exp,0,&expdef);          mkpf("exp",0,1,uarg,(int (*)())mp_exp,exp,simplify_elemfunc_ins,&expdef);
         mkpf("pow",0,2,darg,(int (*)())p_pow,pow,(int (*)())simplify_pow,&powdef);          mkpf("pow",0,2,darg,(int (*)())mp_pow,pow,(int (*)())simplify_pow,&powdef);
   
         mkpf("sin",0,1,uarg,(int (*)())p_sin,sin,0,&sindef);          mkpf("sin",0,1,uarg,(int (*)())mp_sin,sin,simplify_elemfunc_ins,&sindef);
         mkpf("cos",0,1,uarg,(int (*)())p_cos,cos,0,&cosdef);          mkpf("cos",0,1,uarg,(int (*)())mp_cos,cos,simplify_elemfunc_ins,&cosdef);
         mkpf("tan",0,1,uarg,(int (*)())p_tan,tan,0,&tandef);          mkpf("tan",0,1,uarg,(int (*)())mp_tan,tan,simplify_elemfunc_ins,&tandef);
         mkpf("asin",0,1,uarg,(int (*)())p_asin,asin,0,&asindef);          mkpf("asin",0,1,uarg,(int (*)())mp_asin,asin,simplify_elemfunc_ins,&asindef);
         mkpf("acos",0,1,uarg,(int (*)())p_acos,acos,0,&acosdef);          mkpf("acos",0,1,uarg,(int (*)())mp_acos,acos,simplify_elemfunc_ins,&acosdef);
         mkpf("atan",0,1,uarg,(int (*)())p_atan,atan,0,&atandef);          mkpf("atan",0,1,uarg,(int (*)())mp_atan,atan,simplify_elemfunc_ins,&atandef);
   
         mkpf("sinh",0,1,uarg,(int (*)())p_sinh,sinh,0,&sinhdef);          mkpf("sinh",0,1,uarg,(int (*)())mp_sinh,sinh,simplify_elemfunc_ins,&sinhdef);
         mkpf("cosh",0,1,uarg,(int (*)())p_cosh,cosh,0,&coshdef);          mkpf("cosh",0,1,uarg,(int (*)())mp_cosh,cosh,simplify_elemfunc_ins,&coshdef);
         mkpf("tanh",0,1,uarg,(int (*)())p_tanh,tanh,0,&tanhdef);          mkpf("tanh",0,1,uarg,(int (*)())mp_tanh,tanh,simplify_elemfunc_ins,&tanhdef);
 #if !defined(VISUAL)  #if !defined(VISUAL) && !defined(__MINGW32__)
         mkpf("asinh",0,1,uarg,(int (*)())p_asinh,asinh,0,&asinhdef);          mkpf("asinh",0,1,uarg,(int (*)())mp_asinh,asinh,simplify_elemfunc_ins,&asinhdef);
         mkpf("acosh",0,1,uarg,(int (*)())p_acosh,acosh,0,&acoshdef);          mkpf("acosh",0,1,uarg,(int (*)())mp_acosh,acosh,simplify_elemfunc_ins,&acoshdef);
         mkpf("atanh",0,1,uarg,(int (*)())p_atanh,atanh,0,&atanhdef);          mkpf("atanh",0,1,uarg,(int (*)())mp_atanh,atanh,simplify_elemfunc_ins,&atanhdef);
 #endif  #endif
         make_exp();          make_exp();
         make_tri();          make_tri();
         make_itri();          make_itri();
         make_hyp();          make_hyp();
 #if !defined(VISUAL)  #if !defined(VISUAL) && !defined(__MINGW32__)
         make_ihyp();          make_ihyp();
 #endif  #endif
 }  }
Line 279  Obj *r;
Line 276  Obj *r;
         simplify_ins(ins,r);          simplify_ins(ins,r);
 }  }
   
   extern int evalef;
   
 void simplify_pow(ins,rp)  void simplify_pow(ins,rp)
 PFINS ins;  PFINS ins;
 Obj *rp;  Obj *rp;
Line 289  Obj *rp;
Line 288  Obj *rp;
         V v;          V v;
         P t;          P t;
   
           if ( evalef ) {
                   simplify_elemfunc_ins(ins,rp);
                   return;
           }
         pf = ins->pf; ad = ins->ad; a0 = ad[0].arg; a1 = ad[1].arg;          pf = ins->pf; ad = ins->ad; a0 = ad[0].arg; a1 = ad[1].arg;
         if ( !a1 )          if ( !a1 )
                 *rp = (Obj)ONE;                  *rp = (Obj)ONE;
Line 298  Obj *rp;
Line 301  Obj *rp;
                 else if ( RATN(a1) && SGN((Q)a1) < 0 )                  else if ( RATN(a1) && SGN((Q)a1) < 0 )
                         error("simplify_pow : division by 0");                          error("simplify_pow : division by 0");
                 else {                  else {
                         instov(ins,&v); MKV(v,t); *rp = (Obj)t;                          instoobj(ins,rp);
                 }                  }
         } else if ( NUM(a1) && INT(a1) )          } else if ( NUM(a1) && INT(a1) )
                 arf_pwr(CO,a0,a1,rp);                  arf_pwr(CO,a0,a1,rp);
         else {          else {
                 instov(ins,&v); MKV(v,t); *rp = (Obj)t;                  instoobj(ins,rp);
         }          }
 }  }
   
Line 564  void Pcall(NODE arg,Obj *rp)
Line 567  void Pcall(NODE arg,Obj *rp)
 {  {
         P p;          P p;
         V v;          V v;
       NODE n,n1;
       LIST list;
       VECT vect;
       pointer *a;
       int len,i;
   
         p = (P)ARG0(arg);          p = (P)ARG0(arg);
         if ( !p || OID(p) != 2 )          if ( !p || OID(p) != 2 )
Line 571  void Pcall(NODE arg,Obj *rp)
Line 579  void Pcall(NODE arg,Obj *rp)
         v = VR(p);          v = VR(p);
         if ( (int)v->attr != V_SR )          if ( (int)v->attr != V_SR )
                 error("call : no such function");                  error("call : no such function");
           else {
         else          list = (LIST) ARG1(arg);
                 *rp = (Obj)bevalf((FUNC)v->priv,BDY((LIST)ARG1(arg)));          if ( list ) {
               switch (OID(list)) {
               case O_VECT:
                   vect = (VECT)list; len = vect->len; a = BDY(vect);
                   for ( i = len - 1, n = 0; i >= 0; i-- ) {
                       MKNODE(n1,a[i],n); n = n1;
                   }
                   MKLIST(list,n);
                   /* falling next case */
               case O_LIST:
                   *rp = (Obj)bevalf_with_opts((FUNC)v->priv,BDY(list),current_option);
                   return;
               default:
                   break;
               }
           }
           error("call : invalid argument");
           }
 }  }
   
 /* at=position of arg to be used for iteration */  /* at=position of arg to be used for iteration */
Line 591  void Pmapat(NODE arg,Obj *rp)
Line 616  void Pmapat(NODE arg,Obj *rp)
         int len,row,col,i,j,pos;          int len,row,col,i,j,pos;
         Obj iter;          Obj iter;
         pointer val;          pointer val;
           NODE option;
   
           option = current_option;
   
         if ( argc(arg) < 3 )          if ( argc(arg) < 3 )
                 error("mapat : too few arguments");                  error("mapat : too few arguments");
   
Line 616  void Pmapat(NODE arg,Obj *rp)
Line 644  void Pmapat(NODE arg,Obj *rp)
         NEXTNODE(r0,r);          NEXTNODE(r0,r);
         iter = BDY(t); rest = NEXT(t);          iter = BDY(t); rest = NEXT(t);
         if ( !iter ) {          if ( !iter ) {
                 *rp = bevalf(f,node);                  *rp = bevalf_with_opts(f,node,option);
                 return;                  return;
         }          }
         switch ( OID(iter) ) {          switch ( OID(iter) ) {
Line 624  void Pmapat(NODE arg,Obj *rp)
Line 652  void Pmapat(NODE arg,Obj *rp)
                         v = (VECT)iter; len = v->len; MKVECT(rv,len);                          v = (VECT)iter; len = v->len; MKVECT(rv,len);
                         for ( i = 0; i < len; i++ ) {                          for ( i = 0; i < len; i++ ) {
                                 BDY(r) = BDY(v)[i]; NEXT(r) = rest;                                  BDY(r) = BDY(v)[i]; NEXT(r) = rest;
                                 BDY(rv)[i] = bevalf(f,r0);                                  BDY(rv)[i] = bevalf_with_opts(f,r0,option);
                         }                          }
                         *rp = (Obj)rv;                          *rp = (Obj)rv;
                         break;                          break;
Line 633  void Pmapat(NODE arg,Obj *rp)
Line 661  void Pmapat(NODE arg,Obj *rp)
                         for ( i = 0; i < row; i++ )                          for ( i = 0; i < row; i++ )
                                 for ( j = 0; j < col; j++ ) {                                  for ( j = 0; j < col; j++ ) {
                                         BDY(r) = BDY(m)[i][j]; NEXT(r) = rest;                                          BDY(r) = BDY(m)[i][j]; NEXT(r) = rest;
                                         BDY(rm)[i][j] = bevalf(f,r0);                                          BDY(rm)[i][j] = bevalf_with_opts(f,r0,option);
                                 }                                  }
                         *rp = (Obj)rm;                          *rp = (Obj)rm;
                         break;                          break;
Line 641  void Pmapat(NODE arg,Obj *rp)
Line 669  void Pmapat(NODE arg,Obj *rp)
                         n = BDY((LIST)iter);                          n = BDY((LIST)iter);
                         for ( t0 = t = 0; n; n = NEXT(n) ) {                          for ( t0 = t = 0; n; n = NEXT(n) ) {
                                 BDY(r) = BDY(n); NEXT(r) = rest;                                  BDY(r) = BDY(n); NEXT(r) = rest;
                                 NEXTNODE(t0,t); BDY(t) = bevalf(f,r0);                                  NEXTNODE(t0,t); BDY(t) = bevalf_with_opts(f,r0,option);
                         }                          }
                         if ( t0 )                          if ( t0 )
                                 NEXT(t) = 0;                                  NEXT(t) = 0;
Line 649  void Pmapat(NODE arg,Obj *rp)
Line 677  void Pmapat(NODE arg,Obj *rp)
                         *rp = (Obj)rl;                          *rp = (Obj)rl;
                         break;                          break;
                 default:                  default:
                         *rp = bevalf(f,node);                          *rp = bevalf_with_opts(f,node,option);
                         break;                          break;
         }          }
 }  }
Line 668  void Pmap(NODE arg,Obj *rp)
Line 696  void Pmap(NODE arg,Obj *rp)
         int len,row,col,i,j;          int len,row,col,i,j;
         Obj iter;          Obj iter;
         pointer val;          pointer val;
           NODE option;
   
           option = current_option;
   
         if ( argc(arg) < 2 )          if ( argc(arg) < 2 )
                 error("mapat : too few arguments");                  error("mapat : too few arguments");
   
Line 685  void Pmap(NODE arg,Obj *rp)
Line 716  void Pmap(NODE arg,Obj *rp)
                 error("evalmapf : invalid position");                  error("evalmapf : invalid position");
         r0 = 0;          r0 = 0;
         NEXTNODE(r0,r);          NEXTNODE(r0,r);
         iter = BDY(t); rest = NEXT(t);          iter = BDY(node); rest = NEXT(node);
         if ( !iter ) {          if ( !iter ) {
                 *rp = bevalf(f,node);                  *rp = bevalf_with_opts(f,node,option);
                 return;                  return;
         }          }
         switch ( OID(iter) ) {          switch ( OID(iter) ) {
Line 695  void Pmap(NODE arg,Obj *rp)
Line 726  void Pmap(NODE arg,Obj *rp)
                         v = (VECT)iter; len = v->len; MKVECT(rv,len);                          v = (VECT)iter; len = v->len; MKVECT(rv,len);
                         for ( i = 0; i < len; i++ ) {                          for ( i = 0; i < len; i++ ) {
                                 BDY(r) = BDY(v)[i]; NEXT(r) = rest;                                  BDY(r) = BDY(v)[i]; NEXT(r) = rest;
                                 BDY(rv)[i] = bevalf(f,r0);                                  BDY(rv)[i] = bevalf_with_opts(f,r0,option);
                         }                          }
                         *rp = (Obj)rv;                          *rp = (Obj)rv;
                         break;                          break;
Line 704  void Pmap(NODE arg,Obj *rp)
Line 735  void Pmap(NODE arg,Obj *rp)
                         for ( i = 0; i < row; i++ )                          for ( i = 0; i < row; i++ )
                                 for ( j = 0; j < col; j++ ) {                                  for ( j = 0; j < col; j++ ) {
                                         BDY(r) = BDY(m)[i][j]; NEXT(r) = rest;                                          BDY(r) = BDY(m)[i][j]; NEXT(r) = rest;
                                         BDY(rm)[i][j] = bevalf(f,r0);                                          BDY(rm)[i][j] = bevalf_with_opts(f,r0,option);
                                 }                                  }
                         *rp = (Obj)rm;                          *rp = (Obj)rm;
                         break;                          break;
Line 712  void Pmap(NODE arg,Obj *rp)
Line 743  void Pmap(NODE arg,Obj *rp)
                         n = BDY((LIST)iter);                          n = BDY((LIST)iter);
                         for ( t0 = t = 0; n; n = NEXT(n) ) {                          for ( t0 = t = 0; n; n = NEXT(n) ) {
                                 BDY(r) = BDY(n); NEXT(r) = rest;                                  BDY(r) = BDY(n); NEXT(r) = rest;
                                 NEXTNODE(t0,t); BDY(t) = bevalf(f,r0);                                  NEXTNODE(t0,t); BDY(t) = bevalf_with_opts(f,r0,option);
                         }                          }
                         if ( t0 )                          if ( t0 )
                                 NEXT(t) = 0;                                  NEXT(t) = 0;
Line 720  void Pmap(NODE arg,Obj *rp)
Line 751  void Pmap(NODE arg,Obj *rp)
                         *rp = (Obj)rl;                          *rp = (Obj)rl;
                         break;                          break;
                 default:                  default:
                         *rp = bevalf(f,node);                          *rp = bevalf_with_opts(f,node,option);
                         break;                          break;
         }          }
 }  }

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.23

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