Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 :
15 : /********************************************************************/
16 : /** **/
17 : /** GENERIC OPERATIONS **/
18 : /** (second part) **/
19 : /** **/
20 : /********************************************************************/
21 : #include "pari.h"
22 : #include "paripriv.h"
23 :
24 : /*********************************************************************/
25 : /** **/
26 : /** MAP FUNCTIONS WITH GIVEN PROTOTYPES **/
27 : /** **/
28 : /*********************************************************************/
29 : GEN
30 462 : map_proto_G(GEN (*f)(GEN), GEN x)
31 : {
32 462 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_G(f, gel(x,i)));
33 462 : return f(x);
34 : }
35 :
36 : GEN
37 39274085 : map_proto_lG(long (*f)(GEN), GEN x)
38 : {
39 39274169 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_lG(f, gel(x,i)));
40 39272932 : return stoi(f(x));
41 : }
42 :
43 : GEN
44 126 : map_proto_lGL(long (*f)(GEN,long), GEN x, long y)
45 : {
46 154 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_lGL(f,gel(x,i),y));
47 119 : return stoi(f(x,y));
48 : }
49 :
50 : static GEN
51 2201838 : _domul(void *data, GEN x, GEN y)
52 : {
53 2201838 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
54 2201838 : return mul(x,y);
55 : }
56 :
57 : GEN
58 2413571 : gassoc_proto(GEN (*f)(GEN,GEN), GEN x, GEN y)
59 : {
60 2413571 : if (!y)
61 : {
62 2413571 : pari_sp av = avma;
63 2413571 : switch(typ(x))
64 : {
65 21 : case t_LIST:
66 21 : x = list_data(x); if (!x) return gen_1;
67 : case t_VEC:
68 2413557 : case t_COL: break;
69 7 : default: pari_err_TYPE("association",x);
70 : }
71 2413557 : return gerepileupto(av, gen_product(x, (void *)f, _domul));
72 :
73 : }
74 0 : return f(x,y);
75 : }
76 : /*******************************************************************/
77 : /* */
78 : /* CREATION OF A P-ADIC GEN */
79 : /* */
80 : /*******************************************************************/
81 : GEN
82 12416893 : cgetp(GEN x)
83 : {
84 12416893 : GEN y = cgetg(5,t_PADIC);
85 12416851 : y[1] = (x[1]&PRECPBITS) | _evalvalp(0);
86 12416851 : gel(y,2) = icopy(gel(x,2));
87 12416807 : gel(y,3) = icopy(gel(x,3));
88 12416811 : gel(y,4) = cgeti(lgefint(gel(x,3))); return y;
89 : }
90 :
91 : /*******************************************************************/
92 : /* */
93 : /* SIZES */
94 : /* */
95 : /*******************************************************************/
96 :
97 : long
98 5106000 : glength(GEN x)
99 : {
100 5106000 : long tx = typ(x);
101 5106000 : switch(tx)
102 : {
103 126 : case t_INT: return lgefint(x)-2;
104 539 : case t_LIST: {
105 539 : GEN L = list_data(x);
106 539 : return L? lg(L)-1: 0;
107 : }
108 14 : case t_REAL: return signe(x)? lg(x)-2: 0;
109 11 : case t_STR: return strlen( GSTR(x) );
110 91 : case t_VECSMALL: return lg(x)-1;
111 : }
112 5105219 : return lg(x) - lontyp[tx];
113 : }
114 :
115 : long
116 0 : gtranslength(GEN x)
117 : {
118 0 : switch(typ(x))
119 : {
120 0 : case t_VEC: case t_COL:
121 0 : return lg(x)-1;
122 0 : case t_MAT:
123 0 : return lg(x)==1 ? 0: nbrows(x);
124 0 : default:
125 0 : pari_err_TYPE("trans",x);
126 : return 0; /* LCOV_EXCL_LINE */
127 : }
128 : }
129 :
130 : GEN
131 203 : matsize(GEN x)
132 : {
133 203 : long L = lg(x) - 1;
134 203 : switch(typ(x))
135 : {
136 7 : case t_VEC: return mkvec2s(1, L);
137 7 : case t_COL: return mkvec2s(L, 1);
138 182 : case t_MAT: return mkvec2s(L? nbrows(x): 0, L);
139 : }
140 7 : pari_err_TYPE("matsize",x);
141 : return NULL; /* LCOV_EXCL_LINE */
142 : }
143 :
144 : /*******************************************************************/
145 : /* */
146 : /* CONVERSION GEN --> long */
147 : /* */
148 : /*******************************************************************/
149 :
150 : long
151 77 : gtolong(GEN x)
152 : {
153 77 : switch(typ(x))
154 : {
155 42 : case t_INT:
156 42 : return itos(x);
157 7 : case t_REAL:
158 7 : return (long)(rtodbl(x) + 0.5);
159 7 : case t_FRAC:
160 7 : { pari_sp av = avma; return gc_long(av, itos(ground(x))); }
161 7 : case t_COMPLEX:
162 7 : if (gequal0(gel(x,2))) return gtolong(gel(x,1)); break;
163 7 : case t_QUAD:
164 7 : if (gequal0(gel(x,3))) return gtolong(gel(x,2)); break;
165 : }
166 7 : pari_err_TYPE("gtolong",x);
167 : return 0; /* LCOV_EXCL_LINE */
168 : }
169 :
170 : /*******************************************************************/
171 : /* */
172 : /* COMPARISONS */
173 : /* */
174 : /*******************************************************************/
175 : static void
176 189 : chk_true_err()
177 : {
178 189 : GEN E = pari_err_last();
179 189 : switch(err_get_num(E))
180 : {
181 0 : case e_STACK: case e_MEM: case e_ALARM:
182 0 : pari_err(0, E); /* rethrow */
183 : }
184 189 : }
185 : /* x - y == 0 or undefined */
186 : static int
187 3193096 : gequal_try(GEN x, GEN y)
188 : {
189 : int i;
190 3193096 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
191 3193096 : pari_TRY { i = gequal0(gadd(x, gneg_i(y))); } pari_ENDCATCH;
192 3192914 : return i;
193 : }
194 : /* x + y == 0 or undefined */
195 : static int
196 28 : gmequal_try(GEN x, GEN y)
197 : {
198 : int i;
199 28 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
200 28 : pari_TRY { i = gequal0(gadd(x, y)); } pari_ENDCATCH;
201 21 : return i;
202 : }
203 :
204 : int
205 357478698 : isexactzero(GEN g)
206 : {
207 : long i, lx;
208 357478698 : switch (typ(g))
209 : {
210 300829712 : case t_INT:
211 300829712 : return !signe(g);
212 1241785 : case t_INTMOD:
213 1241785 : return !signe(gel(g,2));
214 14069931 : case t_COMPLEX:
215 14069931 : return isexactzero(gel(g,1)) && isexactzero(gel(g,2));
216 8107278 : case t_FFELT:
217 8107278 : return FF_equal0(g);
218 511 : case t_QUAD:
219 511 : return isexactzero(gel(g,2)) && isexactzero(gel(g,3));
220 289010 : case t_POLMOD:
221 289010 : return isexactzero(gel(g,2));
222 12087464 : case t_POL:
223 12087464 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
224 12087464 : return lx == 2 || (lx == 3 && isexactzero(gel(g,2)));
225 462368 : case t_RFRAC:
226 462368 : return isexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
227 43477 : case t_VEC: case t_COL: case t_MAT:
228 43862 : for (i=lg(g)-1; i; i--)
229 43715 : if (!isexactzero(gel(g,i))) return 0;
230 147 : return 1;
231 : }
232 20347162 : return 0;
233 : }
234 : GEN
235 63386196 : gisexactzero(GEN g)
236 : {
237 : long i, lx;
238 : GEN a, b;
239 63386196 : switch (typ(g))
240 : {
241 26660310 : case t_INT:
242 26660310 : return !signe(g)? g: NULL;
243 7064323 : case t_INTMOD:
244 7064323 : return !signe(gel(g,2))? g: NULL;
245 2632 : case t_COMPLEX:
246 2632 : a = gisexactzero(gel(g,1)); if (!a) return NULL;
247 616 : b = gisexactzero(gel(g,2)); if (!b) return NULL;
248 0 : return ggcd(a,b);
249 20608 : case t_FFELT:
250 20608 : return FF_equal0(g)? g: NULL;
251 518 : case t_QUAD:
252 518 : a = gisexactzero(gel(g,2)); if (!a) return NULL;
253 77 : b = gisexactzero(gel(g,3)); if (!b) return NULL;
254 7 : return ggcd(a,b);
255 16920 : case t_POLMOD:
256 16920 : return gisexactzero(gel(g,2));
257 28069542 : case t_POL:
258 28069542 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
259 28069542 : if (lx == 2) return gen_0;
260 22748231 : if (lx == 3) return gisexactzero(gel(g,2));
261 19026907 : return NULL;
262 1190027 : case t_RFRAC:
263 1190027 : return gisexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
264 0 : case t_VEC: case t_COL: case t_MAT:
265 0 : a = gen_0;
266 0 : for (i=lg(g)-1; i; i--)
267 : {
268 0 : b = gisexactzero(gel(g,i));
269 0 : if (!b) return NULL;
270 0 : a = ggcd(a, b);
271 : }
272 0 : return a;
273 : }
274 361316 : return NULL;
275 : }
276 :
277 : int
278 451163875 : isrationalzero(GEN g)
279 : {
280 : long i;
281 451163875 : switch (typ(g))
282 : {
283 272927239 : case t_INT:
284 272927239 : return !signe(g);
285 37269604 : case t_COMPLEX:
286 37269604 : return isintzero(gel(g,1)) && isintzero(gel(g,2));
287 1428 : case t_QUAD:
288 1428 : return isintzero(gel(g,2)) && isintzero(gel(g,3));
289 490254 : case t_POLMOD:
290 490254 : return isrationalzero(gel(g,2));
291 22388091 : case t_POL: return lg(g) == 2;
292 133 : case t_VEC: case t_COL: case t_MAT:
293 448 : for (i=lg(g)-1; i; i--)
294 315 : if (!isrationalzero(gel(g,i))) return 0;
295 133 : return 1;
296 : }
297 118087126 : return 0;
298 : }
299 :
300 : int
301 1972332214 : gequal0(GEN x)
302 : {
303 1972332214 : switch(typ(x))
304 : {
305 1825909902 : case t_INT: case t_REAL: case t_POL: case t_SER:
306 1825909902 : return !signe(x);
307 :
308 7843555 : case t_INTMOD:
309 7843555 : return !signe(gel(x,2));
310 :
311 649348 : case t_FFELT:
312 649348 : return FF_equal0(x);
313 :
314 91707897 : case t_COMPLEX:
315 : /* is 0 iff norm(x) would be 0 (can happen with Re(x) and Im(x) != 0
316 : * only if Re(x) and Im(x) are of type t_REAL). See mp.c:addrr().
317 : */
318 91707897 : if (gequal0(gel(x,1)))
319 : {
320 7226660 : if (gequal0(gel(x,2))) return 1;
321 6884880 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
322 240890 : return (expo(gel(x,1))>=expo(gel(x,2)));
323 : }
324 84482159 : if (gequal0(gel(x,2)))
325 : {
326 1596335 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
327 1513379 : return (expo(gel(x,2))>=expo(gel(x,1)));
328 : }
329 82886148 : return 0;
330 :
331 2040377 : case t_PADIC:
332 2040377 : return !signe(gel(x,4));
333 :
334 1806 : case t_QUAD:
335 1806 : return gequal0(gel(x,2)) && gequal0(gel(x,3));
336 :
337 8146700 : case t_POLMOD:
338 8146700 : return gequal0(gel(x,2));
339 :
340 6103837 : case t_RFRAC:
341 6103837 : return gequal0(gel(x,1));
342 :
343 7801422 : case t_VEC: case t_COL: case t_MAT:
344 : {
345 : long i;
346 19971927 : for (i=lg(x)-1; i; i--)
347 16232833 : if (!gequal0(gel(x,i))) return 0;
348 3739094 : return 1;
349 : }
350 : }
351 22127370 : return 0;
352 : }
353 :
354 : /* x a t_POL or t_SER, return 1 if test(coeff(X,d)) is true and
355 : * coeff(X,i) = 0 for all i != d. Return 0 (false) otherwise */
356 : static int
357 14619346 : is_monomial_test(GEN x, long d, int(*test)(GEN))
358 : {
359 14619346 : long i, l = lg(x);
360 14619346 : if (typ(x) == t_SER)
361 : { /* "0" * x^v * (1+O(x)) ? v <= 0 or null ring */
362 455 : if (l == 3 && isexactzero(gel(x,2))) return d >= 2 || test(gel(x,2));
363 406 : if (d < 2) return 0; /* v > 0 */
364 : }
365 14619178 : if (d >= l)
366 : {
367 60037 : if (typ(x) == t_POL) return 0; /* l = 2 */
368 : /* t_SER, v = 2-d <= 0 */
369 56 : if (!signe(x)) return 1;
370 : }
371 14559141 : else if (!test(gel(x,d))) return 0;
372 7356454 : for (i = 2; i < l; i++) /* 2 <= d < l */
373 4976172 : if (i != d && !gequal0(gel(x,i))) return 0;
374 2380282 : return 1;
375 : }
376 : static int
377 2387 : col_test(GEN x, int(*test)(GEN))
378 : {
379 2387 : long i, l = lg(x);
380 2387 : if (l == 1 || !test(gel(x,1))) return 0;
381 70 : for (i = 2; i < l; i++)
382 42 : if (!gequal0(gel(x,i))) return 0;
383 28 : return 1;
384 : }
385 : static int
386 16268 : mat_test(GEN x, int(*test)(GEN))
387 : {
388 16268 : long i, j, l = lg(x);
389 16268 : if (l == 1) return 1;
390 16254 : if (l != lgcols(x)) return 0;
391 51569 : for (i = 1; i < l; i++)
392 135142 : for (j = 1; j < l; j++)
393 99827 : if (i == j) {
394 35378 : if (!test(gcoeff(x,i,i))) return 0;
395 : } else {
396 64449 : if (!gequal0(gcoeff(x,i,j))) return 0;
397 : }
398 16191 : return 1;
399 : }
400 :
401 : /* returns 1 whenever x = 1, and 0 otherwise */
402 : int
403 306941513 : gequal1(GEN x)
404 : {
405 306941513 : switch(typ(x))
406 : {
407 288743136 : case t_INT:
408 288743136 : return equali1(x);
409 :
410 68145 : case t_REAL:
411 : {
412 68145 : long s = signe(x);
413 68145 : if (!s) return expo(x) >= 0;
414 68047 : return s > 0 ? absrnz_equal1(x): 0;
415 : }
416 632154 : case t_INTMOD:
417 632154 : return is_pm1(gel(x,2)) || is_pm1(gel(x,1));
418 325719 : case t_POLMOD:
419 325719 : return !degpol(gel(x,1)) || gequal1(gel(x,2));
420 :
421 16891 : case t_FFELT:
422 16891 : return FF_equal1(x);
423 :
424 1302895 : case t_FRAC:
425 1302895 : return 0;
426 :
427 21355 : case t_COMPLEX:
428 21355 : return gequal1(gel(x,1)) && gequal0(gel(x,2));
429 :
430 167030 : case t_PADIC:
431 167030 : if (!signe(gel(x,4))) return valp(x) <= 0;
432 166988 : return valp(x) == 0 && gequal1(gel(x,4));
433 :
434 42 : case t_QUAD:
435 42 : return gequal1(gel(x,2)) && gequal0(gel(x,3));
436 :
437 14618817 : case t_POL: return is_monomial_test(x, 2, &gequal1);
438 329 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequal1);
439 :
440 1028403 : case t_RFRAC: return gequal(gel(x,1), gel(x,2));
441 2338 : case t_COL: return col_test(x, &gequal1);
442 16156 : case t_MAT: return mat_test(x, &gequal1);
443 : }
444 30 : return 0;
445 : }
446 :
447 : /* returns 1 whenever the x = -1, 0 otherwise */
448 : int
449 74216246 : gequalm1(GEN x)
450 : {
451 : pari_sp av;
452 : GEN t;
453 :
454 74216246 : switch(typ(x))
455 : {
456 74207430 : case t_INT:
457 74207430 : return equalim1(x);
458 :
459 1484 : case t_REAL:
460 : {
461 1484 : long s = signe(x);
462 1484 : if (!s) return expo(x) >= 0;
463 1477 : return s < 0 ? absrnz_equal1(x): 0;
464 : }
465 4581 : case t_INTMOD:
466 4581 : av = avma; return gc_bool(av, equalii(addui(1,gel(x,2)), gel(x,1)));
467 :
468 154 : case t_FRAC:
469 154 : return 0;
470 :
471 42 : case t_FFELT:
472 42 : return FF_equalm1(x);
473 :
474 2044 : case t_COMPLEX:
475 2044 : return gequalm1(gel(x,1)) && gequal0(gel(x,2));
476 :
477 7 : case t_QUAD:
478 7 : return gequalm1(gel(x,2)) && gequal0(gel(x,3));
479 :
480 49 : case t_PADIC:
481 49 : t = gel(x,4); if (!signe(t)) return valp(x) <= 0;
482 21 : av = avma; return gc_bool(av, !valp(x) && equalii(addui(1,t), gel(x,3)));
483 :
484 56 : case t_POLMOD:
485 56 : return !degpol(gel(x,1)) || gequalm1(gel(x,2));
486 :
487 70 : case t_POL: return is_monomial_test(x, 2, &gequalm1);
488 126 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequalm1);
489 :
490 28 : case t_RFRAC:
491 28 : av = avma; return gc_bool(av, gmequal_try(gel(x,1), gel(x,2)));
492 49 : case t_COL: return col_test(x, &gequalm1);
493 112 : case t_MAT: return mat_test(x, &gequalm1);
494 : }
495 14 : return 0;
496 : }
497 :
498 : int
499 1468275 : gequalX(GEN x) { return typ(x) == t_POL && lg(x) == 4
500 2951379 : && isintzero(gel(x,2)) && isint1(gel(x,3)); }
501 :
502 : static int
503 588 : cmp_str(const char *x, const char *y)
504 : {
505 588 : int f = strcmp(x, y);
506 : return f > 0? 1
507 588 : : f? -1: 0;
508 : }
509 :
510 : static int
511 39035915 : cmp_universal_rec(GEN x, GEN y, long i0)
512 : {
513 39035915 : long i, lx = lg(x), ly = lg(y);
514 39035915 : if (lx < ly) return -1;
515 39033140 : if (lx > ly) return 1;
516 68540552 : for (i = i0; i < lx; i++)
517 : {
518 59677397 : int f = cmp_universal(gel(x,i), gel(y,i));
519 59677397 : if (f) return f;
520 : }
521 8863155 : return 0;
522 : }
523 : /* Universal "meaningless" comparison function. Transitive, returns 0 iff
524 : * gidentical(x,y) */
525 : int
526 84040476 : cmp_universal(GEN x, GEN y)
527 : {
528 84040476 : long lx, ly, i, tx = typ(x), ty = typ(y);
529 :
530 84040476 : if (tx < ty) return -1;
531 83603342 : if (ty < tx) return 1;
532 83146370 : switch(tx)
533 : {
534 43174826 : case t_INT: return cmpii(x,y);
535 567 : case t_STR: return cmp_str(GSTR(x),GSTR(y));
536 934976 : case t_REAL:
537 : case t_VECSMALL:
538 934976 : lx = lg(x);
539 934976 : ly = lg(y);
540 934976 : if (lx < ly) return -1;
541 886704 : if (lx > ly) return 1;
542 3586363 : for (i = 1; i < lx; i++)
543 : {
544 3478731 : if (x[i] < y[i]) return -1;
545 3109810 : if (x[i] > y[i]) return 1;
546 : }
547 107632 : return 0;
548 :
549 768847 : case t_POL:
550 : {
551 768847 : long X = x[1] & (VARNBITS|SIGNBITS);
552 768847 : long Y = y[1] & (VARNBITS|SIGNBITS);
553 768847 : if (X < Y) return -1;
554 768826 : if (X > Y) return 1;
555 768770 : return cmp_universal_rec(x, y, 2);
556 : }
557 881076 : case t_SER:
558 : case t_FFELT:
559 : case t_CLOSURE:
560 881076 : if (x[1] < y[1]) return -1;
561 881069 : if (x[1] > y[1]) return 1;
562 881062 : return cmp_universal_rec(x, y, 2);
563 :
564 35 : case t_LIST:
565 : {
566 35 : long tx = list_typ(x), ty = list_typ(y);
567 : GEN vx, vy;
568 : pari_sp av;
569 35 : if (tx < ty) return -1;
570 35 : if (tx > ty) return 1;
571 35 : vx = list_data(x);
572 35 : vy = list_data(y);
573 35 : if (!vx) return vy? -1: 0;
574 35 : if (!vy) return 1;
575 35 : av = avma;
576 35 : if (tx == t_LIST_MAP)
577 : {
578 14 : vx = maptomat_shallow(x);
579 14 : vy = maptomat_shallow(y);
580 : }
581 35 : return gc_int(av, cmp_universal_rec(vx, vy, 1));
582 : }
583 37386043 : default:
584 37386043 : return cmp_universal_rec(x, y, lontyp[tx]);
585 : }
586 : }
587 :
588 : static int
589 4386113 : cmpfrac(GEN x, GEN y)
590 : {
591 4386113 : pari_sp av = avma;
592 4386113 : GEN a = gel(x,1), b = gel(x,2);
593 4386113 : GEN c = gel(y,1), d = gel(y,2);
594 4386113 : return gc_bool(av, cmpii(mulii(a, d), mulii(b, c)));
595 : }
596 : static int
597 435395 : cmpifrac(GEN a, GEN y)
598 : {
599 435395 : pari_sp av = avma;
600 435395 : GEN c = gel(y,1), d = gel(y,2);
601 435395 : return gc_int(av, cmpii(mulii(a, d), c));
602 : }
603 : static int
604 49915 : cmprfrac(GEN a, GEN y)
605 : {
606 49915 : pari_sp av = avma;
607 49915 : GEN c = gel(y,1), d = gel(y,2);
608 49915 : return gc_int(av, cmpri(mulri(a, d), c));
609 : }
610 : static int
611 161 : cmpgen(GEN x, GEN y)
612 : {
613 161 : pari_sp av = avma;
614 161 : return gc_int(av, gsigne(gsub(x,y)));
615 : }
616 :
617 : /* returns the sign of x - y when it makes sense. 0 otherwise */
618 : int
619 283553057 : gcmp(GEN x, GEN y)
620 : {
621 283553057 : long tx = typ(x), ty = typ(y);
622 :
623 283553057 : if (tx == ty) /* generic case */
624 277968052 : switch(tx)
625 : {
626 154795059 : case t_INT: return cmpii(x, y);
627 118698605 : case t_REAL: return cmprr(x, y);
628 4386113 : case t_FRAC: return cmpfrac(x, y);
629 70 : case t_QUAD: return cmpgen(x, y);
630 21 : case t_STR: return cmp_str(GSTR(x), GSTR(y));
631 101557 : case t_INFINITY:
632 : {
633 101557 : long sx = inf_get_sign(x), sy = inf_get_sign(y);
634 101557 : if (sx < sy) return -1;
635 21 : if (sx > sy) return 1;
636 14 : return 0;
637 : }
638 : }
639 5571632 : if (ty == t_INFINITY) return -inf_get_sign(y);
640 5498865 : switch(tx)
641 : {
642 4957580 : case t_INT:
643 : switch(ty)
644 : {
645 4662024 : case t_REAL: return cmpir(x, y);
646 295541 : case t_FRAC: return cmpifrac(x, y);
647 7 : case t_QUAD: return cmpgen(x, y);
648 : }
649 8 : break;
650 344834 : case t_REAL:
651 : switch(ty)
652 : {
653 336713 : case t_INT: return cmpri(x, y);
654 8100 : case t_FRAC: return cmprfrac(x, y);
655 14 : case t_QUAD: return cmpgen(x, y);
656 : }
657 7 : break;
658 181683 : case t_FRAC:
659 : switch(ty)
660 : {
661 139854 : case t_INT: return -cmpifrac(y, x);
662 41815 : case t_REAL: return -cmprfrac(y, x);
663 7 : case t_QUAD: return cmpgen(x, y);
664 : }
665 7 : break;
666 63 : case t_QUAD:
667 63 : return cmpgen(x, y);
668 31618 : case t_INFINITY: return inf_get_sign(x);
669 : }
670 24 : pari_err_TYPE2("comparison",x,y);
671 : return 0;/*LCOV_EXCL_LINE*/
672 : }
673 :
674 : int
675 555458 : gcmpsg(long s, GEN y)
676 : {
677 555458 : switch(typ(y))
678 : {
679 9737 : case t_INT: return cmpsi(s,y);
680 540618 : case t_REAL: return cmpsr(s,y);
681 5103 : case t_FRAC: {
682 5103 : pari_sp av = avma;
683 5103 : return gc_int(av, cmpii(mulsi(s,gel(y,2)), gel(y,1)));
684 : }
685 0 : case t_QUAD: {
686 0 : pari_sp av = avma;
687 0 : return gc_int(av, gsigne(gsubsg(s, y)));
688 : }
689 0 : case t_INFINITY: return -inf_get_sign(y);
690 : }
691 0 : pari_err_TYPE2("comparison",stoi(s),y);
692 : return 0; /* LCOV_EXCL_LINE */
693 : }
694 :
695 : static long
696 3232460 : roughtype(GEN x)
697 : {
698 3232460 : switch(typ(x))
699 : {
700 2114 : case t_MAT: return t_MAT;
701 742368 : case t_VEC: case t_COL: return t_VEC;
702 1613554 : case t_VECSMALL: return t_VECSMALL;
703 874424 : default: return t_INT;
704 : }
705 : }
706 :
707 : static int lexcmpsg(long x, GEN y);
708 42 : static int lexcmpgs(GEN x, long y) { return -lexcmpsg(y,x); }
709 : /* lexcmp(stoi(x),y), y t_VEC/t_COL/t_MAT */
710 : static int
711 21 : lexcmp_s_matvec(long x, GEN y)
712 : {
713 : int fl;
714 21 : if (lg(y)==1) return 1;
715 14 : fl = lexcmpsg(x,gel(y,1));
716 14 : if (fl) return fl;
717 7 : return -1;
718 : }
719 : /* x a scalar, y a t_VEC/t_COL/t_MAT */
720 : static int
721 357 : lexcmp_scal_matvec(GEN x, GEN y)
722 : {
723 : int fl;
724 357 : if (lg(y)==1) return 1;
725 357 : fl = lexcmp(x,gel(y,1));
726 357 : if (fl) return fl;
727 7 : return -1;
728 : }
729 : /* x a scalar, y a t_VECSMALL */
730 : static int
731 42 : lexcmp_scal_vecsmall(GEN x, GEN y)
732 : {
733 : int fl;
734 42 : if (lg(y)==1) return 1;
735 42 : fl = lexcmpgs(x, y[1]);
736 42 : if (fl) return fl;
737 0 : return -1;
738 : }
739 :
740 : /* tx = ty = t_MAT, or x and y are both vect_t */
741 : static int
742 371976 : lexcmp_similar(GEN x, GEN y)
743 : {
744 371976 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
745 456828 : for (i=1; i<l; i++)
746 : {
747 425204 : int fl = lexcmp(gel(x,i),gel(y,i));
748 425205 : if (fl) return fl;
749 : }
750 31624 : if (lx == ly) return 0;
751 33 : return (lx < ly)? -1 : 1;
752 : }
753 : /* x a t_VECSMALL, y a t_VEC/t_COL ~ lexcmp_similar */
754 : static int
755 154 : lexcmp_vecsmall_vec(GEN x, GEN y)
756 : {
757 154 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
758 343 : for (i=1; i<l; i++)
759 : {
760 287 : int fl = lexcmpsg(x[i], gel(y,i));
761 287 : if (fl) return fl;
762 : }
763 56 : if (lx == ly) return 0;
764 21 : return (lx < ly)? -1 : 1;
765 : }
766 :
767 : /* x t_VEC/t_COL, y t_MAT */
768 : static int
769 98 : lexcmp_vec_mat(GEN x, GEN y)
770 : {
771 : int fl;
772 98 : if (lg(x)==1) return -1;
773 98 : if (lg(y)==1) return 1;
774 98 : fl = lexcmp_similar(x,gel(y,1));
775 98 : if (fl) return fl;
776 7 : return -1;
777 : }
778 : /* x t_VECSMALl, y t_MAT ~ lexcmp_vec_mat */
779 : static int
780 42 : lexcmp_vecsmall_mat(GEN x, GEN y)
781 : {
782 : int fl;
783 42 : if (lg(x)==1) return -1;
784 42 : if (lg(y)==1) return 1;
785 42 : fl = lexcmp_vecsmall_vec(x, gel(y,1));
786 42 : if (fl) return fl;
787 0 : return -1;
788 : }
789 :
790 : /* x a t_VECSMALL, not y */
791 : static int
792 196 : lexcmp_vecsmall_other(GEN x, GEN y, long ty)
793 : {
794 196 : switch(ty)
795 : {
796 42 : case t_MAT: return lexcmp_vecsmall_mat(x, y);
797 112 : case t_VEC: return lexcmp_vecsmall_vec(x, y);
798 42 : default: return -lexcmp_scal_vecsmall(y, x); /*y scalar*/
799 : }
800 : }
801 :
802 : /* lexcmp(stoi(s), y) */
803 : static int
804 343 : lexcmpsg(long x, GEN y)
805 : {
806 343 : switch(roughtype(y))
807 : {
808 21 : case t_MAT:
809 : case t_VEC:
810 21 : return lexcmp_s_matvec(x,y);
811 14 : case t_VECSMALL: /* ~ lexcmp_scal_matvec */
812 14 : if (lg(y)==1) return 1;
813 7 : return (x > y[1])? 1: -1;
814 308 : default: return gcmpsg(x,y);
815 : }
816 : }
817 :
818 : /* as gcmp for vector/matrices, using lexicographic ordering on components */
819 : static int
820 1616059 : lexcmp_i(GEN x, GEN y)
821 : {
822 1616059 : const long tx = roughtype(x), ty = roughtype(y);
823 1616061 : if (tx == ty)
824 1615410 : switch(tx)
825 : {
826 371878 : case t_MAT:
827 371878 : case t_VEC: return lexcmp_similar(x,y);
828 806672 : case t_VECSMALL: return vecsmall_lexcmp(x,y);
829 436860 : default: return gcmp(x,y);
830 : }
831 651 : if (tx == t_VECSMALL) return lexcmp_vecsmall_other(x,y,ty);
832 518 : if (ty == t_VECSMALL) return -lexcmp_vecsmall_other(y,x,tx);
833 :
834 455 : if (tx == t_INT) return lexcmp_scal_matvec(x,y); /*scalar*/
835 203 : if (ty == t_INT) return -lexcmp_scal_matvec(y,x);
836 :
837 98 : if (ty==t_MAT) return lexcmp_vec_mat(x,y);
838 42 : return -lexcmp_vec_mat(y,x); /*tx==t_MAT*/
839 : }
840 : int
841 1616059 : lexcmp(GEN x, GEN y)
842 : {
843 1616059 : pari_sp av = avma;
844 1616059 : if (typ(x) == t_COMPLEX)
845 : {
846 875 : x = mkvec2(gel(x,1), gel(x,2));
847 875 : if (typ(y) == t_COMPLEX) y = mkvec2(gel(y,1), gel(y,2));
848 49 : else y = mkvec2(y, gen_0);
849 : }
850 1615184 : else if (typ(y) == t_COMPLEX)
851 : {
852 63 : x = mkvec2(x, gen_0);
853 63 : y = mkvec2(gel(y,1), gel(y,2));
854 : }
855 1616059 : return gc_int(av, lexcmp_i(x, y));
856 : }
857 :
858 : /*****************************************************************/
859 : /* */
860 : /* EQUALITY */
861 : /* returns 1 if x == y, 0 otherwise */
862 : /* */
863 : /*****************************************************************/
864 : /* x,y t_POL */
865 : static int
866 3432098 : polidentical(GEN x, GEN y)
867 : {
868 : long lx;
869 3432098 : if (x[1] != y[1]) return 0;
870 3432000 : lx = lg(x); if (lg(y) != lg(x)) return 0;
871 14948589 : for (lx--; lx >= 2; lx--) if (!gidentical(gel(x,lx), gel(y,lx))) return 0;
872 3431909 : return 1;
873 : }
874 : /* x,y t_SER */
875 : static int
876 14 : seridentical(GEN x, GEN y) { return polidentical(x,y); }
877 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
878 : static int
879 5242534 : vecidentical(GEN x, GEN y)
880 : {
881 : long i;
882 5242534 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
883 16669120 : for (i = lg(x)-1; i; i--)
884 12710307 : if (! gidentical(gel(x,i),gel(y,i)) ) return 0;
885 3958813 : return 1;
886 : }
887 : static int
888 1505 : identicalrr(GEN x, GEN y)
889 : {
890 1505 : long i, lx = lg(x);
891 1505 : if (lg(y) != lx) return 0;
892 1505 : if (x[1] != y[1]) return 0;
893 5284 : i=2; while (i<lx && x[i]==y[i]) i++;
894 1498 : return (i == lx);
895 : }
896 :
897 : static int
898 70 : closure_identical(GEN x, GEN y)
899 : {
900 70 : if (lg(x)!=lg(y) || x[1]!=y[1]) return 0;
901 56 : if (!gidentical(gel(x,2),gel(y,2)) || !gidentical(gel(x,3),gel(y,3))
902 56 : || !gidentical(gel(x,4),gel(y,4))) return 0;
903 42 : if (lg(x)<8) return 1;
904 0 : return gidentical(gel(x,7),gel(y,7));
905 : }
906 :
907 : static int
908 343 : list_cmp(GEN x, GEN y, int cmp(GEN x, GEN y))
909 : {
910 343 : int t = list_typ(x);
911 : GEN vx, vy;
912 : long lvx, lvy;
913 343 : if (list_typ(y)!=t) return 0;
914 343 : vx = list_data(x);
915 343 : vy = list_data(y);
916 343 : lvx = vx ? lg(vx): 1;
917 343 : lvy = vy ? lg(vy): 1;
918 343 : if (lvx==1 && lvy==1) return 1;
919 329 : if (lvx != lvy) return 0;
920 301 : switch (t)
921 : {
922 280 : case t_LIST_MAP:
923 : {
924 280 : pari_sp av = avma;
925 280 : GEN mx = maptomat_shallow(x), my = maptomat_shallow(y);
926 280 : int ret = gidentical(gel(mx, 1), gel(my, 1)) && cmp(gel(mx, 2), gel(my, 2));
927 280 : return gc_bool(av, ret);
928 : }
929 21 : default:
930 21 : return cmp(vx, vy);
931 : }
932 : }
933 :
934 : int
935 61823853 : gidentical(GEN x, GEN y)
936 : {
937 : long tx;
938 :
939 61823853 : if (x == y) return 1;
940 58217109 : tx = typ(x); if (typ(y) != tx) return 0;
941 57920476 : switch(tx)
942 : {
943 18965474 : case t_INT:
944 18965474 : return equalii(x,y);
945 :
946 1505 : case t_REAL:
947 1505 : return identicalrr(x,y);
948 :
949 795048 : case t_FRAC: case t_INTMOD:
950 795048 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
951 :
952 350 : case t_COMPLEX:
953 350 : return gidentical(gel(x,2),gel(y,2)) && gidentical(gel(x,1),gel(y,1));
954 14 : case t_PADIC:
955 14 : return valp(x) == valp(y)
956 14 : && equalii(gel(x,2),gel(y,2))
957 14 : && equalii(gel(x,3),gel(y,3))
958 28 : && equalii(gel(x,4),gel(y,4));
959 3843 : case t_POLMOD:
960 3843 : return gidentical(gel(x,2),gel(y,2)) && polidentical(gel(x,1),gel(y,1));
961 3432063 : case t_POL:
962 3432063 : return polidentical(x,y);
963 14 : case t_SER:
964 14 : return seridentical(x,y);
965 3024 : case t_FFELT:
966 3024 : return FF_equal(x,y);
967 :
968 391544 : case t_QFB:
969 391544 : return equalii(gel(x,1),gel(y,1))
970 391537 : && equalii(gel(x,2),gel(y,2))
971 783081 : && equalii(gel(x,3),gel(y,3));
972 :
973 14 : case t_QUAD:
974 14 : return ZX_equal(gel(x,1),gel(y,1))
975 7 : && gidentical(gel(x,2),gel(y,2))
976 21 : && gidentical(gel(x,3),gel(y,3));
977 :
978 7 : case t_RFRAC:
979 7 : return gidentical(gel(x,1),gel(y,1)) && gidentical(gel(x,2),gel(y,2));
980 :
981 70 : case t_STR:
982 70 : return !strcmp(GSTR(x),GSTR(y));
983 5242534 : case t_VEC: case t_COL: case t_MAT:
984 5242534 : return vecidentical(x,y);
985 29084762 : case t_VECSMALL:
986 29084762 : return zv_equal(x,y);
987 28 : case t_CLOSURE:
988 28 : return closure_identical(x,y);
989 161 : case t_LIST:
990 161 : return list_cmp(x, y, gidentical);
991 21 : case t_INFINITY: return gidentical(gel(x,1),gel(y,1));
992 : }
993 0 : return 0;
994 : }
995 : /* x,y t_POL in the same variable */
996 : static int
997 7422849 : polequal(GEN x, GEN y)
998 : {
999 : long lx, ly;
1000 : /* Can't do that: Mod(0,1)*x^0 == x^0
1001 : if (signe(x) != signe(y)) return 0; */
1002 7422849 : lx = lg(x); ly = lg(y);
1003 7422849 : while (lx > ly) if (!gequal0(gel(x,--lx))) return 0;
1004 7419300 : while (ly > lx) if (!gequal0(gel(y,--ly))) return 0;
1005 29481786 : for (lx--; lx >= 2; lx--) if (!gequal(gel(x,lx), gel(y,lx))) return 0;
1006 7347305 : return 1;
1007 : }
1008 :
1009 : /* x,y t_SER in the same variable */
1010 : static int
1011 413 : serequal(GEN x, GEN y)
1012 : {
1013 : long LX, LY, lx, ly, vx, vy;
1014 413 : if (!signe(x) && !signe(y)) return 1;
1015 56 : lx = lg(x); vx = valser(x); LX = lx + vx;
1016 56 : ly = lg(y); vy = valser(y); LY = ly + vy;
1017 56 : if (LX > LY) lx = LY - vx; else ly = LX - vy;
1018 282877 : while (lx >= 3 && ly >= 3)
1019 282821 : if (!gequal(gel(x,--lx), gel(y,--ly))) return 0;
1020 56 : while(--ly >= 2) if (!gequal0(gel(y,ly))) return 0;
1021 84 : while(--lx >= 2) if (!gequal0(gel(x,lx))) return 0;
1022 49 : return 1;
1023 : }
1024 :
1025 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
1026 : static int
1027 5536979 : vecequal(GEN x, GEN y)
1028 : {
1029 : long i;
1030 5536979 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
1031 18325956 : for (i = lg(x)-1; i; i--)
1032 15972590 : if (! gequal(gel(x,i),gel(y,i)) ) return 0;
1033 2353366 : return 1;
1034 : }
1035 :
1036 : int
1037 225890345 : gequal(GEN x, GEN y)
1038 : {
1039 : pari_sp av;
1040 : long tx, ty;
1041 : long i;
1042 :
1043 225890345 : if (x == y) return 1;
1044 199544519 : tx = typ(x);
1045 199544519 : ty = typ(y);
1046 199544519 : if (tx == ty)
1047 191753674 : switch(tx)
1048 : {
1049 166073310 : case t_INT:
1050 166073310 : return equalii(x,y);
1051 :
1052 5752 : case t_REAL:
1053 5752 : return equalrr(x,y);
1054 :
1055 6794126 : case t_FRAC: case t_INTMOD:
1056 6794126 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
1057 :
1058 1267 : case t_COMPLEX:
1059 1267 : return gequal(gel(x,2),gel(y,2)) && gequal(gel(x,1),gel(y,1));
1060 763 : case t_PADIC:
1061 763 : if (!equalii(gel(x,2),gel(y,2))) return 0;
1062 763 : av = avma; i = gequal0(gsub(x,y)); set_avma(av);
1063 763 : return i;
1064 3209275 : case t_POLMOD:
1065 3209275 : if (varn(gel(x,1)) != varn(gel(y,1))) break;
1066 3209268 : return gequal(gel(x,2),gel(y,2)) && RgX_equal_var(gel(x,1),gel(y,1));
1067 7431341 : case t_POL:
1068 7431341 : if (varn(x) != varn(y)) break;
1069 7422850 : return polequal(x,y);
1070 413 : case t_SER:
1071 413 : if (varn(x) != varn(y)) break;
1072 413 : return serequal(x,y);
1073 :
1074 56070 : case t_FFELT:
1075 56070 : return FF_equal(x,y);
1076 :
1077 1096404 : case t_QFB:
1078 1096404 : return equalii(gel(x,1),gel(y,1))
1079 247563 : && equalii(gel(x,2),gel(y,2))
1080 1343967 : && equalii(gel(x,3),gel(y,3));
1081 :
1082 7 : case t_QUAD:
1083 7 : return ZX_equal(gel(x,1),gel(y,1))
1084 0 : && gequal(gel(x,2),gel(y,2))
1085 7 : && gequal(gel(x,3),gel(y,3));
1086 :
1087 73717 : case t_RFRAC:
1088 : {
1089 73717 : GEN a = gel(x,1), b = gel(x,2), c = gel(y,1), d = gel(y,2);
1090 73717 : if (gequal(b,d)) return gequal(a,c); /* simple case */
1091 0 : av = avma;
1092 0 : a = simplify_shallow(gmul(a,d));
1093 0 : b = simplify_shallow(gmul(b,c));
1094 0 : return gc_bool(av, gequal(a,b));
1095 : }
1096 :
1097 64673 : case t_STR:
1098 64673 : return !strcmp(GSTR(x),GSTR(y));
1099 5536979 : case t_VEC: case t_COL: case t_MAT:
1100 5536979 : return vecequal(x,y);
1101 1409335 : case t_VECSMALL:
1102 1409335 : return zv_equal(x,y);
1103 182 : case t_LIST:
1104 182 : return list_cmp(x, y, gequal);
1105 42 : case t_CLOSURE:
1106 42 : return closure_identical(x,y);
1107 28 : case t_INFINITY:
1108 28 : return gequal(gel(x,1),gel(y,1));
1109 : }
1110 7799333 : if (is_noncalc_t(tx) || is_noncalc_t(ty)) return 0;
1111 7799438 : if (tx == t_INT && !signe(x)) return gequal0(y);
1112 7796344 : if (ty == t_INT && !signe(y)) return gequal0(x);
1113 3193096 : (void)&av; av = avma; /* emulate volatile */
1114 3193096 : return gc_bool(av, gequal_try(x, y));
1115 : }
1116 :
1117 : int
1118 41664 : gequalsg(long s, GEN x)
1119 41664 : { pari_sp av = avma; return gc_bool(av, gequal(stoi(s), x)); }
1120 :
1121 : /* a and b are t_INT, t_FRAC, t_REAL or t_COMPLEX of those. Check whether
1122 : * a-b is invertible */
1123 : int
1124 32950 : cx_approx_equal(GEN a, GEN b)
1125 : {
1126 32950 : pari_sp av = avma;
1127 : GEN d;
1128 32950 : if (a == b) return 1;
1129 24465 : d = gsub(a,b);
1130 24465 : return gc_bool(av, gequal0(d) || (typ(d)==t_COMPLEX && gequal0(cxnorm(d))));
1131 : }
1132 : static int
1133 1323434 : r_approx0(GEN x, long e) { return e - expo(x) > bit_prec(x); }
1134 : /* x ~ 0 compared to reference y */
1135 : int
1136 1851563 : cx_approx0(GEN x, GEN y)
1137 : {
1138 : GEN a, b;
1139 : long e;
1140 1851563 : switch(typ(x))
1141 : {
1142 469 : case t_COMPLEX:
1143 469 : a = gel(x,1); b = gel(x,2);
1144 469 : if (typ(a) != t_REAL)
1145 : {
1146 14 : if (!gequal0(a)) return 0;
1147 0 : a = NULL;
1148 : }
1149 455 : else if (!signe(a)) a = NULL;
1150 455 : if (typ(b) != t_REAL)
1151 : {
1152 0 : if (!gequal0(b)) return 0;
1153 0 : if (!a) return 1;
1154 0 : b = NULL;
1155 : }
1156 455 : else if (!signe(b))
1157 : {
1158 7 : if (!a) return 1;
1159 7 : b = NULL;
1160 : }
1161 : /* a or b is != NULL iff it is non-zero t_REAL; one of them is */
1162 455 : e = gexpo(y);
1163 455 : return (!a || r_approx0(a, e)) && (!b || r_approx0(b, e));
1164 1322971 : case t_REAL:
1165 1322971 : return !signe(x) || r_approx0(x, gexpo(y));
1166 528123 : default:
1167 528123 : return gequal0(x);
1168 : }
1169 : }
1170 : /*******************************************************************/
1171 : /* */
1172 : /* VALUATION */
1173 : /* p is either a t_INT or a t_POL. */
1174 : /* returns the largest exponent of p dividing x when this makes */
1175 : /* sense : error for types real, integermod and polymod if p does */
1176 : /* not divide the modulus, q-adic if q!=p. */
1177 : /* */
1178 : /*******************************************************************/
1179 :
1180 : static long
1181 336 : minval(GEN x, GEN p)
1182 : {
1183 336 : long i,k, val = LONG_MAX, lx = lg(x);
1184 6538 : for (i=lontyp[typ(x)]; i<lx; i++)
1185 : {
1186 6202 : k = gvaluation(gel(x,i),p);
1187 6202 : if (k < val) val = k;
1188 : }
1189 336 : return val;
1190 : }
1191 :
1192 : static int
1193 91 : intdvd(GEN x, GEN y, GEN *z) { GEN r; *z = dvmdii(x,y,&r); return (r==gen_0); }
1194 :
1195 : /* x t_FRAC, p t_INT, return v_p(x) */
1196 : static long
1197 291090 : frac_val(GEN x, GEN p) {
1198 291090 : long v = Z_pval(gel(x,2),p);
1199 291090 : if (v) return -v;
1200 290949 : return Z_pval(gel(x,1),p);
1201 : }
1202 : long
1203 4016683 : Q_pval(GEN x, GEN p)
1204 : {
1205 4016683 : if (lgefint(p) == 3) return Q_lval(x, uel(p,2));
1206 562 : return (typ(x)==t_INT)? Z_pval(x, p): frac_val(x, p);
1207 : }
1208 :
1209 : static long
1210 433951 : frac_lval(GEN x, ulong p) {
1211 433951 : long v = Z_lval(gel(x,2),p);
1212 433953 : if (v) return -v;
1213 343173 : return Z_lval(gel(x,1),p);
1214 : }
1215 : long
1216 4020845 : Q_lval(GEN x, ulong p){return (typ(x)==t_INT)? Z_lval(x, p): frac_lval(x, p);}
1217 :
1218 : long
1219 3895900 : Q_pvalrem(GEN x, GEN p, GEN *y)
1220 : {
1221 : GEN a, b;
1222 : long v;
1223 3895900 : if (lgefint(p) == 3) return Q_lvalrem(x, uel(p,2), y);
1224 5847 : if (typ(x) == t_INT) return Z_pvalrem(x, p, y);
1225 0 : a = gel(x,1);
1226 0 : b = gel(x,2);
1227 0 : v = Z_pvalrem(b, p, &b);
1228 0 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1229 0 : v = Z_pvalrem(a, p, &a);
1230 0 : *y = mkfrac(a, b); return v;
1231 : }
1232 : long
1233 3894216 : Q_lvalrem(GEN x, ulong p, GEN *y)
1234 : {
1235 : GEN a, b;
1236 : long v;
1237 3894216 : if (typ(x) == t_INT) return Z_lvalrem(x, p, y);
1238 195830 : a = gel(x,1);
1239 195830 : b = gel(x,2);
1240 195830 : v = Z_lvalrem(b, p, &b);
1241 195834 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1242 26330 : v = Z_lvalrem(a, p, &a);
1243 26330 : *y = mkfrac(a, b); return v;
1244 : }
1245 :
1246 : long
1247 1162103 : gvaluation(GEN x, GEN p)
1248 : {
1249 1162103 : long tx = typ(x), tp;
1250 : pari_sp av;
1251 :
1252 1162103 : if (!p)
1253 28 : switch(tx)
1254 : {
1255 7 : case t_PADIC: return valp(x);
1256 7 : case t_POL: return RgX_val(x);
1257 7 : case t_SER: return valser(x);
1258 7 : default: pari_err_TYPE("gvaluation", x);
1259 : }
1260 1162075 : tp = typ(p);
1261 1162075 : switch(tp)
1262 : {
1263 1155943 : case t_INT:
1264 1155943 : if (signe(p) && !is_pm1(p)) break;
1265 28 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1266 6125 : case t_POL:
1267 6125 : if (degpol(p) > 0) break;
1268 : default:
1269 7 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1270 : }
1271 :
1272 1162040 : switch(tx)
1273 : {
1274 146342 : case t_INT:
1275 146342 : if (!signe(x)) return LONG_MAX;
1276 146237 : if (tp == t_POL) return 0;
1277 145915 : return Z_pval(x,p);
1278 :
1279 49 : case t_REAL:
1280 49 : if (tp == t_POL) return 0;
1281 21 : break;
1282 :
1283 28 : case t_FFELT:
1284 28 : if (tp == t_POL) return FF_equal0(x)? LONG_MAX: 0;
1285 14 : break;
1286 :
1287 105 : case t_INTMOD: {
1288 105 : GEN a = gel(x,1), b = gel(x,2);
1289 : long val;
1290 133 : if (tp == t_POL) return signe(b)? 0: LONG_MAX;
1291 42 : av = avma;
1292 42 : if (!intdvd(a, p, &a)) break;
1293 28 : if (!intdvd(b, p, &b)) return gc_long(av,0);
1294 14 : val = 1; while (intdvd(a,p,&a) && intdvd(b,p,&b)) val++;
1295 14 : return gc_long(av,val);
1296 : }
1297 :
1298 291004 : case t_FRAC:
1299 291004 : if (tp == t_POL) return 0;
1300 290990 : return frac_val(x, p);
1301 :
1302 718625 : case t_PADIC:
1303 718625 : if (tp == t_POL) return 0;
1304 718604 : if (!equalii(p,gel(x,2))) break;
1305 718597 : return valp(x);
1306 :
1307 35 : case t_POLMOD: {
1308 35 : GEN a = gel(x,1), b = gel(x,2);
1309 : long v, val;
1310 35 : if (tp == t_INT) return gvaluation(b,p);
1311 21 : v = varn(p);
1312 21 : if (varn(a) != v) return 0;
1313 21 : av = avma;
1314 21 : a = RgX_divrem(a, p, ONLY_DIVIDES);
1315 21 : if (!a) break;
1316 28 : if (typ(b) != t_POL || varn(b) != v ||
1317 21 : !(b = RgX_divrem(b, p, ONLY_DIVIDES)) ) return gc_long(av,0);
1318 7 : val = 1;
1319 28 : while ((a = RgX_divrem(a, p, ONLY_DIVIDES)) &&
1320 21 : (b = RgX_divrem(b, p, ONLY_DIVIDES)) ) val++;
1321 7 : return gc_long(av,val);
1322 : }
1323 5215 : case t_POL: {
1324 5215 : if (tp == t_POL) {
1325 5026 : long vp = varn(p), vx = varn(x);
1326 5026 : if (vp == vx)
1327 : {
1328 : long val;
1329 5012 : if (RgX_is_monomial(p))
1330 : {
1331 4977 : val = RgX_val(x); if (val == LONG_MAX) return LONG_MAX;
1332 4907 : return val / degpol(p);
1333 : }
1334 35 : if (!signe(x)) return LONG_MAX;
1335 21 : av = avma;
1336 21 : for (val=0; ; val++)
1337 : {
1338 35 : x = RgX_divrem(x,p,ONLY_DIVIDES);
1339 35 : if (!x) return gc_long(av,val);
1340 14 : if (gc_needed(av,1))
1341 : {
1342 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gvaluation");
1343 0 : x = gerepilecopy(av, x);
1344 : }
1345 : }
1346 : }
1347 14 : if (varncmp(vx, vp) > 0) return 0;
1348 : }
1349 196 : return minval(x,p);
1350 : }
1351 :
1352 469 : case t_SER: {
1353 469 : if (tp == t_POL) {
1354 455 : long vp = varn(p), vx = varn(x);
1355 455 : if (vp == vx)
1356 : {
1357 448 : long val = RgX_val(p);
1358 448 : if (!val) pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1359 441 : return (long)(valser(x) / val);
1360 : }
1361 7 : if (varncmp(vx, vp) > 0) return 0;
1362 : }
1363 14 : return minval(x,p);
1364 : }
1365 :
1366 42 : case t_RFRAC:
1367 42 : return gvaluation(gel(x,1),p) - gvaluation(gel(x,2),p);
1368 :
1369 126 : case t_COMPLEX: case t_QUAD: case t_VEC: case t_COL: case t_MAT:
1370 126 : return minval(x,p);
1371 : }
1372 63 : pari_err_OP("valuation", x,p);
1373 : return 0; /* LCOV_EXCL_LINE */
1374 : }
1375 : GEN
1376 3808 : gpvaluation(GEN x, GEN p)
1377 : {
1378 3808 : long v = gvaluation(x,p);
1379 3703 : return v == LONG_MAX? mkoo(): stoi(v);
1380 : }
1381 :
1382 : /* x is nonzero */
1383 : long
1384 73555441 : u_lvalrem(ulong x, ulong p, ulong *py)
1385 : {
1386 : ulong vx;
1387 73555441 : if (p == 2) { vx = vals(x); *py = x >> vx; return vx; }
1388 63603052 : for(vx = 0;;)
1389 : {
1390 132844847 : if (x % p) { *py = x; return vx; }
1391 69241795 : x /= p; /* gcc is smart enough to make a single div */
1392 69241795 : vx++;
1393 : }
1394 : }
1395 : long
1396 28090961 : u_lval(ulong x, ulong p)
1397 : {
1398 : ulong vx;
1399 28090961 : if (p == 2) return vals(x);
1400 24811895 : for(vx = 0;;)
1401 : {
1402 54876405 : if (x % p) return vx;
1403 30064510 : x /= p; /* gcc is smart enough to make a single div */
1404 30064510 : vx++;
1405 : }
1406 : }
1407 :
1408 : long
1409 1809303 : z_lval(long s, ulong p) { return u_lval(labs(s), p); }
1410 : long
1411 87349 : z_lvalrem(long s, ulong p, long *py)
1412 : {
1413 : long v;
1414 87349 : if (s < 0)
1415 : {
1416 0 : ulong u = (ulong)-s;
1417 0 : v = u_lvalrem(u, p, &u);
1418 0 : *py = -(long)u;
1419 : }
1420 : else
1421 : {
1422 87349 : ulong u = (ulong)s;
1423 87349 : v = u_lvalrem(u, p, &u);
1424 87349 : *py = (long)u;
1425 : }
1426 87349 : return v;
1427 : }
1428 : /* assume |p| > 1 */
1429 : long
1430 1306543 : z_pval(long s, GEN p)
1431 : {
1432 1306543 : if (lgefint(p) > 3) return 0;
1433 1306543 : return z_lval(s, uel(p,2));
1434 : }
1435 : /* assume |p| > 1 */
1436 : long
1437 399 : z_pvalrem(long s, GEN p, long *py)
1438 : {
1439 399 : if (lgefint(p) > 3) { *py = s; return 0; }
1440 399 : return z_lvalrem(s, uel(p,2), py);
1441 : }
1442 :
1443 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1444 : static long
1445 2107869 : Z_pvalrem_DC(GEN x, GEN q, GEN *py)
1446 : {
1447 2107869 : GEN r, z = dvmdii(x, q, &r);
1448 : long v;
1449 2107824 : if (r != gen_0) { *py = x; return 0; }
1450 1451013 : if (2 * lgefint(q) <= lgefint(z)+3) /* avoid squaring if pointless */
1451 1434236 : v = Z_pvalrem_DC(z, sqri(q), py) << 1;
1452 : else
1453 16777 : { v = 0; *py = z; }
1454 1450993 : z = dvmdii(*py, q, &r);
1455 1451087 : if (r != gen_0) return v + 1;
1456 603171 : *py = z; return v + 2;
1457 : }
1458 :
1459 : static const long VAL_DC_THRESHOLD = 16;
1460 :
1461 : long
1462 21754550 : Z_lval(GEN x, ulong p)
1463 : {
1464 : long vx;
1465 : pari_sp av;
1466 21754550 : if (p == 2) return vali(x);
1467 13477295 : if (lgefint(x) == 3) return u_lval(uel(x,2), p);
1468 1950619 : av = avma;
1469 1950619 : for(vx = 0;;)
1470 8601880 : {
1471 : ulong r;
1472 10552499 : GEN q = absdiviu_rem(x, p, &r);
1473 10552773 : if (r) break;
1474 8756223 : vx++; x = q;
1475 8756223 : if (vx == VAL_DC_THRESHOLD) {
1476 154343 : if (p == 1) pari_err_DOMAIN("Z_lval", "p", "=", gen_1, gen_1);
1477 154343 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1478 154343 : q = absdiviu_rem(x, p, &r); if (!r) vx++;
1479 154343 : break;
1480 : }
1481 : }
1482 1950893 : return gc_long(av,vx);
1483 : }
1484 : long
1485 38120238 : Z_lvalrem(GEN x, ulong p, GEN *py)
1486 : {
1487 : long vx, sx;
1488 : pari_sp av;
1489 38120238 : if (p == 2) { vx = vali(x); *py = shifti(x, -vx); return vx; }
1490 24708485 : if (lgefint(x) == 3) {
1491 : ulong u;
1492 18493359 : vx = u_lvalrem(uel(x,2), p, &u);
1493 18493069 : *py = signe(x) < 0? utoineg(u): utoipos(u);
1494 18491938 : return vx;
1495 : }
1496 6215126 : av = avma; (void)new_chunk(lgefint(x));
1497 6215719 : sx = signe(x);
1498 6215719 : for(vx = 0;;)
1499 17273041 : {
1500 : ulong r;
1501 23488760 : GEN q = absdiviu_rem(x, p, &r);
1502 23488749 : if (r) break;
1503 17791793 : vx++; x = q;
1504 17791793 : if (vx == VAL_DC_THRESHOLD) {
1505 518752 : if (p == 1) pari_err_DOMAIN("Z_lvalrem", "p", "=", gen_1, gen_1);
1506 518752 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1507 518736 : q = absdiviu_rem(x, p, &r); if (!r) { vx++; x = q; }
1508 518744 : break;
1509 : }
1510 : }
1511 6215700 : set_avma(av); *py = icopy(x); setsigne(*py, sx); return vx;
1512 : }
1513 :
1514 : /* Is |q| <= p ? */
1515 : static int
1516 22509351 : isless_iu(GEN q, ulong p) {
1517 22509351 : long l = lgefint(q);
1518 22509351 : return l==2 || (l == 3 && uel(q,2) <= p);
1519 : }
1520 :
1521 : long
1522 272945736 : u_lvalrem_stop(ulong *n, ulong p, int *stop)
1523 : {
1524 272945736 : ulong N = *n, q = N / p, r = N % p; /* gcc makes a single div */
1525 272945736 : long v = 0;
1526 272945736 : if (!r)
1527 : {
1528 27775534 : do { v++; N = q; q = N / p; r = N % p; } while (!r);
1529 22609435 : *n = N;
1530 : }
1531 272945736 : *stop = q <= p; return v;
1532 : }
1533 : /* Assume n > 0. Return v_p(n), set *n := n/p^v_p(n). Set 'stop' if now
1534 : * n < p^2 [implies n prime if no prime < p divides n] */
1535 : long
1536 157889493 : Z_lvalrem_stop(GEN *n, ulong p, int *stop)
1537 : {
1538 : pari_sp av;
1539 : long v;
1540 : ulong r;
1541 : GEN N, q;
1542 :
1543 157889493 : if (lgefint(*n) == 3)
1544 : {
1545 135401494 : r = (*n)[2];
1546 135401494 : v = u_lvalrem_stop(&r, p, stop);
1547 135447648 : if (v) *n = utoipos(r);
1548 135468561 : return v;
1549 : }
1550 22487999 : av = avma; v = 0; q = absdiviu_rem(*n, p, &r);
1551 22509351 : if (r) set_avma(av);
1552 : else
1553 : {
1554 : do {
1555 311148 : v++; N = q;
1556 311148 : if (v == VAL_DC_THRESHOLD)
1557 : {
1558 589 : v += Z_pvalrem_DC(N,sqru(p),&N) << 1;
1559 589 : q = absdiviu_rem(N, p, &r); if (!r) { v++; N = q; }
1560 589 : break;
1561 : }
1562 310559 : q = absdiviu_rem(N, p, &r);
1563 310559 : } while (!r);
1564 266875 : *n = N;
1565 : }
1566 22509365 : *stop = isless_iu(q,p); return v;
1567 : }
1568 :
1569 : /* x is a nonzero integer, |p| > 1 */
1570 : long
1571 30502177 : Z_pvalrem(GEN x, GEN p, GEN *py)
1572 : {
1573 : long vx;
1574 : pari_sp av;
1575 :
1576 30502177 : if (lgefint(p) == 3) return Z_lvalrem(x, uel(p,2), py);
1577 25519 : if (lgefint(x) == 3) { *py = icopy(x); return 0; }
1578 8277 : av = avma; vx = 0; (void)new_chunk(lgefint(x));
1579 : for(;;)
1580 14220 : {
1581 22544 : GEN r, q = dvmdii(x,p,&r);
1582 22544 : if (r != gen_0) { set_avma(av); *py = icopy(x); return vx; }
1583 14220 : vx++; x = q;
1584 : }
1585 : }
1586 : long
1587 2387255 : u_pvalrem(ulong x, GEN p, ulong *py)
1588 : {
1589 2387255 : if (lgefint(p) == 3) return u_lvalrem(x, uel(p,2), py);
1590 543 : *py = x; return 0;
1591 : }
1592 : long
1593 135469 : u_pval(ulong x, GEN p)
1594 : {
1595 135469 : if (lgefint(p) == 3) return u_lval(x, uel(p,2));
1596 0 : return 0;
1597 : }
1598 : long
1599 13267653 : Z_pval(GEN x, GEN p) {
1600 : long vx;
1601 : pari_sp av;
1602 :
1603 13267653 : if (lgefint(p) == 3) return Z_lval(x, uel(p,2));
1604 32883 : if (lgefint(x) == 3) return 0;
1605 7935 : av = avma; vx = 0;
1606 : for(;;)
1607 25407 : {
1608 33342 : GEN r, q = dvmdii(x,p,&r);
1609 33373 : if (r != gen_0) return gc_long(av,vx);
1610 25407 : vx++; x = q;
1611 : }
1612 : }
1613 :
1614 : /* return v_p(n!) = [n/p] + [n/p^2] + ... */
1615 : long
1616 2021577 : factorial_lval(ulong n, ulong p)
1617 : {
1618 : ulong q, v;
1619 2021577 : if (p == 2) return n - hammingl(n);
1620 1352458 : q = p; v = 0;
1621 1499073 : do { v += n/q; q *= p; } while (n >= q);
1622 1352458 : return (long)v;
1623 : }
1624 :
1625 : /********** Same for "containers" ZX / ZV / ZC **********/
1626 :
1627 : /* If the t_INT q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1628 : * Stack clean; assumes lg(x) > 1 */
1629 : static GEN
1630 6592 : gen_Z_divides(GEN x, GEN q, long imin)
1631 : {
1632 : long i, l;
1633 6592 : GEN y = cgetg_copy(x, &l);
1634 :
1635 6592 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1636 88616 : for (i = imin; i < l; i++)
1637 : {
1638 86032 : GEN r, xi = gel(x,i);
1639 86032 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1640 55461 : gel(y,i) = dvmdii(xi, q, &r);
1641 55461 : if (r != gen_0) { set_avma((pari_sp)(y+l)); return NULL; }
1642 : }
1643 2584 : return y;
1644 : }
1645 : /* If q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1646 : * Stack clean; assumes lg(x) > 1 */
1647 : static GEN
1648 4886 : gen_z_divides(GEN x, ulong q, long imin)
1649 : {
1650 : long i, l;
1651 4886 : GEN y = cgetg_copy(x, &l);
1652 :
1653 4886 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1654 43280 : for (i = imin; i < l; i++)
1655 : {
1656 : ulong r;
1657 41979 : GEN xi = gel(x,i);
1658 41979 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1659 28664 : gel(y,i) = absdiviu_rem(xi, q, &r);
1660 28664 : if (r) { set_avma((pari_sp)(y+l)); return NULL; }
1661 25079 : affectsign_safe(xi, &gel(y,i));
1662 : }
1663 1301 : return y;
1664 : }
1665 :
1666 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1667 : static long
1668 11441 : gen_pvalrem_DC(GEN x, GEN q, GEN *py, long imin)
1669 : {
1670 :
1671 11441 : pari_sp av = avma;
1672 11441 : long v, i, l, lz = LONG_MAX;
1673 11441 : GEN y = cgetg_copy(x, &l);
1674 :
1675 11441 : y[1] = x[1];
1676 134686 : for (i = imin; i < l; i++)
1677 : {
1678 128094 : GEN r, xi = gel(x,i);
1679 128094 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1680 86280 : gel(y,i) = dvmdii(xi, q, &r);
1681 86280 : if (r != gen_0) { *py = x; return gc_long(av,0); }
1682 81431 : lz = minss(lz, lgefint(gel(y,i)));
1683 : }
1684 6592 : if (2 * lgefint(q) <= lz+3) /* avoid squaring if pointless */
1685 6541 : v = gen_pvalrem_DC(y, sqri(q), py, imin) << 1;
1686 : else
1687 51 : { v = 0; *py = y; }
1688 :
1689 6592 : y = gen_Z_divides(*py, q, imin);
1690 6592 : if (!y) return v+1;
1691 2584 : *py = y; return v+2;
1692 : }
1693 :
1694 : static long
1695 772331 : gen_2val(GEN x, long imin)
1696 : {
1697 772331 : long i, lx = lg(x), v = LONG_MAX;
1698 2916902 : for (i = imin; i < lx; i++)
1699 : {
1700 2481214 : GEN c = gel(x,i);
1701 : long w;
1702 2481214 : if (!signe(c)) continue;
1703 2268890 : w = vali(c);
1704 2268890 : if (w < v) { v = w; if (!v) break; }
1705 : }
1706 772331 : return v;
1707 : }
1708 : static long
1709 1278258 : gen_lval(GEN x, ulong p, long imin)
1710 : {
1711 : long i, lx, v;
1712 : pari_sp av;
1713 : GEN y;
1714 1278258 : if (p == 2) return gen_2val(x, imin);
1715 505927 : av = avma;
1716 505927 : lx = lg(x); y = leafcopy(x);
1717 739977 : for(v = 0;; v++)
1718 2300166 : for (i = imin; i < lx; i++)
1719 : {
1720 : ulong r;
1721 2066116 : gel(y,i) = absdiviu_rem(gel(y,i), p, &r);
1722 2066116 : if (r) return gc_long(av,v);
1723 : }
1724 : }
1725 : long
1726 745778 : ZX_lval(GEN x, ulong p) { return gen_lval(x, p, 2); }
1727 : long
1728 0 : ZV_lval(GEN x, ulong p) { return gen_lval(x, p, 1); }
1729 :
1730 : long
1731 28924 : zx_lval(GEN f, long p)
1732 : {
1733 28924 : long i, l = lg(f), x = LONG_MAX;
1734 30212 : for(i=2; i<l; i++)
1735 : {
1736 : long y;
1737 29470 : if (f[i] == 0) continue;
1738 29421 : y = z_lval(f[i], p);
1739 29421 : if (y < x) { x = y; if (x == 0) return x; }
1740 : }
1741 742 : return x;
1742 : }
1743 :
1744 : static long
1745 542830 : gen_pval(GEN x, GEN p, long imin)
1746 : {
1747 : long i, lx, v;
1748 : pari_sp av;
1749 : GEN y;
1750 542830 : if (lgefint(p) == 3) return gen_lval(x, p[2], imin);
1751 10350 : av = avma;
1752 10350 : lx = lg(x); y = leafcopy(x);
1753 10350 : for(v = 0;; v++)
1754 : {
1755 10350 : if (v == VAL_DC_THRESHOLD)
1756 : {
1757 0 : if (is_pm1(p)) pari_err_DOMAIN("gen_pval", "p", "=", p, p);
1758 0 : v += gen_pvalrem_DC(y, p, &y, imin);
1759 0 : return gc_long(av,v);
1760 : }
1761 :
1762 10350 : for (i = imin; i < lx; i++)
1763 : {
1764 10350 : GEN r; gel(y,i) = dvmdii(gel(y,i), p, &r);
1765 10350 : if (r != gen_0) return gc_long(av,v);
1766 : }
1767 : }
1768 : }
1769 : long
1770 510404 : ZX_pval(GEN x, GEN p) { return gen_pval(x, p, 2); }
1771 : long
1772 32426 : ZV_pval(GEN x, GEN p) { return gen_pval(x, p, 1); }
1773 : /* v = 0 (mod p) */
1774 : int
1775 448 : ZV_Z_dvd(GEN v, GEN p)
1776 : {
1777 448 : pari_sp av = avma;
1778 448 : long i, l = lg(v);
1779 1456 : for (i=1; i<l; i++)
1780 1057 : if (!dvdii(gel(v,i), p)) return gc_long(av,0);
1781 399 : return gc_long(av,1);
1782 : }
1783 :
1784 : static long
1785 4739933 : gen_2valrem(GEN x, GEN *px, long imin)
1786 : {
1787 4739933 : long i, lx = lg(x), v = LONG_MAX;
1788 : GEN z;
1789 13687287 : for (i = imin; i < lx; i++)
1790 : {
1791 12375481 : GEN c = gel(x,i);
1792 : long w;
1793 12375481 : if (!signe(c)) continue;
1794 11489257 : w = vali(c);
1795 11489290 : if (w < v) {
1796 6807381 : v = w;
1797 6807381 : if (!v) { *px = x; return 0; } /* early abort */
1798 : }
1799 : }
1800 1311806 : z = cgetg_copy(x, &lx); z[1] = x[1];
1801 8424768 : for (i=imin; i<lx; i++) gel(z,i) = shifti(gel(x,i), -v);
1802 1311172 : *px = z; return v;
1803 : }
1804 : static long
1805 7706163 : gen_lvalrem(GEN x, ulong p, GEN *px, long imin)
1806 : {
1807 : long i, lx, v;
1808 : GEN y;
1809 7706163 : if (p == 2) return gen_2valrem(x, px, imin);
1810 2966263 : y = cgetg_copy(x, &lx);
1811 2966414 : y[1] = x[1];
1812 2966414 : x = leafcopy(x);
1813 2966356 : for(v = 0;; v++)
1814 : {
1815 4287152 : if (v == VAL_DC_THRESHOLD)
1816 : {
1817 4886 : if (p == 1) pari_err_DOMAIN("gen_lvalrem", "p", "=", gen_1, gen_1);
1818 4886 : v += gen_pvalrem_DC(x, sqru(p), px, imin) << 1;
1819 4886 : x = gen_z_divides(*px, p, imin);
1820 4886 : if (x) { *px = x; v++; }
1821 4886 : return v;
1822 : }
1823 :
1824 14251992 : for (i = imin; i < lx; i++)
1825 : {
1826 12931196 : ulong r; gel(y,i) = absdiviu_rem(gel(x,i), p, &r);
1827 12929488 : if (r) { *px = x; return v; }
1828 9968048 : affectsign_safe(gel(x,i), &gel(y,i));
1829 : }
1830 1320796 : swap(x, y);
1831 : }
1832 : }
1833 : long
1834 721 : ZX_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 2); }
1835 : long
1836 0 : ZV_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 1); }
1837 :
1838 : static long
1839 7718074 : gen_pvalrem(GEN x, GEN p, GEN *px, long imin)
1840 : {
1841 : long i, lx, v;
1842 : GEN y;
1843 7718074 : if (lgefint(p) == 3) return gen_lvalrem(x, p[2], px, imin);
1844 12784 : y = cgetg_copy(x, &lx);
1845 12863 : y[1] = x[1];
1846 12863 : x = leafcopy(x);
1847 12863 : for(v = 0;; v++)
1848 : {
1849 13652 : if (v == VAL_DC_THRESHOLD)
1850 : {
1851 14 : if (is_pm1(p)) pari_err_DOMAIN("gen_pvalrem", "p", "=", p, p);
1852 14 : return v + gen_pvalrem_DC(x, p, px, imin);
1853 : }
1854 :
1855 22302 : for (i = imin; i < lx; i++)
1856 : {
1857 21513 : GEN r; gel(y,i) = dvmdii(gel(x,i), p, &r);
1858 21513 : if (r != gen_0) { *px = x; return v; }
1859 : }
1860 789 : swap(x, y);
1861 : }
1862 : }
1863 : long
1864 3819578 : ZX_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 2); }
1865 : long
1866 3898414 : ZV_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 1); }
1867 :
1868 : /*******************************************************************/
1869 : /* */
1870 : /* NEGATION: Create -x */
1871 : /* */
1872 : /*******************************************************************/
1873 :
1874 : GEN
1875 412510111 : gneg(GEN x)
1876 : {
1877 : long lx, i;
1878 : GEN y;
1879 :
1880 412510111 : switch(typ(x))
1881 : {
1882 109488131 : case t_INT:
1883 109488131 : return signe(x)? negi(x): gen_0;
1884 222785705 : case t_REAL:
1885 222785705 : return mpneg(x);
1886 :
1887 222248 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1888 222248 : gel(y,1) = icopy(gel(x,1));
1889 222248 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1890 222247 : break;
1891 :
1892 1926161 : case t_FRAC:
1893 1926161 : y = cgetg(3, t_FRAC);
1894 1926161 : gel(y,1) = negi(gel(x,1));
1895 1926161 : gel(y,2) = icopy(gel(x,2)); break;
1896 :
1897 72862578 : case t_COMPLEX:
1898 72862578 : y=cgetg(3, t_COMPLEX);
1899 72863987 : gel(y,1) = gneg(gel(x,1));
1900 72865505 : gel(y,2) = gneg(gel(x,2));
1901 72865394 : break;
1902 :
1903 244479 : case t_POLMOD:
1904 244479 : retmkpolmod(gneg(gel(x,2)), RgX_copy(gel(x,1)));
1905 :
1906 153335 : case t_RFRAC:
1907 153335 : y = cgetg(3, t_RFRAC);
1908 153335 : gel(y,1) = gneg(gel(x,1));
1909 153335 : gel(y,2) = RgX_copy(gel(x,2)); break;
1910 :
1911 118089 : case t_PADIC:
1912 118089 : if (!signe(gel(x,4))) return gcopy(x);
1913 115954 : y = cgetg(5, t_PADIC);
1914 115955 : y[1] = x[1];
1915 115955 : gel(y,2) = icopy(gel(x,2));
1916 115954 : gel(y,3) = icopy(gel(x,3));
1917 115953 : gel(y,4) = subii(gel(x,3),gel(x,4));
1918 115953 : break;
1919 :
1920 133 : case t_QUAD:
1921 133 : y=cgetg(4,t_QUAD);
1922 133 : gel(y,1) = ZX_copy(gel(x,1));
1923 133 : gel(y,2) = gneg(gel(x,2));
1924 133 : gel(y,3) = gneg(gel(x,3)); break;
1925 :
1926 80459 : case t_FFELT: return FF_neg(x);
1927 4276327 : case t_POL: return RgX_neg(x);
1928 1309 : case t_SER:
1929 1309 : y = cgetg_copy(x, &lx); y[1] = x[1];
1930 16352 : for (i=2; i<lx; i++) gel(y,i) = gneg(gel(x,i));
1931 1309 : break;
1932 1519 : case t_VEC: return RgV_neg(x);
1933 460337 : case t_COL: return RgC_neg(x);
1934 315 : case t_MAT: return RgM_neg(x);
1935 770 : case t_INFINITY: return inf_get_sign(x) == 1? mkmoo(): mkoo();
1936 0 : default:
1937 0 : pari_err_TYPE("gneg",x);
1938 : return NULL; /* LCOV_EXCL_LINE */
1939 : }
1940 75284457 : return y;
1941 : }
1942 :
1943 : GEN
1944 112932673 : gneg_i(GEN x)
1945 : {
1946 : long lx, i;
1947 : GEN y;
1948 :
1949 112932673 : switch(typ(x))
1950 : {
1951 62918802 : case t_INT:
1952 62918802 : return signe(x)? negi(x): gen_0;
1953 20105672 : case t_REAL:
1954 20105672 : return mpneg(x);
1955 :
1956 717726 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1957 717726 : gel(y,1) = gel(x,1);
1958 717726 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1959 717726 : break;
1960 :
1961 5093559 : case t_FRAC:
1962 5093559 : y = cgetg(3, t_FRAC);
1963 5093555 : gel(y,1) = negi(gel(x,1));
1964 5093569 : gel(y,2) = gel(x,2); break;
1965 :
1966 7216571 : case t_COMPLEX:
1967 7216571 : y = cgetg(3, t_COMPLEX);
1968 7216678 : gel(y,1) = gneg_i(gel(x,1));
1969 7216791 : gel(y,2) = gneg_i(gel(x,2)); break;
1970 :
1971 2020578 : case t_PADIC: y = cgetg(5,t_PADIC);
1972 2020578 : y[1] = x[1];
1973 2020578 : gel(y,2) = gel(x,2);
1974 2020578 : gel(y,3) = gel(x,3);
1975 2020578 : gel(y,4) = signe(gel(x,4))? subii(gel(x,3),gel(x,4)): gen_0; break;
1976 :
1977 110275 : case t_POLMOD:
1978 110275 : retmkpolmod(gneg_i(gel(x,2)), RgX_copy(gel(x,1)));
1979 :
1980 84504 : case t_FFELT: return FF_neg_i(x);
1981 :
1982 672 : case t_QUAD: y=cgetg(4,t_QUAD);
1983 672 : gel(y,1) = gel(x,1);
1984 672 : gel(y,2) = gneg_i(gel(x,2));
1985 672 : gel(y,3) = gneg_i(gel(x,3)); break;
1986 :
1987 2373 : case t_VEC: case t_COL: case t_MAT:
1988 2373 : y = cgetg_copy(x, &lx);
1989 12803 : for (i=1; i<lx; i++) gel(y,i) = gneg_i(gel(x,i));
1990 2373 : break;
1991 :
1992 9624671 : case t_POL: case t_SER:
1993 9624671 : y = cgetg_copy(x, &lx); y[1]=x[1];
1994 40212716 : for (i=2; i<lx; i++) gel(y,i) = gneg_i(gel(x,i));
1995 9624413 : break;
1996 :
1997 5044843 : case t_RFRAC:
1998 5044843 : y = cgetg(3, t_RFRAC);
1999 5044843 : gel(y,1) = gneg_i(gel(x,1));
2000 5045053 : gel(y,2) = gel(x,2); break;
2001 :
2002 0 : default:
2003 0 : pari_err_TYPE("gneg_i",x);
2004 : return NULL; /* LCOV_EXCL_LINE */
2005 : }
2006 29721199 : return y;
2007 : }
2008 :
2009 : /******************************************************************/
2010 : /* */
2011 : /* ABSOLUTE VALUE */
2012 : /* Create abs(x) if x is integer, real, fraction or complex. */
2013 : /* Error otherwise. */
2014 : /* */
2015 : /******************************************************************/
2016 : static int
2017 0 : is_negative(GEN x) {
2018 0 : switch(typ(x))
2019 : {
2020 0 : case t_INT: case t_REAL:
2021 0 : return (signe(x) < 0);
2022 0 : case t_FRAC:
2023 0 : return (signe(gel(x,1)) < 0);
2024 : }
2025 0 : return 0;
2026 : }
2027 :
2028 : GEN
2029 47607258 : gabs(GEN x, long prec)
2030 : {
2031 : long lx;
2032 : pari_sp av;
2033 : GEN y, N;
2034 :
2035 47607258 : switch(typ(x))
2036 : {
2037 30970635 : case t_INT: case t_REAL:
2038 30970635 : return mpabs(x);
2039 :
2040 11698 : case t_FRAC:
2041 11698 : return absfrac(x);
2042 :
2043 16527220 : case t_COMPLEX:
2044 16527220 : av=avma; N=cxnorm(x);
2045 16524029 : switch(typ(N))
2046 : {
2047 266 : case t_INT:
2048 266 : if (!Z_issquareall(N, &y)) break;
2049 105 : return gerepileupto(av, y);
2050 21315 : case t_FRAC: {
2051 : GEN a,b;
2052 35336 : if (!Z_issquareall(gel(N,1), &a)) break;
2053 14021 : if (!Z_issquareall(gel(N,2), &b)) break;
2054 0 : return gerepileupto(av, gdiv(a,b));
2055 : }
2056 : }
2057 16523924 : return gerepileupto(av, gsqrt(N,prec));
2058 :
2059 21 : case t_QUAD:
2060 21 : av = avma;
2061 21 : return gerepileuptoleaf(av, gabs(quadtofp(x, prec), prec));
2062 :
2063 0 : case t_POL:
2064 0 : lx = lg(x); if (lx<=2) return RgX_copy(x);
2065 0 : return is_negative(gel(x,lx-1))? RgX_neg(x): RgX_copy(x);
2066 :
2067 7 : case t_SER:
2068 7 : if (!signe(x)) pari_err_DOMAIN("abs", "argument", "=", gen_0, x);
2069 7 : if (valser(x)) pari_err_DOMAIN("abs", "series valuation", "!=", gen_0, x);
2070 0 : return is_negative(gel(x,2))? gneg(x): gcopy(x);
2071 :
2072 102622 : case t_VEC: case t_COL: case t_MAT:
2073 614506 : pari_APPLY_same(gabs(gel(x,i),prec));
2074 : }
2075 0 : pari_err_TYPE("gabs",x);
2076 : return NULL; /* LCOV_EXCL_LINE */
2077 : }
2078 :
2079 : GEN
2080 78141 : gmax(GEN x, GEN y) { return gcopy(gmax_shallow(x,y)); }
2081 : GEN
2082 0 : gmaxgs(GEN x, long s) { return (gcmpsg(s,x)>=0)? stoi(s): gcopy(x); }
2083 :
2084 : GEN
2085 12172 : gmin(GEN x, GEN y) { return gcopy(gmin_shallow(x,y)); }
2086 : GEN
2087 0 : gmings(GEN x, long s) { return (gcmpsg(s,x)>0)? gcopy(x): stoi(s); }
2088 :
2089 : long
2090 502224 : vecindexmax(GEN x)
2091 : {
2092 502224 : long lx = lg(x), i0, i;
2093 : GEN s;
2094 :
2095 502224 : if (lx==1) pari_err_DOMAIN("vecindexmax", "empty argument", "=", x,x);
2096 502224 : switch(typ(x))
2097 : {
2098 502224 : case t_VEC: case t_COL:
2099 502224 : s = gel(x,i0=1);
2100 1498978 : for (i=2; i<lx; i++)
2101 996752 : if (gcmp(gel(x,i),s) > 0) s = gel(x,i0=i);
2102 502226 : return i0;
2103 0 : case t_VECSMALL:
2104 0 : return vecsmall_indexmax(x);
2105 0 : default: pari_err_TYPE("vecindexmax",x);
2106 : }
2107 : /* LCOV_EXCL_LINE */
2108 0 : return 0;
2109 : }
2110 : long
2111 167289 : vecindexmin(GEN x)
2112 : {
2113 167289 : long lx = lg(x), i0, i;
2114 : GEN s;
2115 :
2116 167289 : if (lx==1) pari_err_DOMAIN("vecindexmin", "empty argument", "=", x,x);
2117 167289 : switch(typ(x))
2118 : {
2119 167289 : case t_VEC: case t_COL:
2120 167289 : s = gel(x,i0=1);
2121 918406 : for (i=2; i<lx; i++)
2122 751117 : if (gcmp(gel(x,i),s) < 0) s = gel(x,i0=i);
2123 167289 : return i0;
2124 0 : case t_VECSMALL:
2125 0 : return vecsmall_indexmin(x);
2126 0 : default: pari_err_TYPE("vecindexmin",x);
2127 : }
2128 : /* LCOV_EXCL_LINE */
2129 0 : return 0;
2130 : }
2131 :
2132 : GEN
2133 226000 : vecmax0(GEN x, GEN *pi)
2134 : {
2135 226000 : long i, lx = lg(x), tx = typ(x);
2136 226000 : if (!is_matvec_t(tx) && tx != t_VECSMALL) return gcopy(x);
2137 225986 : if (lx==1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2138 225965 : switch(typ(x))
2139 : {
2140 225488 : case t_VEC: case t_COL:
2141 225488 : i = vecindexmax(x); if (pi) *pi = utoipos(i);
2142 225489 : return gcopy(gel(x,i));
2143 463 : case t_MAT: {
2144 463 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2145 : GEN s;
2146 463 : if (lx2 == 1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2147 456 : s = gcoeff(x,i0,j0); i = 2;
2148 1758 : for (j=1; j<lx; j++,i=1)
2149 : {
2150 1302 : GEN c = gel(x,j);
2151 24728 : for (; i<lx2; i++)
2152 23426 : if (gcmp(gel(c,i),s) > 0) { s = gel(c,i); j0=j; i0=i; }
2153 : }
2154 456 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2155 456 : return gcopy(s);
2156 : }
2157 14 : case t_VECSMALL:
2158 14 : i = vecsmall_indexmax(x); if (pi) *pi = utoipos(i);
2159 14 : return stoi(x[i]);
2160 : }
2161 : return NULL;/*LCOV_EXCL_LINE*/
2162 : }
2163 : GEN
2164 132632 : vecmin0(GEN x, GEN *pi)
2165 : {
2166 132632 : long i, lx = lg(x), tx = typ(x);
2167 132632 : if (!is_matvec_t(tx) && tx != t_VECSMALL) return gcopy(x);
2168 132618 : if (lx==1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2169 132604 : switch(typ(x))
2170 : {
2171 132576 : case t_VEC: case t_COL:
2172 132576 : i = vecindexmin(x); if (pi) *pi = utoipos(i);
2173 132576 : return gcopy(gel(x,i));
2174 14 : case t_MAT: {
2175 14 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2176 : GEN s;
2177 14 : if (lx2 == 1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2178 14 : s = gcoeff(x,i0,j0); i = 2;
2179 42 : for (j=1; j<lx; j++,i=1)
2180 : {
2181 28 : GEN c = gel(x,j);
2182 70 : for (; i<lx2; i++)
2183 42 : if (gcmp(gel(c,i),s) < 0) { s = gel(c,i); j0=j; i0=i; }
2184 : }
2185 14 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2186 14 : return gcopy(s);
2187 : }
2188 14 : case t_VECSMALL:
2189 14 : i = vecsmall_indexmin(x); if (pi) *pi = utoipos(i);
2190 14 : return stoi(x[i]);
2191 : }
2192 : return NULL;/*LCOV_EXCL_LINE*/
2193 : }
2194 :
2195 : GEN
2196 66057 : vecmax(GEN x) { return vecmax0(x, NULL); }
2197 : GEN
2198 20555 : vecmin(GEN x) { return vecmin0(x, NULL); }
2199 :
2200 : /*******************************************************************/
2201 : /* */
2202 : /* AFFECT long --> GEN */
2203 : /* affect long s to GEN x. Useful for initialization. */
2204 : /* */
2205 : /*******************************************************************/
2206 :
2207 : static void
2208 0 : padicaff0(GEN x)
2209 : {
2210 0 : if (signe(gel(x,4)))
2211 : {
2212 0 : x[1] = evalvalp(valp(x)+precp(x));
2213 0 : affsi(0,gel(x,4));
2214 : }
2215 0 : }
2216 :
2217 : void
2218 92820 : gaffsg(long s, GEN x)
2219 : {
2220 92820 : switch(typ(x))
2221 : {
2222 91924 : case t_INT: affsi(s,x); break;
2223 896 : case t_REAL: affsr(s,x); break;
2224 0 : case t_INTMOD: modsiz(s,gel(x,1),gel(x,2)); break;
2225 0 : case t_FRAC: affsi(s,gel(x,1)); affsi(1,gel(x,2)); break;
2226 0 : case t_COMPLEX: gaffsg(s,gel(x,1)); gaffsg(0,gel(x,2)); break;
2227 0 : case t_PADIC: {
2228 : long vx;
2229 : GEN y;
2230 0 : if (!s) { padicaff0(x); break; }
2231 0 : vx = Z_pvalrem(stoi(s), gel(x,2), &y);
2232 0 : setvalp(x,vx); modiiz(y,gel(x,3),gel(x,4));
2233 0 : break;
2234 : }
2235 0 : case t_QUAD: gaffsg(s,gel(x,2)); gaffsg(0,gel(x,3)); break;
2236 0 : default: pari_err_TYPE2("=",stoi(s),x);
2237 : }
2238 92820 : }
2239 :
2240 : /*******************************************************************/
2241 : /* */
2242 : /* GENERIC AFFECTATION */
2243 : /* Affect the content of x to y, whenever possible */
2244 : /* */
2245 : /*******************************************************************/
2246 : /* x PADIC, Y INT, return lift(x * Mod(1,Y)) */
2247 : GEN
2248 4466 : padic_to_Fp(GEN x, GEN Y) {
2249 4466 : pari_sp av = avma;
2250 4466 : GEN p = gel(x,2), z;
2251 4466 : long vy, vx = valp(x);
2252 4466 : if (!signe(Y)) pari_err_INV("padic_to_Fp",Y);
2253 4466 : vy = Z_pvalrem(Y,p, &z);
2254 4466 : if (vx < 0 || !gequal1(z)) pari_err_OP("",x, mkintmod(gen_1,Y));
2255 4445 : if (vx >= vy) { set_avma(av); return gen_0; }
2256 4081 : z = gel(x,4);
2257 4081 : if (!signe(z) || vy > vx + precp(x)) pari_err_OP("",x, mkintmod(gen_1,Y));
2258 4081 : if (vx) z = mulii(z, powiu(p,vx));
2259 4081 : return gerepileuptoint(av, remii(z, Y));
2260 : }
2261 : ulong
2262 217441 : padic_to_Fl(GEN x, ulong Y) {
2263 217441 : GEN p = gel(x,2);
2264 : ulong u, z;
2265 217441 : long vy, vx = valp(x);
2266 217441 : vy = u_pvalrem(Y,p, &u);
2267 217439 : if (vx < 0 || u != 1) pari_err_OP("",x, mkintmodu(1,Y));
2268 : /* Y = p^vy */
2269 217439 : if (vx >= vy) return 0;
2270 212980 : z = umodiu(gel(x,4), Y);
2271 212982 : if (!z || vy > vx + precp(x)) pari_err_OP("",x, mkintmodu(1,Y));
2272 212982 : if (vx) {
2273 0 : ulong pp = p[2];
2274 0 : z = Fl_mul(z, upowuu(pp,vx), Y); /* p^vx < p^vy = Y */
2275 : }
2276 212982 : return z;
2277 : }
2278 :
2279 : static void
2280 0 : croak(const char *s) {
2281 : char *t;
2282 0 : t = stack_sprintf("gaffect [overwriting universal object: %s]",s);
2283 0 : pari_err_BUG(t);
2284 0 : }
2285 :
2286 : void
2287 659727 : gaffect(GEN x, GEN y)
2288 : {
2289 659727 : long vx, i, lx, ly, tx = typ(x), ty = typ(y);
2290 : pari_sp av;
2291 : GEN p1, num, den;
2292 :
2293 659727 : if (tx == ty) switch(tx) {
2294 212381 : case t_INT:
2295 566907 : if (!is_universal_constant(y)) { affii(x,y); return; }
2296 : /* y = gen_0, gnil, gen_1 or gen_2 */
2297 0 : if (y==gen_0) croak("gen_0");
2298 0 : if (y==gen_1) croak("gen_1");
2299 0 : if (y==gen_m1) croak("gen_m1");
2300 0 : if (y==gen_m2) croak("gen_m2");
2301 0 : if (y==gen_2) croak("gen_2");
2302 0 : croak("gnil)");
2303 188370 : case t_REAL: affrr(x,y); return;
2304 0 : case t_INTMOD:
2305 0 : if (!dvdii(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2306 0 : modiiz(gel(x,2),gel(y,1),gel(y,2)); return;
2307 0 : case t_FRAC:
2308 0 : affii(gel(x,1),gel(y,1));
2309 0 : affii(gel(x,2),gel(y,2)); return;
2310 93940 : case t_COMPLEX:
2311 93940 : gaffect(gel(x,1),gel(y,1));
2312 93940 : gaffect(gel(x,2),gel(y,2)); return;
2313 0 : case t_PADIC:
2314 0 : if (!equalii(gel(x,2),gel(y,2))) pari_err_OP("",x,y);
2315 0 : modiiz(gel(x,4),gel(y,3),gel(y,4));
2316 0 : setvalp(y,valp(x)); return;
2317 0 : case t_QUAD:
2318 0 : if (! ZX_equal(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2319 0 : affii(gel(x,2),gel(y,2));
2320 0 : affii(gel(x,3),gel(y,3)); return;
2321 72216 : case t_VEC: case t_COL: case t_MAT:
2322 72216 : lx = lg(x); if (lx != lg(y)) pari_err_DIM("gaffect");
2323 192267 : for (i=1; i<lx; i++) gaffect(gel(x,i),gel(y,i));
2324 72216 : return;
2325 : }
2326 :
2327 : /* Various conversions. Avoid them, use specialized routines ! */
2328 :
2329 92820 : if (!is_const_t(ty)) pari_err_TYPE2("=",x,y);
2330 92820 : switch(tx)
2331 : {
2332 0 : case t_INT:
2333 : switch(ty)
2334 : {
2335 0 : case t_REAL:
2336 0 : affir(x,y); break;
2337 :
2338 0 : case t_INTMOD:
2339 0 : modiiz(x,gel(y,1),gel(y,2)); break;
2340 :
2341 0 : case t_COMPLEX:
2342 0 : gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2343 :
2344 0 : case t_PADIC:
2345 0 : if (!signe(x)) { padicaff0(y); break; }
2346 0 : av = avma;
2347 0 : setvalp(y, Z_pvalrem(x,gel(y,2),&p1));
2348 0 : affii(modii(p1,gel(y,3)), gel(y,4));
2349 0 : set_avma(av); break;
2350 :
2351 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2352 0 : default: pari_err_TYPE2("=",x,y);
2353 : }
2354 0 : break;
2355 :
2356 92820 : case t_REAL:
2357 : switch(ty)
2358 : {
2359 92820 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2360 0 : default: pari_err_TYPE2("=",x,y);
2361 : }
2362 92820 : break;
2363 :
2364 0 : case t_FRAC:
2365 : switch(ty)
2366 : {
2367 0 : case t_REAL: rdiviiz(gel(x,1),gel(x,2), y); break;
2368 0 : case t_INTMOD: av = avma;
2369 0 : p1 = Fp_inv(gel(x,2),gel(y,1));
2370 0 : affii(modii(mulii(gel(x,1),p1),gel(y,1)), gel(y,2));
2371 0 : set_avma(av); break;
2372 0 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2373 0 : case t_PADIC:
2374 0 : if (!signe(gel(x,1))) { padicaff0(y); break; }
2375 0 : num = gel(x,1);
2376 0 : den = gel(x,2);
2377 0 : av = avma; vx = Z_pvalrem(num, gel(y,2), &num);
2378 0 : if (!vx) vx = -Z_pvalrem(den,gel(y,2),&den);
2379 0 : setvalp(y,vx);
2380 0 : p1 = mulii(num,Fp_inv(den,gel(y,3)));
2381 0 : affii(modii(p1,gel(y,3)), gel(y,4)); set_avma(av); break;
2382 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2383 0 : default: pari_err_TYPE2("=",x,y);
2384 : }
2385 0 : break;
2386 :
2387 0 : case t_COMPLEX:
2388 0 : if (!gequal0(gel(x,2))) pari_err_TYPE2("=",x,y);
2389 0 : gaffect(gel(x,1), y);
2390 0 : break;
2391 :
2392 0 : case t_PADIC:
2393 : switch(ty)
2394 : {
2395 0 : case t_INTMOD:
2396 0 : av = avma; affii(padic_to_Fp(x, gel(y,1)), gel(y,2));
2397 0 : set_avma(av); break;
2398 0 : default: pari_err_TYPE2("=",x,y);
2399 : }
2400 0 : break;
2401 :
2402 0 : case t_QUAD:
2403 : switch(ty)
2404 : {
2405 0 : case t_INT: case t_INTMOD: case t_FRAC: case t_PADIC:
2406 0 : pari_err_TYPE2("=",x,y);
2407 :
2408 0 : case t_REAL:
2409 0 : av = avma; affgr(quadtofp(x,realprec(y)), y); set_avma(av); break;
2410 0 : case t_COMPLEX:
2411 0 : ly = precision(y); if (!ly) pari_err_TYPE2("=",x,y);
2412 0 : av = avma; gaffect(quadtofp(x,ly), y); set_avma(av); break;
2413 0 : default: pari_err_TYPE2("=",x,y);
2414 : }
2415 0 : default: pari_err_TYPE2("=",x,y);
2416 : }
2417 : }
2418 :
2419 : /*******************************************************************/
2420 : /* */
2421 : /* CONVERSION QUAD --> REAL, COMPLEX OR P-ADIC */
2422 : /* */
2423 : /*******************************************************************/
2424 : GEN
2425 252 : quadtofp(GEN x, long prec)
2426 : {
2427 252 : GEN b, D, z, u = gel(x,2), v = gel(x,3);
2428 : pari_sp av;
2429 252 : if (prec < LOWDEFAULTPREC) prec = LOWDEFAULTPREC;
2430 252 : if (isintzero(v)) return cxcompotor(u, prec);
2431 252 : av = avma; D = quad_disc(x); b = gel(gel(x,1),3); /* 0 or -1 */
2432 : /* u + v (-b + sqrt(D)) / 2 */
2433 252 : if (!signe(b)) b = NULL;
2434 252 : if (b) u = gadd(gmul2n(u,1), v);
2435 252 : z = sqrtr_abs(itor(D, prec));
2436 252 : if (!b) shiftr_inplace(z, -1);
2437 252 : z = gmul(v, z);
2438 252 : if (signe(D) < 0)
2439 : {
2440 35 : z = mkcomplex(cxcompotor(u, prec), z);
2441 35 : if (!b) return gerepilecopy(av, z);
2442 0 : z = gmul2n(z, -1);
2443 : }
2444 : else
2445 : { /* if (b) x ~ (u + z) / 2 and quadnorm(x) ~ (u^2 - z^2) / 4
2446 : * else x ~ u + z and quadnorm(x) ~ u^2 - z^2 */
2447 217 : long s = gsigne(u);
2448 217 : if (s == -gsigne(v)) /* conjugate expression avoids cancellation */
2449 : {
2450 14 : z = gdiv(quadnorm(x), gsub(u, z));
2451 14 : if (b) shiftr_inplace(z, 1);
2452 : }
2453 : else
2454 : {
2455 203 : if (s) z = gadd(u, z);
2456 203 : if (b) shiftr_inplace(z, -1);
2457 : }
2458 : }
2459 217 : return gerepileupto(av, z);
2460 : }
2461 :
2462 : static GEN
2463 28 : qtop(GEN x, GEN p, long d)
2464 : {
2465 28 : GEN z, D, P, b, u = gel(x,2), v = gel(x,3);
2466 : pari_sp av;
2467 28 : if (gequal0(v)) return cvtop(u, p, d);
2468 28 : P = gel(x,1);
2469 28 : b = gel(P,3);
2470 28 : av = avma; D = quad_disc(x);
2471 28 : if (absequaliu(p,2)) d += 2;
2472 28 : z = Qp_sqrt(cvtop(D,p,d));
2473 28 : if (!z) pari_err_SQRTN("Qp_sqrt",D);
2474 14 : z = gmul2n(gsub(z, b), -1);
2475 :
2476 14 : z = gadd(u, gmul(v, z));
2477 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_QUAD of t_INTMODs... */
2478 0 : z = cvtop(z, p, d);
2479 14 : return gerepileupto(av, z);
2480 : }
2481 : static GEN
2482 14 : ctop(GEN x, GEN p, long d)
2483 : {
2484 14 : pari_sp av = avma;
2485 14 : GEN z, u = gel(x,1), v = gel(x,2);
2486 14 : if (isrationalzero(v)) return cvtop(u, p, d);
2487 14 : z = Qp_sqrt(cvtop(gen_m1, p, d - gvaluation(v, p))); /* = I */
2488 14 : if (!z) pari_err_SQRTN("Qp_sqrt",gen_m1);
2489 :
2490 14 : z = gadd(u, gmul(v, z));
2491 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_COMPLEX of t_INTMODs... */
2492 0 : z = cvtop(z, p, d);
2493 14 : return gerepileupto(av, z);
2494 : }
2495 :
2496 : /* cvtop2(stoi(s), y) */
2497 : GEN
2498 399 : cvstop2(long s, GEN y)
2499 : {
2500 399 : GEN z, p = gel(y,2);
2501 399 : long v, d = signe(gel(y,4))? precp(y): 0;
2502 399 : if (!s) return zeropadic_shallow(p, d);
2503 399 : v = z_pvalrem(s, p, &s);
2504 399 : if (d <= 0) return zeropadic_shallow(p, v);
2505 399 : z = cgetg(5, t_PADIC);
2506 399 : z[1] = evalprecp(d) | evalvalp(v);
2507 399 : gel(z,2) = p;
2508 399 : gel(z,3) = gel(y,3);
2509 399 : gel(z,4) = modsi(s, gel(y,3)); return z;
2510 : }
2511 :
2512 : static GEN
2513 6814246 : itop2_coprime(GEN x, GEN y, long v, long d)
2514 : {
2515 6814246 : GEN z = cgetg(5, t_PADIC);
2516 6813563 : z[1] = evalprecp(d) | evalvalp(v);
2517 6813541 : gel(z,2) = gel(y,2);
2518 6813541 : gel(z,3) = gel(y,3);
2519 6813541 : gel(z,4) = modii(x, gel(y,3)); return z;
2520 : }
2521 : /* cvtop(x, gel(y,2), precp(y)), shallow */
2522 : GEN
2523 6820709 : cvtop2(GEN x, GEN y)
2524 : {
2525 6820709 : GEN p = gel(y,2);
2526 6820709 : long v, d = signe(gel(y,4))? precp(y): 0;
2527 6820709 : switch(typ(x))
2528 : {
2529 4050700 : case t_INT:
2530 4050700 : if (!signe(x)) return zeropadic_shallow(p, d);
2531 4050700 : if (d <= 0) return zeropadic_shallow(p, Z_pval(x,p));
2532 4046507 : v = Z_pvalrem(x, p, &x); return itop2_coprime(x, y, v, d);
2533 :
2534 0 : case t_INTMOD:
2535 0 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2536 0 : return cvtop(gel(x,2), p, v);
2537 :
2538 2770004 : case t_FRAC:
2539 : {
2540 : GEN num, den;
2541 2770004 : if (d <= 0) return zeropadic_shallow(p, Q_pval(x,p));
2542 2768723 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2543 2768713 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2544 2768717 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, gel(y,3)));
2545 2768716 : return itop2_coprime(num, y, v, d);
2546 : }
2547 7 : case t_COMPLEX: return ctop(x, p, d);
2548 28 : case t_QUAD: return qtop(x, p, d);
2549 147 : case t_PADIC:
2550 147 : if (!signe(gel(x,4))) return zeropadic_shallow(p, d);
2551 147 : if (precp(x) <= d) return x;
2552 35 : return itop2_coprime(gel(x,4), y, valp(x), d); /* reduce accuracy */
2553 : }
2554 0 : pari_err_TYPE("cvtop2",x);
2555 : return NULL; /* LCOV_EXCL_LINE */
2556 : }
2557 :
2558 : /* assume is_const_t(tx) */
2559 : GEN
2560 385852 : cvtop(GEN x, GEN p, long d)
2561 : {
2562 : GEN z;
2563 : long v;
2564 :
2565 385852 : if (typ(p) != t_INT) pari_err_TYPE("cvtop",p);
2566 385852 : switch(typ(x))
2567 : {
2568 52638 : case t_INT:
2569 52638 : if (!signe(x)) return zeropadic(p, d);
2570 51420 : if (d <= 0) return zeropadic(p, Z_pval(x,p));
2571 51364 : v = Z_pvalrem(x, p, &x);
2572 51364 : z = cgetg(5, t_PADIC);
2573 51364 : z[1] = evalprecp(d) | evalvalp(v);
2574 51364 : gel(z,2) = icopy(p);
2575 51364 : gel(z,3) = powiu(p, d);
2576 51364 : gel(z,4) = modii(x, gel(z,3)); return z; /* not memory-clean */
2577 :
2578 28 : case t_INTMOD:
2579 28 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2580 28 : return cvtop(gel(x,2), p, v);
2581 :
2582 163481 : case t_FRAC:
2583 : {
2584 : GEN num, den;
2585 163481 : if (d <= 0) return zeropadic(p, Q_pval(x,p));
2586 163467 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2587 163467 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2588 163467 : z = cgetg(5, t_PADIC);
2589 163467 : z[1] = evalprecp(d) | evalvalp(v);
2590 163467 : gel(z,2) = icopy(p);
2591 163467 : gel(z,3) = powiu(p, d);
2592 163467 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, gel(z,3)));
2593 163467 : gel(z,4) = modii(num, gel(z,3)); return z; /* not memory-clean */
2594 : }
2595 7 : case t_COMPLEX: return ctop(x, p, d);
2596 169698 : case t_PADIC:
2597 169698 : p = gel(x,2); /* override */
2598 169698 : if (!signe(gel(x,4))) return zeropadic(p, d);
2599 169698 : z = cgetg(5,t_PADIC);
2600 169698 : z[1] = x[1]; setprecp(z,d);
2601 169698 : gel(z,2) = icopy(p);
2602 169698 : gel(z,3) = powiu(p, d);
2603 169698 : gel(z,4) = modii(gel(x,4), gel(z,3)); return z;
2604 :
2605 0 : case t_QUAD: return qtop(x, p, d);
2606 : }
2607 0 : pari_err_TYPE("cvtop",x);
2608 : return NULL; /* LCOV_EXCL_LINE */
2609 : }
2610 :
2611 : GEN
2612 126 : gcvtop(GEN x, GEN p, long r)
2613 : {
2614 : long i, lx;
2615 : GEN y;
2616 :
2617 126 : switch(typ(x))
2618 : {
2619 28 : case t_POL: case t_SER:
2620 28 : y = cgetg_copy(x, &lx); y[1] = x[1];
2621 98 : for (i=2; i<lx; i++) gel(y,i) = gcvtop(gel(x,i),p,r);
2622 28 : return y;
2623 0 : case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
2624 0 : pari_APPLY_same(gcvtop(gel(x,i),p,r));
2625 : }
2626 98 : return cvtop(x,p,r);
2627 : }
2628 :
2629 : long
2630 523958063 : gexpo_safe(GEN x)
2631 : {
2632 523958063 : long tx = typ(x), lx, e, f, i;
2633 :
2634 523958063 : switch(tx)
2635 : {
2636 110835176 : case t_INT:
2637 110835176 : return expi(x);
2638 :
2639 970855 : case t_FRAC:
2640 970855 : return expi(gel(x,1)) - expi(gel(x,2));
2641 :
2642 280202726 : case t_REAL:
2643 280202726 : return expo(x);
2644 :
2645 80097347 : case t_COMPLEX:
2646 80097347 : e = gexpo(gel(x,1));
2647 80098427 : f = gexpo(gel(x,2)); return maxss(e, f);
2648 :
2649 91 : case t_QUAD: {
2650 91 : GEN p = gel(x,1); /* mod = X^2 + {0,1}* X - {D/4, (1-D)/4})*/
2651 91 : long d = 1 + expi(gel(p,2))/2; /* ~ expo(sqrt(D)) */
2652 91 : e = gexpo(gel(x,2));
2653 91 : f = gexpo(gel(x,3)) + d; return maxss(e, f);
2654 : }
2655 43999801 : case t_POL: case t_SER:
2656 43999801 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2657 196354027 : for (i=2; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2658 43992816 : return f;
2659 7988589 : case t_VEC: case t_COL: case t_MAT:
2660 7988589 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2661 84428327 : for (i=1; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2662 7988495 : return f;
2663 : }
2664 48 : return -1-(long)HIGHEXPOBIT;
2665 : }
2666 : long
2667 523723784 : gexpo(GEN x)
2668 : {
2669 523723784 : long e = gexpo_safe(x);
2670 523745722 : if (e < -(long)HIGHEXPOBIT) pari_err_TYPE("gexpo",x);
2671 523751244 : return e;
2672 : }
2673 : GEN
2674 89536 : gpexponent(GEN x)
2675 : {
2676 89536 : long e = gexpo(x);
2677 89536 : return e == -(long)HIGHEXPOBIT? mkmoo(): stoi(e);
2678 : }
2679 :
2680 : long
2681 7 : sizedigit(GEN x)
2682 : {
2683 7 : return gequal0(x)? 0: (long) ((gexpo(x)+1) * LOG10_2) + 1;
2684 : }
2685 :
2686 : /* normalize series. avma is not updated */
2687 : GEN
2688 13296715 : normalizeser(GEN x)
2689 : {
2690 13296715 : long i, lx = lg(x), vx=varn(x), vp=valser(x);
2691 : GEN y, z;
2692 :
2693 13296715 : if (lx == 2) { setsigne(x,0); return x; }
2694 13296351 : if (lx == 3) {
2695 186745 : z = gel(x,2);
2696 186745 : if (!gequal0(z)) { setsigne(x,1); return x; }
2697 22239 : if (isrationalzero(z)) return zeroser(vx,vp+1);
2698 3556 : if (isexactzero(z)) {
2699 : /* dangerous case: already normalized ? */
2700 266 : if (!signe(x)) return x;
2701 35 : setvalser(x,vp+1); /* no: normalize */
2702 : }
2703 3325 : setsigne(x,0); return x;
2704 : }
2705 13403049 : for (i=2; i<lx; i++)
2706 13356338 : if (! isrationalzero(gel(x,i))) break;
2707 13109606 : if (i == lx) return zeroser(vx,lx-2+vp);
2708 13062895 : z = gel(x,i);
2709 13066696 : while (i<lx && isexactzero(gel(x,i))) i++;
2710 13062895 : if (i == lx)
2711 : {
2712 273 : i -= 3; y = x + i;
2713 273 : stackdummy((pari_sp)y, (pari_sp)x);
2714 273 : gel(y,2) = z;
2715 273 : y[1] = evalsigne(0) | evalvalser(lx-2+vp) | evalvarn(vx);
2716 273 : y[0] = evaltyp(t_SER) | _evallg(3);
2717 273 : return y;
2718 : }
2719 :
2720 13062622 : i -= 2; y = x + i; lx -= i;
2721 13062622 : y[1] = evalsigne(1) | evalvalser(vp+i) | evalvarn(vx);
2722 13062622 : y[0] = evaltyp(t_SER) | evallg(lx);
2723 :
2724 13062622 : stackdummy((pari_sp)y, (pari_sp)x);
2725 13091691 : for (i = 2; i < lx; i++)
2726 13090753 : if (!gequal0(gel(y, i))) return y;
2727 938 : setsigne(y, 0); return y;
2728 : }
2729 :
2730 : GEN
2731 0 : normalizepol_approx(GEN x, long lx)
2732 : {
2733 : long i;
2734 0 : for (i = lx-1; i>1; i--)
2735 0 : if (! gequal0(gel(x,i))) break;
2736 0 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + i+1));
2737 0 : setlg(x, i+1); setsigne(x, i!=1); return x;
2738 : }
2739 :
2740 : GEN
2741 600493050 : normalizepol_lg(GEN x, long lx)
2742 : {
2743 600493050 : long i, LX = 0;
2744 600493050 : GEN KEEP = NULL;
2745 :
2746 783372105 : for (i = lx-1; i>1; i--)
2747 : {
2748 719896651 : GEN z = gel(x,i);
2749 719896651 : if (! gequal0(z) ) {
2750 537314915 : if (!LX) LX = i+1;
2751 537314915 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2752 537366779 : x[0] = evaltyp(t_POL) | evallg(LX);
2753 537317769 : setsigne(x,1); return x;
2754 182570619 : } else if (!isexactzero(z)) {
2755 758805 : if (!LX) LX = i+1; /* to be kept as leading coeff */
2756 182123104 : } else if (!isrationalzero(z))
2757 832650 : KEEP = z; /* to be kept iff all other coeffs are exact 0s */
2758 : }
2759 63475454 : if (!LX) {
2760 63139624 : if (KEEP) { /* e.g. Pol(Mod(0,2)) */
2761 348365 : gel(x,2) = KEEP;
2762 348365 : LX = 3;
2763 : } else
2764 62791259 : LX = 2; /* Pol(0) */
2765 : }
2766 63475454 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2767 63383627 : x[0] = evaltyp(t_POL) | evallg(LX);
2768 63378019 : setsigne(x,0); return x;
2769 : }
2770 :
2771 : /* normalize polynomial x in place */
2772 : GEN
2773 58128127 : normalizepol(GEN x)
2774 : {
2775 58128127 : return normalizepol_lg(x, lg(x));
2776 : }
2777 :
2778 : int
2779 72903350 : gsigne(GEN x)
2780 : {
2781 72903350 : switch(typ(x))
2782 : {
2783 72513611 : case t_INT: case t_REAL: return signe(x);
2784 389101 : case t_FRAC: return signe(gel(x,1));
2785 623 : case t_QUAD:
2786 : {
2787 623 : pari_sp av = avma;
2788 623 : GEN T = gel(x,1), a = gel(x,2), b = gel(x,3);
2789 : long sa, sb;
2790 623 : if (signe(gel(T,2)) > 0) break;
2791 609 : a = gmul2n(a,1);
2792 609 : if (signe(gel(T,3))) a = gadd(a,b);
2793 : /* a + b sqrt(D) > 0 ? */
2794 609 : sa = gsigne(a);
2795 609 : sb = gsigne(b); if (sa == sb) return gc_int(av,sa);
2796 224 : if (sa == 0) return gc_int(av,sb);
2797 217 : if (sb == 0) return gc_int(av,sa);
2798 : /* different signs, take conjugate expression */
2799 210 : sb = gsigne(gsub(gsqr(a), gmul(quad_disc(x), gsqr(b))));
2800 210 : return gc_int(av, sb*sa);
2801 : }
2802 14 : case t_INFINITY: return inf_get_sign(x);
2803 : }
2804 15 : pari_err_TYPE("gsigne",x);
2805 : return 0; /* LCOV_EXCL_LINE */
2806 : }
2807 :
2808 : /*******************************************************************/
2809 : /* */
2810 : /* LISTS */
2811 : /* */
2812 : /*******************************************************************/
2813 : /* make sure L can hold l elements, at least doubling the previous max number
2814 : * of components. */
2815 : static void
2816 791217 : ensure_nb(GEN L, long l)
2817 : {
2818 791217 : long nmax = list_nmax(L), i, lw;
2819 : GEN v, w;
2820 791217 : if (l <= nmax) return;
2821 665 : if (nmax)
2822 : {
2823 273 : nmax <<= 1;
2824 273 : if (l > nmax) nmax = l;
2825 273 : w = list_data(L); lw = lg(w);
2826 273 : v = newblock(nmax+1);
2827 273 : v[0] = w[0];
2828 1045653 : for (i=1; i < lw; i++) gel(v,i) = gel(w, i);
2829 273 : killblock(w);
2830 : }
2831 : else /* unallocated */
2832 : {
2833 392 : nmax = 32;
2834 392 : if (list_data(L))
2835 0 : pari_err(e_MISC, "store list in variable before appending elements");
2836 392 : v = newblock(nmax+1);
2837 392 : v[0] = evaltyp(t_VEC) | _evallg(1);
2838 : }
2839 665 : list_data(L) = v;
2840 665 : L[1] = evaltyp(list_typ(L))|evallg(nmax);
2841 : }
2842 :
2843 : void
2844 7 : listkill(GEN L)
2845 : {
2846 :
2847 7 : if (typ(L) != t_LIST) pari_err_TYPE("listkill",L);
2848 7 : if (list_nmax(L)) {
2849 7 : GEN v = list_data(L);
2850 7 : long i, l = lg(v);
2851 49 : for (i=1; i<l; i++) gunclone_deep(gel(v,i));
2852 7 : killblock(v);
2853 7 : L[1] = evaltyp(list_typ(L));
2854 7 : list_data(L) = NULL;
2855 : }
2856 7 : }
2857 :
2858 : GEN
2859 6352 : mklist_typ(long t)
2860 : {
2861 6352 : GEN L = cgetg(3,t_LIST);
2862 6352 : L[1] = evaltyp(t);
2863 6352 : list_data(L) = NULL; return L;
2864 : }
2865 :
2866 : GEN
2867 6296 : mklist(void)
2868 : {
2869 6296 : return mklist_typ(t_LIST_RAW);
2870 : }
2871 :
2872 : GEN
2873 49 : mkmap(void)
2874 : {
2875 49 : return mklist_typ(t_LIST_MAP);
2876 : }
2877 :
2878 : /* return a list with single element x, allocated on stack */
2879 : GEN
2880 56 : mklistcopy(GEN x)
2881 : {
2882 56 : GEN y = mklist();
2883 56 : list_data(y) = mkveccopy(x);
2884 56 : return y;
2885 : }
2886 :
2887 : GEN
2888 7 : listcreate_gp(long n)
2889 : {
2890 7 : (void) n; return mklist();
2891 : }
2892 :
2893 : GEN
2894 756371 : listput(GEN L, GEN x, long index)
2895 : {
2896 : long l;
2897 : GEN z;
2898 :
2899 756371 : if (index < 0) pari_err_COMPONENT("listput", "<", gen_0, stoi(index));
2900 756364 : z = list_data(L);
2901 756364 : l = z? lg(z): 1;
2902 :
2903 756364 : x = gclone(x);
2904 756364 : if (!index || index >= l)
2905 : {
2906 756210 : ensure_nb(L, l);
2907 756210 : z = list_data(L); /* it may change ! */
2908 756210 : index = l;
2909 756210 : l++;
2910 : } else
2911 154 : gunclone_deep( gel(z, index) );
2912 756364 : gel(z,index) = x;
2913 756364 : z[0] = evaltyp(t_VEC) | evallg(l); /*must be after gel(z,index) is set*/
2914 756364 : return gel(z,index);
2915 : }
2916 :
2917 : void
2918 705208 : listput0(GEN L, GEN x, long index)
2919 : {
2920 705208 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2921 14 : pari_err_TYPE("listput",L);
2922 705194 : (void) listput(L, x, index);
2923 705187 : }
2924 :
2925 : GEN
2926 35014 : listinsert(GEN L, GEN x, long index)
2927 : {
2928 : long l, i;
2929 : GEN z;
2930 :
2931 35014 : z = list_data(L); l = z? lg(z): 1;
2932 35014 : if (index <= 0) pari_err_COMPONENT("listinsert", "<=", gen_0, stoi(index));
2933 35007 : if (index > l) index = l;
2934 35007 : ensure_nb(L, l);
2935 35007 : BLOCK_SIGINT_START
2936 35007 : z = list_data(L);
2937 87552507 : for (i=l; i > index; i--) gel(z,i) = gel(z,i-1);
2938 35007 : z[0] = evaltyp(t_VEC) | evallg(l+1);
2939 35007 : gel(z,index) = gclone(x);
2940 35007 : BLOCK_SIGINT_END
2941 35007 : return gel(z,index);
2942 : }
2943 :
2944 : void
2945 35028 : listinsert0(GEN L, GEN x, long index)
2946 : {
2947 35028 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2948 14 : pari_err_TYPE("listinsert",L);
2949 35014 : (void) listinsert(L, x, index);
2950 35007 : }
2951 :
2952 : void
2953 21917 : listpop(GEN L, long index)
2954 : {
2955 : long l, i;
2956 : GEN z;
2957 :
2958 21917 : if (typ(L) != t_LIST) pari_err_TYPE("listinsert",L);
2959 21917 : if (index < 0) pari_err_COMPONENT("listpop", "<", gen_0, stoi(index));
2960 21917 : z = list_data(L);
2961 21917 : if (!z || (l = lg(z)-1) == 0) return;
2962 :
2963 21903 : if (!index || index > l) index = l;
2964 21903 : BLOCK_SIGINT_START
2965 21903 : gunclone_deep( gel(z, index) );
2966 21903 : z[0] = evaltyp(t_VEC) | evallg(l);
2967 21910 : for (i=index; i < l; i++) z[i] = z[i+1];
2968 21903 : BLOCK_SIGINT_END
2969 : }
2970 :
2971 : void
2972 56 : listpop0(GEN L, long index)
2973 : {
2974 56 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2975 14 : pari_err_TYPE("listpop",L);
2976 42 : listpop(L, index);
2977 42 : }
2978 :
2979 : /* return a copy fully allocated on stack. gclone from changevalue is
2980 : * supposed to malloc() it */
2981 : GEN
2982 5524 : gtolist(GEN x)
2983 : {
2984 : GEN y;
2985 :
2986 5524 : if (!x) return mklist();
2987 349 : switch(typ(x))
2988 : {
2989 286 : case t_VEC: case t_COL:
2990 286 : y = mklist();
2991 286 : if (lg(x) == 1) return y;
2992 265 : list_data(y) = gcopy(x);
2993 265 : settyp(list_data(y), t_VEC);
2994 265 : return y;
2995 7 : case t_LIST:
2996 7 : y = mklist();
2997 7 : list_data(y) = list_data(x)? gcopy(list_data(x)): NULL;
2998 7 : return y;
2999 56 : default:
3000 56 : return mklistcopy(x);
3001 : }
3002 : }
3003 :
3004 : void
3005 21 : listsort(GEN L, long flag)
3006 : {
3007 : long i, l;
3008 21 : pari_sp av = avma;
3009 : GEN perm, v, vnew;
3010 :
3011 21 : if (typ(L) != t_LIST) pari_err_TYPE("listsort",L);
3012 21 : v = list_data(L); l = v? lg(v): 1;
3013 21 : if (l < 3) return;
3014 21 : if (flag)
3015 : {
3016 : long lnew;
3017 14 : perm = gen_indexsort_uniq(L, (void*)&cmp_universal, cmp_nodata);
3018 14 : lnew = lg(perm); /* may have changed since 'uniq' */
3019 14 : vnew = cgetg(lnew,t_VEC);
3020 56 : for (i=1; i<lnew; i++) {
3021 42 : long c = perm[i];
3022 42 : gel(vnew,i) = gel(v,c);
3023 42 : gel(v,c) = NULL;
3024 : }
3025 14 : if (l != lnew) { /* was shortened */
3026 105 : for (i=1; i<l; i++)
3027 91 : if (gel(v,i)) gunclone_deep(gel(v,i));
3028 14 : l = lnew;
3029 : }
3030 : }
3031 : else
3032 : {
3033 7 : perm = gen_indexsort(L, (void*)&cmp_universal, cmp_nodata);
3034 7 : vnew = cgetg(l,t_VEC);
3035 63 : for (i=1; i<l; i++) gel(vnew,i) = gel(v,perm[i]);
3036 : }
3037 119 : for (i=1; i<l; i++) gel(v,i) = gel(vnew,i);
3038 21 : v[0] = vnew[0]; set_avma(av);
3039 : }
|
