Annotation of OpenXM_contrib2/asir2000/builtin/parif.c, Revision 1.29
1.29 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.28 2015/08/18 05:35:17 noro Exp $ */
1.1 noro 2: #include "ca.h"
3: #include "parse.h"
1.19 noro 4: #include "ox.h"
1.1 noro 5:
1.19 noro 6: Q ox_pari_stream;
7: int ox_pari_stream_initialized = 0;
1.29 ! noro 8: int ox_get_pari_result = 0;
1.1 noro 9:
1.24 noro 10: typedef void (*mpfr_func)(NODE,Obj *);
11:
12: void Pmpfr_ai();
13: void Pmpfr_eint(), Pmpfr_erf(),Pmpfr_li2();
14: void Pmpfr_zeta();
15: void Pmpfr_j0(), Pmpfr_j1();
16: void Pmpfr_y0(), Pmpfr_y1();
17: void Pmpfr_gamma(), Pmpfr_lngamma(), Pmpfr_digamma();
18: void Pmpfr_floor(), Pmpfr_round(), Pmpfr_ceil();
19:
20: struct mpfr_tab_rec {
21: char *name;
22: mpfr_func func;
23: } mpfr_tab[] = {
24: {"ai",Pmpfr_ai},
25: {"zeta",Pmpfr_zeta},
26: {"j0",Pmpfr_j0},
27: {"j1",Pmpfr_j1},
28: {"y0",Pmpfr_y0},
29: {"y1",Pmpfr_y1},
30: {"eint",Pmpfr_eint},
31: {"erf",Pmpfr_erf},
32: {"li2",Pmpfr_li2},
33: {"gamma",Pmpfr_gamma},
34: {"lngamma",Pmpfr_gamma},
35: {"digamma",Pmpfr_gamma},
36: {"floor",Pmpfr_floor},
37: {"ceil",Pmpfr_ceil},
38: {"round",Pmpfr_round},
39: };
40:
41: mpfr_func mpfr_search(char *name)
42: {
43: int i,n;
44:
45: n = sizeof(mpfr_tab)/sizeof(struct mpfr_tab_rec);
46: for ( i = 0; i < n; i++ )
47: if ( !strcmp(name,mpfr_tab[i].name) )
48: return mpfr_tab[i].func;
49: return 0;
50: }
51:
1.28 noro 52: Obj list_to_vect(Obj a)
53: {
54: int len,i;
55: VECT v;
56: NODE nd;
57:
58: if ( !a || OID(a) != O_LIST ) return a;
59: len = length(BDY((LIST)a));
60: MKVECT(v,len);
61: for ( i = 0, nd = BDY((LIST)a); nd; nd = NEXT(nd), i++ )
62: v->body[i] = (pointer)list_to_vect((Obj)BDY(nd));
63: return (Obj)v;
64: }
65:
1.29 ! noro 66: void reset_ox_pari()
! 67: {
! 68: NODE nd;
! 69: Obj r;
! 70:
! 71: if ( ox_get_pari_result ) {
! 72: nd = mknode(1,ox_pari_stream);
! 73: Pox_shutdown(nd,&r);
! 74: ox_get_pari_result = 0;
! 75: ox_pari_stream_initialized = 0;
! 76: }
! 77: }
! 78:
1.19 noro 79: pointer evalparif(FUNC f,NODE arg)
1.1 noro 80: {
1.19 noro 81: int ac,intarg,opt,prec;
82: Q q,r,narg;
1.25 noro 83: NODE nd,oxarg,t,t1,n;
1.19 noro 84: STRING name;
85: USINT ui;
86: Obj ret,dmy;
1.24 noro 87: mpfr_func mpfr_function;
1.19 noro 88:
1.24 noro 89: if ( mpfr_function = mpfr_search(f->name) ) {
90: (*mpfr_function)(arg,&ret);
91: return (pointer) ret;
1.20 takayama 92: }
1.24 noro 93:
1.19 noro 94: if ( !ox_pari_stream_initialized ) {
1.29 ! noro 95: MKSTR(name,"ox_pari");
! 96: nd = mknode(2,NULL,name);
! 97: Pox_launch_nox(nd,&r);
! 98: ox_pari_stream = r;
1.19 noro 99: ox_pari_stream_initialized = 1;
100: }
1.25 noro 101:
102: ac = argc(arg);
103: /* reverse the arg list */
104: for ( n = arg, t = 0; n; n = NEXT(n) ) {
105: MKNODE(t1,BDY(n),t); t = t1;
106: }
107: /* push the reversed arg list */
108: for ( ; t; t = NEXT(t) ) {
109: oxarg = mknode(2,ox_pari_stream,BDY(t));
110: Pox_push_cmo(oxarg,&dmy);
111: }
112: MKSTR(name,f->name);
113: STOQ(ac,narg);
114: oxarg = mknode(3,ox_pari_stream,name,narg);
115: Pox_execute_function(oxarg,&dmy);
116: oxarg = mknode(1,ox_pari_stream);
1.29 ! noro 117: ox_get_pari_result = 1;
1.28 noro 118: Pox_pop_cmo(oxarg,&ret);
1.29 ! noro 119: ox_get_pari_result = 0;
1.28 noro 120: if ( ret && OID(ret) == O_LIST )
121: ret = list_to_vect(ret);
122: return ret;
1.1 noro 123: }
124:
125: struct pariftab {
126: char *name;
1.19 noro 127: int dmy;
1.1 noro 128: int type;
129: };
130:
1.8 noro 131: /*
132: * type = 1 => argc = 1, second arg = precision
133: * type = 2 => argc = 1, second arg = optional (long int)
134: *
135: */
1.19 noro 136: /*
137: {"abs",0,1},
138: {"adj",0,1},
139: */
1.8 noro 140:
1.1 noro 141: struct pariftab pariftab[] = {
1.19 noro 142: {"arg",0,1},
143: {"bigomega",0,1},
144: {"binary",0,1},
145: {"ceil",0,1},
146: {"centerlift",0,1},
147: {"cf",0,1},
148: {"classno",0,1},
149: {"classno2",0,1},
150: {"conj",0,1},
151: {"content",0,1},
152: {"denom",0,1},
153: {"det",0,1},
154: {"det2",0,1},
155: {"dilog",0,1},
156: {"disc",0,1},
157: {"discf",0,1},
158: {"divisors",0,1},
159: {"eigen",0,1},
160: {"eintg1",0,1},
161: {"erfc",0,1},
162: {"eta",0,1},
163: {"floor",0,1},
164: {"frac",0,1},
165: {"galois",0,1},
166: {"galoisconj",0,1},
167: {"gamh",0,1},
168: {"gamma",0,1},
169: {"hclassno",0,1},
170: {"hermite",0,1},
171: {"hess",0,1},
172: {"imag",0,1},
173: {"image",0,1},
174: {"image2",0,1},
175: {"indexrank",0,1},
176: {"indsort",0,1},
177: {"initalg",0,1},
178: {"isfund",0,1},
179: {"ispsp",0,1},
180: {"isqrt",0,1},
181: {"issqfree",0,1},
182: {"issquare",0,1},
183: {"jacobi",0,1},
184: {"jell",0,1},
185: {"ker",0,1},
186: {"keri",0,1},
187: {"kerint",0,1},
188: {"kerintg1",0,1},
189: {"length",0,1},
190: {"lexsort",0,1},
191: {"lift",0,1},
192: {"lindep",0,1},
193: {"lll",0,1},
194: {"lllgen",0,1},
195: {"lllgram",0,1},
196: {"lllgramgen",0,1},
197: {"lllgramint",0,1},
198: {"lllgramkerim",0,1},
199: {"lllgramkerimgen",0,1},
200: {"lllint",0,1},
201: {"lllkerim",0,1},
202: {"lllkerimgen",0,1},
203: {"lngamma",0,1},
204: {"logagm",0,1},
205: {"mat",0,1},
206: {"matrixqz2",0,1},
207: {"matrixqz3",0,1},
208: {"matsize",0,1},
209: {"modreverse",0,1},
210: {"mu",0,1},
211: {"nextprime",0,1},
212: {"norm",0,1},
213: {"norml2",0,1},
214: {"numdiv",0,1},
215: {"numer",0,1},
216: {"omega",0,1},
217: {"order",0,1},
218: {"ordred",0,1},
219: {"phi",0,1},
220: {"pnqn",0,1},
221: {"polred",0,1},
222: {"polred2",0,1},
223: {"primroot",0,1},
224: {"psi",0,1},
225: {"quadgen",0,1},
226: {"quadpoly",0,1},
227: {"real",0,1},
228: {"recip",0,1},
229: {"redreal",0,1},
230: {"regula",0,1},
231: {"reorder",0,1},
232: {"reverse",0,1},
233: {"rhoreal",0,1},
234: {"roots",0,1},
235: {"round",0,1},
236: {"sigma",0,1},
237: {"signat",0,1},
238: {"simplify",0,1},
239: {"smalldiscf",0,1},
240: {"smallfact",0,1},
241: {"smallpolred",0,1},
242: {"smallpolred2",0,1},
243: {"smith",0,1},
244: {"smith2",0,1},
245: {"sort",0,1},
246: {"sqr",0,1},
247: {"sqred",0,1},
248: {"sqrt",0,1},
249: {"supplement",0,1},
250: {"trace",0,1},
251: {"trans",0,1},
252: {"trunc",0,1},
253: {"unit",0,1},
254: {"vec",0,1},
255: {"wf",0,1},
256: {"wf2",0,1},
257: {"zeta",0,1},
258: {"factor",0,1},
259:
260: {"allocatemem",0,0},
261:
262: {"isprime",0,2},
263: {"factorint",0,2},
1.1 noro 264: {0,0,0},
265: };
266:
267: void parif_init() {
268: int i;
269:
270: for ( i = 0, parif = 0; pariftab[i].name; i++ )
1.19 noro 271: appendparif(&parif,pariftab[i].name, 0,pariftab[i].type);
1.1 noro 272: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>