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 36956487 : map_proto_lG(long (*f)(GEN), GEN x)
38 : {
39 36956571 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_lG(f, gel(x,i)));
40 36943905 : 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 2205297 : _domul(void *data, GEN x, GEN y)
52 : {
53 2205297 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
54 2205297 : return mul(x,y);
55 : }
56 :
57 : GEN
58 2419454 : gassoc_proto(GEN (*f)(GEN,GEN), GEN x, GEN y)
59 : {
60 2419454 : if (!y)
61 : {
62 2419454 : pari_sp av = avma;
63 2419454 : 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 2419440 : case t_COL: break;
69 7 : default: pari_err_TYPE("association",x);
70 : }
71 2419440 : return gc_upto(av, gen_product(x, (void *)f, _domul));
72 :
73 : }
74 0 : return f(x,y);
75 : }
76 :
77 : /*******************************************************************/
78 : /* */
79 : /* SIZES */
80 : /* */
81 : /*******************************************************************/
82 :
83 : long
84 5145781 : glength(GEN x)
85 : {
86 5145781 : long tx = typ(x);
87 5145781 : switch(tx)
88 : {
89 126 : case t_INT: return lgefint(x)-2;
90 609 : case t_LIST: {
91 609 : GEN L = list_data(x);
92 609 : return L? lg(L)-1: 0;
93 : }
94 14 : case t_REAL: return signe(x)? lg(x)-2: 0;
95 11 : case t_STR: return strlen( GSTR(x) );
96 91 : case t_VECSMALL: return lg(x)-1;
97 : }
98 5144930 : return lg(x) - lontyp[tx];
99 : }
100 :
101 : long
102 3878 : gtranslength(GEN x)
103 : {
104 3878 : switch(typ(x))
105 : {
106 0 : case t_VEC: case t_COL:
107 0 : return lg(x)-1;
108 3878 : case t_MAT:
109 3878 : return lg(x)==1 ? 0: nbrows(x);
110 0 : default:
111 0 : pari_err_TYPE("trans",x);
112 : return 0; /* LCOV_EXCL_LINE */
113 : }
114 : }
115 :
116 : GEN
117 1862 : matsize(GEN x)
118 : {
119 1862 : long L = lg(x) - 1;
120 1862 : switch(typ(x))
121 : {
122 7 : case t_VEC: return mkvec2s(1, L);
123 7 : case t_COL: return mkvec2s(L, 1);
124 1841 : case t_MAT: return mkvec2s(L? nbrows(x): 0, L);
125 : }
126 7 : pari_err_TYPE("matsize",x);
127 : return NULL; /* LCOV_EXCL_LINE */
128 : }
129 :
130 : /*******************************************************************/
131 : /* */
132 : /* CONVERSION GEN --> long */
133 : /* */
134 : /*******************************************************************/
135 :
136 : long
137 77 : gtolong(GEN x)
138 : {
139 77 : switch(typ(x))
140 : {
141 42 : case t_INT:
142 42 : return itos(x);
143 7 : case t_REAL:
144 7 : return (long)(rtodbl(x) + 0.5);
145 7 : case t_FRAC:
146 7 : { pari_sp av = avma; return gc_long(av, itos(ground(x))); }
147 7 : case t_COMPLEX:
148 7 : if (gequal0(gel(x,2))) return gtolong(gel(x,1)); break;
149 7 : case t_QUAD:
150 7 : if (gequal0(gel(x,3))) return gtolong(gel(x,2)); break;
151 : }
152 7 : pari_err_TYPE("gtolong",x);
153 : return 0; /* LCOV_EXCL_LINE */
154 : }
155 :
156 : /*******************************************************************/
157 : /* */
158 : /* COMPARISONS */
159 : /* */
160 : /*******************************************************************/
161 : static void
162 189 : chk_true_err()
163 : {
164 189 : GEN E = pari_err_last();
165 189 : switch(err_get_num(E))
166 : {
167 0 : case e_STACK: case e_MEM: case e_ALARM:
168 0 : pari_err(0, E); /* rethrow */
169 : }
170 189 : }
171 : /* x - y == 0 or undefined */
172 : static int
173 3190998 : gequal_try(GEN x, GEN y)
174 : {
175 : int i;
176 3190998 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
177 3190998 : pari_TRY { i = gequal0(gadd(x, gneg_i(y))); } pari_ENDCATCH;
178 3190816 : return i;
179 : }
180 : /* x + y == 0 or undefined */
181 : static int
182 28 : gmequal_try(GEN x, GEN y)
183 : {
184 : int i;
185 28 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
186 28 : pari_TRY { i = gequal0(gadd(x, y)); } pari_ENDCATCH;
187 21 : return i;
188 : }
189 :
190 : int
191 576543826 : isexactzero(GEN g)
192 : {
193 : long i, lx;
194 576543826 : switch (typ(g))
195 : {
196 474054418 : case t_INT:
197 474054418 : return !signe(g);
198 719957 : case t_INTMOD:
199 719957 : return !signe(gel(g,2));
200 14896076 : case t_COMPLEX:
201 14896076 : return isexactzero(gel(g,1)) && isexactzero(gel(g,2));
202 8110589 : case t_FFELT:
203 8110589 : return FF_equal0(g);
204 490 : case t_QUAD:
205 490 : return isexactzero(gel(g,2)) && isexactzero(gel(g,3));
206 276598 : case t_POLMOD:
207 276598 : return isexactzero(gel(g,2));
208 35983514 : case t_POL:
209 35983514 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
210 35983514 : return lx == 2 || (lx == 3 && isexactzero(gel(g,2)));
211 461255 : case t_RFRAC:
212 461255 : return isexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
213 43393 : case t_VEC: case t_COL: case t_MAT:
214 43694 : for (i=lg(g)-1; i; i--)
215 43589 : if (!isexactzero(gel(g,i))) return 0;
216 105 : return 1;
217 : }
218 41997536 : return 0;
219 : }
220 : GEN
221 57209904 : gisexactzero(GEN g)
222 : {
223 : long i, lx;
224 : GEN a, b;
225 57209904 : switch (typ(g))
226 : {
227 24248689 : case t_INT:
228 24248689 : return !signe(g)? g: NULL;
229 5631171 : case t_INTMOD:
230 5631171 : return !signe(gel(g,2))? g: NULL;
231 3311 : case t_COMPLEX:
232 3311 : a = gisexactzero(gel(g,1)); if (!a) return NULL;
233 1295 : b = gisexactzero(gel(g,2)); if (!b) return NULL;
234 0 : return ggcd(a,b);
235 21056 : case t_FFELT:
236 21056 : return FF_equal0(g)? g: NULL;
237 581 : case t_QUAD:
238 581 : a = gisexactzero(gel(g,2)); if (!a) return NULL;
239 77 : b = gisexactzero(gel(g,3)); if (!b) return NULL;
240 7 : return ggcd(a,b);
241 17067 : case t_POLMOD:
242 17067 : return gisexactzero(gel(g,2));
243 25496136 : case t_POL:
244 25496136 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
245 25496136 : if (lx == 2) return gen_0;
246 20164031 : if (lx == 3) return gisexactzero(gel(g,2));
247 16480670 : return NULL;
248 1191315 : case t_RFRAC:
249 1191315 : return gisexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
250 0 : case t_VEC: case t_COL: case t_MAT:
251 0 : a = gen_0;
252 0 : for (i=lg(g)-1; i; i--)
253 : {
254 0 : b = gisexactzero(gel(g,i));
255 0 : if (!b) return NULL;
256 0 : a = ggcd(a, b);
257 : }
258 0 : return a;
259 : }
260 600578 : return NULL;
261 : }
262 :
263 : int
264 768911177 : isrationalzero(GEN g)
265 : {
266 : long i;
267 768911177 : switch (typ(g))
268 : {
269 444999055 : case t_INT:
270 444999055 : return !signe(g);
271 39506627 : case t_COMPLEX:
272 39506627 : return isintzero(gel(g,1)) && isintzero(gel(g,2));
273 1449 : case t_QUAD:
274 1449 : return isintzero(gel(g,2)) && isintzero(gel(g,3));
275 484976 : case t_POLMOD:
276 484976 : return isrationalzero(gel(g,2));
277 139315657 : case t_POL: return lg(g) == 2;
278 91 : case t_VEC: case t_COL: case t_MAT:
279 322 : for (i=lg(g)-1; i; i--)
280 231 : if (!isrationalzero(gel(g,i))) return 0;
281 91 : return 1;
282 : }
283 144603322 : return 0;
284 : }
285 :
286 : int
287 2488868359 : gequal0(GEN x)
288 : {
289 2488868359 : switch(typ(x))
290 : {
291 2325968809 : case t_INT: case t_REAL: case t_POL: case t_SER:
292 2325968809 : return !signe(x);
293 :
294 6748165 : case t_INTMOD:
295 6748165 : return !signe(gel(x,2));
296 :
297 648852 : case t_FFELT:
298 648852 : return FF_equal0(x);
299 :
300 105283112 : case t_COMPLEX:
301 : /* is 0 iff norm(x) would be 0 (can happen with Re(x) and Im(x) != 0
302 : * only if Re(x) and Im(x) are of type t_REAL). See mp.c:addrr().
303 : */
304 105283112 : if (gequal0(gel(x,1)))
305 : {
306 8020672 : if (gequal0(gel(x,2))) return 1;
307 7636219 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
308 274104 : return (expo(gel(x,1))>=expo(gel(x,2)));
309 : }
310 97262601 : if (gequal0(gel(x,2)))
311 : {
312 1691011 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
313 1607039 : return (expo(gel(x,2))>=expo(gel(x,1)));
314 : }
315 95568229 : return 0;
316 :
317 2046686 : case t_PADIC:
318 2046686 : return !signe(padic_u(x));
319 :
320 1750 : case t_QUAD:
321 1750 : return gequal0(gel(x,2)) && gequal0(gel(x,3));
322 :
323 8508156 : case t_POLMOD:
324 8508156 : return gequal0(gel(x,2));
325 :
326 6109584 : case t_RFRAC:
327 6109584 : return gequal0(gel(x,1));
328 :
329 9796521 : case t_VEC: case t_COL: case t_MAT:
330 : {
331 : long i;
332 22722753 : for (i=lg(x)-1; i; i--)
333 18952485 : if (!gequal0(gel(x,i))) return 0;
334 3770268 : return 1;
335 : }
336 : }
337 23756724 : return 0;
338 : }
339 :
340 : /* x a t_POL or t_SER, return 1 if test(coeff(X,d)) is true and
341 : * coeff(X,i) = 0 for all i != d. Return 0 (false) otherwise */
342 : static int
343 22645628 : is_monomial_test(GEN x, long d, int(*test)(GEN))
344 : {
345 22645628 : long i, l = lg(x);
346 22645628 : if (typ(x) == t_SER)
347 : { /* "0" * x^v * (1+O(x)) ? v <= 0 or null ring */
348 602 : if (l == 3 && isexactzero(gel(x,2))) return d >= 2 || test(gel(x,2));
349 553 : if (d < 2) return 0; /* v > 0 */
350 : }
351 22645397 : if (d >= l)
352 : {
353 2304364 : if (typ(x) == t_POL) return 0; /* l = 2 */
354 : /* t_SER, v = 2-d <= 0 */
355 56 : if (!signe(x)) return 1;
356 : }
357 20341033 : else if (!test(gel(x,d))) return 0;
358 7609784 : for (i = 2; i < l; i++) /* 2 <= d < l */
359 5187110 : if (i != d && !gequal0(gel(x,i))) return 0;
360 2422674 : return 1;
361 : }
362 : static int
363 294560 : col_test(GEN x, int(*test)(GEN))
364 : {
365 294560 : long i, l = lg(x);
366 294560 : if (l == 1 || !test(gel(x,1))) return 0;
367 13167 : for (i = 2; i < l; i++)
368 11186 : if (!gequal0(gel(x,i))) return 0;
369 1981 : return 1;
370 : }
371 : static int
372 16366 : mat_test(GEN x, int(*test)(GEN))
373 : {
374 16366 : long i, j, l = lg(x);
375 16366 : if (l == 1) return 1;
376 16352 : if (l != lgcols(x)) return 0;
377 52283 : for (i = 1; i < l; i++)
378 140973 : for (j = 1; j < l; j++)
379 105042 : if (i == j) {
380 36015 : if (!test(gcoeff(x,i,i))) return 0;
381 : } else {
382 69027 : if (!gequal0(gcoeff(x,i,j))) return 0;
383 : }
384 16268 : return 1;
385 : }
386 :
387 : /* returns 1 whenever x = 1, and 0 otherwise */
388 : int
389 345167528 : gequal1(GEN x)
390 : {
391 345167528 : switch(typ(x))
392 : {
393 318080642 : case t_INT:
394 318080642 : return equali1(x);
395 :
396 75936 : case t_REAL:
397 : {
398 75936 : long s = signe(x);
399 75936 : if (!s) return expo(x) >= 0;
400 75838 : return s > 0 ? absrnz_equal1(x): 0;
401 : }
402 350907 : case t_INTMOD:
403 350907 : return is_pm1(gel(x,2)) || is_pm1(gel(x,1));
404 393476 : case t_POLMOD:
405 393476 : return !degpol(gel(x,1)) || gequal1(gel(x,2));
406 :
407 16282 : case t_FFELT:
408 16282 : return FF_equal1(x);
409 :
410 1685480 : case t_FRAC:
411 1685480 : return 0;
412 :
413 24001 : case t_COMPLEX:
414 24001 : return gequal1(gel(x,1)) && gequal0(gel(x,2));
415 :
416 166302 : case t_PADIC:
417 166302 : if (!signe(padic_u(x))) return valp(x) <= 0;
418 166260 : return valp(x) == 0 && gequal1(padic_u(x));
419 :
420 42 : case t_QUAD:
421 42 : return gequal1(gel(x,2)) && gequal0(gel(x,3));
422 :
423 22644958 : case t_POL: return is_monomial_test(x, 2, &gequal1);
424 476 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequal1);
425 :
426 1030454 : case t_RFRAC: return gequal(gel(x,1), gel(x,2));
427 294511 : case t_COL: return col_test(x, &gequal1);
428 16254 : case t_MAT: return mat_test(x, &gequal1);
429 : }
430 387807 : return 0;
431 : }
432 :
433 : /* returns 1 whenever the x = -1, 0 otherwise */
434 : int
435 74232990 : gequalm1(GEN x)
436 : {
437 : pari_sp av;
438 : GEN t;
439 :
440 74232990 : switch(typ(x))
441 : {
442 74224104 : case t_INT:
443 74224104 : return equalim1(x);
444 :
445 1484 : case t_REAL:
446 : {
447 1484 : long s = signe(x);
448 1484 : if (!s) return expo(x) >= 0;
449 1477 : return s < 0 ? absrnz_equal1(x): 0;
450 : }
451 4651 : case t_INTMOD:
452 4651 : av = avma; return gc_bool(av, equalii(addui(1,gel(x,2)), gel(x,1)));
453 :
454 154 : case t_FRAC:
455 154 : return 0;
456 :
457 42 : case t_FFELT:
458 42 : return FF_equalm1(x);
459 :
460 2044 : case t_COMPLEX:
461 2044 : return gequalm1(gel(x,1)) && gequal0(gel(x,2));
462 :
463 7 : case t_QUAD:
464 7 : return gequalm1(gel(x,2)) && gequal0(gel(x,3));
465 :
466 49 : case t_PADIC:
467 49 : t = padic_u(x); if (!signe(t)) return valp(x) <= 0;
468 21 : av = avma; return gc_bool(av, !valp(x) && equalii(addui(1,t), gel(x,3)));
469 :
470 56 : case t_POLMOD:
471 56 : return !degpol(gel(x,1)) || gequalm1(gel(x,2));
472 :
473 70 : case t_POL: return is_monomial_test(x, 2, &gequalm1);
474 126 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequalm1);
475 :
476 28 : case t_RFRAC:
477 28 : av = avma; return gc_bool(av, gmequal_try(gel(x,1), gel(x,2)));
478 49 : case t_COL: return col_test(x, &gequalm1);
479 112 : case t_MAT: return mat_test(x, &gequalm1);
480 : }
481 14 : return 0;
482 : }
483 :
484 : int
485 1470181 : gequalX(GEN x) { return typ(x) == t_POL && lg(x) == 4
486 9955247 : && isintzero(gel(x,2)) && isint1(gel(x,3)); }
487 :
488 : static int
489 672 : cmp_str(const char *x, const char *y)
490 : {
491 672 : int f = strcmp(x, y);
492 : return f > 0? 1
493 672 : : f? -1: 0;
494 : }
495 :
496 : static int
497 39230555 : cmp_universal_rec(GEN x, GEN y, long i0)
498 : {
499 39230555 : long i, lx = lg(x), ly = lg(y);
500 39230555 : if (lx < ly) return -1;
501 39227780 : if (lx > ly) return 1;
502 69546226 : for (i = i0; i < lx; i++)
503 : {
504 60610168 : int f = cmp_universal(gel(x,i), gel(y,i));
505 60610168 : if (f) return f;
506 : }
507 8936058 : return 0;
508 : }
509 : /* Universal "meaningless" comparison function. Transitive, returns 0 iff
510 : * gidentical(x,y) */
511 : int
512 85188796 : cmp_universal(GEN x, GEN y)
513 : {
514 85188796 : long lx, ly, i, tx = typ(x), ty = typ(y);
515 :
516 85188796 : if (tx < ty) return -1;
517 84816945 : if (ty < tx) return 1;
518 84287690 : switch(tx)
519 : {
520 44121410 : case t_INT: return cmpii(x,y);
521 651 : case t_STR: return cmp_str(GSTR(x),GSTR(y));
522 934997 : case t_REAL:
523 : case t_VECSMALL:
524 934997 : lx = lg(x);
525 934997 : ly = lg(y);
526 934997 : if (lx < ly) return -1;
527 886725 : if (lx > ly) return 1;
528 3586440 : for (i = 1; i < lx; i++)
529 : {
530 3478808 : if (x[i] < y[i]) return -1;
531 3109879 : if (x[i] > y[i]) return 1;
532 : }
533 107632 : return 0;
534 :
535 771815 : case t_POL:
536 : {
537 771815 : long X = x[1] & (VARNBITS|SIGNBITS);
538 771815 : long Y = y[1] & (VARNBITS|SIGNBITS);
539 771815 : if (X < Y) return -1;
540 771794 : if (X > Y) return 1;
541 771738 : return cmp_universal_rec(x, y, 2);
542 : }
543 881076 : case t_SER:
544 : case t_FFELT:
545 : case t_CLOSURE:
546 881076 : if (x[1] < y[1]) return -1;
547 881069 : if (x[1] > y[1]) return 1;
548 881062 : return cmp_universal_rec(x, y, 2);
549 :
550 35 : case t_LIST:
551 : {
552 35 : long tx = list_typ(x), ty = list_typ(y);
553 : GEN vx, vy;
554 : pari_sp av;
555 35 : if (tx < ty) return -1;
556 35 : if (tx > ty) return 1;
557 35 : vx = list_data(x);
558 35 : vy = list_data(y);
559 35 : if (!vx) return vy? -1: 0;
560 35 : if (!vy) return 1;
561 35 : av = avma;
562 35 : if (tx == t_LIST_MAP)
563 : {
564 14 : vx = maptomat_shallow(x);
565 14 : vy = maptomat_shallow(y);
566 : }
567 35 : return gc_int(av, cmp_universal_rec(vx, vy, 1));
568 : }
569 37577706 : default:
570 37577706 : return cmp_universal_rec(x, y, lontyp[tx]);
571 : }
572 : }
573 :
574 : static int
575 4588959 : cmpfrac(GEN x, GEN y)
576 : {
577 4588959 : pari_sp av = avma;
578 4588959 : GEN a = gel(x,1), b = gel(x,2);
579 4588959 : GEN c = gel(y,1), d = gel(y,2);
580 4588959 : return gc_bool(av, cmpii(mulii(a, d), mulii(b, c)));
581 : }
582 : static int
583 455541 : cmpifrac(GEN a, GEN y)
584 : {
585 455541 : pari_sp av = avma;
586 455541 : GEN c = gel(y,1), d = gel(y,2);
587 455541 : return gc_int(av, cmpii(mulii(a, d), c));
588 : }
589 : static int
590 81259 : cmprfrac(GEN a, GEN y)
591 : {
592 81259 : pari_sp av = avma;
593 81259 : GEN c = gel(y,1), d = gel(y,2);
594 81259 : return gc_int(av, cmpri(mulri(a, d), c));
595 : }
596 : static int
597 161 : cmpgen(GEN x, GEN y)
598 : {
599 161 : pari_sp av = avma;
600 161 : return gc_int(av, gsigne(gsub(x,y)));
601 : }
602 :
603 : /* returns the sign of x - y when it makes sense. 0 otherwise */
604 : int
605 297713797 : gcmp(GEN x, GEN y)
606 : {
607 297713797 : long tx = typ(x), ty = typ(y);
608 :
609 297713797 : if (tx == ty) /* generic case */
610 288209404 : switch(tx)
611 : {
612 160218220 : case t_INT: return cmpii(x, y);
613 123312545 : case t_REAL: return cmprr(x, y);
614 4588959 : case t_FRAC: return cmpfrac(x, y);
615 70 : case t_QUAD: return cmpgen(x, y);
616 21 : case t_STR: return cmp_str(GSTR(x), GSTR(y));
617 104743 : case t_INFINITY:
618 : {
619 104743 : long sx = inf_get_sign(x), sy = inf_get_sign(y);
620 104743 : if (sx < sy) return -1;
621 42 : if (sx > sy) return 1;
622 14 : return 0;
623 : }
624 : }
625 9489239 : if (ty == t_INFINITY) return -inf_get_sign(y);
626 8542212 : switch(tx)
627 : {
628 8126973 : case t_INT:
629 : switch(ty)
630 : {
631 7814199 : case t_REAL: return cmpir(x, y);
632 312761 : case t_FRAC: return cmpifrac(x, y);
633 7 : case t_QUAD: return cmpgen(x, y);
634 : }
635 6 : break;
636 215188 : case t_REAL:
637 : switch(ty)
638 : {
639 178320 : case t_INT: return cmpri(x, y);
640 36847 : case t_FRAC: return cmprfrac(x, y);
641 14 : case t_QUAD: return cmpgen(x, y);
642 : }
643 7 : break;
644 187206 : case t_FRAC:
645 : switch(ty)
646 : {
647 142780 : case t_INT: return -cmpifrac(y, x);
648 44412 : case t_REAL: return -cmprfrac(y, x);
649 7 : case t_QUAD: return cmpgen(x, y);
650 : }
651 7 : break;
652 63 : case t_QUAD:
653 63 : return cmpgen(x, y);
654 31660 : case t_INFINITY: return inf_get_sign(x);
655 : }
656 24 : pari_err_TYPE2("comparison",x,y);
657 : return 0;/*LCOV_EXCL_LINE*/
658 : }
659 :
660 : int
661 785945 : gcmpsg(long s, GEN y)
662 : {
663 785945 : switch(typ(y))
664 : {
665 12432 : case t_INT: return cmpsi(s,y);
666 768319 : case t_REAL: return cmpsr(s,y);
667 5194 : case t_FRAC: {
668 5194 : pari_sp av = avma;
669 5194 : return gc_int(av, cmpii(mulsi(s,gel(y,2)), gel(y,1)));
670 : }
671 0 : case t_QUAD: {
672 0 : pari_sp av = avma;
673 0 : return gc_int(av, gsigne(gsubsg(s, y)));
674 : }
675 0 : case t_INFINITY: return -inf_get_sign(y);
676 : }
677 0 : pari_err_TYPE2("comparison",stoi(s),y);
678 : return 0; /* LCOV_EXCL_LINE */
679 : }
680 :
681 : static long
682 3232843 : roughtype(GEN x)
683 : {
684 3232843 : switch(typ(x))
685 : {
686 2114 : case t_MAT: return t_MAT;
687 742472 : case t_VEC: case t_COL: return t_VEC;
688 1613554 : case t_VECSMALL: return t_VECSMALL;
689 874703 : default: return t_INT;
690 : }
691 : }
692 :
693 : static int lexcmpsg(long x, GEN y);
694 42 : static int lexcmpgs(GEN x, long y) { return -lexcmpsg(y,x); }
695 : /* lexcmp(stoi(x),y), y t_VEC/t_COL/t_MAT */
696 : static int
697 21 : lexcmp_s_matvec(long x, GEN y)
698 : {
699 : int fl;
700 21 : if (lg(y)==1) return 1;
701 14 : fl = lexcmpsg(x,gel(y,1));
702 14 : if (fl) return fl;
703 7 : return -1;
704 : }
705 : /* x a scalar, y a t_VEC/t_COL/t_MAT */
706 : static int
707 357 : lexcmp_scal_matvec(GEN x, GEN y)
708 : {
709 : int fl;
710 357 : if (lg(y)==1) return 1;
711 357 : fl = lexcmp(x,gel(y,1));
712 357 : if (fl) return fl;
713 7 : return -1;
714 : }
715 : /* x a scalar, y a t_VECSMALL */
716 : static int
717 42 : lexcmp_scal_vecsmall(GEN x, GEN y)
718 : {
719 : int fl;
720 42 : if (lg(y)==1) return 1;
721 42 : fl = lexcmpgs(x, y[1]);
722 42 : if (fl) return fl;
723 0 : return -1;
724 : }
725 :
726 : /* tx = ty = t_MAT, or x and y are both vect_t */
727 : static int
728 372028 : lexcmp_similar(GEN x, GEN y)
729 : {
730 372028 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
731 456916 : for (i=1; i<l; i++)
732 : {
733 425274 : int fl = lexcmp(gel(x,i),gel(y,i));
734 425275 : if (fl) return fl;
735 : }
736 31642 : if (lx == ly) return 0;
737 37 : return (lx < ly)? -1 : 1;
738 : }
739 : /* x a t_VECSMALL, y a t_VEC/t_COL ~ lexcmp_similar */
740 : static int
741 154 : lexcmp_vecsmall_vec(GEN x, GEN y)
742 : {
743 154 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
744 343 : for (i=1; i<l; i++)
745 : {
746 287 : int fl = lexcmpsg(x[i], gel(y,i));
747 287 : if (fl) return fl;
748 : }
749 56 : if (lx == ly) return 0;
750 21 : return (lx < ly)? -1 : 1;
751 : }
752 :
753 : /* x t_VEC/t_COL, y t_MAT */
754 : static int
755 98 : lexcmp_vec_mat(GEN x, GEN y)
756 : {
757 : int fl;
758 98 : if (lg(x)==1) return -1;
759 98 : if (lg(y)==1) return 1;
760 98 : fl = lexcmp_similar(x,gel(y,1));
761 98 : if (fl) return fl;
762 7 : return -1;
763 : }
764 : /* x t_VECSMALl, y t_MAT ~ lexcmp_vec_mat */
765 : static int
766 42 : lexcmp_vecsmall_mat(GEN x, GEN y)
767 : {
768 : int fl;
769 42 : if (lg(x)==1) return -1;
770 42 : if (lg(y)==1) return 1;
771 42 : fl = lexcmp_vecsmall_vec(x, gel(y,1));
772 42 : if (fl) return fl;
773 0 : return -1;
774 : }
775 :
776 : /* x a t_VECSMALL, not y */
777 : static int
778 196 : lexcmp_vecsmall_other(GEN x, GEN y, long ty)
779 : {
780 196 : switch(ty)
781 : {
782 42 : case t_MAT: return lexcmp_vecsmall_mat(x, y);
783 112 : case t_VEC: return lexcmp_vecsmall_vec(x, y);
784 42 : default: return -lexcmp_scal_vecsmall(y, x); /*y scalar*/
785 : }
786 : }
787 :
788 : /* lexcmp(stoi(s), y) */
789 : static int
790 343 : lexcmpsg(long x, GEN y)
791 : {
792 343 : switch(roughtype(y))
793 : {
794 21 : case t_MAT:
795 : case t_VEC:
796 21 : return lexcmp_s_matvec(x,y);
797 14 : case t_VECSMALL: /* ~ lexcmp_scal_matvec */
798 14 : if (lg(y)==1) return 1;
799 7 : return (x > y[1])? 1: -1;
800 308 : default: return gcmpsg(x,y);
801 : }
802 : }
803 :
804 : /* as gcmp for vector/matrices, using lexicographic ordering on components */
805 : static int
806 1616248 : lexcmp_i(GEN x, GEN y)
807 : {
808 1616248 : const long tx = roughtype(x), ty = roughtype(y);
809 1616252 : if (tx == ty)
810 1615601 : switch(tx)
811 : {
812 371929 : case t_MAT:
813 371929 : case t_VEC: return lexcmp_similar(x,y);
814 806672 : case t_VECSMALL: return vecsmall_lexcmp(x,y);
815 437000 : default: return gcmp(x,y);
816 : }
817 651 : if (tx == t_VECSMALL) return lexcmp_vecsmall_other(x,y,ty);
818 518 : if (ty == t_VECSMALL) return -lexcmp_vecsmall_other(y,x,tx);
819 :
820 455 : if (tx == t_INT) return lexcmp_scal_matvec(x,y); /*scalar*/
821 203 : if (ty == t_INT) return -lexcmp_scal_matvec(y,x);
822 :
823 98 : if (ty==t_MAT) return lexcmp_vec_mat(x,y);
824 42 : return -lexcmp_vec_mat(y,x); /*tx==t_MAT*/
825 : }
826 : int
827 1616249 : lexcmp(GEN x, GEN y)
828 : {
829 1616249 : pari_sp av = avma;
830 1616249 : if (typ(x) == t_COMPLEX)
831 : {
832 875 : x = mkvec2(gel(x,1), gel(x,2));
833 875 : if (typ(y) == t_COMPLEX) y = mkvec2(gel(y,1), gel(y,2));
834 49 : else y = mkvec2(y, gen_0);
835 : }
836 1615374 : else if (typ(y) == t_COMPLEX)
837 : {
838 63 : x = mkvec2(x, gen_0);
839 63 : y = mkvec2(gel(y,1), gel(y,2));
840 : }
841 1616249 : return gc_int(av, lexcmp_i(x, y));
842 : }
843 :
844 : /*****************************************************************/
845 : /* */
846 : /* EQUALITY */
847 : /* returns 1 if x == y, 0 otherwise */
848 : /* */
849 : /*****************************************************************/
850 : /* x,y t_POL */
851 : static int
852 1521175 : polidentical(GEN x, GEN y)
853 : {
854 : long lx;
855 1521175 : if (x[1] != y[1]) return 0;
856 1521077 : lx = lg(x); if (lg(y) != lg(x)) return 0;
857 7636319 : for (lx--; lx >= 2; lx--) if (!gidentical(gel(x,lx), gel(y,lx))) return 0;
858 1520986 : return 1;
859 : }
860 : /* x,y t_SER */
861 : static int
862 14 : seridentical(GEN x, GEN y) { return polidentical(x,y); }
863 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
864 : static int
865 5263961 : vecidentical(GEN x, GEN y)
866 : {
867 : long i;
868 5263961 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
869 16813906 : for (i = lg(x)-1; i; i--)
870 12843275 : if (! gidentical(gel(x,i),gel(y,i)) ) return 0;
871 3970631 : return 1;
872 : }
873 : static int
874 1547 : identicalrr(GEN x, GEN y)
875 : {
876 1547 : long i, lx = lg(x);
877 1547 : if (lg(y) != lx) return 0;
878 1547 : if (x[1] != y[1]) return 0;
879 5465 : i=2; while (i<lx && x[i]==y[i]) i++;
880 1540 : return (i == lx);
881 : }
882 :
883 : static int
884 70 : closure_identical(GEN x, GEN y)
885 : {
886 70 : if (lg(x)!=lg(y) || x[1]!=y[1]) return 0;
887 56 : if (!gidentical(gel(x,2),gel(y,2)) || !gidentical(gel(x,3),gel(y,3))
888 56 : || !gidentical(gel(x,4),gel(y,4))) return 0;
889 42 : if (lg(x)<8) return 1;
890 0 : return gidentical(gel(x,7),gel(y,7));
891 : }
892 :
893 : static int
894 343 : list_cmp(GEN x, GEN y, int cmp(GEN x, GEN y))
895 : {
896 343 : int t = list_typ(x);
897 : GEN vx, vy;
898 : long lvx, lvy;
899 343 : if (list_typ(y)!=t) return 0;
900 343 : vx = list_data(x);
901 343 : vy = list_data(y);
902 343 : lvx = vx ? lg(vx): 1;
903 343 : lvy = vy ? lg(vy): 1;
904 343 : if (lvx==1 && lvy==1) return 1;
905 329 : if (lvx != lvy) return 0;
906 301 : switch (t)
907 : {
908 280 : case t_LIST_MAP:
909 : {
910 280 : pari_sp av = avma;
911 280 : GEN mx = maptomat_shallow(x), my = maptomat_shallow(y);
912 280 : int ret = gidentical(gel(mx, 1), gel(my, 1)) && cmp(gel(mx, 2), gel(my, 2));
913 280 : return gc_bool(av, ret);
914 : }
915 21 : default:
916 21 : return cmp(vx, vy);
917 : }
918 : }
919 :
920 : int
921 54465334 : gidentical(GEN x, GEN y)
922 : {
923 : long tx;
924 :
925 54465334 : if (x == y) return 1;
926 50761441 : tx = typ(x); if (typ(y) != tx) return 0;
927 50534456 : switch(tx)
928 : {
929 13680243 : case t_INT:
930 13680243 : return equalii(x,y);
931 :
932 1547 : case t_REAL:
933 1547 : return identicalrr(x,y);
934 :
935 431838 : case t_FRAC: case t_INTMOD:
936 431838 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
937 :
938 343 : case t_COMPLEX:
939 343 : return gidentical(gel(x,2),gel(y,2)) && gidentical(gel(x,1),gel(y,1));
940 21 : case t_PADIC:
941 21 : return valp(x) == valp(y) && precp(x) == precp(y)
942 14 : && equalii(padic_p(x), padic_p(y))
943 42 : && equalii(padic_u(x), padic_u(y));
944 3892 : case t_POLMOD:
945 3892 : return gidentical(gel(x,2),gel(y,2)) && polidentical(gel(x,1),gel(y,1));
946 1521140 : case t_POL:
947 1521140 : return polidentical(x,y);
948 14 : case t_SER:
949 14 : return seridentical(x,y);
950 4340 : case t_FFELT:
951 4340 : return FF_equal(x,y);
952 :
953 401071 : case t_QFB:
954 401071 : return equalii(gel(x,1),gel(y,1))
955 401064 : && equalii(gel(x,2),gel(y,2))
956 802135 : && equalii(gel(x,3),gel(y,3));
957 :
958 14 : case t_QUAD:
959 14 : return ZX_equal(gel(x,1),gel(y,1))
960 7 : && gidentical(gel(x,2),gel(y,2))
961 21 : && gidentical(gel(x,3),gel(y,3));
962 :
963 7 : case t_RFRAC:
964 7 : return gidentical(gel(x,1),gel(y,1)) && gidentical(gel(x,2),gel(y,2));
965 :
966 70 : case t_STR:
967 70 : return !strcmp(GSTR(x),GSTR(y));
968 5263961 : case t_VEC: case t_COL: case t_MAT:
969 5263961 : return vecidentical(x,y);
970 29225745 : case t_VECSMALL:
971 29225745 : return zv_equal(x,y);
972 28 : case t_CLOSURE:
973 28 : return closure_identical(x,y);
974 161 : case t_LIST:
975 161 : return list_cmp(x, y, gidentical);
976 21 : case t_INFINITY: return gidentical(gel(x,1),gel(y,1));
977 : }
978 0 : return 0;
979 : }
980 : /* x,y t_POL in the same variable */
981 : static int
982 12734018 : polequal(GEN x, GEN y)
983 : {
984 : long lx, ly;
985 : /* Can't do that: Mod(0,1)*x^0 == x^0
986 : if (signe(x) != signe(y)) return 0; */
987 12734018 : lx = lg(x); ly = lg(y);
988 12734018 : while (lx > ly) if (!gequal0(gel(x,--lx))) return 0;
989 12730497 : while (ly > lx) if (!gequal0(gel(y,--ly))) return 0;
990 44160596 : for (lx--; lx >= 2; lx--) if (!gequal(gel(x,lx), gel(y,lx))) return 0;
991 12658422 : return 1;
992 : }
993 :
994 : /* x,y t_SER in the same variable */
995 : static int
996 420 : serequal(GEN x, GEN y)
997 : {
998 : long LX, LY, lx, ly, vx, vy;
999 420 : if (!signe(x) && !signe(y)) return 1;
1000 56 : lx = lg(x); vx = valser(x); LX = lx + vx;
1001 56 : ly = lg(y); vy = valser(y); LY = ly + vy;
1002 56 : if (LX > LY) lx = LY - vx; else ly = LX - vy;
1003 282877 : while (lx >= 3 && ly >= 3)
1004 282821 : if (!gequal(gel(x,--lx), gel(y,--ly))) return 0;
1005 56 : while(--ly >= 2) if (!gequal0(gel(y,ly))) return 0;
1006 84 : while(--lx >= 2) if (!gequal0(gel(x,lx))) return 0;
1007 49 : return 1;
1008 : }
1009 :
1010 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
1011 : static int
1012 5521715 : vecequal(GEN x, GEN y)
1013 : {
1014 : long i;
1015 5521715 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
1016 18442855 : for (i = lg(x)-1; i; i--)
1017 16129707 : if (! gequal(gel(x,i),gel(y,i)) ) return 0;
1018 2313148 : return 1;
1019 : }
1020 :
1021 : int
1022 243379433 : gequal(GEN x, GEN y)
1023 : {
1024 : pari_sp av;
1025 : GEN A, B, a, b;
1026 : long tx, ty;
1027 :
1028 243379433 : if (x == y) return 1;
1029 210072403 : tx = typ(x); ty = typ(y);
1030 210072403 : if (tx == ty)
1031 202246607 : switch(tx)
1032 : {
1033 171237654 : case t_INT:
1034 171237654 : return equalii(x,y);
1035 :
1036 20460 : case t_REAL:
1037 20460 : return equalrr(x,y);
1038 :
1039 295644 : case t_FRAC:
1040 295644 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
1041 :
1042 6519688 : case t_INTMOD:
1043 6519688 : A = gel(x,1); B = gel(y,1);
1044 6519688 : a = gel(x,2); b = gel(y,2);
1045 6519688 : if (equalii(A, B)) return equalii(a, b);
1046 14 : av = avma; A = gcdii(A, B);
1047 14 : return gc_bool(av, equalii(modii(a,A), modii(b,A)));
1048 :
1049 1316 : case t_COMPLEX:
1050 1316 : return gequal(gel(x,2),gel(y,2)) && gequal(gel(x,1),gel(y,1));
1051 770 : case t_PADIC:
1052 770 : if (!equalii(padic_p(x), padic_p(y))) return 0;
1053 770 : av = avma; return gc_bool(av, gequal0(gsub(x,y)));
1054 :
1055 3188695 : case t_POLMOD:
1056 3188695 : A = gel(x,1); B = gel(y,1);
1057 3188695 : if (varn(A) != varn(B)) break;
1058 3188674 : a = gel(x,2); b = gel(y,2);
1059 3188674 : if (RgX_equal_var(A, B)) return gequal(a,b);
1060 14 : av = avma; A = ggcd(A, B);
1061 14 : return gc_bool(av, gequal(gmod(a,A), gmod(b,A)));
1062 :
1063 12746198 : case t_POL:
1064 12746198 : if (varn(x) != varn(y)) break;
1065 12734018 : return polequal(x,y);
1066 420 : case t_SER:
1067 420 : if (varn(x) != varn(y)) break;
1068 420 : return serequal(x,y);
1069 :
1070 61670 : case t_FFELT:
1071 61670 : return FF_equal(x,y);
1072 :
1073 1097048 : case t_QFB:
1074 1097048 : return equalii(gel(x,1),gel(y,1))
1075 247759 : && equalii(gel(x,2),gel(y,2))
1076 1344807 : && equalii(gel(x,3),gel(y,3));
1077 :
1078 7 : case t_QUAD:
1079 7 : return ZX_equal(gel(x,1),gel(y,1))
1080 0 : && gequal(gel(x,2),gel(y,2))
1081 7 : && gequal(gel(x,3),gel(y,3));
1082 :
1083 73759 : case t_RFRAC:
1084 : {
1085 73759 : GEN a = gel(x,1), b = gel(x,2), c = gel(y,1), d = gel(y,2);
1086 73759 : if (gequal(b,d)) return gequal(a,c); /* simple case */
1087 0 : av = avma;
1088 0 : a = simplify_shallow(gmul(a,d));
1089 0 : b = simplify_shallow(gmul(b,c));
1090 0 : return gc_bool(av, gequal(a,b));
1091 : }
1092 :
1093 65030 : case t_STR:
1094 65030 : return !strcmp(GSTR(x),GSTR(y));
1095 5521715 : case t_VEC: case t_COL: case t_MAT:
1096 5521715 : return vecequal(x,y);
1097 1416293 : case t_VECSMALL:
1098 1416293 : return zv_equal(x,y);
1099 182 : case t_LIST:
1100 182 : return list_cmp(x, y, gequal);
1101 42 : case t_CLOSURE:
1102 42 : return closure_identical(x,y);
1103 28 : case t_INFINITY:
1104 28 : return gequal(gel(x,1),gel(y,1));
1105 : }
1106 7837985 : if (is_noncalc_t(tx) || is_noncalc_t(ty)) return 0;
1107 7838106 : if (tx == t_INT && !signe(x)) return gequal0(y);
1108 7795206 : if (ty == t_INT && !signe(y)) return gequal0(x);
1109 3190998 : (void)&av; av = avma; /* emulate volatile */
1110 3190998 : return gc_bool(av, gequal_try(x, y));
1111 : }
1112 :
1113 : int
1114 43988 : gequalsg(long s, GEN x)
1115 43988 : { pari_sp av = avma; return gc_bool(av, gequal(stoi(s), x)); }
1116 :
1117 : /* a and b are t_INT, t_FRAC, t_REAL or t_COMPLEX of those. Check whether
1118 : * a-b is invertible */
1119 : int
1120 49981 : cx_approx_equal(GEN a, GEN b)
1121 : {
1122 49981 : pari_sp av = avma;
1123 : GEN d;
1124 49981 : if (a == b) return 1;
1125 24486 : d = gsub(a,b);
1126 24486 : return gc_bool(av, gequal0(d) || (typ(d)==t_COMPLEX && gequal0(cxnorm(d))));
1127 : }
1128 : static int
1129 1748449 : r_approx0(GEN x, long e) { return e - expo(x) > bit_prec(x); }
1130 : /* x ~ 0 compared to reference y */
1131 : int
1132 2477857 : cx_approx0(GEN x, GEN y)
1133 : {
1134 : GEN a, b;
1135 : long e;
1136 2477857 : switch(typ(x))
1137 : {
1138 469 : case t_COMPLEX:
1139 469 : a = gel(x,1); b = gel(x,2);
1140 469 : if (typ(a) != t_REAL)
1141 : {
1142 14 : if (!gequal0(a)) return 0;
1143 0 : a = NULL;
1144 : }
1145 455 : else if (!signe(a)) a = NULL;
1146 455 : if (typ(b) != t_REAL)
1147 : {
1148 0 : if (!gequal0(b)) return 0;
1149 0 : if (!a) return 1;
1150 0 : b = NULL;
1151 : }
1152 455 : else if (!signe(b))
1153 : {
1154 7 : if (!a) return 1;
1155 7 : b = NULL;
1156 : }
1157 : /* a or b is != NULL iff it is non-zero t_REAL; one of them is */
1158 455 : e = gexpo(y);
1159 455 : return (!a || r_approx0(a, e)) && (!b || r_approx0(b, e));
1160 1748184 : case t_REAL:
1161 1748184 : return !signe(x) || r_approx0(x, gexpo(y));
1162 729204 : default:
1163 729204 : return gequal0(x);
1164 : }
1165 : }
1166 : /*******************************************************************/
1167 : /* */
1168 : /* VALUATION */
1169 : /* p is either a t_INT or a t_POL. */
1170 : /* returns the largest exponent of p dividing x when this makes */
1171 : /* sense : error for types real, integermod and polymod if p does */
1172 : /* not divide the modulus, q-adic if q!=p. */
1173 : /* */
1174 : /*******************************************************************/
1175 :
1176 : static long
1177 137186 : minval(GEN x, GEN p)
1178 : {
1179 137186 : long i,k, val = LONG_MAX, lx = lg(x);
1180 376943 : for (i=lontyp[typ(x)]; i<lx; i++)
1181 : {
1182 239757 : k = gvaluation(gel(x,i),p);
1183 239757 : if (k < val) val = k;
1184 : }
1185 137186 : return val;
1186 : }
1187 :
1188 : static int
1189 91 : intdvd(GEN x, GEN y, GEN *z) { GEN r; *z = dvmdii(x,y,&r); return (r==gen_0); }
1190 :
1191 : /* x t_FRAC, p t_INT, return v_p(x) */
1192 : static long
1193 292596 : frac_val(GEN x, GEN p) {
1194 292596 : long v = Z_pval(gel(x,2),p);
1195 292596 : if (v) return -v;
1196 292454 : return Z_pval(gel(x,1),p);
1197 : }
1198 : long
1199 9308419 : Q_pval(GEN x, GEN p)
1200 : {
1201 9308419 : if (lgefint(p) == 3) return Q_lval(x, uel(p,2));
1202 547 : return (typ(x)==t_INT)? Z_pval(x, p): frac_val(x, p);
1203 : }
1204 :
1205 : static long
1206 370849 : frac_lval(GEN x, ulong p) {
1207 370849 : long v = Z_lval(gel(x,2),p);
1208 370848 : if (v) return -v;
1209 221686 : return Z_lval(gel(x,1),p);
1210 : }
1211 : long
1212 9312622 : Q_lval(GEN x, ulong p){return (typ(x)==t_INT)? Z_lval(x, p): frac_lval(x, p);}
1213 :
1214 : long
1215 6304314 : Q_pvalrem(GEN x, GEN p, GEN *y)
1216 : {
1217 : GEN a, b;
1218 : long v;
1219 6304314 : if (lgefint(p) == 3) return Q_lvalrem(x, uel(p,2), y);
1220 5808 : if (typ(x) == t_INT) return Z_pvalrem(x, p, y);
1221 0 : a = gel(x,1);
1222 0 : b = gel(x,2);
1223 0 : v = Z_pvalrem(b, p, &b);
1224 0 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1225 0 : v = Z_pvalrem(a, p, &a);
1226 0 : *y = mkfrac(a, b); return v;
1227 : }
1228 : long
1229 6302708 : Q_lvalrem(GEN x, ulong p, GEN *y)
1230 : {
1231 : GEN a, b;
1232 : long v;
1233 6302708 : if (typ(x) == t_INT) return Z_lvalrem(x, p, y);
1234 398377 : a = gel(x,1);
1235 398377 : b = gel(x,2);
1236 398377 : v = Z_lvalrem(b, p, &b);
1237 398378 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1238 228917 : v = Z_lvalrem(a, p, &a);
1239 228917 : *y = mkfrac(a, b); return v;
1240 : }
1241 :
1242 : long
1243 1399739 : gvaluation(GEN x, GEN p)
1244 : {
1245 1399739 : long tx = typ(x), tp;
1246 : pari_sp av;
1247 :
1248 1399739 : if (!p)
1249 28 : switch(tx)
1250 : {
1251 7 : case t_PADIC: return valp(x);
1252 7 : case t_POL: return RgX_val(x);
1253 7 : case t_SER: return valser(x);
1254 7 : default: pari_err_TYPE("gvaluation", x);
1255 : }
1256 1399711 : tp = typ(p);
1257 1399711 : switch(tp)
1258 : {
1259 1340407 : case t_INT:
1260 1340407 : if (signe(p) && !is_pm1(p)) break;
1261 28 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1262 59297 : case t_POL:
1263 59297 : if (degpol(p) > 0) break;
1264 : default:
1265 7 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1266 : }
1267 :
1268 1399676 : switch(tx)
1269 : {
1270 223643 : case t_INT:
1271 223643 : if (!signe(x)) return LONG_MAX;
1272 159460 : if (tp == t_POL) return 0;
1273 158851 : return Z_pval(x,p);
1274 :
1275 49 : case t_REAL:
1276 49 : if (tp == t_POL) return 0;
1277 21 : break;
1278 :
1279 28 : case t_FFELT:
1280 28 : if (tp == t_POL) return FF_equal0(x)? LONG_MAX: 0;
1281 14 : break;
1282 :
1283 105 : case t_INTMOD: {
1284 105 : GEN a = gel(x,1), b = gel(x,2);
1285 : long val;
1286 133 : if (tp == t_POL) return signe(b)? 0: LONG_MAX;
1287 42 : av = avma;
1288 42 : if (!intdvd(a, p, &a)) break;
1289 28 : if (!intdvd(b, p, &b)) return gc_long(av,0);
1290 14 : val = 1; while (intdvd(a,p,&a) && intdvd(b,p,&b)) val++;
1291 14 : return gc_long(av,val);
1292 : }
1293 :
1294 292516 : case t_FRAC:
1295 292516 : if (tp == t_POL) return 0;
1296 292502 : return frac_val(x, p);
1297 :
1298 721908 : case t_PADIC:
1299 721908 : if (tp == t_POL) return 0;
1300 721887 : if (!equalii(p, padic_p(x))) break;
1301 721880 : return valp(x);
1302 :
1303 35 : case t_POLMOD: {
1304 35 : GEN a = gel(x,1), b = gel(x,2);
1305 : long v, val;
1306 35 : if (tp == t_INT) return gvaluation(b,p);
1307 21 : v = varn(p);
1308 21 : if (varn(a) != v) return 0;
1309 21 : av = avma;
1310 21 : a = RgX_divrem(a, p, ONLY_DIVIDES);
1311 21 : if (!a) break;
1312 28 : if (typ(b) != t_POL || varn(b) != v ||
1313 21 : !(b = RgX_divrem(b, p, ONLY_DIVIDES)) ) return gc_long(av,0);
1314 7 : val = 1;
1315 28 : while ((a = RgX_divrem(a, p, ONLY_DIVIDES)) &&
1316 21 : (b = RgX_divrem(b, p, ONLY_DIVIDES)) ) val++;
1317 7 : return gc_long(av,val);
1318 : }
1319 160727 : case t_POL: {
1320 160727 : if (tp == t_POL) {
1321 57435 : long vp = varn(p), vx = varn(x);
1322 57435 : if (vp == vx)
1323 : {
1324 : long val;
1325 23674 : if (RgX_is_monomial(p))
1326 : {
1327 23639 : val = RgX_val(x); if (val == LONG_MAX) return LONG_MAX;
1328 12796 : return val / degpol(p);
1329 : }
1330 35 : if (!signe(x)) return LONG_MAX;
1331 21 : av = avma;
1332 21 : for (val=0; ; val++)
1333 : {
1334 35 : x = RgX_divrem(x,p,ONLY_DIVIDES);
1335 35 : if (!x) return gc_long(av,val);
1336 14 : if (gc_needed(av,1))
1337 : {
1338 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gvaluation");
1339 0 : x = gc_GEN(av, x);
1340 : }
1341 : }
1342 : }
1343 33761 : if (varncmp(vx, vp) > 0) return 0;
1344 : }
1345 137046 : return minval(x,p);
1346 : }
1347 :
1348 490 : case t_SER: {
1349 490 : if (tp == t_POL) {
1350 476 : long vp = varn(p), vx = varn(x);
1351 476 : if (vp == vx)
1352 : {
1353 469 : long val = RgX_val(p);
1354 469 : if (!val) pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1355 462 : return (long)(valser(x) / val);
1356 : }
1357 7 : if (varncmp(vx, vp) > 0) return 0;
1358 : }
1359 14 : return minval(x,p);
1360 : }
1361 :
1362 49 : case t_RFRAC:
1363 49 : return gvaluation(gel(x,1),p) - gvaluation(gel(x,2),p);
1364 :
1365 126 : case t_COMPLEX: case t_QUAD: case t_VEC: case t_COL: case t_MAT:
1366 126 : return minval(x,p);
1367 : }
1368 63 : pari_err_OP("valuation", x,p);
1369 : return 0; /* LCOV_EXCL_LINE */
1370 : }
1371 : GEN
1372 3934 : gpvaluation(GEN x, GEN p)
1373 : {
1374 3934 : long v = gvaluation(x,p);
1375 3829 : return v == LONG_MAX? mkoo(): stoi(v);
1376 : }
1377 :
1378 : /* x is nonzero */
1379 : long
1380 87582747 : u_lvalrem(ulong x, ulong p, ulong *py)
1381 : {
1382 : ulong vx;
1383 87582747 : if (p == 2) { vx = vals(x); *py = x >> vx; return vx; }
1384 77463893 : for(vx = 0;;)
1385 : {
1386 124307517 : if (x % p) { *py = x; return vx; }
1387 46843624 : x /= p; /* gcc is smart enough to make a single div */
1388 46843624 : vx++;
1389 : }
1390 : }
1391 : long
1392 65864774 : u_lval(ulong x, ulong p)
1393 : {
1394 : ulong vx;
1395 65864774 : if (p == 2) return vals(x);
1396 62554472 : for(vx = 0;;)
1397 : {
1398 101862699 : if (x % p) return vx;
1399 39308227 : x /= p; /* gcc is smart enough to make a single div */
1400 39308227 : vx++;
1401 : }
1402 : }
1403 :
1404 : long
1405 1826742 : z_lval(long s, ulong p) { return u_lval(labs(s), p); }
1406 : long
1407 87345 : z_lvalrem(long s, ulong p, long *py)
1408 : {
1409 : long v;
1410 87345 : if (s < 0)
1411 : {
1412 0 : ulong u = (ulong)-s;
1413 0 : v = u_lvalrem(u, p, &u);
1414 0 : *py = -(long)u;
1415 : }
1416 : else
1417 : {
1418 87345 : ulong u = (ulong)s;
1419 87345 : v = u_lvalrem(u, p, &u);
1420 87344 : *py = (long)u;
1421 : }
1422 87344 : return v;
1423 : }
1424 : /* assume |p| > 1 */
1425 : long
1426 1317992 : z_pval(long s, GEN p)
1427 : {
1428 1317992 : if (lgefint(p) > 3) return 0;
1429 1317992 : return z_lval(s, uel(p,2));
1430 : }
1431 : /* assume |p| > 1 */
1432 : long
1433 399 : z_pvalrem(long s, GEN p, long *py)
1434 : {
1435 399 : if (lgefint(p) > 3) { *py = s; return 0; }
1436 399 : return z_lvalrem(s, uel(p,2), py);
1437 : }
1438 :
1439 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1440 : static long
1441 2142097 : Z_pvalrem_DC(GEN x, GEN q, GEN *py)
1442 : {
1443 2142097 : GEN r, z = dvmdii(x, q, &r);
1444 : long v;
1445 2142036 : if (r != gen_0) { *py = x; return 0; }
1446 1480516 : if (2 * lgefint(q) <= lgefint(z)+3) /* avoid squaring if pointless */
1447 1464421 : v = Z_pvalrem_DC(z, sqri(q), py) << 1;
1448 : else
1449 16095 : { v = 0; *py = z; }
1450 1480497 : z = dvmdii(*py, q, &r);
1451 1480575 : if (r != gen_0) return v + 1;
1452 619490 : *py = z; return v + 2;
1453 : }
1454 :
1455 : static const long VAL_DC_THRESHOLD = 16;
1456 :
1457 : long
1458 62941077 : Z_lval(GEN x, ulong p)
1459 : {
1460 : long vx;
1461 : pari_sp av;
1462 62941077 : if (p == 2) return vali(x);
1463 48432560 : if (lgefint(x) == 3) return u_lval(uel(x,2), p);
1464 2193196 : av = avma;
1465 2193196 : for(vx = 0;;)
1466 10692161 : {
1467 : ulong r;
1468 12885357 : GEN q = absdiviu_rem(x, p, &r);
1469 12886001 : if (r) break;
1470 10876324 : vx++; x = q;
1471 10876324 : if (vx == VAL_DC_THRESHOLD) {
1472 184163 : if (p == 1) pari_err_DOMAIN("Z_lval", "p", "=", gen_1, gen_1);
1473 184163 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1474 184163 : q = absdiviu_rem(x, p, &r); if (!r) vx++;
1475 184163 : break;
1476 : }
1477 : }
1478 2193840 : return gc_long(av,vx);
1479 : }
1480 : long
1481 63254027 : Z_lvalrem(GEN x, ulong p, GEN *py)
1482 : {
1483 : long vx, sx;
1484 : pari_sp av;
1485 63254027 : if (p == 2) { vx = vali(x); *py = shifti(x, -vx); return vx; }
1486 49928820 : if (lgefint(x) == 3) {
1487 : ulong u;
1488 43487554 : vx = u_lvalrem(uel(x,2), p, &u);
1489 43486950 : *py = signe(x) < 0? utoineg(u): utoipos(u);
1490 43485986 : return vx;
1491 : }
1492 6441266 : av = avma; (void)new_chunk(lgefint(x));
1493 6441837 : sx = signe(x);
1494 6441837 : for(vx = 0;;)
1495 16818808 : {
1496 : ulong r;
1497 23260645 : GEN q = absdiviu_rem(x, p, &r);
1498 23260634 : if (r) break;
1499 17311714 : vx++; x = q;
1500 17311714 : if (vx == VAL_DC_THRESHOLD) {
1501 492906 : if (p == 1) pari_err_DOMAIN("Z_lvalrem", "p", "=", gen_1, gen_1);
1502 492906 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1503 492905 : q = absdiviu_rem(x, p, &r); if (!r) { vx++; x = q; }
1504 492913 : break;
1505 : }
1506 : }
1507 6441833 : set_avma(av); *py = icopy(x); setsigne(*py, sx); return vx;
1508 : }
1509 :
1510 : /* Is |q| <= p ? */
1511 : static int
1512 15005852 : isless_iu(GEN q, ulong p) {
1513 15005852 : long l = lgefint(q);
1514 15005852 : return l==2 || (l == 3 && uel(q,2) <= p);
1515 : }
1516 :
1517 : long
1518 134013516 : u_lvalrem_stop(ulong *n, ulong p, int *stop)
1519 : {
1520 134013516 : ulong N = *n, q = N / p, r = N % p; /* gcc makes a single div */
1521 134013516 : long v = 0;
1522 134013516 : if (!r)
1523 : {
1524 21206509 : do { v++; N = q; q = N / p; r = N % p; } while (!r);
1525 13676774 : *n = N;
1526 : }
1527 134013516 : *stop = q <= p; return v;
1528 : }
1529 : /* Assume n > 0. Return v_p(n), set *n := n/p^v_p(n). Set 'stop' if now
1530 : * n < p^2 [implies n prime if no prime < p divides n] */
1531 : long
1532 116807415 : Z_lvalrem_stop(GEN *n, ulong p, int *stop)
1533 : {
1534 : pari_sp av;
1535 : long v;
1536 : ulong r;
1537 : GEN N, q;
1538 :
1539 116807415 : if (lgefint(*n) == 3)
1540 : {
1541 101800863 : r = (*n)[2];
1542 101800863 : v = u_lvalrem_stop(&r, p, stop);
1543 101804171 : if (v) *n = utoipos(r);
1544 101806659 : return v;
1545 : }
1546 15006552 : av = avma; v = 0; q = absdiviu_rem(*n, p, &r);
1547 15005879 : if (r) set_avma(av);
1548 : else
1549 : {
1550 : do {
1551 265494 : v++; N = q;
1552 265494 : if (v == VAL_DC_THRESHOLD)
1553 : {
1554 629 : v += Z_pvalrem_DC(N,sqru(p),&N) << 1;
1555 629 : q = absdiviu_rem(N, p, &r); if (!r) { v++; N = q; }
1556 629 : break;
1557 : }
1558 264865 : q = absdiviu_rem(N, p, &r);
1559 264865 : } while (!r);
1560 224108 : *n = N;
1561 : }
1562 15005872 : *stop = isless_iu(q,p); return v;
1563 : }
1564 :
1565 : /* x is a nonzero integer, |p| > 1 */
1566 : long
1567 67637470 : Z_pvalrem(GEN x, GEN p, GEN *py)
1568 : {
1569 : long vx;
1570 : pari_sp av;
1571 :
1572 67637470 : if (lgefint(p) == 3) return Z_lvalrem(x, uel(p,2), py);
1573 13870505 : if (lgefint(x) == 3) { *py = icopy(x); return 0; }
1574 1573136 : av = avma; vx = 0; (void)new_chunk(lgefint(x));
1575 : for(;;)
1576 21655 : {
1577 1594878 : GEN r, q = dvmdii(x,p,&r);
1578 1594878 : if (r != gen_0) { set_avma(av); *py = icopy(x); return vx; }
1579 21655 : vx++; x = q;
1580 : }
1581 : }
1582 : long
1583 2625348 : u_pvalrem(ulong x, GEN p, ulong *py)
1584 : {
1585 2625348 : if (lgefint(p) == 3) return u_lvalrem(x, uel(p,2), py);
1586 550 : *py = x; return 0;
1587 : }
1588 : long
1589 136789 : u_pval(ulong x, GEN p)
1590 : {
1591 136789 : if (lgefint(p) == 3) return u_lval(x, uel(p,2));
1592 0 : return 0;
1593 : }
1594 : long
1595 47255210 : Z_pval(GEN x, GEN p) {
1596 : long vx;
1597 : pari_sp av;
1598 :
1599 47255210 : if (lgefint(p) == 3) return Z_lval(x, uel(p,2));
1600 32558 : if (lgefint(x) == 3) return 0;
1601 7902 : av = avma; vx = 0;
1602 : for(;;)
1603 25346 : {
1604 33248 : GEN r, q = dvmdii(x,p,&r);
1605 33281 : if (r != gen_0) return gc_long(av,vx);
1606 25346 : vx++; x = q;
1607 : }
1608 : }
1609 :
1610 : /* return v_p(n!) = [n/p] + [n/p^2] + ... */
1611 : long
1612 1992676 : factorial_lval(ulong n, ulong p)
1613 : {
1614 : ulong q, v;
1615 1992676 : if (p == 2) return n - hammingl(n);
1616 1319651 : q = p; v = 0;
1617 1448291 : do { v += n/q; q *= p; } while (n >= q);
1618 1319651 : return (long)v;
1619 : }
1620 :
1621 : /********** Same for "containers" ZX / ZV / ZC **********/
1622 :
1623 : /* If the t_INT q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1624 : * Stack clean; assumes lg(x) > 1 */
1625 : static GEN
1626 6859 : gen_Z_divides(GEN x, GEN q, long imin)
1627 : {
1628 : long i, l;
1629 6859 : GEN y = cgetg_copy(x, &l);
1630 :
1631 6859 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1632 89956 : for (i = imin; i < l; i++)
1633 : {
1634 87239 : GEN r, xi = gel(x,i);
1635 87239 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1636 56654 : gel(y,i) = dvmdii(xi, q, &r);
1637 56654 : if (r != gen_0) { set_avma((pari_sp)(y+l)); return NULL; }
1638 : }
1639 2717 : return y;
1640 : }
1641 : /* If q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1642 : * Stack clean; assumes lg(x) > 1 */
1643 : static GEN
1644 4935 : gen_z_divides(GEN x, ulong q, long imin)
1645 : {
1646 : long i, l;
1647 4935 : GEN y = cgetg_copy(x, &l);
1648 :
1649 4935 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1650 42915 : for (i = imin; i < l; i++)
1651 : {
1652 : ulong r;
1653 41593 : GEN xi = gel(x,i);
1654 41593 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1655 28208 : gel(y,i) = absdiviu_rem(xi, q, &r);
1656 28208 : if (r) { set_avma((pari_sp)(y+l)); return NULL; }
1657 24595 : affectsign_safe(xi, &gel(y,i));
1658 : }
1659 1322 : return y;
1660 : }
1661 :
1662 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1663 : static long
1664 11756 : gen_pvalrem_DC(GEN x, GEN q, GEN *py, long imin)
1665 : {
1666 :
1667 11756 : pari_sp av = avma;
1668 11756 : long v, i, l, lz = LONG_MAX;
1669 11756 : GEN y = cgetg_copy(x, &l);
1670 :
1671 11756 : y[1] = x[1];
1672 136387 : for (i = imin; i < l; i++)
1673 : {
1674 129528 : GEN r, xi = gel(x,i);
1675 129528 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1676 87624 : gel(y,i) = dvmdii(xi, q, &r);
1677 87624 : if (r != gen_0) { *py = x; return gc_long(av,0); }
1678 82727 : lz = minss(lz, lgefint(gel(y,i)));
1679 : }
1680 6859 : if (2 * lgefint(q) <= lz+3) /* avoid squaring if pointless */
1681 6807 : v = gen_pvalrem_DC(y, sqri(q), py, imin) << 1;
1682 : else
1683 52 : { v = 0; *py = y; }
1684 :
1685 6859 : y = gen_Z_divides(*py, q, imin);
1686 6859 : if (!y) return v+1;
1687 2717 : *py = y; return v+2;
1688 : }
1689 :
1690 : static long
1691 773487 : gen_2val(GEN x, long imin)
1692 : {
1693 773487 : long i, lx = lg(x), v = LONG_MAX;
1694 2927305 : for (i = imin; i < lx; i++)
1695 : {
1696 2488979 : GEN c = gel(x,i);
1697 : long w;
1698 2488979 : if (!signe(c)) continue;
1699 2277596 : w = vali(c);
1700 2277596 : if (w < v) { v = w; if (!v) break; }
1701 : }
1702 773487 : return v;
1703 : }
1704 : static long
1705 870660 : gen_lval(GEN x, ulong p, long imin)
1706 : {
1707 : long i, lx, v;
1708 : pari_sp av;
1709 : GEN y;
1710 870660 : if (p == 2) return gen_2val(x, imin);
1711 97173 : av = avma;
1712 97173 : lx = lg(x); y = leafcopy(x);
1713 292737 : for(v = 0;; v++)
1714 1437273 : for (i = imin; i < lx; i++)
1715 : {
1716 : ulong r;
1717 1241709 : gel(y,i) = absdiviu_rem(gel(y,i), p, &r);
1718 1241709 : if (r) return gc_long(av,v);
1719 : }
1720 : }
1721 : long
1722 748784 : ZX_lval(GEN x, ulong p) { return gen_lval(x, p, 2); }
1723 : long
1724 0 : ZV_lval(GEN x, ulong p) { return gen_lval(x, p, 1); }
1725 :
1726 : long
1727 28931 : zx_lval(GEN f, long p)
1728 : {
1729 28931 : long i, l = lg(f), x = LONG_MAX;
1730 30219 : for(i=2; i<l; i++)
1731 : {
1732 : long y;
1733 29477 : if (f[i] == 0) continue;
1734 29428 : y = z_lval(f[i], p);
1735 29428 : if (y < x) { x = y; if (x == 0) return x; }
1736 : }
1737 742 : return x;
1738 : }
1739 :
1740 : static long
1741 132194 : gen_pval(GEN x, GEN p, long imin)
1742 : {
1743 : long i, lx, v;
1744 : pari_sp av;
1745 : GEN y;
1746 132194 : if (lgefint(p) == 3) return gen_lval(x, p[2], imin);
1747 10318 : av = avma;
1748 10318 : lx = lg(x); y = leafcopy(x);
1749 10318 : for(v = 0;; v++)
1750 : {
1751 10318 : if (v == VAL_DC_THRESHOLD)
1752 : {
1753 0 : if (is_pm1(p)) pari_err_DOMAIN("gen_pval", "p", "=", p, p);
1754 0 : v += gen_pvalrem_DC(y, p, &y, imin);
1755 0 : return gc_long(av,v);
1756 : }
1757 :
1758 10318 : for (i = imin; i < lx; i++)
1759 : {
1760 10318 : GEN r; gel(y,i) = dvmdii(gel(y,i), p, &r);
1761 10318 : if (r != gen_0) return gc_long(av,v);
1762 : }
1763 : }
1764 : }
1765 : long
1766 101289 : ZX_pval(GEN x, GEN p) { return gen_pval(x, p, 2); }
1767 : long
1768 30905 : ZV_pval(GEN x, GEN p) { return gen_pval(x, p, 1); }
1769 : /* v = 0 (mod p) */
1770 : int
1771 1309 : ZV_Z_dvd(GEN v, GEN p)
1772 : {
1773 1309 : pari_sp av = avma;
1774 1309 : long i, l = lg(v);
1775 4613 : for (i=1; i<l; i++)
1776 3423 : if (!dvdii(gel(v,i), p)) return gc_int(av, 0);
1777 1190 : return gc_int(av, 1);
1778 : }
1779 :
1780 : static long
1781 4815408 : gen_2valrem(GEN x, GEN *px, long imin)
1782 : {
1783 4815408 : long i, lx = lg(x), v = LONG_MAX;
1784 : GEN z;
1785 13908391 : for (i = imin; i < lx; i++)
1786 : {
1787 12590653 : GEN c = gel(x,i);
1788 : long w;
1789 12590653 : if (!signe(c)) continue;
1790 11701925 : w = vali(c);
1791 11702167 : if (w < v) {
1792 6932677 : v = w;
1793 6932677 : if (!v) { *px = x; return 0; } /* early abort */
1794 : }
1795 : }
1796 1317738 : z = cgetg_copy(x, &lx); z[1] = x[1];
1797 8519037 : for (i=imin; i<lx; i++) gel(z,i) = shifti(gel(x,i), -v);
1798 1317336 : *px = z; return v;
1799 : }
1800 : static long
1801 8239576 : gen_lvalrem(GEN x, ulong p, GEN *px, long imin)
1802 : {
1803 : long i, lx, v;
1804 : GEN y;
1805 8239576 : if (p == 2) return gen_2valrem(x, px, imin);
1806 3424247 : y = cgetg_copy(x, &lx);
1807 3424453 : y[1] = x[1];
1808 3424453 : x = leafcopy(x);
1809 3424030 : for(v = 0;; v++)
1810 : {
1811 4836581 : if (v == VAL_DC_THRESHOLD)
1812 : {
1813 4935 : if (p == 1) pari_err_DOMAIN("gen_lvalrem", "p", "=", gen_1, gen_1);
1814 4935 : v += gen_pvalrem_DC(x, sqru(p), px, imin) << 1;
1815 4935 : x = gen_z_divides(*px, p, imin);
1816 4935 : if (x) { *px = x; v++; }
1817 4935 : return v;
1818 : }
1819 :
1820 15531098 : for (i = imin; i < lx; i++)
1821 : {
1822 14118547 : ulong r; gel(y,i) = absdiviu_rem(gel(x,i), p, &r);
1823 14118335 : if (r) { *px = x; return v; }
1824 10698876 : affectsign_safe(gel(x,i), &gel(y,i));
1825 : }
1826 1412551 : swap(x, y);
1827 : }
1828 : }
1829 : long
1830 721 : ZX_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 2); }
1831 : long
1832 0 : ZV_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 1); }
1833 :
1834 : static long
1835 8251773 : gen_pvalrem(GEN x, GEN p, GEN *px, long imin)
1836 : {
1837 : long i, lx, v;
1838 : GEN y;
1839 8251773 : if (lgefint(p) == 3) return gen_lvalrem(x, p[2], px, imin);
1840 12943 : y = cgetg_copy(x, &lx);
1841 12945 : y[1] = x[1];
1842 12945 : x = leafcopy(x);
1843 12945 : for(v = 0;; v++)
1844 : {
1845 13734 : if (v == VAL_DC_THRESHOLD)
1846 : {
1847 14 : if (is_pm1(p)) pari_err_DOMAIN("gen_pvalrem", "p", "=", p, p);
1848 14 : return v + gen_pvalrem_DC(x, p, px, imin);
1849 : }
1850 :
1851 22384 : for (i = imin; i < lx; i++)
1852 : {
1853 21595 : GEN r; gel(y,i) = dvmdii(gel(x,i), p, &r);
1854 21595 : if (r != gen_0) { *px = x; return v; }
1855 : }
1856 789 : swap(x, y);
1857 : }
1858 : }
1859 : long
1860 4301930 : ZX_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 2); }
1861 : long
1862 3949852 : ZV_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 1); }
1863 :
1864 : static long
1865 1190 : ZX_gen_pvalrem(GEN x, GEN p, GEN *px, long imin)
1866 : {
1867 : long i, lx, v;
1868 : GEN y;
1869 1190 : y = cgetg_copy(x, &lx);
1870 1190 : y[1] = x[1];
1871 1190 : x = leafcopy(x);
1872 12985 : for (i = imin; i < lx; i++)
1873 11795 : if (typ(gel(x, i)) != t_INT)
1874 : {
1875 10633 : gel(x, i) = leafcopy(gel(x,i));
1876 10633 : gel(y, i) = leafcopy(gel(x,i));
1877 : }
1878 1190 : for(v = 0;; v++)
1879 : {
1880 : #if 0
1881 : if (v == VAL_DC_THRESHOLD) /* TODO */
1882 : {
1883 : if (is_pm1(p)) pari_err_DOMAIN("ZX_gen_pvalrem", "p", "=", p, p);
1884 : return v + ZX_gen_pvalrem_DC(x, p, px, imin);
1885 : }
1886 : #endif
1887 :
1888 1253 : for (i = imin; i < lx; i++)
1889 : {
1890 1246 : GEN r, xi = gel(x,i);
1891 1246 : if (typ(xi) == t_INT)
1892 : {
1893 70 : gel(y,i) = dvmdii(xi, p, &r);
1894 1246 : if (r != gen_0) { *px = x; return v; }
1895 : } else
1896 : {
1897 1176 : long j, lxi = lg(xi);
1898 3017 : for(j = 2; j < lxi; j++)
1899 : {
1900 3017 : gmael(y,i,j) = dvmdii(gel(xi,j), p, &r);
1901 3017 : if (r != gen_0) { *px = x; return v; }
1902 : }
1903 : }
1904 : }
1905 7 : swap(x, y);
1906 : }
1907 : }
1908 :
1909 : long
1910 1190 : ZXX_pvalrem(GEN x, GEN p, GEN *px) { return ZX_gen_pvalrem(x,p,px, 2); }
1911 : long
1912 0 : ZXV_pvalrem(GEN x, GEN p, GEN *px) { return ZX_gen_pvalrem(x,p,px, 1); }
1913 :
1914 : /*******************************************************************/
1915 : /* */
1916 : /* NEGATION: Create -x */
1917 : /* */
1918 : /*******************************************************************/
1919 :
1920 : GEN
1921 468114336 : gneg(GEN x)
1922 : {
1923 : GEN y;
1924 468114336 : switch(typ(x))
1925 : {
1926 138450038 : case t_INT:
1927 138450038 : return signe(x)? negi(x): gen_0;
1928 241828713 : case t_REAL:
1929 241828713 : return mpneg(x);
1930 :
1931 153244 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1932 153244 : gel(y,1) = icopy(gel(x,1));
1933 153244 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1934 153244 : break;
1935 :
1936 3001908 : case t_FRAC:
1937 3001908 : y = cgetg(3, t_FRAC);
1938 3001906 : gel(y,1) = negi(gel(x,1));
1939 3001904 : gel(y,2) = icopy(gel(x,2)); break;
1940 :
1941 75700178 : case t_COMPLEX:
1942 75700178 : y=cgetg(3, t_COMPLEX);
1943 75701564 : gel(y,1) = gneg(gel(x,1));
1944 75703605 : gel(y,2) = gneg(gel(x,2));
1945 75703712 : break;
1946 :
1947 247269 : case t_POLMOD:
1948 247269 : retmkpolmod(gneg(gel(x,2)), RgX_copy(gel(x,1)));
1949 :
1950 153335 : case t_RFRAC:
1951 153335 : y = cgetg(3, t_RFRAC);
1952 153335 : gel(y,1) = gneg(gel(x,1));
1953 153335 : gel(y,2) = RgX_copy(gel(x,2)); break;
1954 :
1955 648278 : case t_PADIC:
1956 : {
1957 648278 : GEN u = padic_u(x), pd = padic_pd(x), p = padic_p(x);
1958 648278 : if (!signe(u)) return gcopy(x);
1959 644673 : retmkpadic(subii(pd, u), icopy(p), icopy(pd), valp(x), precp(x));
1960 : }
1961 133 : case t_QUAD:
1962 133 : y=cgetg(4,t_QUAD);
1963 133 : gel(y,1) = ZX_copy(gel(x,1));
1964 133 : gel(y,2) = gneg(gel(x,2));
1965 133 : gel(y,3) = gneg(gel(x,3)); break;
1966 :
1967 82181 : case t_FFELT: return FF_neg(x);
1968 7535333 : case t_POL: return RgX_neg(x);
1969 16688 : case t_SER: pari_APPLY_ser_normalized(gneg(gel(x,i)));
1970 1533 : case t_VEC: return RgV_neg(x);
1971 422623 : case t_COL: return RgC_neg(x);
1972 1351 : case t_MAT: return RgM_neg(x);
1973 784 : case t_INFINITY: return inf_get_sign(x) == 1? mkmoo(): mkoo();
1974 0 : default:
1975 0 : pari_err_TYPE("gneg",x);
1976 : return NULL; /* LCOV_EXCL_LINE */
1977 : }
1978 79012272 : return y;
1979 : }
1980 :
1981 : GEN
1982 128993456 : gneg_i(GEN x)
1983 : {
1984 : GEN y;
1985 128993456 : switch(typ(x))
1986 : {
1987 62483340 : case t_INT:
1988 62483340 : return signe(x)? negi(x): gen_0;
1989 31684015 : case t_REAL:
1990 31684015 : return mpneg(x);
1991 :
1992 588812 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1993 588812 : gel(y,1) = gel(x,1);
1994 588812 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1995 588812 : break;
1996 :
1997 5541079 : case t_FRAC:
1998 5541079 : y = cgetg(3, t_FRAC);
1999 5541079 : gel(y,1) = negi(gel(x,1));
2000 5541080 : gel(y,2) = gel(x,2); break;
2001 :
2002 10689592 : case t_COMPLEX:
2003 10689592 : y = cgetg(3, t_COMPLEX);
2004 10689685 : gel(y,1) = gneg_i(gel(x,1));
2005 10689788 : gel(y,2) = gneg_i(gel(x,2)); break;
2006 :
2007 2014945 : case t_PADIC:
2008 : {
2009 2014945 : GEN u = padic_u(x), pd = padic_pd(x), p = padic_p(x);
2010 2014945 : if (!signe(u)) return zeropadic_shallow(p, valp(x));
2011 2013398 : retmkpadic(subii(pd, u), p, pd, valp(x), precp(x));
2012 : }
2013 134553 : case t_POLMOD:
2014 134553 : retmkpolmod(gneg_i(gel(x,2)), RgX_copy(gel(x,1)));
2015 :
2016 84588 : case t_FFELT: return FF_neg_i(x);
2017 :
2018 672 : case t_QUAD: y=cgetg(4,t_QUAD);
2019 672 : gel(y,1) = gel(x,1);
2020 672 : gel(y,2) = gneg_i(gel(x,2));
2021 672 : gel(y,3) = gneg_i(gel(x,3)); break;
2022 :
2023 2590 : case t_VEC:
2024 : case t_COL:
2025 14042 : case t_MAT: pari_APPLY_same(gneg_i(gel(x,i)));
2026 37889909 : case t_POL: pari_APPLY_pol_normalized(gneg_i(gel(x,i)));
2027 3749133 : case t_SER: pari_APPLY_ser_normalized(gneg_i(gel(x,i)));
2028 :
2029 5005769 : case t_RFRAC:
2030 5005769 : y = cgetg(3, t_RFRAC);
2031 5005769 : gel(y,1) = gneg_i(gel(x,1));
2032 5005765 : gel(y,2) = gel(x,2); break;
2033 :
2034 0 : default:
2035 0 : pari_err_TYPE("gneg_i",x);
2036 : return NULL; /* LCOV_EXCL_LINE */
2037 : }
2038 21826143 : return y;
2039 : }
2040 :
2041 : /******************************************************************/
2042 : /* */
2043 : /* ABSOLUTE VALUE */
2044 : /* Create abs(x) if x is integer, real, fraction or complex. */
2045 : /* Error otherwise. */
2046 : /* */
2047 : /******************************************************************/
2048 : static int
2049 0 : is_negative(GEN x) {
2050 0 : switch(typ(x))
2051 : {
2052 0 : case t_INT: case t_REAL:
2053 0 : return (signe(x) < 0);
2054 0 : case t_FRAC:
2055 0 : return (signe(gel(x,1)) < 0);
2056 : }
2057 0 : return 0;
2058 : }
2059 :
2060 : GEN
2061 53315195 : gabs(GEN x, long prec)
2062 : {
2063 : long lx;
2064 : pari_sp av;
2065 : GEN y, N;
2066 :
2067 53315195 : switch(typ(x))
2068 : {
2069 35234129 : case t_INT: case t_REAL:
2070 35234129 : return mpabs(x);
2071 :
2072 12804 : case t_FRAC:
2073 12804 : return absfrac(x);
2074 :
2075 17971750 : case t_COMPLEX:
2076 17971750 : av=avma; N=cxnorm(x);
2077 17952782 : switch(typ(N))
2078 : {
2079 266 : case t_INT:
2080 266 : if (!Z_issquareall(N, &y)) break;
2081 105 : return gc_upto(av, y);
2082 21735 : case t_FRAC: {
2083 : GEN a,b;
2084 36036 : if (!Z_issquareall(gel(N,1), &a)) break;
2085 14301 : if (!Z_issquareall(gel(N,2), &b)) break;
2086 0 : return gc_upto(av, gdiv(a,b));
2087 : }
2088 : }
2089 17952677 : return gc_upto(av, gsqrt(N,prec));
2090 :
2091 21 : case t_QUAD:
2092 21 : av = avma;
2093 21 : return gc_uptoleaf(av, gabs(quadtofp(x, prec), prec));
2094 :
2095 0 : case t_POL:
2096 0 : lx = lg(x); if (lx<=2) return RgX_copy(x);
2097 0 : return is_negative(gel(x,lx-1))? RgX_neg(x): RgX_copy(x);
2098 :
2099 7 : case t_SER:
2100 7 : if (!signe(x)) pari_err_DOMAIN("abs", "argument", "=", gen_0, x);
2101 7 : if (valser(x)) pari_err_DOMAIN("abs", "series valuation", "!=", gen_0, x);
2102 0 : return is_negative(gel(x,2))? gneg(x): gcopy(x);
2103 :
2104 101972 : case t_VEC: case t_COL: case t_MAT:
2105 591415 : pari_APPLY_same(gabs(gel(x,i),prec));
2106 :
2107 14 : case t_INFINITY:
2108 14 : return mkoo();
2109 : }
2110 0 : pari_err_TYPE("gabs",x);
2111 : return NULL; /* LCOV_EXCL_LINE */
2112 : }
2113 :
2114 : GEN
2115 79310 : gmax(GEN x, GEN y) { return gcopy(gmax_shallow(x,y)); }
2116 : GEN
2117 0 : gmaxgs(GEN x, long s) { return (gcmpsg(s,x)>=0)? stoi(s): gcopy(x); }
2118 :
2119 : GEN
2120 12180 : gmin(GEN x, GEN y) { return gcopy(gmin_shallow(x,y)); }
2121 : GEN
2122 0 : gmings(GEN x, long s) { return (gcmpsg(s,x)>0)? gcopy(x): stoi(s); }
2123 :
2124 : long
2125 503168 : vecindexmax(GEN x)
2126 : {
2127 503168 : long lx = lg(x), i0, i;
2128 : GEN s;
2129 :
2130 503168 : if (lx==1) pari_err_DOMAIN("vecindexmax", "empty argument", "=", x,x);
2131 503169 : switch(typ(x))
2132 : {
2133 503169 : case t_VEC: case t_COL:
2134 503169 : s = gel(x,i0=1);
2135 1502450 : for (i=2; i<lx; i++)
2136 999277 : if (gcmp(gel(x,i),s) > 0) s = gel(x,i0=i);
2137 503173 : return i0;
2138 0 : case t_VECSMALL:
2139 0 : return vecsmall_indexmax(x);
2140 0 : default: pari_err_TYPE("vecindexmax",x);
2141 : }
2142 : /* LCOV_EXCL_LINE */
2143 0 : return 0;
2144 : }
2145 : long
2146 181380 : vecindexmin(GEN x)
2147 : {
2148 181380 : long lx = lg(x), i0, i;
2149 : GEN s;
2150 :
2151 181380 : if (lx==1) pari_err_DOMAIN("vecindexmin", "empty argument", "=", x,x);
2152 181380 : switch(typ(x))
2153 : {
2154 181380 : case t_VEC: case t_COL:
2155 181380 : s = gel(x,i0=1);
2156 943865 : for (i=2; i<lx; i++)
2157 762485 : if (gcmp(gel(x,i),s) < 0) s = gel(x,i0=i);
2158 181380 : return i0;
2159 0 : case t_VECSMALL:
2160 0 : return vecsmall_indexmin(x);
2161 0 : default: pari_err_TYPE("vecindexmin",x);
2162 : }
2163 : /* LCOV_EXCL_LINE */
2164 0 : return 0;
2165 : }
2166 :
2167 : GEN
2168 226770 : vecmax0(GEN x, GEN *pi)
2169 : {
2170 226770 : long i, lx = lg(x), tx = typ(x);
2171 226770 : if (!is_matvec_t(tx) && tx != t_VECSMALL
2172 49 : && (tx != t_LIST || list_typ(x) != t_LIST_RAW)) return gcopy(x);
2173 226749 : if (tx == t_LIST)
2174 28 : { if (list_data(x)) { x = list_data(x); lx = lg(x); } else lx = 1; }
2175 226749 : if (lx==1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2176 226707 : switch(typ(x))
2177 : {
2178 226230 : case t_VEC: case t_COL:
2179 226230 : i = vecindexmax(x); if (pi) *pi = utoipos(i);
2180 226234 : return gcopy(gel(x,i));
2181 456 : case t_MAT: {
2182 456 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2183 : GEN s;
2184 456 : if (lx2 == 1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2185 449 : s = gcoeff(x,i0,j0); i = 2;
2186 1205 : for (j=1; j<lx; j++,i=1)
2187 : {
2188 756 : GEN c = gel(x,j);
2189 1817 : for (; i<lx2; i++)
2190 1061 : if (gcmp(gel(c,i),s) > 0) { s = gel(c,i); j0=j; i0=i; }
2191 : }
2192 449 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2193 449 : return gcopy(s);
2194 : }
2195 21 : case t_VECSMALL:
2196 21 : i = vecsmall_indexmax(x); if (pi) *pi = utoipos(i);
2197 21 : return stoi(x[i]);
2198 : }
2199 : return NULL;/*LCOV_EXCL_LINE*/
2200 : }
2201 : GEN
2202 146730 : vecmin0(GEN x, GEN *pi)
2203 : {
2204 146730 : long i, lx = lg(x), tx = typ(x);
2205 146730 : if (!is_matvec_t(tx) && tx != t_VECSMALL
2206 49 : && (tx != t_LIST || list_typ(x) != t_LIST_RAW)) return gcopy(x);
2207 146709 : if (tx == t_LIST)
2208 28 : { if (list_data(x)) { x = list_data(x); lx = lg(x); } else lx = 1; }
2209 146709 : if (lx==1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2210 146674 : switch(typ(x))
2211 : {
2212 146632 : case t_VEC: case t_COL:
2213 146632 : i = vecindexmin(x); if (pi) *pi = utoipos(i);
2214 146632 : return gcopy(gel(x,i));
2215 21 : case t_MAT: {
2216 21 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2217 : GEN s;
2218 21 : if (lx2 == 1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2219 21 : s = gcoeff(x,i0,j0); i = 2;
2220 63 : for (j=1; j<lx; j++,i=1)
2221 : {
2222 42 : GEN c = gel(x,j);
2223 105 : for (; i<lx2; i++)
2224 63 : if (gcmp(gel(c,i),s) < 0) { s = gel(c,i); j0=j; i0=i; }
2225 : }
2226 21 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2227 21 : return gcopy(s);
2228 : }
2229 21 : case t_VECSMALL:
2230 21 : i = vecsmall_indexmin(x); if (pi) *pi = utoipos(i);
2231 21 : return stoi(x[i]);
2232 : }
2233 : return NULL;/*LCOV_EXCL_LINE*/
2234 : }
2235 :
2236 : GEN
2237 66185 : vecmax(GEN x) { return vecmax0(x, NULL); }
2238 : GEN
2239 34562 : vecmin(GEN x) { return vecmin0(x, NULL); }
2240 :
2241 : /*******************************************************************/
2242 : /* */
2243 : /* AFFECT long --> GEN */
2244 : /* affect long s to GEN x. Useful for initialization. */
2245 : /* */
2246 : /*******************************************************************/
2247 :
2248 : static void
2249 0 : padicaff0(GEN x)
2250 : {
2251 0 : if (signe(padic_u(x)))
2252 : {
2253 0 : setvalp(x, valp(x) + precp(x));
2254 0 : affsi(0, padic_u(x));
2255 : }
2256 0 : }
2257 :
2258 : void
2259 91840 : gaffsg(long s, GEN x)
2260 : {
2261 91840 : switch(typ(x))
2262 : {
2263 90930 : case t_INT: affsi(s,x); break;
2264 910 : case t_REAL: affsr(s,x); break;
2265 0 : case t_INTMOD: modsiz(s,gel(x,1),gel(x,2)); break;
2266 0 : case t_FRAC: affsi(s,gel(x,1)); affsi(1,gel(x,2)); break;
2267 0 : case t_COMPLEX: gaffsg(s,gel(x,1)); gaffsg(0,gel(x,2)); break;
2268 0 : case t_PADIC: {
2269 : long vx;
2270 : GEN y;
2271 0 : if (!s) { padicaff0(x); break; }
2272 0 : vx = Z_pvalrem(stoi(s), padic_p(x), &y);
2273 0 : setvalp(x,vx); modiiz(y, padic_pd(x), padic_u(x));
2274 0 : break;
2275 : }
2276 0 : case t_QUAD: gaffsg(s,gel(x,2)); gaffsg(0,gel(x,3)); break;
2277 0 : default: pari_err_TYPE2("=",stoi(s),x);
2278 : }
2279 91840 : }
2280 :
2281 : /*******************************************************************/
2282 : /* */
2283 : /* GENERIC AFFECTATION */
2284 : /* Affect the content of x to y, whenever possible */
2285 : /* */
2286 : /*******************************************************************/
2287 : /* x PADIC, Y INT, return lift(x * Mod(1,Y)) */
2288 : GEN
2289 4298 : padic_to_Fp(GEN x, GEN Y) {
2290 4298 : pari_sp av = avma;
2291 4298 : GEN p = padic_p(x), z;
2292 4298 : long vy, vx = valp(x);
2293 4298 : if (!signe(Y)) pari_err_INV("padic_to_Fp",Y);
2294 4298 : vy = Z_pvalrem(Y,p, &z);
2295 4298 : if (vx < 0 || !gequal1(z)) pari_err_OP("",x, mkintmod(gen_1,Y));
2296 4277 : if (vx >= vy) { set_avma(av); return gen_0; }
2297 3962 : z = padic_u(x);
2298 3962 : if (!signe(z) || vy > vx + precp(x)) pari_err_OP("",x, mkintmod(gen_1,Y));
2299 3962 : if (vx) z = mulii(z, powiu(p,vx));
2300 3962 : return gc_INT(av, remii(z, Y));
2301 : }
2302 : ulong
2303 421693 : padic_to_Fl(GEN x, ulong Y) {
2304 421693 : GEN p = padic_p(x);
2305 : ulong u, z;
2306 421693 : long vy, vx = valp(x);
2307 421693 : vy = u_pvalrem(Y,p, &u);
2308 421695 : if (vx < 0 || u != 1) pari_err_OP("",x, mkintmodu(1,Y));
2309 : /* Y = p^vy */
2310 421695 : if (vx >= vy) return 0;
2311 375985 : z = umodiu(padic_u(x), Y);
2312 375987 : if (!z || vy > vx + precp(x)) pari_err_OP("",x, mkintmodu(1,Y));
2313 375987 : if (vx) {
2314 0 : ulong pp = p[2];
2315 0 : z = Fl_mul(z, upowuu(pp,vx), Y); /* p^vx < p^vy = Y */
2316 : }
2317 375987 : return z;
2318 : }
2319 :
2320 : static void
2321 0 : croak(const char *s) {
2322 : char *t;
2323 0 : t = stack_sprintf("gaffect [overwriting universal object: %s]",s);
2324 0 : pari_err_BUG(t);
2325 0 : }
2326 :
2327 : void
2328 664578 : gaffect(GEN x, GEN y)
2329 : {
2330 664578 : long vx, i, lx, ly, tx = typ(x), ty = typ(y);
2331 : pari_sp av;
2332 : GEN p1, num, den;
2333 :
2334 664578 : if (tx == ty) switch(tx) {
2335 215629 : case t_INT:
2336 572738 : if (!is_universal_constant(y)) { affii(x,y); return; }
2337 : /* y = gen_0, gnil, gen_1 or gen_2 */
2338 0 : if (y==gen_0) croak("gen_0");
2339 0 : if (y==gen_1) croak("gen_1");
2340 0 : if (y==gen_m1) croak("gen_m1");
2341 0 : if (y==gen_m2) croak("gen_m2");
2342 0 : if (y==gen_2) croak("gen_2");
2343 0 : croak("gnil)");
2344 188958 : case t_REAL: affrr(x,y); return;
2345 0 : case t_INTMOD:
2346 0 : if (!dvdii(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2347 0 : modiiz(gel(x,2),gel(y,1),gel(y,2)); return;
2348 0 : case t_FRAC:
2349 0 : affii(gel(x,1),gel(y,1));
2350 0 : affii(gel(x,2),gel(y,2)); return;
2351 95438 : case t_COMPLEX:
2352 95438 : gaffect(gel(x,1),gel(y,1));
2353 95438 : gaffect(gel(x,2),gel(y,2)); return;
2354 0 : case t_PADIC:
2355 0 : if (!equalii(padic_p(x), padic_p(y))) pari_err_OP("",x,y);
2356 0 : modiiz(padic_u(x), padic_pd(y), padic_u(y));
2357 0 : setvalp(y, valp(x)); return;
2358 0 : case t_QUAD:
2359 0 : if (! ZX_equal(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2360 0 : affii(gel(x,2),gel(y,2));
2361 0 : affii(gel(x,3),gel(y,3)); return;
2362 72713 : case t_VEC: case t_COL: case t_MAT:
2363 72713 : lx = lg(x); if (lx != lg(y)) pari_err_DIM("gaffect");
2364 194584 : for (i=1; i<lx; i++) gaffect(gel(x,i),gel(y,i));
2365 72713 : return;
2366 : }
2367 :
2368 : /* Various conversions. Avoid them, use specialized routines ! */
2369 :
2370 91840 : if (!is_const_t(ty)) pari_err_TYPE2("=",x,y);
2371 91840 : switch(tx)
2372 : {
2373 0 : case t_INT:
2374 : switch(ty)
2375 : {
2376 0 : case t_REAL:
2377 0 : affir(x,y); break;
2378 :
2379 0 : case t_INTMOD:
2380 0 : modiiz(x,gel(y,1),gel(y,2)); break;
2381 :
2382 0 : case t_COMPLEX:
2383 0 : gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2384 :
2385 0 : case t_PADIC:
2386 0 : if (!signe(x)) { padicaff0(y); break; }
2387 0 : av = avma;
2388 0 : setvalp(y, Z_pvalrem(x, padic_p(y), &p1));
2389 0 : affii(modii(p1, padic_pd(y)), padic_u(y));
2390 0 : set_avma(av); break;
2391 :
2392 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2393 0 : default: pari_err_TYPE2("=",x,y);
2394 : }
2395 0 : break;
2396 :
2397 91840 : case t_REAL:
2398 : switch(ty)
2399 : {
2400 91840 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2401 0 : default: pari_err_TYPE2("=",x,y);
2402 : }
2403 91840 : break;
2404 :
2405 0 : case t_FRAC:
2406 : switch(ty)
2407 : {
2408 0 : case t_REAL: rdiviiz(gel(x,1),gel(x,2), y); break;
2409 0 : case t_INTMOD: av = avma;
2410 0 : p1 = Fp_inv(gel(x,2),gel(y,1));
2411 0 : affii(modii(mulii(gel(x,1),p1),gel(y,1)), gel(y,2));
2412 0 : set_avma(av); break;
2413 0 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2414 0 : case t_PADIC:
2415 : {
2416 0 : GEN p = padic_p(y), pd = padic_pd(y);
2417 0 : if (!signe(gel(x,1))) { padicaff0(y); break; }
2418 0 : num = gel(x,1);
2419 0 : den = gel(x,2);
2420 0 : av = avma; vx = Z_pvalrem(num, p, &num);
2421 0 : if (!vx) vx = -Z_pvalrem(den, p, &den);
2422 0 : setvalp(y, vx);
2423 0 : p1 = mulii(num, Fp_inv(den, pd));
2424 0 : affii(modii(p1,pd), padic_u(y)); set_avma(av); break;
2425 : }
2426 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2427 0 : default: pari_err_TYPE2("=",x,y);
2428 : }
2429 0 : break;
2430 :
2431 0 : case t_COMPLEX:
2432 0 : if (!gequal0(gel(x,2))) pari_err_TYPE2("=",x,y);
2433 0 : gaffect(gel(x,1), y);
2434 0 : break;
2435 :
2436 0 : case t_PADIC:
2437 : switch(ty)
2438 : {
2439 0 : case t_INTMOD:
2440 0 : av = avma; affii(padic_to_Fp(x, gel(y,1)), gel(y,2));
2441 0 : set_avma(av); break;
2442 0 : default: pari_err_TYPE2("=",x,y);
2443 : }
2444 0 : break;
2445 :
2446 0 : case t_QUAD:
2447 : switch(ty)
2448 : {
2449 0 : case t_INT: case t_INTMOD: case t_FRAC: case t_PADIC:
2450 0 : pari_err_TYPE2("=",x,y);
2451 :
2452 0 : case t_REAL:
2453 0 : av = avma; affgr(quadtofp(x,realprec(y)), y); set_avma(av); break;
2454 0 : case t_COMPLEX:
2455 0 : ly = precision(y); if (!ly) pari_err_TYPE2("=",x,y);
2456 0 : av = avma; gaffect(quadtofp(x,ly), y); set_avma(av); break;
2457 0 : default: pari_err_TYPE2("=",x,y);
2458 : }
2459 0 : default: pari_err_TYPE2("=",x,y);
2460 : }
2461 : }
2462 :
2463 : /*******************************************************************/
2464 : /* */
2465 : /* CONVERSION QUAD --> REAL, COMPLEX OR P-ADIC */
2466 : /* */
2467 : /*******************************************************************/
2468 : GEN
2469 252 : quadtofp(GEN x, long prec)
2470 : {
2471 252 : GEN b, D, z, u = gel(x,2), v = gel(x,3);
2472 : pari_sp av;
2473 252 : if (prec < LOWDEFAULTPREC) prec = LOWDEFAULTPREC;
2474 252 : if (isintzero(v)) return cxcompotor(u, prec);
2475 252 : av = avma; D = quad_disc(x); b = gel(gel(x,1),3); /* 0 or -1 */
2476 : /* u + v (-b + sqrt(D)) / 2 */
2477 252 : if (!signe(b)) b = NULL;
2478 252 : if (b) u = gadd(gmul2n(u,1), v);
2479 252 : z = sqrtr_abs(itor(D, prec));
2480 252 : if (!b) shiftr_inplace(z, -1);
2481 252 : z = gmul(v, z);
2482 252 : if (signe(D) < 0)
2483 : {
2484 35 : z = mkcomplex(cxcompotor(u, prec), z);
2485 35 : if (!b) return gc_GEN(av, z);
2486 0 : z = gmul2n(z, -1);
2487 : }
2488 : else
2489 : { /* if (b) x ~ (u + z) / 2 and quadnorm(x) ~ (u^2 - z^2) / 4
2490 : * else x ~ u + z and quadnorm(x) ~ u^2 - z^2 */
2491 217 : long s = gsigne(u);
2492 217 : if (s == -gsigne(v)) /* conjugate expression avoids cancellation */
2493 : {
2494 14 : z = gdiv(quadnorm(x), gsub(u, z));
2495 14 : if (b) shiftr_inplace(z, 1);
2496 : }
2497 : else
2498 : {
2499 203 : if (s) z = gadd(u, z);
2500 203 : if (b) shiftr_inplace(z, -1);
2501 : }
2502 : }
2503 217 : return gc_upto(av, z);
2504 : }
2505 :
2506 : static GEN
2507 42 : qtop(GEN x, GEN p, long d)
2508 : {
2509 42 : GEN z, D, P, b, u = gel(x,2), v = gel(x,3);
2510 : pari_sp av;
2511 42 : if (gequal0(v)) return cvtop(u, p, d);
2512 28 : P = gel(x,1);
2513 28 : b = gel(P,3);
2514 28 : av = avma; D = quad_disc(x);
2515 28 : if (absequaliu(p,2)) d += 2;
2516 28 : z = Qp_sqrt(cvtop(D,p,d));
2517 28 : if (!z) pari_err_SQRTN("Qp_sqrt",D);
2518 14 : z = gmul2n(gsub(z, b), -1);
2519 :
2520 14 : z = gadd(u, gmul(v, z));
2521 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_QUAD of t_INTMODs... */
2522 0 : z = cvtop(z, p, d);
2523 14 : return gc_upto(av, z);
2524 : }
2525 : static GEN
2526 14 : ctop(GEN x, GEN p, long d)
2527 : {
2528 14 : pari_sp av = avma;
2529 14 : GEN z, u = gel(x,1), v = gel(x,2);
2530 14 : if (isrationalzero(v)) return cvtop(u, p, d);
2531 14 : z = Qp_sqrt(cvtop(gen_m1, p, d - gvaluation(v, p))); /* = I */
2532 14 : if (!z) pari_err_SQRTN("Qp_sqrt",gen_m1);
2533 :
2534 14 : z = gadd(u, gmul(v, z));
2535 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_COMPLEX of t_INTMODs... */
2536 0 : z = cvtop(z, p, d);
2537 14 : return gc_upto(av, z);
2538 : }
2539 :
2540 : /* cvtop2(stoi(s), y) */
2541 : GEN
2542 399 : cvstop2(long s, GEN y)
2543 : {
2544 399 : GEN p = padic_p(y), pd = padic_pd(y), u = padic_u(y);
2545 399 : long v, d = signe(u)? precp(y): 0;
2546 399 : if (!s) return zeropadic_shallow(p, d);
2547 399 : v = z_pvalrem(s, p, &s);
2548 399 : if (d <= 0) return zeropadic_shallow(p, v);
2549 399 : retmkpadic(modsi(s, pd), p, pd, v, d);
2550 : }
2551 :
2552 : static GEN
2553 17611378 : itop2_coprime(GEN x, GEN y, long v, long d)
2554 : {
2555 17611378 : GEN p = padic_p(y), pd = padic_pd(y);
2556 17611378 : retmkpadic(modii(x, pd), p, pd, v, d);
2557 : }
2558 : /* cvtop(x, gel(y,2), precp(y)), shallow */
2559 : GEN
2560 17619261 : cvtop2(GEN x, GEN y)
2561 : {
2562 17619261 : GEN p = padic_p(y), u;
2563 17619261 : long v, d = signe(padic_u(y))? precp(y): 0;
2564 17619261 : switch(typ(x))
2565 : {
2566 14820760 : case t_INT:
2567 14820760 : if (!signe(x)) return zeropadic_shallow(p, d);
2568 14820760 : if (d <= 0) return zeropadic_shallow(p, Z_pval(x,p));
2569 14816357 : v = Z_pvalrem(x, p, &x); return itop2_coprime(x, y, v, d);
2570 :
2571 0 : case t_INTMOD:
2572 0 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2573 0 : return cvtop(gel(x,2), p, v);
2574 :
2575 2797472 : case t_FRAC:
2576 : {
2577 : GEN num, den;
2578 2797472 : if (d <= 0) return zeropadic_shallow(p, Q_pval(x,p));
2579 2796191 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2580 2796183 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2581 2796203 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, padic_pd(y)));
2582 2796201 : return itop2_coprime(num, y, v, d);
2583 : }
2584 7 : case t_COMPLEX: return ctop(x, p, d);
2585 42 : case t_QUAD: return qtop(x, p, d);
2586 1197 : case t_PADIC:
2587 1197 : u = padic_u(x);
2588 1197 : if (!signe(u)) return zeropadic_shallow(p, d);
2589 1197 : if (precp(x) <= d) return x;
2590 35 : return itop2_coprime(u, y, valp(x), d); /* reduce accuracy */
2591 : }
2592 0 : pari_err_TYPE("cvtop2",x);
2593 : return NULL; /* LCOV_EXCL_LINE */
2594 : }
2595 :
2596 : static GEN
2597 163004 : _Fp_div(GEN n, GEN d, GEN q)
2598 163004 : { return equali1(d)? modii(n, q): Fp_div(n, d, q); }
2599 :
2600 : /* assume is_const_t(tx) */
2601 : GEN
2602 600510 : cvtop(GEN x, GEN p, long d)
2603 : {
2604 : GEN u;
2605 : long v;
2606 :
2607 600510 : if (typ(p) != t_INT) pari_err_TYPE("cvtop",p);
2608 600510 : switch(typ(x))
2609 : {
2610 268220 : case t_INT:
2611 268220 : if (!signe(x)) return zeropadic(p, d);
2612 267002 : if (d <= 0) return zeropadic(p, Z_pval(x,p));
2613 266946 : v = Z_pvalrem(x, p, &x); /* not memory-clean */
2614 266945 : retmkpadic_i(modii(x, _pd), icopy(p), powiu(p,d), v, d);
2615 :
2616 28 : case t_INTMOD:
2617 28 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2618 28 : return cvtop(gel(x,2), p, v);
2619 :
2620 163019 : case t_FRAC:
2621 : {
2622 : GEN num, den;
2623 163019 : if (d <= 0) return zeropadic(p, Q_pval(x,p));
2624 163005 : num = gel(x,1); v = Z_pvalrem(num, p, &num); /* not memory-clean */
2625 163005 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2626 163005 : retmkpadic_i(_Fp_div(num, den, _pd), icopy(p), powiu(p,d), v, d);
2627 : }
2628 7 : case t_COMPLEX: return ctop(x, p, d);
2629 169236 : case t_PADIC:
2630 169236 : p = padic_p(x); /* override */
2631 169236 : u = padic_u(x);
2632 169236 : if (!signe(u)) return zeropadic(p, d);
2633 169152 : retmkpadic_i(modii(u, _pd), icopy(p), powiu(p,d), valp(x), d);
2634 :
2635 0 : case t_QUAD: return qtop(x, p, d);
2636 : }
2637 0 : pari_err_TYPE("cvtop",x);
2638 : return NULL; /* LCOV_EXCL_LINE */
2639 : }
2640 :
2641 : GEN
2642 126 : gcvtop(GEN x, GEN p, long r)
2643 : {
2644 126 : switch(typ(x))
2645 : {
2646 63 : case t_POL: pari_APPLY_pol_normalized(gcvtop(gel(x,i),p,r));
2647 35 : case t_SER: pari_APPLY_ser_normalized(gcvtop(gel(x,i),p,r));
2648 0 : case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
2649 0 : pari_APPLY_same(gcvtop(gel(x,i),p,r));
2650 : }
2651 98 : return cvtop(x,p,r);
2652 : }
2653 :
2654 : long
2655 837846699 : gexpo_safe(GEN x)
2656 : {
2657 837846699 : long tx = typ(x), lx, e, f, i;
2658 :
2659 837846699 : switch(tx)
2660 : {
2661 176339286 : case t_INT:
2662 176339286 : return expi(x);
2663 :
2664 1070352 : case t_FRAC:
2665 1070352 : return expi(gel(x,1)) - expi(gel(x,2));
2666 :
2667 457703748 : case t_REAL:
2668 457703748 : return expo(x);
2669 :
2670 87252207 : case t_COMPLEX:
2671 87252207 : e = gexpo(gel(x,1));
2672 87251793 : f = gexpo(gel(x,2)); return maxss(e, f);
2673 :
2674 91 : case t_QUAD: {
2675 91 : GEN p = gel(x,1); /* mod = X^2 + {0,1}* X - {D/4, (1-D)/4})*/
2676 91 : long d = 1 + expi(gel(p,2))/2; /* ~ expo(sqrt(D)) */
2677 91 : e = gexpo(gel(x,2));
2678 91 : f = gexpo(gel(x,3)) + d; return maxss(e, f);
2679 : }
2680 83989042 : case t_POL: case t_SER:
2681 83989042 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2682 325500469 : for (i=2; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2683 83983197 : return f;
2684 31608341 : case t_VEC: case t_COL: case t_MAT:
2685 31608341 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2686 217183951 : for (i=1; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2687 31608269 : return f;
2688 : }
2689 48 : return -1-(long)HIGHEXPOBIT;
2690 : }
2691 : long
2692 837608179 : gexpo(GEN x)
2693 : {
2694 837608179 : long e = gexpo_safe(x);
2695 837601945 : if (e < -(long)HIGHEXPOBIT) pari_err_TYPE("gexpo",x);
2696 837598475 : return e;
2697 : }
2698 : GEN
2699 89998 : gpexponent(GEN x)
2700 : {
2701 89998 : long e = gexpo(x);
2702 89998 : return e == -(long)HIGHEXPOBIT? mkmoo(): stoi(e);
2703 : }
2704 :
2705 : long
2706 7 : sizedigit(GEN x)
2707 : {
2708 7 : return gequal0(x)? 0: (long) ((gexpo(x)+1) * LOG10_2) + 1;
2709 : }
2710 :
2711 : /* normalize series. avma is not updated */
2712 : GEN
2713 13353492 : normalizeser(GEN x)
2714 : {
2715 13353492 : long i, lx = lg(x), vx=varn(x), vp=valser(x);
2716 : GEN y, z;
2717 :
2718 13353492 : if (lx == 2) { setsigne(x,0); return x; }
2719 13353128 : if (lx == 3) {
2720 191358 : z = gel(x,2);
2721 191358 : if (!gequal0(z)) { setsigne(x,1); return x; }
2722 23758 : if (isrationalzero(z)) return zeroser(vx,vp+1);
2723 4291 : if (isexactzero(z)) {
2724 : /* dangerous case: already normalized ? */
2725 252 : if (!signe(x)) return x;
2726 35 : setvalser(x,vp+1); /* no: normalize */
2727 : }
2728 4074 : setsigne(x,0); return x;
2729 : }
2730 13456089 : for (i=2; i<lx; i++)
2731 13409336 : if (! isrationalzero(gel(x,i))) break;
2732 13161770 : if (i == lx) return zeroser(vx,lx-2+vp);
2733 13115017 : z = gel(x,i);
2734 13118818 : while (i<lx && isexactzero(gel(x,i))) i++;
2735 13115017 : if (i == lx)
2736 : {
2737 273 : i -= 3; y = x + i;
2738 273 : stackdummy((pari_sp)y, (pari_sp)x);
2739 273 : gel(y,2) = z;
2740 273 : y[1] = evalsigne(0) | evalvalser(lx-2+vp) | evalvarn(vx);
2741 273 : y[0] = evaltyp(t_SER) | _evallg(3);
2742 273 : return y;
2743 : }
2744 :
2745 13114744 : i -= 2; y = x + i; lx -= i;
2746 13114744 : y[1] = evalsigne(1) | evalvalser(vp+i) | evalvarn(vx);
2747 13114744 : y[0] = evaltyp(t_SER) | _evallg(lx);
2748 :
2749 13114744 : stackdummy((pari_sp)y, (pari_sp)x);
2750 13143771 : for (i = 2; i < lx; i++)
2751 13142882 : if (!gequal0(gel(y, i))) return y;
2752 889 : setsigne(y, 0); return y;
2753 : }
2754 :
2755 : GEN
2756 0 : normalizepol_approx(GEN x, long lx)
2757 : {
2758 : long i;
2759 0 : for (i = lx-1; i>1; i--)
2760 0 : if (! gequal0(gel(x,i))) break;
2761 0 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + i+1));
2762 0 : setlg(x, i+1); setsigne(x, i!=1); return x;
2763 : }
2764 :
2765 : GEN
2766 943243969 : normalizepol_lg(GEN x, long lx)
2767 : {
2768 943243969 : long i, LX = 0;
2769 943243969 : GEN KEEP = NULL;
2770 :
2771 1288428202 : for (i = lx-1; i>1; i--)
2772 : {
2773 1130832716 : GEN z = gel(x,i);
2774 1130832716 : if (! gequal0(z) ) {
2775 785888826 : if (!LX) LX = i+1;
2776 785888826 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2777 785872714 : x[0] = evaltyp(t_POL) | _evallg(LX);
2778 785872714 : setsigne(x,1); return x;
2779 344920124 : } else if (!isexactzero(z)) {
2780 977298 : if (!LX) LX = i+1; /* to be kept as leading coeff */
2781 344211178 : } else if (!isrationalzero(z))
2782 456964 : KEEP = z; /* to be kept iff all other coeffs are exact 0s */
2783 : }
2784 157595486 : if (!LX) {
2785 157066352 : if (KEEP) { /* e.g. Pol(Mod(0,2)) */
2786 113555 : gel(x,2) = KEEP;
2787 113555 : LX = 3;
2788 : } else
2789 156952797 : LX = 2; /* Pol(0) */
2790 : }
2791 157595486 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2792 157470334 : x[0] = evaltyp(t_POL) | _evallg(LX);
2793 157470334 : setsigne(x,0); return x;
2794 : }
2795 :
2796 : /* normalize polynomial x in place */
2797 : GEN
2798 99358622 : normalizepol(GEN x)
2799 : {
2800 99358622 : return normalizepol_lg(x, lg(x));
2801 : }
2802 :
2803 : int
2804 79574104 : gsigne(GEN x)
2805 : {
2806 79574104 : switch(typ(x))
2807 : {
2808 79193527 : case t_INT: case t_REAL: return signe(x);
2809 379952 : case t_FRAC: return signe(gel(x,1));
2810 623 : case t_QUAD:
2811 : {
2812 623 : pari_sp av = avma;
2813 623 : GEN T = gel(x,1), a = gel(x,2), b = gel(x,3);
2814 : long sa, sb;
2815 623 : if (signe(gel(T,2)) > 0) break;
2816 609 : a = gmul2n(a,1);
2817 609 : if (signe(gel(T,3))) a = gadd(a,b);
2818 : /* a + b sqrt(D) > 0 ? */
2819 609 : sa = gsigne(a);
2820 609 : sb = gsigne(b); if (sa == sb) return gc_int(av,sa);
2821 224 : if (sa == 0) return gc_int(av,sb);
2822 217 : if (sb == 0) return gc_int(av,sa);
2823 : /* different signs, take conjugate expression */
2824 210 : sb = gsigne(gsub(gsqr(a), gmul(quad_disc(x), gsqr(b))));
2825 210 : return gc_int(av, sb*sa);
2826 : }
2827 14 : case t_INFINITY: return inf_get_sign(x);
2828 : }
2829 12 : pari_err_TYPE("gsigne",x);
2830 : return 0; /* LCOV_EXCL_LINE */
2831 : }
2832 :
2833 : /*******************************************************************/
2834 : /* */
2835 : /* LISTS */
2836 : /* */
2837 : /*******************************************************************/
2838 : /* make sure L can hold l elements, at least doubling the previous max number
2839 : * of components. */
2840 : static void
2841 810971 : ensure_nb(GEN L, long l)
2842 : {
2843 810971 : long nmax = list_nmax(L), i, lw;
2844 : GEN v, w;
2845 810971 : if (l <= nmax) return;
2846 1246 : if (nmax)
2847 : {
2848 490 : nmax <<= 1;
2849 490 : if (l > nmax) nmax = l;
2850 490 : w = list_data(L); lw = lg(w);
2851 490 : v = newblock(nmax+1);
2852 490 : v[0] = w[0];
2853 1070958 : for (i=1; i < lw; i++) gel(v,i) = gel(w, i);
2854 490 : killblock(w);
2855 : }
2856 : else /* unallocated */
2857 : {
2858 756 : nmax = 32;
2859 756 : if (list_data(L))
2860 0 : pari_err(e_MISC, "store list in variable before appending elements");
2861 756 : v = newblock(nmax+1);
2862 756 : v[0] = evaltyp(t_VEC) | _evallg(1);
2863 : }
2864 1246 : list_data(L) = v;
2865 1246 : L[1] = evaltyp(list_typ(L))|evallg(nmax);
2866 : }
2867 :
2868 : GEN
2869 6891 : mklist_typ(long t)
2870 : {
2871 6891 : GEN L = cgetg(3,t_LIST);
2872 6891 : L[1] = evaltyp(t);
2873 6891 : list_data(L) = NULL; return L;
2874 : }
2875 :
2876 : GEN
2877 6835 : mklist(void)
2878 : {
2879 6835 : return mklist_typ(t_LIST_RAW);
2880 : }
2881 :
2882 : GEN
2883 49 : mkmap(void)
2884 : {
2885 49 : return mklist_typ(t_LIST_MAP);
2886 : }
2887 :
2888 : /* return a list with single element x, allocated on stack */
2889 : GEN
2890 63 : mklistcopy(GEN x)
2891 : {
2892 63 : GEN y = mklist();
2893 63 : list_data(y) = mkveccopy(x);
2894 63 : return y;
2895 : }
2896 :
2897 : GEN
2898 776125 : listput(GEN L, GEN x, long index)
2899 : {
2900 : long l;
2901 : GEN z;
2902 :
2903 776125 : if (index < 0) pari_err_COMPONENT("listput", "<", gen_0, stoi(index));
2904 776118 : z = list_data(L);
2905 776118 : l = z? lg(z): 1;
2906 :
2907 776118 : x = gclone(x);
2908 776118 : if (!index || index >= l)
2909 : {
2910 775964 : ensure_nb(L, l);
2911 775964 : z = list_data(L); /* it may change ! */
2912 775964 : index = l;
2913 775964 : l++;
2914 : } else
2915 154 : gunclone_deep( gel(z, index) );
2916 776118 : gel(z,index) = x;
2917 776118 : z[0] = evaltyp(t_VEC) | evallg(l); /*must be after gel(z,index) is set*/
2918 776118 : return gel(z,index);
2919 : }
2920 :
2921 : GEN
2922 724955 : listput0(GEN L, GEN x, long index)
2923 : {
2924 724955 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2925 14 : pari_err_TYPE("listput",L);
2926 724941 : (void) listput(L, x, index);
2927 724934 : return x;
2928 : }
2929 :
2930 : GEN
2931 35014 : listinsert(GEN L, GEN x, long index)
2932 : {
2933 : long l, i;
2934 : GEN z;
2935 :
2936 35014 : z = list_data(L); l = z? lg(z): 1;
2937 35014 : if (index <= 0) pari_err_COMPONENT("listinsert", "<=", gen_0, stoi(index));
2938 35007 : if (index > l) index = l;
2939 35007 : ensure_nb(L, l);
2940 35007 : BLOCK_SIGINT_START
2941 35007 : z = list_data(L);
2942 87552507 : for (i=l; i > index; i--) gel(z,i) = gel(z,i-1);
2943 35007 : z[0] = evaltyp(t_VEC) | evallg(l+1);
2944 35007 : gel(z,index) = gclone(x);
2945 35007 : BLOCK_SIGINT_END
2946 35007 : return gel(z,index);
2947 : }
2948 :
2949 : GEN
2950 35028 : listinsert0(GEN L, GEN x, long index)
2951 : {
2952 35028 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2953 14 : pari_err_TYPE("listinsert",L);
2954 35014 : (void) listinsert(L, x, index);
2955 35007 : return x;
2956 : }
2957 :
2958 : void
2959 21917 : listpop(GEN L, long index)
2960 : {
2961 : long l, i;
2962 : GEN z;
2963 :
2964 21917 : if (typ(L) != t_LIST) pari_err_TYPE("listinsert",L);
2965 21917 : if (index < 0) pari_err_COMPONENT("listpop", "<", gen_0, stoi(index));
2966 21917 : z = list_data(L);
2967 21917 : if (!z || (l = lg(z)-1) == 0) return;
2968 :
2969 21903 : if (!index || index > l) index = l;
2970 21903 : BLOCK_SIGINT_START
2971 21903 : gunclone_deep( gel(z, index) );
2972 21903 : z[0] = evaltyp(t_VEC) | _evallg(l);
2973 21910 : for (i=index; i < l; i++) z[i] = z[i+1];
2974 21903 : BLOCK_SIGINT_END
2975 : }
2976 :
2977 : void
2978 56 : listpop0(GEN L, long index)
2979 : {
2980 56 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2981 14 : pari_err_TYPE("listpop",L);
2982 42 : listpop(L, index);
2983 42 : }
2984 :
2985 : /* return a copy fully allocated on stack. gclone from changevalue is
2986 : * supposed to malloc() it */
2987 : GEN
2988 5930 : gtolist(GEN x)
2989 : {
2990 : GEN y;
2991 :
2992 5930 : if (!x) return mklist();
2993 370 : switch(typ(x))
2994 : {
2995 300 : case t_VEC: case t_COL:
2996 300 : y = mklist();
2997 300 : if (lg(x) == 1) return y;
2998 279 : list_data(y) = gcopy(x);
2999 279 : settyp(list_data(y), t_VEC);
3000 279 : return y;
3001 7 : case t_LIST:
3002 7 : y = mklist();
3003 7 : list_data(y) = list_data(x)? gcopy(list_data(x)): NULL;
3004 7 : return y;
3005 63 : default:
3006 63 : return mklistcopy(x);
3007 : }
3008 : }
3009 :
3010 : void
3011 21 : listsort(GEN L, long flag)
3012 : {
3013 : long i, l;
3014 21 : pari_sp av = avma;
3015 : GEN perm, v, vnew;
3016 :
3017 21 : if (typ(L) != t_LIST) pari_err_TYPE("listsort",L);
3018 21 : v = list_data(L); l = v? lg(v): 1;
3019 21 : if (l < 3) return;
3020 21 : if (flag)
3021 : {
3022 : long lnew;
3023 14 : perm = gen_indexsort_uniq(L, (void*)&cmp_universal, cmp_nodata);
3024 14 : lnew = lg(perm); /* may have changed since 'uniq' */
3025 14 : vnew = cgetg(lnew,t_VEC);
3026 56 : for (i=1; i<lnew; i++) {
3027 42 : long c = perm[i];
3028 42 : gel(vnew,i) = gel(v,c);
3029 42 : gel(v,c) = NULL;
3030 : }
3031 14 : if (l != lnew) { /* was shortened */
3032 105 : for (i=1; i<l; i++)
3033 91 : if (gel(v,i)) gunclone_deep(gel(v,i));
3034 14 : l = lnew;
3035 : }
3036 : }
3037 : else
3038 : {
3039 7 : perm = gen_indexsort(L, (void*)&cmp_universal, cmp_nodata);
3040 7 : vnew = cgetg(l,t_VEC);
3041 63 : for (i=1; i<l; i++) gel(vnew,i) = gel(v,perm[i]);
3042 : }
3043 119 : for (i=1; i<l; i++) gel(v,i) = gel(vnew,i);
3044 21 : v[0] = vnew[0]; set_avma(av);
3045 : }
|
