=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/pf.c,v retrieving revision 1.15 retrieving revision 1.23 diff -u -p -r1.15 -r1.23 --- OpenXM_contrib2/asir2000/builtin/pf.c 2008/11/18 20:52:47 1.15 +++ OpenXM_contrib2/asir2000/builtin/pf.c 2018/03/27 06:29:19 1.23 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.14 2008/09/02 17:23:33 ohara Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.22 2015/08/14 13:51:54 fujimoto Exp $ */ #include "ca.h" #include "math.h" @@ -62,6 +62,7 @@ void make_itri(void); void make_tri(void); void make_exp(void); void simplify_pow(PFINS,Obj *); +FNODE partial_eval(FNODE f); void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval(),Pfunargs_ext(); void Pregister_handler(); @@ -89,18 +90,12 @@ struct ftab puref_tab[] = { {0,0,0}, }; -#if defined(PARI) -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(); -#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 +int mp_pi(),mp_e(); +int mp_exp(), mp_log(), mp_pow(); +int mp_sin(),mp_cos(),mp_tan(),mp_asin(),mp_acos(),mp_atan(); +int mp_sinh(),mp_cosh(),mp_tanh(),mp_asinh(),mp_acosh(),mp_atanh(); + static V *uarg,*darg; static P x,y; static PF pidef,edef; @@ -115,6 +110,8 @@ static PF asinhdef,acoshdef,atanhdef; double const_pi() { return 3.14159265358979323846264338327950288; } double const_e() { return 2.718281828459045235360287471352662497; } +int simplify_elemfunc_ins(); + void pf_init() { uarg = (V *)CALLOC(1,sizeof(V)); uarg[0] = &oVAR[26]; MKV(uarg[0],x); @@ -123,33 +120,33 @@ void pf_init() { darg[0] = &oVAR[26]; darg[1] = &oVAR[27]; MKV(darg[1],y); - mkpf("@pi",0,0,0,(int (*)())p_pi,const_pi,0,&pidef); - mkpf("@e",0,0,0,(int (*)())p_e,const_e,0,&edef); + mkpf("@pi",0,0,0,(int (*)())mp_pi,const_pi,simplify_elemfunc_ins,&pidef); + 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("exp",0,1,uarg,(int (*)())p_exp,exp,0,&expdef); - mkpf("pow",0,2,darg,(int (*)())p_pow,pow,(int (*)())simplify_pow,&powdef); + mkpf("log",0,1,uarg,(int (*)())mp_log,log,simplify_elemfunc_ins,&logdef); + mkpf("exp",0,1,uarg,(int (*)())mp_exp,exp,simplify_elemfunc_ins,&expdef); + 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("cos",0,1,uarg,(int (*)())p_cos,cos,0,&cosdef); - mkpf("tan",0,1,uarg,(int (*)())p_tan,tan,0,&tandef); - mkpf("asin",0,1,uarg,(int (*)())p_asin,asin,0,&asindef); - mkpf("acos",0,1,uarg,(int (*)())p_acos,acos,0,&acosdef); - mkpf("atan",0,1,uarg,(int (*)())p_atan,atan,0,&atandef); + mkpf("sin",0,1,uarg,(int (*)())mp_sin,sin,simplify_elemfunc_ins,&sindef); + mkpf("cos",0,1,uarg,(int (*)())mp_cos,cos,simplify_elemfunc_ins,&cosdef); + mkpf("tan",0,1,uarg,(int (*)())mp_tan,tan,simplify_elemfunc_ins,&tandef); + mkpf("asin",0,1,uarg,(int (*)())mp_asin,asin,simplify_elemfunc_ins,&asindef); + mkpf("acos",0,1,uarg,(int (*)())mp_acos,acos,simplify_elemfunc_ins,&acosdef); + 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("cosh",0,1,uarg,(int (*)())p_cosh,cosh,0,&coshdef); - mkpf("tanh",0,1,uarg,(int (*)())p_tanh,tanh,0,&tanhdef); -#if !defined(VISUAL) - mkpf("asinh",0,1,uarg,(int (*)())p_asinh,asinh,0,&asinhdef); - mkpf("acosh",0,1,uarg,(int (*)())p_acosh,acosh,0,&acoshdef); - mkpf("atanh",0,1,uarg,(int (*)())p_atanh,atanh,0,&atanhdef); + mkpf("sinh",0,1,uarg,(int (*)())mp_sinh,sinh,simplify_elemfunc_ins,&sinhdef); + mkpf("cosh",0,1,uarg,(int (*)())mp_cosh,cosh,simplify_elemfunc_ins,&coshdef); + mkpf("tanh",0,1,uarg,(int (*)())mp_tanh,tanh,simplify_elemfunc_ins,&tanhdef); +#if !defined(VISUAL) && !defined(__MINGW32__) + mkpf("asinh",0,1,uarg,(int (*)())mp_asinh,asinh,simplify_elemfunc_ins,&asinhdef); + mkpf("acosh",0,1,uarg,(int (*)())mp_acosh,acosh,simplify_elemfunc_ins,&acoshdef); + mkpf("atanh",0,1,uarg,(int (*)())mp_atanh,atanh,simplify_elemfunc_ins,&atanhdef); #endif make_exp(); make_tri(); make_itri(); make_hyp(); -#if !defined(VISUAL) +#if !defined(VISUAL) && !defined(__MINGW32__) make_ihyp(); #endif } @@ -279,6 +276,8 @@ Obj *r; simplify_ins(ins,r); } +extern int evalef; + void simplify_pow(ins,rp) PFINS ins; Obj *rp; @@ -289,6 +288,10 @@ Obj *rp; V v; P t; + if ( evalef ) { + simplify_elemfunc_ins(ins,rp); + return; + } pf = ins->pf; ad = ins->ad; a0 = ad[0].arg; a1 = ad[1].arg; if ( !a1 ) *rp = (Obj)ONE; @@ -298,12 +301,12 @@ Obj *rp; else if ( RATN(a1) && SGN((Q)a1) < 0 ) error("simplify_pow : division by 0"); else { - instov(ins,&v); MKV(v,t); *rp = (Obj)t; + instoobj(ins,rp); } } else if ( NUM(a1) && INT(a1) ) arf_pwr(CO,a0,a1,rp); else { - instov(ins,&v); MKV(v,t); *rp = (Obj)t; + instoobj(ins,rp); } } @@ -613,7 +616,10 @@ void Pmapat(NODE arg,Obj *rp) int len,row,col,i,j,pos; Obj iter; pointer val; + NODE option; + option = current_option; + if ( argc(arg) < 3 ) error("mapat : too few arguments"); @@ -638,7 +644,7 @@ void Pmapat(NODE arg,Obj *rp) NEXTNODE(r0,r); iter = BDY(t); rest = NEXT(t); if ( !iter ) { - *rp = bevalf(f,node); + *rp = bevalf_with_opts(f,node,option); return; } switch ( OID(iter) ) { @@ -646,7 +652,7 @@ void Pmapat(NODE arg,Obj *rp) v = (VECT)iter; len = v->len; MKVECT(rv,len); for ( i = 0; i < len; i++ ) { 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; break; @@ -655,7 +661,7 @@ void Pmapat(NODE arg,Obj *rp) for ( i = 0; i < row; i++ ) for ( j = 0; j < col; j++ ) { 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; break; @@ -663,7 +669,7 @@ void Pmapat(NODE arg,Obj *rp) n = BDY((LIST)iter); for ( t0 = t = 0; n; n = NEXT(n) ) { 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 ) NEXT(t) = 0; @@ -671,7 +677,7 @@ void Pmapat(NODE arg,Obj *rp) *rp = (Obj)rl; break; default: - *rp = bevalf(f,node); + *rp = bevalf_with_opts(f,node,option); break; } } @@ -690,7 +696,10 @@ void Pmap(NODE arg,Obj *rp) int len,row,col,i,j; Obj iter; pointer val; + NODE option; + option = current_option; + if ( argc(arg) < 2 ) error("mapat : too few arguments"); @@ -707,9 +716,9 @@ void Pmap(NODE arg,Obj *rp) error("evalmapf : invalid position"); r0 = 0; NEXTNODE(r0,r); - iter = BDY(t); rest = NEXT(t); + iter = BDY(node); rest = NEXT(node); if ( !iter ) { - *rp = bevalf(f,node); + *rp = bevalf_with_opts(f,node,option); return; } switch ( OID(iter) ) { @@ -717,7 +726,7 @@ void Pmap(NODE arg,Obj *rp) v = (VECT)iter; len = v->len; MKVECT(rv,len); for ( i = 0; i < len; i++ ) { 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; break; @@ -726,7 +735,7 @@ void Pmap(NODE arg,Obj *rp) for ( i = 0; i < row; i++ ) for ( j = 0; j < col; j++ ) { 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; break; @@ -734,7 +743,7 @@ void Pmap(NODE arg,Obj *rp) n = BDY((LIST)iter); for ( t0 = t = 0; n; n = NEXT(n) ) { 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 ) NEXT(t) = 0; @@ -742,7 +751,7 @@ void Pmap(NODE arg,Obj *rp) *rp = (Obj)rl; break; default: - *rp = bevalf(f,node); + *rp = bevalf_with_opts(f,node,option); break; } }