===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/bfaux.c,v
retrieving revision 1.13
retrieving revision 1.16
diff -u -p -r1.13 -r1.16
--- OpenXM_contrib2/asir2000/builtin/bfaux.c	2017/03/09 00:46:44	1.13
+++ OpenXM_contrib2/asir2000/builtin/bfaux.c	2018/03/28 05:27:22	1.16
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.12 2016/03/14 04:15:05 noro Exp $ */
+/* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.15 2017/08/31 04:21:48 noro Exp $ */
 #include "ca.h"
 #include "parse.h"
 
@@ -11,6 +11,10 @@ void Pmpfr_y0(), Pmpfr_y1();
 void Pmpfr_gamma(), Pmpfr_lngamma(), Pmpfr_digamma();
 void Pmpfr_floor(), Pmpfr_round(), Pmpfr_ceil();
 void Prk_ratmat();
+void mp_sin(),mp_cos(),mp_tan(),mp_asin(),mp_acos(),mp_atan();
+void mp_sinh(),mp_cosh(),mp_tanh(),mp_asinh(),mp_acosh(),mp_atanh();
+void mp_exp(),mp_log(),mp_pow();
+void mp_factorial(),mp_abs();
 
 struct ftab bf_tab[] = {
 	{"eval",Peval,-2},
@@ -18,6 +22,21 @@ struct ftab bf_tab[] = {
 	{"setbprec",Psetbprec,-1},
 	{"setround",Psetround,-1},
 	{"todouble",Ptodouble,1},
+	{"mpfr_sin",mp_sin,-2},
+	{"mpfr_cos",mp_cos,-2},
+	{"mpfr_tan",mp_tan,-2},
+	{"mpfr_asin",mp_asin,-2},
+	{"mpfr_acos",mp_acos,-2},
+	{"mpfr_atan",mp_atan,-2},
+	{"mpfr_sinh",mp_sinh,-2},
+	{"mpfr_cosh",mp_cosh,-2},
+	{"mpfr_tanh",mp_tanh,-2},
+	{"mpfr_asinh",mp_asinh,-2},
+	{"mpfr_acosh",mp_acosh,-2},
+	{"mpfr_atanh",mp_atanh,-2},
+	{"mpfr_exp",mp_exp,-2},
+	{"mpfr_log",mp_log,-2},
+	{"mpfr_pow",mp_pow,-3},
 	{"mpfr_ai",Pmpfr_ai,-2},
 	{"mpfr_zeta",Pmpfr_zeta,-2},
 	{"mpfr_j0",Pmpfr_j0,-2},
@@ -40,37 +59,149 @@ struct ftab bf_tab[] = {
 
 int mpfr_roundmode = MPFR_RNDN;
 
-void Ptodouble(NODE arg,Num *rp)
+void todoublen(Num a,Num *rp)
 {
 	double r,i;
 	Real real,imag;
-	Num num;
 
-	asir_assert(ARG0(arg),O_N,"todouble");
-	num = (Num)ARG0(arg);
-	if ( !num ) {
+	if ( !a ) {
 		*rp = 0;
 		return;
 	}
-	switch ( NID(num) ) {
+	switch ( NID(a) ) {
 		case N_R: case N_Q: case N_B:
-			r = ToReal(num);
+			r = ToReal(a);
 			MKReal(r,real);
 			*rp = (Num)real;
 			break;
 		case N_C:
-			r = ToReal(((C)num)->r);
-			i = ToReal(((C)num)->i);
+			r = ToReal(((C)a)->r);
+			i = ToReal(((C)a)->i);
 			MKReal(r,real);
 			MKReal(i,imag);
 			reimtocplx((Num)real,(Num)imag,rp);
 			break;
 		default:
-			*rp = num;
+			*rp = a;
 			break;
 	}
 }
 
+void todoublep(P a,P *rp)
+{
+  DCP dc,dcr,dcr0;
+
+  if ( !a ) *rp = 0;
+  else if ( OID(a) == O_N ) todoublen((Num)a,(Num *)rp);
+  else {
+    for ( dcr0 = 0, dc = DC(a); dc; dc = NEXT(dc) ) {
+      NEXTDC(dcr0,dcr);
+      DEG(dcr) = DEG(dc);
+      todoublep(COEF(dc),&COEF(dcr));
+    }
+    NEXT(dcr) = 0;
+    MKP(VR(a),dcr0,*rp);
+  }
+}
+
+void todoubler(R a,R *rp)
+{
+  R b;
+
+  if ( !a ) *rp = 0;
+  else if ( OID(a) <= O_P ) todoublep((P)a,(P *)rp);
+  else {
+    NEWR(b);
+    todoublep(a->nm,&b->nm);
+    todoublep(a->dn,&b->dn);
+    *rp = b;
+  }
+}
+
+void todouble(Obj a,Obj *b)
+{
+	Obj t;
+	LIST l;
+	V v;
+	int row,col,len;
+	VECT vect;
+	MAT mat;
+	int i,j;
+	NODE n0,n,nd;
+	MP m,mp,mp0;
+	DP d;
+
+	if ( !a ) {
+		*b = 0;
+		return;
+	}
+	switch ( OID(a) ) {
+		case O_N:
+      todoublen((Num)a,(Num *)b);
+      break;
+    case O_P:
+      todoublep((P)a,(P *)b);
+      break;
+    case O_R:
+			todoubler((R)a,(R *)b);
+			break;
+		case O_LIST:
+			n0 = 0;
+			for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) {
+				NEXTNODE(n0,n);
+				todouble((Obj)BDY(nd),(Obj *)&BDY(n));
+			}
+			if ( n0 )
+				NEXT(n) = 0;
+			MKLIST(l,n0);
+			*b = (Obj)l;
+			break;
+		case O_VECT:
+			len = ((VECT)a)->len;
+			MKVECT(vect,len);
+			for ( i = 0; i < len; i++ ) {
+				todouble((Obj)BDY((VECT)a)[i],(Obj *)&BDY(vect)[i]);
+			}
+			*b = (Obj)vect;
+			break;
+		case O_MAT:
+			row = ((MAT)a)->row;
+			col = ((MAT)a)->col;
+			MKMAT(mat,row,col);
+			for ( i = 0; i < row; i++ )
+				for ( j = 0; j < col; j++ ) {
+				  todouble((Obj)BDY((MAT)a)[i][j],(Obj *)&BDY(mat)[i][j]);
+				}
+			*b = (Obj)mat;
+			break;
+		case O_DP:
+			mp0 = 0;
+			for ( m = BDY((DP)a); m; m = NEXT(m) ) {
+				todouble(C(m),&t);
+				if ( t ) {
+					NEXTMP(mp0,mp);
+					C(mp) = t;
+					mp->dl = m->dl;
+				}
+			}
+			if ( mp0 ) {
+				MKDP(NV((DP)a),mp0,d);
+				d->sugar = ((DP)a)->sugar;
+				*b = (Obj)d;
+			} else
+				*b = 0;
+
+			break;
+		default:
+			error("todouble : invalid argument");
+	}
+}
+
+void Ptodouble(NODE arg,Obj *rp)
+{
+  todouble((Obj)ARG0(arg),rp);
+}
+
 void Peval(NODE arg,Obj *rp)
 {
   int prec;
@@ -299,6 +430,27 @@ void mp_exp(NODE arg,Num *rp)
 void mp_log(NODE arg,Num *rp)
 {
   mpfr_or_mpc(arg,mpfr_log,mpc_log,rp);
+}
+
+void mp_abs(NODE arg,Num *rp)
+{
+  mpfr_or_mpc(arg,mpfr_abs,mpc_abs,rp);
+}
+
+void mp_factorial(NODE arg,Num *rp)
+{
+  struct oNODE arg0;
+  Num a,a1;
+
+  a = (Num)ARG0(arg);
+  if ( !a ) *rp = (Num)ONE;
+  else if ( INT(a) ) Pfac(arg,rp);
+  else {
+    addnum(0,a,(Num)ONE,&a1);
+    arg0.body = (pointer)a1;
+    arg0.next = arg->next;
+    Pmpfr_gamma(&arg0,rp);
+  }
 }
 
 void mp_pow(NODE arg,Num *rp)