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