Annotation of OpenXM/src/ox_pari/convert.c, Revision 1.7
1.1 noro 1: #include "ox_pari.h"
2:
1.7 ! noro 3: int with_gmp;
! 4:
! 5: int gmp_check()
! 6: {
! 7: GEN z1,z2;
! 8:
! 9: // z1=[*,*,1,2], z2=[*,*,2,1]
! 10: // if gmp style => z1>z2 else z1<z2
! 11: z1 = cgeti(2+2); setsigne(z1,1); setlgefint(z1,lg(z1));
! 12: z1[2] = 1; z1[3] = 2;
! 13: z2 = cgeti(2+2); setsigne(z2,1); setlgefint(z2,lg(z2));
! 14: z2[2] = 2; z2[3] = 1;
! 15: if ( cmpii(z1,z2) > 0 ) with_gmp = 1;
! 16: else with_gmp = 0;
! 17: }
! 18:
1.1 noro 19: GEN cmo_int32_to_GEN(cmo_int32 *c)
20: {
21: GEN z;
22: int i,sgn;
23:
24: i = c->i;
25: if ( !i ) return gen_0;
26: z = cgeti(3);
27: sgn = 1;
28: if ( i < 0 ) {
29: i = -i;
30: sgn = -1;
31: }
32: z[2] = i;
33: setsigne(z,sgn);
34: setlgefint(z,lg(z));
35: return z;
36: }
37:
1.5 noro 38: GEN cmo_string_to_GEN(cmo_string *c)
39: {
40: GEN z;
41: int l;
42:
43: l = strlen(c->s);
44: z = cgetg(l+1,t_STR);
45: strcpy(GSTR(z),c->s);
46: return z;
47: }
48:
1.1 noro 49: GEN cmo_zz_to_GEN(cmo_zz *c)
50: {
51: mpz_ptr mpz;
52: GEN z;
53: long *ptr;
54: int j,sgn,len;
55:
56: mpz = c->mpz;
57: sgn = mpz_sgn(mpz);
58: len = ABSIZ(mpz);
59: ptr = (long *)PTR(mpz);
60: z = cgeti(len+2);
1.7 ! noro 61: if ( with_gmp ) // least signifcant first
! 62: for ( j = 0; j < len; j++ )
! 63: z[j+2] = ptr[j];
! 64: else // most signifcant first
! 65: for ( j = 0; j < len; j++ )
! 66: z[len-j+1] = ptr[j];
1.1 noro 67: setsigne(z,sgn);
68: setlgefint(z,lg(z));
69: return z;
70: }
71:
72: GEN cmo_qq_to_GEN(cmo_qq *c)
73: {
74: GEN z,nm,den;
75:
76: z = cgetg(3,t_FRAC);
77: nm = cmo_zz_to_GEN(new_cmo_zz_set_mpz(mpq_numref(c->mpq)));
78: den = cmo_zz_to_GEN(new_cmo_zz_set_mpz(mpq_denref(c->mpq)));
79: z[1] = (long)nm;
80: z[2] = (long)den;
81: return z;
82: }
83:
84: GEN cmo_bf_to_GEN(cmo_bf *c)
85: {
86: mpfr_ptr mpfr;
87: GEN z;
88: int sgn,len,j;
89: long exp;
90: long *ptr;
91:
92: mpfr = c->mpfr;
93: sgn = MPFR_SIGN(mpfr);
94: exp = MPFR_EXP(mpfr)-1;
95: len = MPFR_LIMB_SIZE(mpfr);
96: ptr = (long *)MPFR_MANT(mpfr);
97: z = cgetr(len+2);
98: for ( j = 0; j < len; j++ )
99: z[len-j+1] = ptr[j];
100: z[1] = evalsigne(sgn)|evalexpo(exp);
101: setsigne(z,sgn);
102: return z;
103: }
104:
105: /* list->vector */
106:
107: GEN cmo_list_to_GEN(cmo_list *c)
108: {
109: GEN z;
110: int i;
111: cell *cell;
112:
113: z = cgetg(c->length+1,t_VEC);
114: for ( i = 0, cell = c->head->next; cell != c->head; cell = cell->next, i++ ) {
115: z[i+1] = (long)cmo_to_GEN(cell->cmo);
116: }
117: return z;
118: }
119:
120: GEN cmo_complex_to_GEN(cmo_complex *c)
121: {
122: GEN z;
123:
124: z = cgetg(3,t_COMPLEX);
125: z[1] = (long)cmo_to_GEN(c->re);
126: z[2] = (long)cmo_to_GEN(c->im);
127: return z;
128: }
129:
130: GEN cmo_up_to_GEN(cmo_polynomial_in_one_variable *c)
131: {
132: GEN z;
133: int d,i;
134: cell *cell;
135:
136: d = c->head->next->exp;
137: z = cgetg(d+3,t_POL);
138: setsigne(z,1);
139: setvarn(z,c->var);
1.6 noro 140: setlg(z,d+3);
1.1 noro 141: for ( i = 2; i <= d+2; i++ )
142: z[i] = (long)gen_0;
143: for ( cell = c->head->next; cell != c->head; cell = cell->next ) {
144: z[2+cell->exp] = (long)cmo_to_GEN(cell->cmo);
145: }
146: return z;
147: }
148:
149: cmo_list *current_ringdef;
150:
151: void register_variables(cmo_list *ringdef)
152: {
153: current_ringdef = ringdef;
154: }
155:
156: GEN cmo_rp_to_GEN(cmo_recursive_polynomial *c)
157: {
158: register_variables(c->ringdef);
159: switch ( c->coef->tag ) {
160: case CMO_ZERO:
161: case CMO_NULL:
162: return gen_0;
163: case CMO_INT32:
164: return cmo_int32_to_GEN((cmo_int32 *)c->coef);
165: case CMO_ZZ:
166: return cmo_zz_to_GEN((cmo_zz *)c->coef);
167: case CMO_QQ:
168: return cmo_qq_to_GEN((cmo_qq *)c->coef);
169: case CMO_POLYNOMIAL_IN_ONE_VARIABLE:
170: return cmo_up_to_GEN((cmo_polynomial_in_one_variable *)c->coef);
171: default:
172: return 0;
173: }
174: }
175:
1.5 noro 176: cmo_zz *GEN_to_cmo_string(GEN z)
177: {
178: cmo_string *c;
179:
180: c = new_cmo_string(GSTR(z));
1.6 noro 181: return (cmo_zz *)c;
1.5 noro 182: }
183:
1.1 noro 184: cmo_zz *GEN_to_cmo_zz(GEN z)
185: {
186: cmo_zz *c;
187:
188: c = new_cmo_zz();
1.7 ! noro 189: // -1:least significant first, 1:most significant first
! 190: mpz_import(c->mpz,lg(z)-2,with_gmp?-1:1,sizeof(long),0,0,&z[2]);
1.1 noro 191: if ( signe(z) < 0 )
192: mpz_neg(c->mpz,c->mpz);
193: return c;
194: }
195:
196: cmo_qq *GEN_to_cmo_qq(GEN z)
197: {
198: cmo_qq *c;
199: GEN num,den;
200:
201: num = (GEN)z[1];
202: den = (GEN)z[2];
203: c = new_cmo_qq();
1.6 noro 204: mpz_import(mpq_numref(c->mpq),lg(num)-2,1,sizeof(long),0,0,&num[2]);
205: mpz_import(mpq_denref(c->mpq),lg(den)-2,1,sizeof(long),0,0,&den[2]);
1.1 noro 206: if ( signe(num)*signe(den) < 0 )
207: mpz_neg(mpq_numref(c->mpq),mpq_numref(c->mpq));
208: return c;
209: }
210:
211:
212: cmo_bf *GEN_to_cmo_bf(GEN z)
213: {
214: cmo_bf *c;
215: int len,prec,j;
216: long *ptr;
217:
218: c = new_cmo_bf();
219: len = lg(z)-2;
220: prec = len*sizeof(long)*8;
221: mpfr_init2(c->mpfr,prec);
222: ptr = (long *)MPFR_MANT(c->mpfr);
223: for ( j = 0; j < len; j++ )
224: ptr[j] = z[len-j+1];
225: MPFR_EXP(c->mpfr) = (long long)(expo(z)+1);
226: MPFR_SIGN(c->mpfr) = gsigne(z);
1.2 noro 227: if ( !mpfr_sgn(c->mpfr) ) c = (cmo_bf *)new_cmo_zero();
1.1 noro 228: return c;
229: }
230:
231:
232: cmo_list *GEN_to_cmo_list(GEN z)
233: {
234: cmo_list *c;
235: cmo *ob;
236: int i,len;
237:
238: c = new_cmo_list();
239: len = lg(z)-1;
240: for ( i = 1; i <= len; i++ ) {
241: ob = GEN_to_cmo((GEN)z[i]);
242: c = list_append(c,ob);
243: }
244: return c;
245: }
246:
247: cmo_complex *GEN_to_cmo_complex(GEN z)
248: {
249: cmo_complex *c;
1.2 noro 250: cmo_bf *re,*im;
1.1 noro 251:
1.2 noro 252: re = (cmo_bf *)GEN_to_cmo((GEN)z[1]);
253: im = (cmo_bf *)GEN_to_cmo((GEN)z[2]);
254: if ( im->tag == CMO_ZERO )
255: return (cmo_complex *)re;
256: else {
257: c = new_cmo_complex();
258: c->re = (cmo *)re; c->im = (cmo *)im;
259: return c;
260: }
1.1 noro 261: }
262:
263: cmo_polynomial_in_one_variable *GEN_to_cmo_up(GEN z)
264: {
265: cmo_polynomial_in_one_variable *c;
266: int i;
267: cmo *coef;
268:
269: c = new_cmo_polynomial_in_one_variable(varn(z));
270: for ( i = lg(z)-1; i >= 2; i-- )
271: if ( (GEN)z[i] != gen_0 ) {
272: coef = GEN_to_cmo((GEN)z[i]);
273: list_append_monomial((cmo_list *)c, coef, i-2);
274: }
275: return c;
276: }
277:
278: cmo_recursive_polynomial *GEN_to_cmo_rp(GEN z)
279: {
280: cmo_recursive_polynomial *c;
281:
282: if ( !signe(z) ) return (cmo_recursive_polynomial *)new_cmo_zero();
283: c = new_cmo_recursive_polynomial(current_ringdef,(cmo *)GEN_to_cmo_up(z));
284: return c;
285: }
286:
287: GEN cmo_to_GEN(cmo *c)
288: {
289: switch ( c->tag ) {
290: case CMO_ZERO:
291: case CMO_NULL:
292: return gen_0;
293: case CMO_ZZ: /* int */
294: return cmo_zz_to_GEN((cmo_zz *)c);
295: case CMO_QQ:
296: return cmo_qq_to_GEN((cmo_qq *)c);
297: case CMO_COMPLEX: /* complex */
298: return cmo_complex_to_GEN((cmo_complex *)c);
299: case CMO_IEEE_DOUBLE_FLOAT:
300: return dbltor(((cmo_double *)c)->d);
1.3 ohara 301: case CMO_BIGFLOAT32: /* bigfloat */
1.1 noro 302: return cmo_bf_to_GEN((cmo_bf *)c);
303: case CMO_LIST:
304: return cmo_list_to_GEN((cmo_list *)c);
305: case CMO_RECURSIVE_POLYNOMIAL:
306: return cmo_rp_to_GEN((cmo_recursive_polynomial *)c);
307: case CMO_POLYNOMIAL_IN_ONE_VARIABLE:
308: return cmo_up_to_GEN((cmo_polynomial_in_one_variable *)c);
1.5 noro 309: case CMO_STRING:
310: return cmo_string_to_GEN((cmo_string *)c);
1.1 noro 311: default:
312: return 0;
313: }
314: }
315:
316: cmo *GEN_to_cmo(GEN z)
317: {
318: char buf[BUFSIZ];
319:
320: if ( gcmp0(z) )
321: return new_cmo_zero();
322: switch ( typ(z) ) {
323: case t_INT: /* int */
324: return (cmo *)GEN_to_cmo_zz(z);
325: case t_REAL: /* bigfloat */
326: return (cmo *)GEN_to_cmo_bf(z);
327: case t_FRAC: /* rational number */
328: return (cmo *)GEN_to_cmo_qq(z);
329: case t_COMPLEX: /* complex */
330: return (cmo *)GEN_to_cmo_complex(z);
331: case t_POL:
332: return (cmo *)GEN_to_cmo_rp(z);
333: case t_VEC: case t_COL: /* vector */
334: return (cmo *)GEN_to_cmo_list(z);
335: case t_MAT: /* matrix */
336: return (cmo *)GEN_to_cmo_list(shallowtrans(z));
1.5 noro 337: case t_STR: /* string */
338: return (cmo *)GEN_to_cmo_string(z);
1.1 noro 339: default:
340: sprintf(buf,"GEN_to_cmo : unsupported type=%d",(int)typ(z));
341: return (cmo *)make_error2(buf);
342: }
343: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to convert.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_pari