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 39438986 : map_proto_lG(long (*f)(GEN), GEN x)
38 : {
39 39439070 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_lG(f, gel(x,i)));
40 39423952 : 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 2198073 : _domul(void *data, GEN x, GEN y)
52 : {
53 2198073 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
54 2198073 : return mul(x,y);
55 : }
56 :
57 : GEN
58 2405127 : gassoc_proto(GEN (*f)(GEN,GEN), GEN x, GEN y)
59 : {
60 2405127 : if (!y)
61 : {
62 2405127 : pari_sp av = avma;
63 2405127 : 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 2405113 : case t_COL: break;
69 7 : default: pari_err_TYPE("association",x);
70 : }
71 2405113 : return gerepileupto(av, gen_product(x, (void *)f, _domul));
72 :
73 : }
74 0 : return f(x,y);
75 : }
76 : /*******************************************************************/
77 : /* */
78 : /* CREATION OF A P-ADIC GEN */
79 : /* */
80 : /*******************************************************************/
81 : GEN
82 12400707 : cgetp(GEN x)
83 : {
84 12400707 : GEN y = cgetg(5,t_PADIC);
85 12400696 : y[1] = (x[1]&PRECPBITS) | _evalvalp(0);
86 12400696 : gel(y,2) = icopy(gel(x,2));
87 12400660 : gel(y,3) = icopy(gel(x,3));
88 12400731 : gel(y,4) = cgeti(lgefint(gel(x,3))); return y;
89 : }
90 :
91 : /*******************************************************************/
92 : /* */
93 : /* SIZES */
94 : /* */
95 : /*******************************************************************/
96 :
97 : long
98 4993720 : glength(GEN x)
99 : {
100 4993720 : long tx = typ(x);
101 4993720 : switch(tx)
102 : {
103 126 : case t_INT: return lgefint(x)-2;
104 539 : case t_LIST: {
105 539 : GEN L = list_data(x);
106 539 : return L? lg(L)-1: 0;
107 : }
108 14 : case t_REAL: return signe(x)? lg(x)-2: 0;
109 11 : case t_STR: return strlen( GSTR(x) );
110 91 : case t_VECSMALL: return lg(x)-1;
111 : }
112 4992939 : return lg(x) - lontyp[tx];
113 : }
114 :
115 : GEN
116 203 : matsize(GEN x)
117 : {
118 203 : long L = lg(x) - 1;
119 203 : switch(typ(x))
120 : {
121 7 : case t_VEC: return mkvec2s(1, L);
122 7 : case t_COL: return mkvec2s(L, 1);
123 182 : case t_MAT: return mkvec2s(L? nbrows(x): 0, L);
124 : }
125 7 : pari_err_TYPE("matsize",x);
126 : return NULL; /* LCOV_EXCL_LINE */
127 : }
128 :
129 : /*******************************************************************/
130 : /* */
131 : /* CONVERSION GEN --> long */
132 : /* */
133 : /*******************************************************************/
134 :
135 : long
136 77 : gtolong(GEN x)
137 : {
138 77 : switch(typ(x))
139 : {
140 42 : case t_INT:
141 42 : return itos(x);
142 7 : case t_REAL:
143 7 : return (long)(rtodbl(x) + 0.5);
144 7 : case t_FRAC:
145 7 : { pari_sp av = avma; return gc_long(av, itos(ground(x))); }
146 7 : case t_COMPLEX:
147 7 : if (gequal0(gel(x,2))) return gtolong(gel(x,1)); break;
148 7 : case t_QUAD:
149 7 : if (gequal0(gel(x,3))) return gtolong(gel(x,2)); break;
150 : }
151 7 : pari_err_TYPE("gtolong",x);
152 : return 0; /* LCOV_EXCL_LINE */
153 : }
154 :
155 : /*******************************************************************/
156 : /* */
157 : /* COMPARISONS */
158 : /* */
159 : /*******************************************************************/
160 : static void
161 189 : chk_true_err()
162 : {
163 189 : GEN E = pari_err_last();
164 189 : switch(err_get_num(E))
165 : {
166 0 : case e_STACK: case e_MEM: case e_ALARM:
167 0 : pari_err(0, E); /* rethrow */
168 : }
169 189 : }
170 : /* x - y == 0 or undefined */
171 : static int
172 3198055 : gequal_try(GEN x, GEN y)
173 : {
174 : int i;
175 3198055 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
176 3198055 : pari_TRY { i = gequal0(gadd(x, gneg_i(y))); } pari_ENDCATCH;
177 3197873 : return i;
178 : }
179 : /* x + y == 0 or undefined */
180 : static int
181 28 : gmequal_try(GEN x, GEN y)
182 : {
183 : int i;
184 28 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
185 28 : pari_TRY { i = gequal0(gadd(x, y)); } pari_ENDCATCH;
186 21 : return i;
187 : }
188 :
189 : int
190 361284945 : isexactzero(GEN g)
191 : {
192 : long i, lx;
193 361284945 : switch (typ(g))
194 : {
195 304462729 : case t_INT:
196 304462729 : return !signe(g);
197 1241806 : case t_INTMOD:
198 1241806 : return !signe(gel(g,2));
199 14308445 : case t_COMPLEX:
200 14308445 : return isexactzero(gel(g,1)) && isexactzero(gel(g,2));
201 8108013 : case t_FFELT:
202 8108013 : return FF_equal0(g);
203 511 : case t_QUAD:
204 511 : return isexactzero(gel(g,2)) && isexactzero(gel(g,3));
205 289241 : case t_POLMOD:
206 289241 : return isexactzero(gel(g,2));
207 12093694 : case t_POL:
208 12093694 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
209 12093694 : return lx == 2 || (lx == 3 && isexactzero(gel(g,2)));
210 462648 : case t_RFRAC:
211 462648 : return isexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
212 43477 : case t_VEC: case t_COL: case t_MAT:
213 43862 : for (i=lg(g)-1; i; i--)
214 43715 : if (!isexactzero(gel(g,i))) return 0;
215 147 : return 1;
216 : }
217 20274381 : return 0;
218 : }
219 : GEN
220 63490170 : gisexactzero(GEN g)
221 : {
222 : long i, lx;
223 : GEN a, b;
224 63490170 : switch (typ(g))
225 : {
226 26792305 : case t_INT:
227 26792305 : return !signe(g)? g: NULL;
228 7064351 : case t_INTMOD:
229 7064351 : return !signe(gel(g,2))? g: NULL;
230 2632 : case t_COMPLEX:
231 2632 : a = gisexactzero(gel(g,1)); if (!a) return NULL;
232 616 : b = gisexactzero(gel(g,2)); if (!b) return NULL;
233 0 : return ggcd(a,b);
234 20608 : case t_FFELT:
235 20608 : return FF_equal0(g)? g: NULL;
236 518 : case t_QUAD:
237 518 : a = gisexactzero(gel(g,2)); if (!a) return NULL;
238 77 : b = gisexactzero(gel(g,3)); if (!b) return NULL;
239 7 : return ggcd(a,b);
240 16920 : case t_POLMOD:
241 16920 : return gisexactzero(gel(g,2));
242 28054542 : case t_POL:
243 28054542 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
244 28054542 : if (lx == 2) return gen_0;
245 22722451 : if (lx == 3) return gisexactzero(gel(g,2));
246 18991271 : return NULL;
247 1193996 : case t_RFRAC:
248 1193996 : return gisexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
249 0 : case t_VEC: case t_COL: case t_MAT:
250 0 : a = gen_0;
251 0 : for (i=lg(g)-1; i; i--)
252 : {
253 0 : b = gisexactzero(gel(g,i));
254 0 : if (!b) return NULL;
255 0 : a = ggcd(a, b);
256 : }
257 0 : return a;
258 : }
259 344298 : return NULL;
260 : }
261 :
262 : int
263 456427922 : isrationalzero(GEN g)
264 : {
265 : long i;
266 456427922 : switch (typ(g))
267 : {
268 275444042 : case t_INT:
269 275444042 : return !signe(g);
270 38012465 : case t_COMPLEX:
271 38012465 : return isintzero(gel(g,1)) && isintzero(gel(g,2));
272 1428 : case t_QUAD:
273 1428 : return isintzero(gel(g,2)) && isintzero(gel(g,3));
274 489832 : case t_POLMOD:
275 489832 : return isrationalzero(gel(g,2));
276 22408013 : case t_POL: return lg(g) == 2;
277 133 : case t_VEC: case t_COL: case t_MAT:
278 448 : for (i=lg(g)-1; i; i--)
279 315 : if (!isrationalzero(gel(g,i))) return 0;
280 133 : return 1;
281 : }
282 120072009 : return 0;
283 : }
284 :
285 : int
286 1970595987 : gequal0(GEN x)
287 : {
288 1970595987 : switch(typ(x))
289 : {
290 1824971202 : case t_INT: case t_REAL: case t_POL: case t_SER:
291 1824971202 : return !signe(x);
292 :
293 7841299 : case t_INTMOD:
294 7841299 : return !signe(gel(x,2));
295 :
296 649331 : case t_FFELT:
297 649331 : return FF_equal0(x);
298 :
299 91638212 : case t_COMPLEX:
300 : /* is 0 iff norm(x) would be 0 (can happen with Re(x) and Im(x) != 0
301 : * only if Re(x) and Im(x) are of type t_REAL). See mp.c:addrr().
302 : */
303 91638212 : if (gequal0(gel(x,1)))
304 : {
305 7289576 : if (gequal0(gel(x,2))) return 1;
306 6931404 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
307 244485 : return (expo(gel(x,1))>=expo(gel(x,2)));
308 : }
309 84348693 : if (gequal0(gel(x,2)))
310 : {
311 1627819 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
312 1544041 : return (expo(gel(x,2))>=expo(gel(x,1)));
313 : }
314 82726300 : return 0;
315 :
316 2025061 : case t_PADIC:
317 2025061 : return !signe(gel(x,4));
318 :
319 1806 : case t_QUAD:
320 1806 : return gequal0(gel(x,2)) && gequal0(gel(x,3));
321 :
322 8138760 : case t_POLMOD:
323 8138760 : return gequal0(gel(x,2));
324 :
325 6109619 : case t_RFRAC:
326 6109619 : return gequal0(gel(x,1));
327 :
328 7226713 : case t_VEC: case t_COL: case t_MAT:
329 : {
330 : long i;
331 19414657 : for (i=lg(x)-1; i; i--)
332 15674126 : if (!gequal0(gel(x,i))) return 0;
333 3740531 : return 1;
334 : }
335 : }
336 21993984 : return 0;
337 : }
338 :
339 : /* x a t_POL or t_SER, return 1 if test(coeff(X,d)) is true and
340 : * coeff(X,i) = 0 for all i != d. Return 0 (false) otherwise */
341 : static int
342 14634435 : is_monomial_test(GEN x, long d, int(*test)(GEN))
343 : {
344 14634435 : long i, l = lg(x);
345 14634435 : if (typ(x) == t_SER)
346 : { /* "0" * x^v * (1+O(x)) ? v <= 0 or null ring */
347 455 : if (l == 3 && isexactzero(gel(x,2))) return d >= 2 || test(gel(x,2));
348 406 : if (d < 2) return 0; /* v > 0 */
349 : }
350 14634267 : if (d >= l)
351 : {
352 68138 : if (typ(x) == t_POL) return 0; /* l = 2 */
353 : /* t_SER, v = 2-d <= 0 */
354 56 : if (!signe(x)) return 1;
355 : }
356 14566129 : else if (!test(gel(x,d))) return 0;
357 7368497 : for (i = 2; i < l; i++) /* 2 <= d < l */
358 4979246 : if (i != d && !gequal0(gel(x,i))) return 0;
359 2389251 : return 1;
360 : }
361 : static int
362 2387 : col_test(GEN x, int(*test)(GEN))
363 : {
364 2387 : long i, l = lg(x);
365 2387 : if (l == 1 || !test(gel(x,1))) return 0;
366 70 : for (i = 2; i < l; i++)
367 42 : if (!gequal0(gel(x,i))) return 0;
368 28 : return 1;
369 : }
370 : static int
371 16268 : mat_test(GEN x, int(*test)(GEN))
372 : {
373 16268 : long i, j, l = lg(x);
374 16268 : if (l == 1) return 1;
375 16254 : if (l != lgcols(x)) return 0;
376 51569 : for (i = 1; i < l; i++)
377 135142 : for (j = 1; j < l; j++)
378 99827 : if (i == j) {
379 35378 : if (!test(gcoeff(x,i,i))) return 0;
380 : } else {
381 64449 : if (!gequal0(gcoeff(x,i,j))) return 0;
382 : }
383 16191 : return 1;
384 : }
385 :
386 : /* returns 1 whenever x = 1, and 0 otherwise */
387 : int
388 307988468 : gequal1(GEN x)
389 : {
390 307988468 : switch(typ(x))
391 : {
392 289775476 : case t_INT:
393 289775476 : return equali1(x);
394 :
395 68145 : case t_REAL:
396 : {
397 68145 : long s = signe(x);
398 68145 : if (!s) return expo(x) >= 0;
399 68047 : return s > 0 ? absrnz_equal1(x): 0;
400 : }
401 632205 : case t_INTMOD:
402 632205 : return is_pm1(gel(x,2)) || is_pm1(gel(x,1));
403 319354 : case t_POLMOD:
404 319354 : return !degpol(gel(x,1)) || gequal1(gel(x,2));
405 :
406 16891 : case t_FFELT:
407 16891 : return FF_equal1(x);
408 :
409 1302023 : case t_FRAC:
410 1302023 : return 0;
411 :
412 21327 : case t_COMPLEX:
413 21327 : return gequal1(gel(x,1)) && gequal0(gel(x,2));
414 :
415 169332 : case t_PADIC:
416 169332 : if (!signe(gel(x,4))) return valp(x) <= 0;
417 169290 : return valp(x) == 0 && gequal1(gel(x,4));
418 :
419 42 : case t_QUAD:
420 42 : return gequal1(gel(x,2)) && gequal0(gel(x,3));
421 :
422 14633908 : case t_POL: return is_monomial_test(x, 2, &gequal1);
423 329 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequal1);
424 :
425 1032099 : case t_RFRAC: return gequal(gel(x,1), gel(x,2));
426 2338 : case t_COL: return col_test(x, &gequal1);
427 16156 : case t_MAT: return mat_test(x, &gequal1);
428 : }
429 30 : return 0;
430 : }
431 :
432 : /* returns 1 whenever the x = -1, 0 otherwise */
433 : int
434 74215300 : gequalm1(GEN x)
435 : {
436 : pari_sp av;
437 : GEN t;
438 :
439 74215300 : switch(typ(x))
440 : {
441 74206576 : case t_INT:
442 74206576 : return equalim1(x);
443 :
444 1484 : case t_REAL:
445 : {
446 1484 : long s = signe(x);
447 1484 : if (!s) return expo(x) >= 0;
448 1477 : return s < 0 ? absrnz_equal1(x): 0;
449 : }
450 4580 : case t_INTMOD:
451 4580 : av = avma; return gc_bool(av, equalii(addui(1,gel(x,2)), gel(x,1)));
452 :
453 91 : case t_FRAC:
454 91 : return 0;
455 :
456 42 : case t_FFELT:
457 42 : return FF_equalm1(x);
458 :
459 2016 : case t_COMPLEX:
460 2016 : return gequalm1(gel(x,1)) && gequal0(gel(x,2));
461 :
462 7 : case t_QUAD:
463 7 : return gequalm1(gel(x,2)) && gequal0(gel(x,3));
464 :
465 49 : case t_PADIC:
466 49 : t = gel(x,4); if (!signe(t)) return valp(x) <= 0;
467 21 : av = avma; return gc_bool(av, !valp(x) && equalii(addui(1,t), gel(x,3)));
468 :
469 56 : case t_POLMOD:
470 56 : return !degpol(gel(x,1)) || gequalm1(gel(x,2));
471 :
472 70 : case t_POL: return is_monomial_test(x, 2, &gequalm1);
473 126 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequalm1);
474 :
475 28 : case t_RFRAC:
476 28 : av = avma; return gc_bool(av, gmequal_try(gel(x,1), gel(x,2)));
477 49 : case t_COL: return col_test(x, &gequalm1);
478 112 : case t_MAT: return mat_test(x, &gequalm1);
479 : }
480 14 : return 0;
481 : }
482 :
483 : int
484 1470832 : gequalX(GEN x) { return typ(x) == t_POL && lg(x) == 4
485 2956436 : && isintzero(gel(x,2)) && isint1(gel(x,3)); }
486 :
487 : static int
488 588 : cmp_str(const char *x, const char *y)
489 : {
490 588 : int f = strcmp(x, y);
491 : return f > 0? 1
492 588 : : f? -1: 0;
493 : }
494 :
495 : static int
496 39198825 : cmp_universal_rec(GEN x, GEN y, long i0)
497 : {
498 39198825 : long i, lx = lg(x), ly = lg(y);
499 39198825 : if (lx < ly) return -1;
500 39196036 : if (lx > ly) return 1;
501 69090673 : for (i = i0; i < lx; i++)
502 : {
503 60202715 : int f = cmp_universal(gel(x,i), gel(y,i));
504 60202715 : if (f) return f;
505 : }
506 8887958 : return 0;
507 : }
508 : /* Universal "meaningless" comparison function. Transitive, returns 0 iff
509 : * gidentical(x,y) */
510 : int
511 84753609 : cmp_universal(GEN x, GEN y)
512 : {
513 84753609 : long lx, ly, i, tx = typ(x), ty = typ(y);
514 :
515 84753609 : if (tx < ty) return -1;
516 84314933 : if (ty < tx) return 1;
517 83850093 : switch(tx)
518 : {
519 43715643 : case t_INT: return cmpii(x,y);
520 567 : case t_STR: return cmp_str(GSTR(x),GSTR(y));
521 934976 : case t_REAL:
522 : case t_VECSMALL:
523 934976 : lx = lg(x);
524 934976 : ly = lg(y);
525 934976 : if (lx < ly) return -1;
526 886704 : if (lx > ly) return 1;
527 3586363 : for (i = 1; i < lx; i++)
528 : {
529 3478731 : if (x[i] < y[i]) return -1;
530 3109810 : if (x[i] > y[i]) return 1;
531 : }
532 107632 : return 0;
533 :
534 769089 : case t_POL:
535 : {
536 769089 : long X = x[1] & (VARNBITS|SIGNBITS);
537 769089 : long Y = y[1] & (VARNBITS|SIGNBITS);
538 769089 : if (X < Y) return -1;
539 769068 : if (X > Y) return 1;
540 769012 : return cmp_universal_rec(x, y, 2);
541 : }
542 881076 : case t_SER:
543 : case t_FFELT:
544 : case t_CLOSURE:
545 881076 : if (x[1] < y[1]) return -1;
546 881069 : if (x[1] > y[1]) return 1;
547 881062 : return cmp_universal_rec(x, y, 2);
548 :
549 35 : case t_LIST:
550 : {
551 35 : long tx = list_typ(x), ty = list_typ(y);
552 : GEN vx, vy;
553 : pari_sp av;
554 35 : if (tx < ty) return -1;
555 35 : if (tx > ty) return 1;
556 35 : vx = list_data(x);
557 35 : vy = list_data(y);
558 35 : if (!vx) return vy? -1: 0;
559 35 : if (!vy) return 1;
560 35 : av = avma;
561 35 : if (tx == t_LIST_MAP)
562 : {
563 14 : vx = maptomat_shallow(x);
564 14 : vy = maptomat_shallow(y);
565 : }
566 35 : return gc_int(av, cmp_universal_rec(vx, vy, 1));
567 : }
568 37548707 : default:
569 37548707 : return cmp_universal_rec(x, y, lontyp[tx]);
570 : }
571 : }
572 :
573 : static int
574 4386153 : cmpfrac(GEN x, GEN y)
575 : {
576 4386153 : pari_sp av = avma;
577 4386153 : GEN a = gel(x,1), b = gel(x,2);
578 4386153 : GEN c = gel(y,1), d = gel(y,2);
579 4386153 : return gc_bool(av, cmpii(mulii(a, d), mulii(b, c)));
580 : }
581 : static int
582 435416 : cmpifrac(GEN a, GEN y)
583 : {
584 435416 : pari_sp av = avma;
585 435416 : GEN c = gel(y,1), d = gel(y,2);
586 435416 : return gc_int(av, cmpii(mulii(a, d), c));
587 : }
588 : static int
589 49796 : cmprfrac(GEN a, GEN y)
590 : {
591 49796 : pari_sp av = avma;
592 49796 : GEN c = gel(y,1), d = gel(y,2);
593 49796 : return gc_int(av, cmpri(mulri(a, d), c));
594 : }
595 : static int
596 161 : cmpgen(GEN x, GEN y)
597 : {
598 161 : pari_sp av = avma;
599 161 : return gc_int(av, gsigne(gsub(x,y)));
600 : }
601 :
602 : /* returns the sign of x - y when it makes sense. 0 otherwise */
603 : int
604 261159730 : gcmp(GEN x, GEN y)
605 : {
606 261159730 : long tx = typ(x), ty = typ(y);
607 :
608 261159730 : if (tx == ty) /* generic case */
609 260069115 : switch(tx)
610 : {
611 142753984 : case t_INT: return cmpii(x, y);
612 112843501 : case t_REAL: return cmprr(x, y);
613 4386153 : case t_FRAC: return cmpfrac(x, y);
614 70 : case t_QUAD: return cmpgen(x, y);
615 21 : case t_STR: return cmp_str(GSTR(x), GSTR(y));
616 101650 : case t_INFINITY:
617 : {
618 101650 : long sx = inf_get_sign(x), sy = inf_get_sign(y);
619 101650 : if (sx < sy) return -1;
620 21 : if (sx > sy) return 1;
621 14 : return 0;
622 : }
623 : }
624 1074351 : if (ty == t_INFINITY) return -inf_get_sign(y);
625 1001635 : switch(tx)
626 : {
627 462021 : case t_INT:
628 : switch(ty)
629 : {
630 166461 : case t_REAL: return cmpir(x, y);
631 295546 : case t_FRAC: return cmpifrac(x, y);
632 7 : case t_QUAD: return cmpgen(x, y);
633 : }
634 7 : break;
635 345073 : case t_REAL:
636 : switch(ty)
637 : {
638 336967 : case t_INT: return cmpri(x, y);
639 8086 : case t_FRAC: return cmprfrac(x, y);
640 14 : case t_QUAD: return cmpgen(x, y);
641 : }
642 6 : break;
643 181594 : case t_FRAC:
644 : switch(ty)
645 : {
646 139870 : case t_INT: return -cmpifrac(y, x);
647 41710 : case t_REAL: return -cmprfrac(y, x);
648 7 : case t_QUAD: return cmpgen(x, y);
649 : }
650 7 : break;
651 63 : case t_QUAD:
652 63 : return cmpgen(x, y);
653 31618 : case t_INFINITY: return inf_get_sign(x);
654 : }
655 24 : pari_err_TYPE2("comparison",x,y);
656 : return 0;/*LCOV_EXCL_LINE*/
657 : }
658 :
659 : int
660 580872 : gcmpsg(long s, GEN y)
661 : {
662 580872 : switch(typ(y))
663 : {
664 9737 : case t_INT: return cmpsi(s,y);
665 566032 : case t_REAL: return cmpsr(s,y);
666 5103 : case t_FRAC: {
667 5103 : pari_sp av = avma;
668 5103 : return gc_int(av, cmpii(mulsi(s,gel(y,2)), gel(y,1)));
669 : }
670 0 : case t_QUAD: {
671 0 : pari_sp av = avma;
672 0 : return gc_int(av, gsigne(gsubsg(s, y)));
673 : }
674 0 : case t_INFINITY: return -inf_get_sign(y);
675 : }
676 0 : pari_err_TYPE2("comparison",stoi(s),y);
677 : return 0; /* LCOV_EXCL_LINE */
678 : }
679 :
680 : static long
681 1691305 : roughtype(GEN x)
682 : {
683 1691305 : switch(typ(x))
684 : {
685 2100 : case t_MAT: return t_MAT;
686 18298 : case t_VEC: case t_COL: return t_VEC;
687 1613514 : case t_VECSMALL: return t_VECSMALL;
688 57393 : default: return t_INT;
689 : }
690 : }
691 :
692 : static int lexcmpsg(long x, GEN y);
693 42 : static int lexcmpgs(GEN x, long y) { return -lexcmpsg(y,x); }
694 : /* lexcmp(stoi(x),y), y t_VEC/t_COL/t_MAT */
695 : static int
696 21 : lexcmp_s_matvec(long x, GEN y)
697 : {
698 : int fl;
699 21 : if (lg(y)==1) return 1;
700 14 : fl = lexcmpsg(x,gel(y,1));
701 14 : if (fl) return fl;
702 7 : return -1;
703 : }
704 : /* x a scalar, y a t_VEC/t_COL/t_MAT */
705 : static int
706 357 : lexcmp_scal_matvec(GEN x, GEN y)
707 : {
708 : int fl;
709 357 : if (lg(y)==1) return 1;
710 357 : fl = lexcmp(x,gel(y,1));
711 357 : if (fl) return fl;
712 7 : return -1;
713 : }
714 : /* x a scalar, y a t_VECSMALL */
715 : static int
716 42 : lexcmp_scal_vecsmall(GEN x, GEN y)
717 : {
718 : int fl;
719 42 : if (lg(y)==1) return 1;
720 42 : fl = lexcmpgs(x, y[1]);
721 42 : if (fl) return fl;
722 0 : return -1;
723 : }
724 :
725 : /* tx = ty = t_MAT, or x and y are both vect_t */
726 : static int
727 9933 : lexcmp_similar(GEN x, GEN y)
728 : {
729 9933 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
730 18326 : for (i=1; i<l; i++)
731 : {
732 16730 : int fl = lexcmp(gel(x,i),gel(y,i));
733 16730 : if (fl) return fl;
734 : }
735 1596 : if (lx == ly) return 0;
736 35 : return (lx < ly)? -1 : 1;
737 : }
738 : /* x a t_VECSMALL, y a t_VEC/t_COL ~ lexcmp_similar */
739 : static int
740 154 : lexcmp_vecsmall_vec(GEN x, GEN y)
741 : {
742 154 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
743 343 : for (i=1; i<l; i++)
744 : {
745 287 : int fl = lexcmpsg(x[i], gel(y,i));
746 287 : if (fl) return fl;
747 : }
748 56 : if (lx == ly) return 0;
749 21 : return (lx < ly)? -1 : 1;
750 : }
751 :
752 : /* x t_VEC/t_COL, y t_MAT */
753 : static int
754 98 : lexcmp_vec_mat(GEN x, GEN y)
755 : {
756 : int fl;
757 98 : if (lg(x)==1) return -1;
758 98 : if (lg(y)==1) return 1;
759 98 : fl = lexcmp_similar(x,gel(y,1));
760 98 : if (fl) return fl;
761 7 : return -1;
762 : }
763 : /* x t_VECSMALl, y t_MAT ~ lexcmp_vec_mat */
764 : static int
765 42 : lexcmp_vecsmall_mat(GEN x, GEN y)
766 : {
767 : int fl;
768 42 : if (lg(x)==1) return -1;
769 42 : if (lg(y)==1) return 1;
770 42 : fl = lexcmp_vecsmall_vec(x, gel(y,1));
771 42 : if (fl) return fl;
772 0 : return -1;
773 : }
774 :
775 : /* x a t_VECSMALL, not y */
776 : static int
777 196 : lexcmp_vecsmall_other(GEN x, GEN y, long ty)
778 : {
779 196 : switch(ty)
780 : {
781 42 : case t_MAT: return lexcmp_vecsmall_mat(x, y);
782 112 : case t_VEC: return lexcmp_vecsmall_vec(x, y);
783 42 : default: return -lexcmp_scal_vecsmall(y, x); /*y scalar*/
784 : }
785 : }
786 :
787 : /* lexcmp(stoi(s), y) */
788 : static int
789 343 : lexcmpsg(long x, GEN y)
790 : {
791 343 : switch(roughtype(y))
792 : {
793 21 : case t_MAT:
794 : case t_VEC:
795 21 : return lexcmp_s_matvec(x,y);
796 14 : case t_VECSMALL: /* ~ lexcmp_scal_matvec */
797 14 : if (lg(y)==1) return 1;
798 7 : return (x > y[1])? 1: -1;
799 308 : default: return gcmpsg(x,y);
800 : }
801 : }
802 :
803 : /* as gcmp for vector/matrices, using lexicographic ordering on components */
804 : static int
805 845481 : lexcmp_i(GEN x, GEN y)
806 : {
807 845481 : const long tx = roughtype(x), ty = roughtype(y);
808 845481 : if (tx == ty)
809 844830 : switch(tx)
810 : {
811 9835 : case t_MAT:
812 9835 : case t_VEC: return lexcmp_similar(x,y);
813 806652 : case t_VECSMALL: return vecsmall_lexcmp(x,y);
814 28343 : default: return gcmp(x,y);
815 : }
816 651 : if (tx == t_VECSMALL) return lexcmp_vecsmall_other(x,y,ty);
817 518 : if (ty == t_VECSMALL) return -lexcmp_vecsmall_other(y,x,tx);
818 :
819 455 : if (tx == t_INT) return lexcmp_scal_matvec(x,y); /*scalar*/
820 203 : if (ty == t_INT) return -lexcmp_scal_matvec(y,x);
821 :
822 98 : if (ty==t_MAT) return lexcmp_vec_mat(x,y);
823 42 : return -lexcmp_vec_mat(y,x); /*tx==t_MAT*/
824 : }
825 : int
826 845481 : lexcmp(GEN x, GEN y)
827 : {
828 845481 : pari_sp av = avma;
829 845481 : if (typ(x) == t_COMPLEX)
830 : {
831 875 : x = mkvec2(gel(x,1), gel(x,2));
832 875 : if (typ(y) == t_COMPLEX) y = mkvec2(gel(y,1), gel(y,2));
833 49 : else y = mkvec2(y, gen_0);
834 : }
835 844606 : else if (typ(y) == t_COMPLEX)
836 : {
837 63 : x = mkvec2(x, gen_0);
838 63 : y = mkvec2(gel(y,1), gel(y,2));
839 : }
840 845481 : return gc_int(av, lexcmp_i(x, y));
841 : }
842 :
843 : /*****************************************************************/
844 : /* */
845 : /* EQUALITY */
846 : /* returns 1 if x == y, 0 otherwise */
847 : /* */
848 : /*****************************************************************/
849 : /* x,y t_POL */
850 : static int
851 3432098 : polidentical(GEN x, GEN y)
852 : {
853 : long lx;
854 3432098 : if (x[1] != y[1]) return 0;
855 3432000 : lx = lg(x); if (lg(y) != lg(x)) return 0;
856 14948589 : for (lx--; lx >= 2; lx--) if (!gidentical(gel(x,lx), gel(y,lx))) return 0;
857 3431909 : return 1;
858 : }
859 : /* x,y t_SER */
860 : static int
861 14 : seridentical(GEN x, GEN y) { return polidentical(x,y); }
862 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
863 : static int
864 5248833 : vecidentical(GEN x, GEN y)
865 : {
866 : long i;
867 5248833 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
868 16713682 : for (i = lg(x)-1; i; i--)
869 12745650 : if (! gidentical(gel(x,i),gel(y,i)) ) return 0;
870 3968032 : return 1;
871 : }
872 : static int
873 1372 : identicalrr(GEN x, GEN y)
874 : {
875 1372 : long i, lx = lg(x);
876 1372 : if (lg(y) != lx) return 0;
877 1372 : if (x[1] != y[1]) return 0;
878 5748 : i=2; while (i<lx && x[i]==y[i]) i++;
879 1365 : return (i == lx);
880 : }
881 :
882 : static int
883 70 : closure_identical(GEN x, GEN y)
884 : {
885 70 : if (lg(x)!=lg(y) || x[1]!=y[1]) return 0;
886 56 : if (!gidentical(gel(x,2),gel(y,2)) || !gidentical(gel(x,3),gel(y,3))
887 56 : || !gidentical(gel(x,4),gel(y,4))) return 0;
888 42 : if (lg(x)<8) return 1;
889 0 : return gidentical(gel(x,7),gel(y,7));
890 : }
891 :
892 : static int
893 343 : list_cmp(GEN x, GEN y, int cmp(GEN x, GEN y))
894 : {
895 343 : int t = list_typ(x);
896 : GEN vx, vy;
897 : long lvx, lvy;
898 343 : if (list_typ(y)!=t) return 0;
899 343 : vx = list_data(x);
900 343 : vy = list_data(y);
901 343 : lvx = vx ? lg(vx): 1;
902 343 : lvy = vy ? lg(vy): 1;
903 343 : if (lvx==1 && lvy==1) return 1;
904 329 : if (lvx != lvy) return 0;
905 301 : switch (t)
906 : {
907 280 : case t_LIST_MAP:
908 : {
909 280 : pari_sp av = avma;
910 280 : GEN mx = maptomat_shallow(x), my = maptomat_shallow(y);
911 280 : int ret = gidentical(gel(mx, 1), gel(my, 1)) && cmp(gel(mx, 2), gel(my, 2));
912 280 : return gc_bool(av, ret);
913 : }
914 21 : default:
915 21 : return cmp(vx, vy);
916 : }
917 : }
918 :
919 : int
920 61860066 : gidentical(GEN x, GEN y)
921 : {
922 : long tx;
923 :
924 61860066 : if (x == y) return 1;
925 58232538 : tx = typ(x); if (typ(y) != tx) return 0;
926 57935619 : switch(tx)
927 : {
928 18985613 : case t_INT:
929 18985613 : return equalii(x,y);
930 :
931 1372 : case t_REAL:
932 1372 : return identicalrr(x,y);
933 :
934 794434 : case t_FRAC: case t_INTMOD:
935 794434 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
936 :
937 217 : case t_COMPLEX:
938 217 : return gidentical(gel(x,2),gel(y,2)) && gidentical(gel(x,1),gel(y,1));
939 14 : case t_PADIC:
940 14 : return valp(x) == valp(y)
941 14 : && equalii(gel(x,2),gel(y,2))
942 14 : && equalii(gel(x,3),gel(y,3))
943 28 : && equalii(gel(x,4),gel(y,4));
944 3850 : case t_POLMOD:
945 3850 : return gidentical(gel(x,2),gel(y,2)) && polidentical(gel(x,1),gel(y,1));
946 3432063 : case t_POL:
947 3432063 : return polidentical(x,y);
948 14 : case t_SER:
949 14 : return seridentical(x,y);
950 3024 : case t_FFELT:
951 3024 : return FF_equal(x,y);
952 :
953 391544 : case t_QFB:
954 391544 : return equalii(gel(x,1),gel(y,1))
955 391537 : && equalii(gel(x,2),gel(y,2))
956 783081 : && 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 5248833 : case t_VEC: case t_COL: case t_MAT:
969 5248833 : return vecidentical(x,y);
970 29074340 : case t_VECSMALL:
971 29074340 : 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 7419625 : 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 7419625 : lx = lg(x); ly = lg(y);
988 7419625 : while (lx > ly) if (!gequal0(gel(x,--lx))) return 0;
989 7416069 : while (ly > lx) if (!gequal0(gel(y,--ly))) return 0;
990 29470573 : for (lx--; lx >= 2; lx--) if (!gequal(gel(x,lx), gel(y,lx))) return 0;
991 7345224 : return 1;
992 : }
993 :
994 : /* x,y t_SER in the same variable */
995 : static int
996 413 : serequal(GEN x, GEN y)
997 : {
998 : long LX, LY, lx, ly, vx, vy;
999 413 : 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 5538033 : vecequal(GEN x, GEN y)
1013 : {
1014 : long i;
1015 5538033 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
1016 18293333 : for (i = lg(x)-1; i; i--)
1017 15940049 : if (! gequal(gel(x,i),gel(y,i)) ) return 0;
1018 2353284 : return 1;
1019 : }
1020 :
1021 : int
1022 225991454 : gequal(GEN x, GEN y)
1023 : {
1024 : pari_sp av;
1025 : long tx, ty;
1026 : long i;
1027 :
1028 225991454 : if (x == y) return 1;
1029 199417455 : tx = typ(x);
1030 199417455 : ty = typ(y);
1031 199417455 : if (tx == ty)
1032 191621940 : switch(tx)
1033 : {
1034 165947494 : case t_INT:
1035 165947494 : return equalii(x,y);
1036 :
1037 5710 : case t_REAL:
1038 5710 : return equalrr(x,y);
1039 :
1040 6790170 : case t_FRAC: case t_INTMOD:
1041 6790170 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
1042 :
1043 1267 : case t_COMPLEX:
1044 1267 : return gequal(gel(x,2),gel(y,2)) && gequal(gel(x,1),gel(y,1));
1045 763 : case t_PADIC:
1046 763 : if (!equalii(gel(x,2),gel(y,2))) return 0;
1047 763 : av = avma; i = gequal0(gsub(x,y)); set_avma(av);
1048 763 : return i;
1049 3209278 : case t_POLMOD:
1050 3209278 : if (varn(gel(x,1)) != varn(gel(y,1))) break;
1051 3209271 : return gequal(gel(x,2),gel(y,2)) && RgX_equal_var(gel(x,1),gel(y,1));
1052 7428340 : case t_POL:
1053 7428340 : if (varn(x) != varn(y)) break;
1054 7419625 : return polequal(x,y);
1055 413 : case t_SER:
1056 413 : if (varn(x) != varn(y)) break;
1057 413 : return serequal(x,y);
1058 :
1059 56070 : case t_FFELT:
1060 56070 : return FF_equal(x,y);
1061 :
1062 1096404 : case t_QFB:
1063 1096404 : return equalii(gel(x,1),gel(y,1))
1064 247563 : && equalii(gel(x,2),gel(y,2))
1065 1343967 : && equalii(gel(x,3),gel(y,3));
1066 :
1067 7 : case t_QUAD:
1068 7 : return ZX_equal(gel(x,1),gel(y,1))
1069 0 : && gequal(gel(x,2),gel(y,2))
1070 7 : && gequal(gel(x,3),gel(y,3));
1071 :
1072 73717 : case t_RFRAC:
1073 : {
1074 73717 : GEN a = gel(x,1), b = gel(x,2), c = gel(y,1), d = gel(y,2);
1075 73717 : if (gequal(b,d)) return gequal(a,c); /* simple case */
1076 0 : av = avma;
1077 0 : a = simplify_shallow(gmul(a,d));
1078 0 : b = simplify_shallow(gmul(b,c));
1079 0 : return gc_bool(av, gequal(a,b));
1080 : }
1081 :
1082 64288 : case t_STR:
1083 64288 : return !strcmp(GSTR(x),GSTR(y));
1084 5538032 : case t_VEC: case t_COL: case t_MAT:
1085 5538032 : return vecequal(x,y);
1086 1409747 : case t_VECSMALL:
1087 1409747 : return zv_equal(x,y);
1088 182 : case t_LIST:
1089 182 : return list_cmp(x, y, gequal);
1090 42 : case t_CLOSURE:
1091 42 : return closure_identical(x,y);
1092 28 : case t_INFINITY:
1093 28 : return gequal(gel(x,1),gel(y,1));
1094 : }
1095 7804225 : if (is_noncalc_t(tx) || is_noncalc_t(ty)) return 0;
1096 7804348 : if (tx == t_INT && !signe(x)) return gequal0(y);
1097 7801268 : if (ty == t_INT && !signe(y)) return gequal0(x);
1098 3198055 : (void)&av; av = avma; /* emulate volatile */
1099 3198055 : return gc_bool(av, gequal_try(x, y));
1100 : }
1101 :
1102 : int
1103 41650 : gequalsg(long s, GEN x)
1104 41650 : { pari_sp av = avma; return gc_bool(av, gequal(stoi(s), x)); }
1105 :
1106 : /* a and b are t_INT, t_FRAC, t_REAL or t_COMPLEX of those. Check whether
1107 : * a-b is invertible */
1108 : int
1109 32781 : cx_approx_equal(GEN a, GEN b)
1110 : {
1111 32781 : pari_sp av = avma;
1112 : GEN d;
1113 32781 : if (a == b) return 1;
1114 24451 : d = gsub(a,b);
1115 24451 : return gc_bool(av, gequal0(d) || (typ(d)==t_COMPLEX && gequal0(cxnorm(d))));
1116 : }
1117 : static int
1118 1307680 : r_approx0(GEN x, long e) { return e - expo(x) > bit_prec(x); }
1119 : /* x ~ 0 compared to reference y */
1120 : int
1121 1827150 : cx_approx0(GEN x, GEN y)
1122 : {
1123 : GEN a, b;
1124 : long e;
1125 1827150 : switch(typ(x))
1126 : {
1127 469 : case t_COMPLEX:
1128 469 : a = gel(x,1); b = gel(x,2);
1129 469 : if (typ(a) != t_REAL)
1130 : {
1131 14 : if (!gequal0(a)) return 0;
1132 0 : a = NULL;
1133 : }
1134 455 : else if (!signe(a)) a = NULL;
1135 455 : if (typ(b) != t_REAL)
1136 : {
1137 0 : if (!gequal0(b)) return 0;
1138 0 : if (!a) return 1;
1139 0 : b = NULL;
1140 : }
1141 455 : else if (!signe(b))
1142 : {
1143 7 : if (!a) return 1;
1144 7 : b = NULL;
1145 : }
1146 : /* a or b is != NULL iff it is non-zero t_REAL; one of them is */
1147 455 : e = gexpo(y);
1148 455 : return (!a || r_approx0(a, e)) && (!b || r_approx0(b, e));
1149 1307219 : case t_REAL:
1150 1307219 : return !signe(x) || r_approx0(x, gexpo(y));
1151 519462 : default:
1152 519462 : return gequal0(x);
1153 : }
1154 : }
1155 : /*******************************************************************/
1156 : /* */
1157 : /* VALUATION */
1158 : /* p is either a t_INT or a t_POL. */
1159 : /* returns the largest exponent of p dividing x when this makes */
1160 : /* sense : error for types real, integermod and polymod if p does */
1161 : /* not divide the modulus, q-adic if q!=p. */
1162 : /* */
1163 : /*******************************************************************/
1164 :
1165 : static long
1166 336 : minval(GEN x, GEN p)
1167 : {
1168 336 : long i,k, val = LONG_MAX, lx = lg(x);
1169 6538 : for (i=lontyp[typ(x)]; i<lx; i++)
1170 : {
1171 6202 : k = gvaluation(gel(x,i),p);
1172 6202 : if (k < val) val = k;
1173 : }
1174 336 : return val;
1175 : }
1176 :
1177 : static int
1178 91 : intdvd(GEN x, GEN y, GEN *z) { GEN r; *z = dvmdii(x,y,&r); return (r==gen_0); }
1179 :
1180 : /* x t_FRAC, p t_INT, return v_p(x) */
1181 : static long
1182 290726 : frac_val(GEN x, GEN p) {
1183 290726 : long v = Z_pval(gel(x,2),p);
1184 290726 : if (v) return -v;
1185 290585 : return Z_pval(gel(x,1),p);
1186 : }
1187 : long
1188 3960780 : Q_pval(GEN x, GEN p)
1189 : {
1190 3960780 : if (lgefint(p) == 3) return Q_lval(x, uel(p,2));
1191 391 : return (typ(x)==t_INT)? Z_pval(x, p): frac_val(x, p);
1192 : }
1193 :
1194 : static long
1195 433531 : frac_lval(GEN x, ulong p) {
1196 433531 : long v = Z_lval(gel(x,2),p);
1197 433530 : if (v) return -v;
1198 342437 : return Z_lval(gel(x,1),p);
1199 : }
1200 : long
1201 3965112 : Q_lval(GEN x, ulong p){return (typ(x)==t_INT)? Z_lval(x, p): frac_lval(x, p);}
1202 :
1203 : long
1204 3905714 : Q_pvalrem(GEN x, GEN p, GEN *y)
1205 : {
1206 : GEN a, b;
1207 : long v;
1208 3905714 : if (lgefint(p) == 3) return Q_lvalrem(x, uel(p,2), y);
1209 5743 : if (typ(x) == t_INT) return Z_pvalrem(x, p, y);
1210 0 : a = gel(x,1);
1211 0 : b = gel(x,2);
1212 0 : v = Z_pvalrem(b, p, &b);
1213 0 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1214 0 : v = Z_pvalrem(a, p, &a);
1215 0 : *y = mkfrac(a, b); return v;
1216 : }
1217 : long
1218 3904129 : Q_lvalrem(GEN x, ulong p, GEN *y)
1219 : {
1220 : GEN a, b;
1221 : long v;
1222 3904129 : if (typ(x) == t_INT) return Z_lvalrem(x, p, y);
1223 197685 : a = gel(x,1);
1224 197685 : b = gel(x,2);
1225 197685 : v = Z_lvalrem(b, p, &b);
1226 197690 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1227 25812 : v = Z_lvalrem(a, p, &a);
1228 25812 : *y = mkfrac(a, b); return v;
1229 : }
1230 :
1231 : long
1232 1149727 : gvaluation(GEN x, GEN p)
1233 : {
1234 1149727 : long tx = typ(x), tp;
1235 : pari_sp av;
1236 :
1237 1149727 : if (!p)
1238 28 : switch(tx)
1239 : {
1240 7 : case t_PADIC: return valp(x);
1241 7 : case t_POL: return RgX_val(x);
1242 7 : case t_SER: return valser(x);
1243 7 : default: pari_err_TYPE("gvaluation", x);
1244 : }
1245 1149699 : tp = typ(p);
1246 1149699 : switch(tp)
1247 : {
1248 1143567 : case t_INT:
1249 1143567 : if (signe(p) && !is_pm1(p)) break;
1250 28 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1251 6125 : case t_POL:
1252 6125 : if (degpol(p) > 0) break;
1253 : default:
1254 7 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1255 : }
1256 :
1257 1149664 : switch(tx)
1258 : {
1259 146860 : case t_INT:
1260 146860 : if (!signe(x)) return LONG_MAX;
1261 146755 : if (tp == t_POL) return 0;
1262 146433 : return Z_pval(x,p);
1263 :
1264 49 : case t_REAL:
1265 49 : if (tp == t_POL) return 0;
1266 21 : break;
1267 :
1268 28 : case t_FFELT:
1269 28 : if (tp == t_POL) return FF_equal0(x)? LONG_MAX: 0;
1270 14 : break;
1271 :
1272 105 : case t_INTMOD: {
1273 105 : GEN a = gel(x,1), b = gel(x,2);
1274 : long val;
1275 133 : if (tp == t_POL) return signe(b)? 0: LONG_MAX;
1276 42 : av = avma;
1277 42 : if (!intdvd(a, p, &a)) break;
1278 28 : if (!intdvd(b, p, &b)) return gc_long(av,0);
1279 14 : val = 1; while (intdvd(a,p,&a) && intdvd(b,p,&b)) val++;
1280 14 : return gc_long(av,val);
1281 : }
1282 :
1283 290633 : case t_FRAC:
1284 290633 : if (tp == t_POL) return 0;
1285 290619 : return frac_val(x, p);
1286 :
1287 706102 : case t_PADIC:
1288 706102 : if (tp == t_POL) return 0;
1289 706081 : if (!equalii(p,gel(x,2))) break;
1290 706074 : return valp(x);
1291 :
1292 35 : case t_POLMOD: {
1293 35 : GEN a = gel(x,1), b = gel(x,2);
1294 : long v, val;
1295 35 : if (tp == t_INT) return gvaluation(b,p);
1296 21 : v = varn(p);
1297 21 : if (varn(a) != v) return 0;
1298 21 : av = avma;
1299 21 : a = RgX_divrem(a, p, ONLY_DIVIDES);
1300 21 : if (!a) break;
1301 28 : if (typ(b) != t_POL || varn(b) != v ||
1302 21 : !(b = RgX_divrem(b, p, ONLY_DIVIDES)) ) return gc_long(av,0);
1303 7 : val = 1;
1304 28 : while ((a = RgX_divrem(a, p, ONLY_DIVIDES)) &&
1305 21 : (b = RgX_divrem(b, p, ONLY_DIVIDES)) ) val++;
1306 7 : return gc_long(av,val);
1307 : }
1308 5215 : case t_POL: {
1309 5215 : if (tp == t_POL) {
1310 5026 : long vp = varn(p), vx = varn(x);
1311 5026 : if (vp == vx)
1312 : {
1313 : long val;
1314 5012 : if (RgX_is_monomial(p))
1315 : {
1316 4977 : val = RgX_val(x); if (val == LONG_MAX) return LONG_MAX;
1317 4907 : return val / degpol(p);
1318 : }
1319 35 : if (!signe(x)) return LONG_MAX;
1320 21 : av = avma;
1321 21 : for (val=0; ; val++)
1322 : {
1323 35 : x = RgX_divrem(x,p,ONLY_DIVIDES);
1324 35 : if (!x) return gc_long(av,val);
1325 14 : if (gc_needed(av,1))
1326 : {
1327 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gvaluation");
1328 0 : x = gerepilecopy(av, x);
1329 : }
1330 : }
1331 : }
1332 14 : if (varncmp(vx, vp) > 0) return 0;
1333 : }
1334 196 : return minval(x,p);
1335 : }
1336 :
1337 469 : case t_SER: {
1338 469 : if (tp == t_POL) {
1339 455 : long vp = varn(p), vx = varn(x);
1340 455 : if (vp == vx)
1341 : {
1342 448 : long val = RgX_val(p);
1343 448 : if (!val) pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1344 441 : return (long)(valser(x) / val);
1345 : }
1346 7 : if (varncmp(vx, vp) > 0) return 0;
1347 : }
1348 14 : return minval(x,p);
1349 : }
1350 :
1351 42 : case t_RFRAC:
1352 42 : return gvaluation(gel(x,1),p) - gvaluation(gel(x,2),p);
1353 :
1354 126 : case t_COMPLEX: case t_QUAD: case t_VEC: case t_COL: case t_MAT:
1355 126 : return minval(x,p);
1356 : }
1357 63 : pari_err_OP("valuation", x,p);
1358 : return 0; /* LCOV_EXCL_LINE */
1359 : }
1360 : GEN
1361 3808 : gpvaluation(GEN x, GEN p)
1362 : {
1363 3808 : long v = gvaluation(x,p);
1364 3703 : return v == LONG_MAX? mkoo(): stoi(v);
1365 : }
1366 :
1367 : /* x is nonzero */
1368 : long
1369 73843824 : u_lvalrem(ulong x, ulong p, ulong *py)
1370 : {
1371 : ulong vx;
1372 73843824 : if (p == 2) { vx = vals(x); *py = x >> vx; return vx; }
1373 63829427 : for(vx = 0;;)
1374 : {
1375 133520666 : if (x % p) { *py = x; return vx; }
1376 69691239 : x /= p; /* gcc is smart enough to make a single div */
1377 69691239 : vx++;
1378 : }
1379 : }
1380 : long
1381 28129802 : u_lval(ulong x, ulong p)
1382 : {
1383 : ulong vx;
1384 28129802 : if (p == 2) return vals(x);
1385 24833586 : for(vx = 0;;)
1386 : {
1387 54894809 : if (x % p) return vx;
1388 30061223 : x /= p; /* gcc is smart enough to make a single div */
1389 30061223 : vx++;
1390 : }
1391 : }
1392 :
1393 : long
1394 1806891 : z_lval(long s, ulong p) { return u_lval(labs(s), p); }
1395 : long
1396 87214 : z_lvalrem(long s, ulong p, long *py)
1397 : {
1398 : long v;
1399 87214 : if (s < 0)
1400 : {
1401 0 : ulong u = (ulong)-s;
1402 0 : v = u_lvalrem(u, p, &u);
1403 0 : *py = -(long)u;
1404 : }
1405 : else
1406 : {
1407 87214 : ulong u = (ulong)s;
1408 87214 : v = u_lvalrem(u, p, &u);
1409 87213 : *py = (long)u;
1410 : }
1411 87213 : return v;
1412 : }
1413 : /* assume |p| > 1 */
1414 : long
1415 1306011 : z_pval(long s, GEN p)
1416 : {
1417 1306011 : if (lgefint(p) > 3) return 0;
1418 1306011 : return z_lval(s, uel(p,2));
1419 : }
1420 : /* assume |p| > 1 */
1421 : long
1422 266 : z_pvalrem(long s, GEN p, long *py)
1423 : {
1424 266 : if (lgefint(p) > 3) { *py = s; return 0; }
1425 266 : return z_lvalrem(s, uel(p,2), py);
1426 : }
1427 :
1428 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1429 : static long
1430 2136081 : Z_pvalrem_DC(GEN x, GEN q, GEN *py)
1431 : {
1432 2136081 : GEN r, z = dvmdii(x, q, &r);
1433 : long v;
1434 2136045 : if (r != gen_0) { *py = x; return 0; }
1435 1473473 : if (2 * lgefint(q) <= lgefint(z)+3) /* avoid squaring if pointless */
1436 1456193 : v = Z_pvalrem_DC(z, sqri(q), py) << 1;
1437 : else
1438 17280 : { v = 0; *py = z; }
1439 1473481 : z = dvmdii(*py, q, &r);
1440 1473542 : if (r != gen_0) return v + 1;
1441 615491 : *py = z; return v + 2;
1442 : }
1443 :
1444 : static const long VAL_DC_THRESHOLD = 16;
1445 :
1446 : long
1447 21597953 : Z_lval(GEN x, ulong p)
1448 : {
1449 : long vx;
1450 : pari_sp av;
1451 21597953 : if (p == 2) return vali(x);
1452 13301428 : if (lgefint(x) == 3) return u_lval(uel(x,2), p);
1453 1785908 : av = avma;
1454 1785908 : for(vx = 0;;)
1455 8274308 : {
1456 : ulong r;
1457 10060216 : GEN q = absdiviu_rem(x, p, &r);
1458 10060533 : if (r) break;
1459 8429783 : vx++; x = q;
1460 8429783 : if (vx == VAL_DC_THRESHOLD) {
1461 155475 : if (p == 1) pari_err_DOMAIN("Z_lval", "p", "=", gen_1, gen_1);
1462 155475 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1463 155475 : q = absdiviu_rem(x, p, &r); if (!r) vx++;
1464 155475 : break;
1465 : }
1466 : }
1467 1786225 : return gc_long(av,vx);
1468 : }
1469 : long
1470 38111929 : Z_lvalrem(GEN x, ulong p, GEN *py)
1471 : {
1472 : long vx, sx;
1473 : pari_sp av;
1474 38111929 : if (p == 2) { vx = vali(x); *py = shifti(x, -vx); return vx; }
1475 24727274 : if (lgefint(x) == 3) {
1476 : ulong u;
1477 18531151 : vx = u_lvalrem(uel(x,2), p, &u);
1478 18530899 : *py = signe(x) < 0? utoineg(u): utoipos(u);
1479 18530342 : return vx;
1480 : }
1481 6196123 : av = avma; (void)new_chunk(lgefint(x));
1482 6196353 : sx = signe(x);
1483 6196353 : for(vx = 0;;)
1484 17446767 : {
1485 : ulong r;
1486 23643120 : GEN q = absdiviu_rem(x, p, &r);
1487 23643100 : if (r) break;
1488 17970599 : vx++; x = q;
1489 17970599 : if (vx == VAL_DC_THRESHOLD) {
1490 523832 : if (p == 1) pari_err_DOMAIN("Z_lvalrem", "p", "=", gen_1, gen_1);
1491 523832 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1492 523831 : q = absdiviu_rem(x, p, &r); if (!r) { vx++; x = q; }
1493 523834 : break;
1494 : }
1495 : }
1496 6196335 : set_avma(av); *py = icopy(x); setsigne(*py, sx); return vx;
1497 : }
1498 :
1499 : /* Is |q| <= p ? */
1500 : static int
1501 23410042 : isless_iu(GEN q, ulong p) {
1502 23410042 : long l = lgefint(q);
1503 23410042 : return l==2 || (l == 3 && uel(q,2) <= p);
1504 : }
1505 :
1506 : long
1507 279948594 : u_lvalrem_stop(ulong *n, ulong p, int *stop)
1508 : {
1509 279948594 : ulong N = *n, q = N / p, r = N % p; /* gcc makes a single div */
1510 279948594 : long v = 0;
1511 279948594 : if (!r)
1512 : {
1513 27867232 : do { v++; N = q; q = N / p; r = N % p; } while (!r);
1514 22701062 : *n = N;
1515 : }
1516 279948594 : *stop = q <= p; return v;
1517 : }
1518 : /* Assume n > 0. Return v_p(n), set *n := n/p^v_p(n). Set 'stop' if now
1519 : * n < p^2 [implies n prime if no prime < p divides n] */
1520 : long
1521 166402208 : Z_lvalrem_stop(GEN *n, ulong p, int *stop)
1522 : {
1523 : pari_sp av;
1524 : long v;
1525 : ulong r;
1526 : GEN N, q;
1527 :
1528 166402208 : if (lgefint(*n) == 3)
1529 : {
1530 143006045 : r = (*n)[2];
1531 143006045 : v = u_lvalrem_stop(&r, p, stop);
1532 143102373 : if (v) *n = utoipos(r);
1533 143095166 : return v;
1534 : }
1535 23396163 : av = avma; v = 0; q = absdiviu_rem(*n, p, &r);
1536 23410042 : if (r) set_avma(av);
1537 : else
1538 : {
1539 : do {
1540 375071 : v++; N = q;
1541 375071 : if (v == VAL_DC_THRESHOLD)
1542 : {
1543 600 : v += Z_pvalrem_DC(N,sqru(p),&N) << 1;
1544 600 : q = absdiviu_rem(N, p, &r); if (!r) { v++; N = q; }
1545 600 : break;
1546 : }
1547 374471 : q = absdiviu_rem(N, p, &r);
1548 374471 : } while (!r);
1549 330675 : *n = N;
1550 : }
1551 23410042 : *stop = isless_iu(q,p); return v;
1552 : }
1553 :
1554 : /* x is a nonzero integer, |p| > 1 */
1555 : long
1556 30393989 : Z_pvalrem(GEN x, GEN p, GEN *py)
1557 : {
1558 : long vx;
1559 : pari_sp av;
1560 :
1561 30393989 : if (lgefint(p) == 3) return Z_lvalrem(x, uel(p,2), py);
1562 23645 : if (lgefint(x) == 3) { *py = icopy(x); return 0; }
1563 7901 : av = avma; vx = 0; (void)new_chunk(lgefint(x));
1564 : for(;;)
1565 13282 : {
1566 21245 : GEN r, q = dvmdii(x,p,&r);
1567 21245 : if (r != gen_0) { set_avma(av); *py = icopy(x); return vx; }
1568 13282 : vx++; x = q;
1569 : }
1570 : }
1571 : long
1572 2401645 : u_pvalrem(ulong x, GEN p, ulong *py)
1573 : {
1574 2401645 : if (lgefint(p) == 3) return u_lvalrem(x, uel(p,2), py);
1575 458 : *py = x; return 0;
1576 : }
1577 : long
1578 135358 : u_pval(ulong x, GEN p)
1579 : {
1580 135358 : if (lgefint(p) == 3) return u_lval(x, uel(p,2));
1581 0 : return 0;
1582 : }
1583 : long
1584 13166523 : Z_pval(GEN x, GEN p) {
1585 : long vx;
1586 : pari_sp av;
1587 :
1588 13166523 : if (lgefint(p) == 3) return Z_lval(x, uel(p,2));
1589 30468 : if (lgefint(x) == 3) return 0;
1590 7128 : av = avma; vx = 0;
1591 : for(;;)
1592 24242 : {
1593 31370 : GEN r, q = dvmdii(x,p,&r);
1594 31395 : if (r != gen_0) return gc_long(av,vx);
1595 24242 : vx++; x = q;
1596 : }
1597 : }
1598 :
1599 : /* return v_p(n!) = [n/p] + [n/p^2] + ... */
1600 : long
1601 2043235 : factorial_lval(ulong n, ulong p)
1602 : {
1603 : ulong q, v;
1604 2043235 : if (p == 2) return n - hammingl(n);
1605 1366198 : q = p; v = 0;
1606 1515425 : do { v += n/q; q *= p; } while (n >= q);
1607 1366198 : return (long)v;
1608 : }
1609 :
1610 : /********** Same for "containers" ZX / ZV / ZC **********/
1611 :
1612 : /* If the t_INT q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1613 : * Stack clean; assumes lg(x) > 1 */
1614 : static GEN
1615 6440 : gen_Z_divides(GEN x, GEN q, long imin)
1616 : {
1617 : long i, l;
1618 6440 : GEN y = cgetg_copy(x, &l);
1619 :
1620 6440 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1621 89446 : for (i = imin; i < l; i++)
1622 : {
1623 86940 : GEN r, xi = gel(x,i);
1624 86940 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1625 55607 : gel(y,i) = dvmdii(xi, q, &r);
1626 55607 : if (r != gen_0) { set_avma((pari_sp)(y+l)); return NULL; }
1627 : }
1628 2506 : return y;
1629 : }
1630 : /* If q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1631 : * Stack clean; assumes lg(x) > 1 */
1632 : static GEN
1633 4697 : gen_z_divides(GEN x, ulong q, long imin)
1634 : {
1635 : long i, l;
1636 4697 : GEN y = cgetg_copy(x, &l);
1637 :
1638 4697 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1639 43302 : for (i = imin; i < l; i++)
1640 : {
1641 : ulong r;
1642 42077 : GEN xi = gel(x,i);
1643 42077 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1644 28398 : gel(y,i) = absdiviu_rem(xi, q, &r);
1645 28398 : if (r) { set_avma((pari_sp)(y+l)); return NULL; }
1646 24926 : affectsign_safe(xi, &gel(y,i));
1647 : }
1648 1225 : return y;
1649 : }
1650 :
1651 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1652 : static long
1653 11099 : gen_pvalrem_DC(GEN x, GEN q, GEN *py, long imin)
1654 : {
1655 :
1656 11099 : pari_sp av = avma;
1657 11099 : long v, i, l, lz = LONG_MAX;
1658 11099 : GEN y = cgetg_copy(x, &l);
1659 :
1660 11099 : y[1] = x[1];
1661 135774 : for (i = imin; i < l; i++)
1662 : {
1663 129334 : GEN r, xi = gel(x,i);
1664 129334 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1665 86439 : gel(y,i) = dvmdii(xi, q, &r);
1666 86439 : if (r != gen_0) { *py = x; return gc_long(av,0); }
1667 81780 : lz = minss(lz, lgefint(gel(y,i)));
1668 : }
1669 6440 : if (2 * lgefint(q) <= lz+3) /* avoid squaring if pointless */
1670 6388 : v = gen_pvalrem_DC(y, sqri(q), py, imin) << 1;
1671 : else
1672 52 : { v = 0; *py = y; }
1673 :
1674 6440 : y = gen_Z_divides(*py, q, imin);
1675 6440 : if (!y) return v+1;
1676 2506 : *py = y; return v+2;
1677 : }
1678 :
1679 : static long
1680 771630 : gen_2val(GEN x, long imin)
1681 : {
1682 771630 : long i, lx = lg(x), v = LONG_MAX;
1683 2914337 : for (i = imin; i < lx; i++)
1684 : {
1685 2478695 : GEN c = gel(x,i);
1686 : long w;
1687 2478695 : if (!signe(c)) continue;
1688 2266854 : w = vali(c);
1689 2266854 : if (w < v) { v = w; if (!v) break; }
1690 : }
1691 771630 : return v;
1692 : }
1693 : static long
1694 1276847 : gen_lval(GEN x, ulong p, long imin)
1695 : {
1696 : long i, lx, v;
1697 : pari_sp av;
1698 : GEN y;
1699 1276847 : if (p == 2) return gen_2val(x, imin);
1700 505217 : av = avma;
1701 505217 : lx = lg(x); y = leafcopy(x);
1702 739126 : for(v = 0;; v++)
1703 2299674 : for (i = imin; i < lx; i++)
1704 : {
1705 : ulong r;
1706 2065765 : gel(y,i) = absdiviu_rem(gel(y,i), p, &r);
1707 2065765 : if (r) return gc_long(av,v);
1708 : }
1709 : }
1710 : long
1711 745212 : ZX_lval(GEN x, ulong p) { return gen_lval(x, p, 2); }
1712 : long
1713 0 : ZV_lval(GEN x, ulong p) { return gen_lval(x, p, 1); }
1714 :
1715 : long
1716 28924 : zx_lval(GEN f, long p)
1717 : {
1718 28924 : long i, l = lg(f), x = LONG_MAX;
1719 30212 : for(i=2; i<l; i++)
1720 : {
1721 : long y;
1722 29470 : if (f[i] == 0) continue;
1723 29421 : y = z_lval(f[i], p);
1724 29421 : if (y < x) { x = y; if (x == 0) return x; }
1725 : }
1726 742 : return x;
1727 : }
1728 :
1729 : static long
1730 541971 : gen_pval(GEN x, GEN p, long imin)
1731 : {
1732 : long i, lx, v;
1733 : pari_sp av;
1734 : GEN y;
1735 541971 : if (lgefint(p) == 3) return gen_lval(x, p[2], imin);
1736 10336 : av = avma;
1737 10336 : lx = lg(x); y = leafcopy(x);
1738 10336 : for(v = 0;; v++)
1739 : {
1740 10336 : if (v == VAL_DC_THRESHOLD)
1741 : {
1742 0 : if (is_pm1(p)) pari_err_DOMAIN("gen_pval", "p", "=", p, p);
1743 0 : v += gen_pvalrem_DC(y, p, &y, imin);
1744 0 : return gc_long(av,v);
1745 : }
1746 :
1747 10336 : for (i = imin; i < lx; i++)
1748 : {
1749 10336 : GEN r; gel(y,i) = dvmdii(gel(y,i), p, &r);
1750 10336 : if (r != gen_0) return gc_long(av,v);
1751 : }
1752 : }
1753 : }
1754 : long
1755 510135 : ZX_pval(GEN x, GEN p) { return gen_pval(x, p, 2); }
1756 : long
1757 31836 : ZV_pval(GEN x, GEN p) { return gen_pval(x, p, 1); }
1758 : /* v = 0 (mod p) */
1759 : int
1760 434 : ZV_Z_dvd(GEN v, GEN p)
1761 : {
1762 434 : pari_sp av = avma;
1763 434 : long i, l = lg(v);
1764 1421 : for (i=1; i<l; i++)
1765 1036 : if (!dvdii(gel(v,i), p)) return gc_long(av,0);
1766 385 : return gc_long(av,1);
1767 : }
1768 :
1769 : static long
1770 4658243 : gen_2valrem(GEN x, GEN *px, long imin)
1771 : {
1772 4658243 : long i, lx = lg(x), v = LONG_MAX;
1773 : GEN z;
1774 13528683 : for (i = imin; i < lx; i++)
1775 : {
1776 12213385 : GEN c = gel(x,i);
1777 : long w;
1778 12213385 : if (!signe(c)) continue;
1779 11362906 : w = vali(c);
1780 11362914 : if (w < v) {
1781 6679939 : v = w;
1782 6679939 : if (!v) { *px = x; return 0; } /* early abort */
1783 : }
1784 : }
1785 1315298 : z = cgetg_copy(x, &lx); z[1] = x[1];
1786 8452941 : for (i=imin; i<lx; i++) gel(z,i) = shifti(gel(x,i), -v);
1787 1314674 : *px = z; return v;
1788 : }
1789 : static long
1790 7613771 : gen_lvalrem(GEN x, ulong p, GEN *px, long imin)
1791 : {
1792 : long i, lx, v;
1793 : GEN y;
1794 7613771 : if (p == 2) return gen_2valrem(x, px, imin);
1795 2955540 : y = cgetg_copy(x, &lx);
1796 2955655 : y[1] = x[1];
1797 2955655 : x = leafcopy(x);
1798 2955820 : for(v = 0;; v++)
1799 : {
1800 4264911 : if (v == VAL_DC_THRESHOLD)
1801 : {
1802 4697 : if (p == 1) pari_err_DOMAIN("gen_lvalrem", "p", "=", gen_1, gen_1);
1803 4697 : v += gen_pvalrem_DC(x, sqru(p), px, imin) << 1;
1804 4697 : x = gen_z_divides(*px, p, imin);
1805 4697 : if (x) { *px = x; v++; }
1806 4697 : return v;
1807 : }
1808 :
1809 14350001 : for (i = imin; i < lx; i++)
1810 : {
1811 13040910 : ulong r; gel(y,i) = absdiviu_rem(gel(x,i), p, &r);
1812 13039071 : if (r) { *px = x; return v; }
1813 10088213 : affectsign_safe(gel(x,i), &gel(y,i));
1814 : }
1815 1309091 : swap(x, y);
1816 : }
1817 : }
1818 : long
1819 721 : ZX_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 2); }
1820 : long
1821 0 : ZV_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 1); }
1822 :
1823 : static long
1824 7625783 : gen_pvalrem(GEN x, GEN p, GEN *px, long imin)
1825 : {
1826 : long i, lx, v;
1827 : GEN y;
1828 7625783 : if (lgefint(p) == 3) return gen_lvalrem(x, p[2], px, imin);
1829 12867 : y = cgetg_copy(x, &lx);
1830 12950 : y[1] = x[1];
1831 12950 : x = leafcopy(x);
1832 12950 : for(v = 0;; v++)
1833 : {
1834 13676 : if (v == VAL_DC_THRESHOLD)
1835 : {
1836 14 : if (is_pm1(p)) pari_err_DOMAIN("gen_pvalrem", "p", "=", p, p);
1837 14 : return v + gen_pvalrem_DC(x, p, px, imin);
1838 : }
1839 :
1840 21913 : for (i = imin; i < lx; i++)
1841 : {
1842 21187 : GEN r; gel(y,i) = dvmdii(gel(x,i), p, &r);
1843 21187 : if (r != gen_0) { *px = x; return v; }
1844 : }
1845 726 : swap(x, y);
1846 : }
1847 : }
1848 : long
1849 3836763 : ZX_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 2); }
1850 : long
1851 3788837 : ZV_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 1); }
1852 :
1853 : /*******************************************************************/
1854 : /* */
1855 : /* NEGATION: Create -x */
1856 : /* */
1857 : /*******************************************************************/
1858 :
1859 : GEN
1860 413452539 : gneg(GEN x)
1861 : {
1862 : long lx, i;
1863 : GEN y;
1864 :
1865 413452539 : switch(typ(x))
1866 : {
1867 109780317 : case t_INT:
1868 109780317 : return signe(x)? negi(x): gen_0;
1869 223287376 : case t_REAL:
1870 223287376 : return mpneg(x);
1871 :
1872 222272 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1873 222272 : gel(y,1) = icopy(gel(x,1));
1874 222272 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1875 222271 : break;
1876 :
1877 1890375 : case t_FRAC:
1878 1890375 : y = cgetg(3, t_FRAC);
1879 1890375 : gel(y,1) = negi(gel(x,1));
1880 1890375 : gel(y,2) = icopy(gel(x,2)); break;
1881 :
1882 73023899 : case t_COMPLEX:
1883 73023899 : y=cgetg(3, t_COMPLEX);
1884 73025647 : gel(y,1) = gneg(gel(x,1));
1885 73028008 : gel(y,2) = gneg(gel(x,2));
1886 73027956 : break;
1887 :
1888 243800 : case t_POLMOD:
1889 243800 : retmkpolmod(gneg(gel(x,2)), RgX_copy(gel(x,1)));
1890 :
1891 153335 : case t_RFRAC:
1892 153335 : y = cgetg(3, t_RFRAC);
1893 153335 : gel(y,1) = gneg(gel(x,1));
1894 153335 : gel(y,2) = RgX_copy(gel(x,2)); break;
1895 :
1896 118084 : case t_PADIC:
1897 118084 : if (!signe(gel(x,4))) return gcopy(x);
1898 115949 : y = cgetg(5, t_PADIC);
1899 115950 : y[1] = x[1];
1900 115950 : gel(y,2) = icopy(gel(x,2));
1901 115949 : gel(y,3) = icopy(gel(x,3));
1902 115948 : gel(y,4) = subii(gel(x,3),gel(x,4));
1903 115947 : break;
1904 :
1905 133 : case t_QUAD:
1906 133 : y=cgetg(4,t_QUAD);
1907 133 : gel(y,1) = ZX_copy(gel(x,1));
1908 133 : gel(y,2) = gneg(gel(x,2));
1909 133 : gel(y,3) = gneg(gel(x,3)); break;
1910 :
1911 80459 : case t_FFELT: return FF_neg(x);
1912 4312302 : case t_POL: return RgX_neg(x);
1913 1309 : case t_SER:
1914 1309 : y = cgetg_copy(x, &lx); y[1] = x[1];
1915 16352 : for (i=2; i<lx; i++) gel(y,i) = gneg(gel(x,i));
1916 1309 : break;
1917 1519 : case t_VEC: return RgV_neg(x);
1918 460701 : case t_COL: return RgC_neg(x);
1919 315 : case t_MAT: return RgM_neg(x);
1920 770 : case t_INFINITY: return inf_get_sign(x) == 1? mkmoo(): mkoo();
1921 0 : default:
1922 0 : pari_err_TYPE("gneg",x);
1923 : return NULL; /* LCOV_EXCL_LINE */
1924 : }
1925 75411245 : return y;
1926 : }
1927 :
1928 : GEN
1929 112013157 : gneg_i(GEN x)
1930 : {
1931 : long lx, i;
1932 : GEN y;
1933 :
1934 112013157 : switch(typ(x))
1935 : {
1936 61623564 : case t_INT:
1937 61623564 : return signe(x)? negi(x): gen_0;
1938 20460843 : case t_REAL:
1939 20460843 : return mpneg(x);
1940 :
1941 717726 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1942 717726 : gel(y,1) = gel(x,1);
1943 717726 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1944 717726 : break;
1945 :
1946 4943586 : case t_FRAC:
1947 4943586 : y = cgetg(3, t_FRAC);
1948 4943581 : gel(y,1) = negi(gel(x,1));
1949 4943595 : gel(y,2) = gel(x,2); break;
1950 :
1951 7371131 : case t_COMPLEX:
1952 7371131 : y = cgetg(3, t_COMPLEX);
1953 7371309 : gel(y,1) = gneg_i(gel(x,1));
1954 7371450 : gel(y,2) = gneg_i(gel(x,2)); break;
1955 :
1956 2033593 : case t_PADIC: y = cgetg(5,t_PADIC);
1957 2033593 : y[1] = x[1];
1958 2033593 : gel(y,2) = gel(x,2);
1959 2033593 : gel(y,3) = gel(x,3);
1960 2033593 : gel(y,4) = signe(gel(x,4))? subii(gel(x,3),gel(x,4)): gen_0; break;
1961 :
1962 110253 : case t_POLMOD:
1963 110253 : retmkpolmod(gneg_i(gel(x,2)), RgX_copy(gel(x,1)));
1964 :
1965 84504 : case t_FFELT: return FF_neg_i(x);
1966 :
1967 672 : case t_QUAD: y=cgetg(4,t_QUAD);
1968 672 : gel(y,1) = gel(x,1);
1969 672 : gel(y,2) = gneg_i(gel(x,2));
1970 672 : gel(y,3) = gneg_i(gel(x,3)); break;
1971 :
1972 2373 : case t_VEC: case t_COL: case t_MAT:
1973 2373 : y = cgetg_copy(x, &lx);
1974 12803 : for (i=1; i<lx; i++) gel(y,i) = gneg_i(gel(x,i));
1975 2373 : break;
1976 :
1977 9627666 : case t_POL: case t_SER:
1978 9627666 : y = cgetg_copy(x, &lx); y[1]=x[1];
1979 40155391 : for (i=2; i<lx; i++) gel(y,i) = gneg_i(gel(x,i));
1980 9627452 : break;
1981 :
1982 5044843 : case t_RFRAC:
1983 5044843 : y = cgetg(3, t_RFRAC);
1984 5044843 : gel(y,1) = gneg_i(gel(x,1));
1985 5045044 : gel(y,2) = gel(x,2); break;
1986 :
1987 0 : default:
1988 0 : pari_err_TYPE("gneg_i",x);
1989 : return NULL; /* LCOV_EXCL_LINE */
1990 : }
1991 29741964 : return y;
1992 : }
1993 :
1994 : /******************************************************************/
1995 : /* */
1996 : /* ABSOLUTE VALUE */
1997 : /* Create abs(x) if x is integer, real, fraction or complex. */
1998 : /* Error otherwise. */
1999 : /* */
2000 : /******************************************************************/
2001 : static int
2002 0 : is_negative(GEN x) {
2003 0 : switch(typ(x))
2004 : {
2005 0 : case t_INT: case t_REAL:
2006 0 : return (signe(x) < 0);
2007 0 : case t_FRAC:
2008 0 : return (signe(gel(x,1)) < 0);
2009 : }
2010 0 : return 0;
2011 : }
2012 :
2013 : GEN
2014 48715356 : gabs(GEN x, long prec)
2015 : {
2016 : long lx;
2017 : pari_sp av;
2018 : GEN y, N;
2019 :
2020 48715356 : switch(typ(x))
2021 : {
2022 31822511 : case t_INT: case t_REAL:
2023 31822511 : return mpabs(x);
2024 :
2025 11564 : case t_FRAC:
2026 11564 : return absfrac(x);
2027 :
2028 16783852 : case t_COMPLEX:
2029 16783852 : av=avma; N=cxnorm(x);
2030 16765138 : switch(typ(N))
2031 : {
2032 266 : case t_INT:
2033 266 : if (!Z_issquareall(N, &y)) break;
2034 105 : return gerepileupto(av, y);
2035 21315 : case t_FRAC: {
2036 : GEN a,b;
2037 35336 : if (!Z_issquareall(gel(N,1), &a)) break;
2038 14021 : if (!Z_issquareall(gel(N,2), &b)) break;
2039 0 : return gerepileupto(av, gdiv(a,b));
2040 : }
2041 : }
2042 16765033 : return gerepileupto(av, gsqrt(N,prec));
2043 :
2044 21 : case t_QUAD:
2045 21 : av = avma;
2046 21 : return gerepileuptoleaf(av, gabs(quadtofp(x, prec), prec));
2047 :
2048 0 : case t_POL:
2049 0 : lx = lg(x); if (lx<=2) return RgX_copy(x);
2050 0 : return is_negative(gel(x,lx-1))? RgX_neg(x): RgX_copy(x);
2051 :
2052 7 : case t_SER:
2053 7 : if (!signe(x)) pari_err_DOMAIN("abs", "argument", "=", gen_0, x);
2054 7 : if (valser(x)) pari_err_DOMAIN("abs", "series valuation", "!=", gen_0, x);
2055 0 : return is_negative(gel(x,2))? gneg(x): gcopy(x);
2056 :
2057 102662 : case t_VEC: case t_COL: case t_MAT:
2058 615036 : pari_APPLY_same(gabs(gel(x,i),prec));
2059 : }
2060 0 : pari_err_TYPE("gabs",x);
2061 : return NULL; /* LCOV_EXCL_LINE */
2062 : }
2063 :
2064 : GEN
2065 78141 : gmax(GEN x, GEN y) { return gcopy(gmax_shallow(x,y)); }
2066 : GEN
2067 0 : gmaxgs(GEN x, long s) { return (gcmpsg(s,x)>=0)? stoi(s): gcopy(x); }
2068 :
2069 : GEN
2070 12173 : gmin(GEN x, GEN y) { return gcopy(gmin_shallow(x,y)); }
2071 : GEN
2072 0 : gmings(GEN x, long s) { return (gcmpsg(s,x)>0)? gcopy(x): stoi(s); }
2073 :
2074 : long
2075 392366 : vecindexmax(GEN x)
2076 : {
2077 392366 : long lx = lg(x), i0, i;
2078 : GEN s;
2079 :
2080 392366 : if (lx==1) pari_err_DOMAIN("vecindexmax", "empty argument", "=", x,x);
2081 392366 : switch(typ(x))
2082 : {
2083 392366 : case t_VEC: case t_COL:
2084 392366 : s = gel(x,i0=1);
2085 800340 : for (i=2; i<lx; i++)
2086 407971 : if (gcmp(gel(x,i),s) > 0) s = gel(x,i0=i);
2087 392369 : return i0;
2088 0 : case t_VECSMALL:
2089 0 : return vecsmall_indexmax(x);
2090 0 : default: pari_err_TYPE("vecindexmax",x);
2091 : }
2092 : /* LCOV_EXCL_LINE */
2093 0 : return 0;
2094 : }
2095 : long
2096 55268 : vecindexmin(GEN x)
2097 : {
2098 55268 : long lx = lg(x), i0, i;
2099 : GEN s;
2100 :
2101 55268 : if (lx==1) pari_err_DOMAIN("vecindexmin", "empty argument", "=", x,x);
2102 55268 : switch(typ(x))
2103 : {
2104 55268 : case t_VEC: case t_COL:
2105 55268 : s = gel(x,i0=1);
2106 224538 : for (i=2; i<lx; i++)
2107 169270 : if (gcmp(gel(x,i),s) < 0) s = gel(x,i0=i);
2108 55268 : return i0;
2109 0 : case t_VECSMALL:
2110 0 : return vecsmall_indexmin(x);
2111 0 : default: pari_err_TYPE("vecindexmin",x);
2112 : }
2113 : /* LCOV_EXCL_LINE */
2114 0 : return 0;
2115 : }
2116 :
2117 : GEN
2118 110733 : vecmax0(GEN x, GEN *pi)
2119 : {
2120 110733 : long i, lx = lg(x), tx = typ(x);
2121 110733 : if (!is_matvec_t(tx) && tx != t_VECSMALL) return gcopy(x);
2122 110720 : if (lx==1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2123 110699 : switch(typ(x))
2124 : {
2125 110224 : case t_VEC: case t_COL:
2126 110224 : i = vecindexmax(x); if (pi) *pi = utoipos(i);
2127 110228 : return gcopy(gel(x,i));
2128 461 : case t_MAT: {
2129 461 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2130 : GEN s;
2131 461 : if (lx2 == 1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2132 454 : s = gcoeff(x,i0,j0); i = 2;
2133 1752 : for (j=1; j<lx; j++,i=1)
2134 : {
2135 1298 : GEN c = gel(x,j);
2136 24718 : for (; i<lx2; i++)
2137 23420 : if (gcmp(gel(c,i),s) > 0) { s = gel(c,i); j0=j; i0=i; }
2138 : }
2139 454 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2140 454 : return gcopy(s);
2141 : }
2142 14 : case t_VECSMALL:
2143 14 : i = vecsmall_indexmax(x); if (pi) *pi = utoipos(i);
2144 14 : return stoi(x[i]);
2145 : }
2146 : return NULL;/*LCOV_EXCL_LINE*/
2147 : }
2148 : GEN
2149 20632 : vecmin0(GEN x, GEN *pi)
2150 : {
2151 20632 : long i, lx = lg(x), tx = typ(x);
2152 20632 : if (!is_matvec_t(tx) && tx != t_VECSMALL) return gcopy(x);
2153 20618 : if (lx==1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2154 20604 : switch(typ(x))
2155 : {
2156 20576 : case t_VEC: case t_COL:
2157 20576 : i = vecindexmin(x); if (pi) *pi = utoipos(i);
2158 20576 : return gcopy(gel(x,i));
2159 14 : case t_MAT: {
2160 14 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2161 : GEN s;
2162 14 : if (lx2 == 1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2163 14 : s = gcoeff(x,i0,j0); i = 2;
2164 42 : for (j=1; j<lx; j++,i=1)
2165 : {
2166 28 : GEN c = gel(x,j);
2167 70 : for (; i<lx2; i++)
2168 42 : if (gcmp(gel(c,i),s) < 0) { s = gel(c,i); j0=j; i0=i; }
2169 : }
2170 14 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2171 14 : return gcopy(s);
2172 : }
2173 14 : case t_VECSMALL:
2174 14 : i = vecsmall_indexmin(x); if (pi) *pi = utoipos(i);
2175 14 : return stoi(x[i]);
2176 : }
2177 : return NULL;/*LCOV_EXCL_LINE*/
2178 : }
2179 :
2180 : GEN
2181 66092 : vecmax(GEN x) { return vecmax0(x, NULL); }
2182 : GEN
2183 20555 : vecmin(GEN x) { return vecmin0(x, NULL); }
2184 :
2185 : /*******************************************************************/
2186 : /* */
2187 : /* AFFECT long --> GEN */
2188 : /* affect long s to GEN x. Useful for initialization. */
2189 : /* */
2190 : /*******************************************************************/
2191 :
2192 : static void
2193 0 : padicaff0(GEN x)
2194 : {
2195 0 : if (signe(gel(x,4)))
2196 : {
2197 0 : x[1] = evalvalp(valp(x)+precp(x));
2198 0 : affsi(0,gel(x,4));
2199 : }
2200 0 : }
2201 :
2202 : void
2203 966 : gaffsg(long s, GEN x)
2204 : {
2205 966 : switch(typ(x))
2206 : {
2207 0 : case t_INT: affsi(s,x); break;
2208 966 : case t_REAL: affsr(s,x); break;
2209 0 : case t_INTMOD: modsiz(s,gel(x,1),gel(x,2)); break;
2210 0 : case t_FRAC: affsi(s,gel(x,1)); affsi(1,gel(x,2)); break;
2211 0 : case t_COMPLEX: gaffsg(s,gel(x,1)); gaffsg(0,gel(x,2)); break;
2212 0 : case t_PADIC: {
2213 : long vx;
2214 : GEN y;
2215 0 : if (!s) { padicaff0(x); break; }
2216 0 : vx = Z_pvalrem(stoi(s), gel(x,2), &y);
2217 0 : setvalp(x,vx); modiiz(y,gel(x,3),gel(x,4));
2218 0 : break;
2219 : }
2220 0 : case t_QUAD: gaffsg(s,gel(x,2)); gaffsg(0,gel(x,3)); break;
2221 0 : default: pari_err_TYPE2("=",stoi(s),x);
2222 : }
2223 966 : }
2224 :
2225 : /*******************************************************************/
2226 : /* */
2227 : /* GENERIC AFFECTATION */
2228 : /* Affect the content of x to y, whenever possible */
2229 : /* */
2230 : /*******************************************************************/
2231 : /* x PADIC, Y INT, return lift(x * Mod(1,Y)) */
2232 : GEN
2233 4466 : padic_to_Fp(GEN x, GEN Y) {
2234 4466 : pari_sp av = avma;
2235 4466 : GEN p = gel(x,2), z;
2236 4466 : long vy, vx = valp(x);
2237 4466 : if (!signe(Y)) pari_err_INV("padic_to_Fp",Y);
2238 4466 : vy = Z_pvalrem(Y,p, &z);
2239 4466 : if (vx < 0 || !gequal1(z)) pari_err_OP("",x, mkintmod(gen_1,Y));
2240 4445 : if (vx >= vy) { set_avma(av); return gen_0; }
2241 4076 : z = gel(x,4);
2242 4076 : if (!signe(z) || vy > vx + precp(x)) pari_err_OP("",x, mkintmod(gen_1,Y));
2243 4076 : if (vx) z = mulii(z, powiu(p,vx));
2244 4076 : return gerepileuptoint(av, remii(z, Y));
2245 : }
2246 : ulong
2247 217431 : padic_to_Fl(GEN x, ulong Y) {
2248 217431 : GEN p = gel(x,2);
2249 : ulong u, z;
2250 217431 : long vy, vx = valp(x);
2251 217431 : vy = u_pvalrem(Y,p, &u);
2252 217438 : if (vx < 0 || u != 1) pari_err_OP("",x, mkintmodu(1,Y));
2253 : /* Y = p^vy */
2254 217438 : if (vx >= vy) return 0;
2255 212979 : z = umodiu(gel(x,4), Y);
2256 212979 : if (!z || vy > vx + precp(x)) pari_err_OP("",x, mkintmodu(1,Y));
2257 212979 : if (vx) {
2258 0 : ulong pp = p[2];
2259 0 : z = Fl_mul(z, upowuu(pp,vx), Y); /* p^vx < p^vy = Y */
2260 : }
2261 212979 : return z;
2262 : }
2263 :
2264 : static void
2265 0 : croak(const char *s) {
2266 : char *t;
2267 0 : t = stack_sprintf("gaffect [overwriting universal object: %s]",s);
2268 0 : pari_err_BUG(t);
2269 0 : }
2270 :
2271 : void
2272 199659 : gaffect(GEN x, GEN y)
2273 : {
2274 199659 : long vx, i, lx, ly, tx = typ(x), ty = typ(y);
2275 : pari_sp av;
2276 : GEN p1, num, den;
2277 :
2278 199659 : if (tx == ty) switch(tx) {
2279 120051 : case t_INT:
2280 198693 : if (!is_universal_constant(y)) { affii(x,y); return; }
2281 : /* y = gen_0, gnil, gen_1 or gen_2 */
2282 0 : if (y==gen_0) croak("gen_0");
2283 0 : if (y==gen_1) croak("gen_1");
2284 0 : if (y==gen_m1) croak("gen_m1");
2285 0 : if (y==gen_m2) croak("gen_m2");
2286 0 : if (y==gen_2) croak("gen_2");
2287 0 : croak("gnil)");
2288 4606 : case t_REAL: affrr(x,y); return;
2289 0 : case t_INTMOD:
2290 0 : if (!dvdii(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2291 0 : modiiz(gel(x,2),gel(y,1),gel(y,2)); return;
2292 0 : case t_FRAC:
2293 0 : affii(gel(x,1),gel(y,1));
2294 0 : affii(gel(x,2),gel(y,2)); return;
2295 1820 : case t_COMPLEX:
2296 1820 : gaffect(gel(x,1),gel(y,1));
2297 1820 : gaffect(gel(x,2),gel(y,2)); return;
2298 0 : case t_PADIC:
2299 0 : if (!equalii(gel(x,2),gel(y,2))) pari_err_OP("",x,y);
2300 0 : modiiz(gel(x,4),gel(y,3),gel(y,4));
2301 0 : setvalp(y,valp(x)); return;
2302 0 : case t_QUAD:
2303 0 : if (! ZX_equal(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2304 0 : affii(gel(x,2),gel(y,2));
2305 0 : affii(gel(x,3),gel(y,3)); return;
2306 72216 : case t_VEC: case t_COL: case t_MAT:
2307 72216 : lx = lg(x); if (lx != lg(y)) pari_err_DIM("gaffect");
2308 192267 : for (i=1; i<lx; i++) gaffect(gel(x,i),gel(y,i));
2309 72216 : return;
2310 : }
2311 :
2312 : /* Various conversions. Avoid them, use specialized routines ! */
2313 :
2314 966 : if (!is_const_t(ty)) pari_err_TYPE2("=",x,y);
2315 966 : switch(tx)
2316 : {
2317 0 : case t_INT:
2318 : switch(ty)
2319 : {
2320 0 : case t_REAL:
2321 0 : affir(x,y); break;
2322 :
2323 0 : case t_INTMOD:
2324 0 : modiiz(x,gel(y,1),gel(y,2)); break;
2325 :
2326 0 : case t_COMPLEX:
2327 0 : gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2328 :
2329 0 : case t_PADIC:
2330 0 : if (!signe(x)) { padicaff0(y); break; }
2331 0 : av = avma;
2332 0 : setvalp(y, Z_pvalrem(x,gel(y,2),&p1));
2333 0 : affii(modii(p1,gel(y,3)), gel(y,4));
2334 0 : set_avma(av); break;
2335 :
2336 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2337 0 : default: pari_err_TYPE2("=",x,y);
2338 : }
2339 0 : break;
2340 :
2341 966 : case t_REAL:
2342 : switch(ty)
2343 : {
2344 966 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2345 0 : default: pari_err_TYPE2("=",x,y);
2346 : }
2347 966 : break;
2348 :
2349 0 : case t_FRAC:
2350 : switch(ty)
2351 : {
2352 0 : case t_REAL: rdiviiz(gel(x,1),gel(x,2), y); break;
2353 0 : case t_INTMOD: av = avma;
2354 0 : p1 = Fp_inv(gel(x,2),gel(y,1));
2355 0 : affii(modii(mulii(gel(x,1),p1),gel(y,1)), gel(y,2));
2356 0 : set_avma(av); break;
2357 0 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2358 0 : case t_PADIC:
2359 0 : if (!signe(gel(x,1))) { padicaff0(y); break; }
2360 0 : num = gel(x,1);
2361 0 : den = gel(x,2);
2362 0 : av = avma; vx = Z_pvalrem(num, gel(y,2), &num);
2363 0 : if (!vx) vx = -Z_pvalrem(den,gel(y,2),&den);
2364 0 : setvalp(y,vx);
2365 0 : p1 = mulii(num,Fp_inv(den,gel(y,3)));
2366 0 : affii(modii(p1,gel(y,3)), gel(y,4)); set_avma(av); break;
2367 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2368 0 : default: pari_err_TYPE2("=",x,y);
2369 : }
2370 0 : break;
2371 :
2372 0 : case t_COMPLEX:
2373 0 : if (!gequal0(gel(x,2))) pari_err_TYPE2("=",x,y);
2374 0 : gaffect(gel(x,1), y);
2375 0 : break;
2376 :
2377 0 : case t_PADIC:
2378 : switch(ty)
2379 : {
2380 0 : case t_INTMOD:
2381 0 : av = avma; affii(padic_to_Fp(x, gel(y,1)), gel(y,2));
2382 0 : set_avma(av); break;
2383 0 : default: pari_err_TYPE2("=",x,y);
2384 : }
2385 0 : break;
2386 :
2387 0 : case t_QUAD:
2388 : switch(ty)
2389 : {
2390 0 : case t_INT: case t_INTMOD: case t_FRAC: case t_PADIC:
2391 0 : pari_err_TYPE2("=",x,y);
2392 :
2393 0 : case t_REAL:
2394 0 : av = avma; affgr(quadtofp(x,realprec(y)), y); set_avma(av); break;
2395 0 : case t_COMPLEX:
2396 0 : ly = precision(y); if (!ly) pari_err_TYPE2("=",x,y);
2397 0 : av = avma; gaffect(quadtofp(x,ly), y); set_avma(av); break;
2398 0 : default: pari_err_TYPE2("=",x,y);
2399 : }
2400 0 : default: pari_err_TYPE2("=",x,y);
2401 : }
2402 : }
2403 :
2404 : /*******************************************************************/
2405 : /* */
2406 : /* CONVERSION QUAD --> REAL, COMPLEX OR P-ADIC */
2407 : /* */
2408 : /*******************************************************************/
2409 : GEN
2410 252 : quadtofp(GEN x, long prec)
2411 : {
2412 252 : GEN b, D, z, u = gel(x,2), v = gel(x,3);
2413 : pari_sp av;
2414 252 : if (prec < LOWDEFAULTPREC) prec = LOWDEFAULTPREC;
2415 252 : if (isintzero(v)) return cxcompotor(u, prec);
2416 252 : av = avma; D = quad_disc(x); b = gel(gel(x,1),3); /* 0 or -1 */
2417 : /* u + v (-b + sqrt(D)) / 2 */
2418 252 : if (!signe(b)) b = NULL;
2419 252 : if (b) u = gadd(gmul2n(u,1), v);
2420 252 : z = sqrtr_abs(itor(D, prec));
2421 252 : if (!b) shiftr_inplace(z, -1);
2422 252 : z = gmul(v, z);
2423 252 : if (signe(D) < 0)
2424 : {
2425 35 : z = mkcomplex(cxcompotor(u, prec), z);
2426 35 : if (!b) return gerepilecopy(av, z);
2427 0 : z = gmul2n(z, -1);
2428 : }
2429 : else
2430 : { /* if (b) x ~ (u + z) / 2 and quadnorm(x) ~ (u^2 - z^2) / 4
2431 : * else x ~ u + z and quadnorm(x) ~ u^2 - z^2 */
2432 217 : long s = gsigne(u);
2433 217 : if (s == -gsigne(v)) /* conjugate expression avoids cancellation */
2434 : {
2435 14 : z = gdiv(quadnorm(x), gsub(u, z));
2436 14 : if (b) shiftr_inplace(z, 1);
2437 : }
2438 : else
2439 : {
2440 203 : if (s) z = gadd(u, z);
2441 203 : if (b) shiftr_inplace(z, -1);
2442 : }
2443 : }
2444 217 : return gerepileupto(av, z);
2445 : }
2446 :
2447 : static GEN
2448 28 : qtop(GEN x, GEN p, long d)
2449 : {
2450 28 : GEN z, D, P, b, u = gel(x,2), v = gel(x,3);
2451 : pari_sp av;
2452 28 : if (gequal0(v)) return cvtop(u, p, d);
2453 28 : P = gel(x,1);
2454 28 : b = gel(P,3);
2455 28 : av = avma; D = quad_disc(x);
2456 28 : if (absequaliu(p,2)) d += 2;
2457 28 : z = Qp_sqrt(cvtop(D,p,d));
2458 28 : if (!z) pari_err_SQRTN("Qp_sqrt",D);
2459 14 : z = gmul2n(gsub(z, b), -1);
2460 :
2461 14 : z = gadd(u, gmul(v, z));
2462 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_QUAD of t_INTMODs... */
2463 0 : z = cvtop(z, p, d);
2464 14 : return gerepileupto(av, z);
2465 : }
2466 : static GEN
2467 14 : ctop(GEN x, GEN p, long d)
2468 : {
2469 14 : pari_sp av = avma;
2470 14 : GEN z, u = gel(x,1), v = gel(x,2);
2471 14 : if (isrationalzero(v)) return cvtop(u, p, d);
2472 14 : z = Qp_sqrt(cvtop(gen_m1, p, d - gvaluation(v, p))); /* = I */
2473 14 : if (!z) pari_err_SQRTN("Qp_sqrt",gen_m1);
2474 :
2475 14 : z = gadd(u, gmul(v, z));
2476 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_COMPLEX of t_INTMODs... */
2477 0 : z = cvtop(z, p, d);
2478 14 : return gerepileupto(av, z);
2479 : }
2480 :
2481 : /* cvtop2(stoi(s), y) */
2482 : GEN
2483 266 : cvstop2(long s, GEN y)
2484 : {
2485 266 : GEN z, p = gel(y,2);
2486 266 : long v, d = signe(gel(y,4))? precp(y): 0;
2487 266 : if (!s) return zeropadic_shallow(p, d);
2488 266 : v = z_pvalrem(s, p, &s);
2489 266 : if (d <= 0) return zeropadic_shallow(p, v);
2490 266 : z = cgetg(5, t_PADIC);
2491 266 : z[1] = evalprecp(d) | evalvalp(v);
2492 266 : gel(z,2) = p;
2493 266 : gel(z,3) = gel(y,3);
2494 266 : gel(z,4) = modsi(s, gel(y,3)); return z;
2495 : }
2496 :
2497 : static GEN
2498 6816431 : itop2_coprime(GEN x, GEN y, long v, long d)
2499 : {
2500 6816431 : GEN z = cgetg(5, t_PADIC);
2501 6815875 : z[1] = evalprecp(d) | evalvalp(v);
2502 6815720 : gel(z,2) = gel(y,2);
2503 6815720 : gel(z,3) = gel(y,3);
2504 6815720 : gel(z,4) = modii(x, gel(y,3)); return z;
2505 : }
2506 : /* cvtop(x, gel(y,2), precp(y)), shallow */
2507 : GEN
2508 6822903 : cvtop2(GEN x, GEN y)
2509 : {
2510 6822903 : GEN p = gel(y,2);
2511 6822903 : long v, d = signe(gel(y,4))? precp(y): 0;
2512 6822903 : switch(typ(x))
2513 : {
2514 4053846 : case t_INT:
2515 4053846 : if (!signe(x)) return zeropadic_shallow(p, d);
2516 4053846 : if (d <= 0) return zeropadic_shallow(p, Z_pval(x,p));
2517 4049653 : v = Z_pvalrem(x, p, &x); return itop2_coprime(x, y, v, d);
2518 :
2519 0 : case t_INTMOD:
2520 0 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2521 0 : return cvtop(gel(x,2), p, v);
2522 :
2523 2768994 : case t_FRAC:
2524 : {
2525 : GEN num, den;
2526 2768994 : if (d <= 0) return zeropadic_shallow(p, Q_pval(x,p));
2527 2767713 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2528 2767714 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2529 2767713 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, gel(y,3)));
2530 2767712 : return itop2_coprime(num, y, v, d);
2531 : }
2532 7 : case t_COMPLEX: return ctop(x, p, d);
2533 28 : case t_QUAD: return qtop(x, p, d);
2534 147 : case t_PADIC:
2535 147 : if (!signe(gel(x,4))) return zeropadic_shallow(p, d);
2536 147 : if (precp(x) <= d) return x;
2537 35 : return itop2_coprime(gel(x,4), y, valp(x), d); /* reduce accuracy */
2538 : }
2539 0 : pari_err_TYPE("cvtop2",x);
2540 : return NULL; /* LCOV_EXCL_LINE */
2541 : }
2542 :
2543 : /* assume is_const_t(tx) */
2544 : GEN
2545 389887 : cvtop(GEN x, GEN p, long d)
2546 : {
2547 : GEN z;
2548 : long v;
2549 :
2550 389887 : if (typ(p) != t_INT) pari_err_TYPE("cvtop",p);
2551 389887 : switch(typ(x))
2552 : {
2553 51663 : case t_INT:
2554 51663 : if (!signe(x)) return zeropadic(p, d);
2555 50445 : if (d <= 0) return zeropadic(p, Z_pval(x,p));
2556 50389 : v = Z_pvalrem(x, p, &x);
2557 50389 : z = cgetg(5, t_PADIC);
2558 50389 : z[1] = evalprecp(d) | evalvalp(v);
2559 50389 : gel(z,2) = icopy(p);
2560 50389 : gel(z,3) = powiu(p, d);
2561 50389 : gel(z,4) = modii(x, gel(z,3)); return z; /* not memory-clean */
2562 :
2563 28 : case t_INTMOD:
2564 28 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2565 28 : return cvtop(gel(x,2), p, v);
2566 :
2567 166161 : case t_FRAC:
2568 : {
2569 : GEN num, den;
2570 166161 : if (d <= 0) return zeropadic(p, Q_pval(x,p));
2571 166147 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2572 166147 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2573 166147 : z = cgetg(5, t_PADIC);
2574 166147 : z[1] = evalprecp(d) | evalvalp(v);
2575 166147 : gel(z,2) = icopy(p);
2576 166147 : gel(z,3) = powiu(p, d);
2577 166147 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, gel(z,3)));
2578 166147 : gel(z,4) = modii(num, gel(z,3)); return z; /* not memory-clean */
2579 : }
2580 7 : case t_COMPLEX: return ctop(x, p, d);
2581 172028 : case t_PADIC:
2582 172028 : p = gel(x,2); /* override */
2583 172028 : if (!signe(gel(x,4))) return zeropadic(p, d);
2584 172028 : z = cgetg(5,t_PADIC);
2585 172028 : z[1] = x[1]; setprecp(z,d);
2586 172028 : gel(z,2) = icopy(p);
2587 172028 : gel(z,3) = powiu(p, d);
2588 172028 : gel(z,4) = modii(gel(x,4), gel(z,3)); return z;
2589 :
2590 0 : case t_QUAD: return qtop(x, p, d);
2591 : }
2592 0 : pari_err_TYPE("cvtop",x);
2593 : return NULL; /* LCOV_EXCL_LINE */
2594 : }
2595 :
2596 : GEN
2597 126 : gcvtop(GEN x, GEN p, long r)
2598 : {
2599 : long i, lx;
2600 : GEN y;
2601 :
2602 126 : switch(typ(x))
2603 : {
2604 28 : case t_POL: case t_SER:
2605 28 : y = cgetg_copy(x, &lx); y[1] = x[1];
2606 98 : for (i=2; i<lx; i++) gel(y,i) = gcvtop(gel(x,i),p,r);
2607 28 : return y;
2608 0 : case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
2609 0 : pari_APPLY_same(gcvtop(gel(x,i),p,r));
2610 : }
2611 98 : return cvtop(x,p,r);
2612 : }
2613 :
2614 : long
2615 534571171 : gexpo_safe(GEN x)
2616 : {
2617 534571171 : long tx = typ(x), lx, e, f, i;
2618 :
2619 534571171 : switch(tx)
2620 : {
2621 112349968 : case t_INT:
2622 112349968 : return expi(x);
2623 :
2624 952787 : case t_FRAC:
2625 952787 : return expi(gel(x,1)) - expi(gel(x,2));
2626 :
2627 285601478 : case t_REAL:
2628 285601478 : return expo(x);
2629 :
2630 82219979 : case t_COMPLEX:
2631 82219979 : e = gexpo(gel(x,1));
2632 82222674 : f = gexpo(gel(x,2)); return maxss(e, f);
2633 :
2634 91 : case t_QUAD: {
2635 91 : GEN p = gel(x,1); /* mod = X^2 + {0,1}* X - {D/4, (1-D)/4})*/
2636 91 : long d = 1 + expi(gel(p,2))/2; /* ~ expo(sqrt(D)) */
2637 91 : e = gexpo(gel(x,2));
2638 91 : f = gexpo(gel(x,3)) + d; return maxss(e, f);
2639 : }
2640 45595232 : case t_POL: case t_SER:
2641 45595232 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2642 203231806 : for (i=2; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2643 45596179 : return f;
2644 7989902 : case t_VEC: case t_COL: case t_MAT:
2645 7989902 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2646 84831746 : for (i=1; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2647 7989974 : return f;
2648 : }
2649 48 : return -1-(long)HIGHEXPOBIT;
2650 : }
2651 : long
2652 534330259 : gexpo(GEN x)
2653 : {
2654 534330259 : long e = gexpo_safe(x);
2655 534392881 : if (e < -(long)HIGHEXPOBIT) pari_err_TYPE("gexpo",x);
2656 534398891 : return e;
2657 : }
2658 : GEN
2659 89390 : gpexponent(GEN x)
2660 : {
2661 89390 : long e = gexpo(x);
2662 89390 : return e == -(long)HIGHEXPOBIT? mkmoo(): stoi(e);
2663 : }
2664 :
2665 : long
2666 7 : sizedigit(GEN x)
2667 : {
2668 7 : return gequal0(x)? 0: (long) ((gexpo(x)+1) * LOG10_2) + 1;
2669 : }
2670 :
2671 : /* normalize series. avma is not updated */
2672 : GEN
2673 13192877 : normalizeser(GEN x)
2674 : {
2675 13192877 : long i, lx = lg(x), vx=varn(x), vp=valser(x);
2676 : GEN y, z;
2677 :
2678 13192877 : if (lx == 2) { setsigne(x,0); return x; }
2679 13192513 : if (lx == 3) {
2680 185037 : z = gel(x,2);
2681 185037 : if (!gequal0(z)) { setsigne(x,1); return x; }
2682 22239 : if (isrationalzero(z)) return zeroser(vx,vp+1);
2683 3556 : if (isexactzero(z)) {
2684 : /* dangerous case: already normalized ? */
2685 266 : if (!signe(x)) return x;
2686 35 : setvalser(x,vp+1); /* no: normalize */
2687 : }
2688 3325 : setsigne(x,0); return x;
2689 : }
2690 13298057 : for (i=2; i<lx; i++)
2691 13251346 : if (! isrationalzero(gel(x,i))) break;
2692 13007476 : if (i == lx) return zeroser(vx,lx-2+vp);
2693 12960765 : z = gel(x,i);
2694 12964566 : while (i<lx && isexactzero(gel(x,i))) i++;
2695 12960765 : if (i == lx)
2696 : {
2697 273 : i -= 3; y = x + i;
2698 273 : stackdummy((pari_sp)y, (pari_sp)x);
2699 273 : gel(y,2) = z;
2700 273 : y[1] = evalsigne(0) | evalvalser(lx-2+vp) | evalvarn(vx);
2701 273 : y[0] = evaltyp(t_SER) | _evallg(3);
2702 273 : return y;
2703 : }
2704 :
2705 12960492 : i -= 2; y = x + i; lx -= i;
2706 12960492 : y[1] = evalsigne(1) | evalvalser(vp+i) | evalvarn(vx);
2707 12960492 : y[0] = evaltyp(t_SER) | evallg(lx);
2708 :
2709 12960492 : stackdummy((pari_sp)y, (pari_sp)x);
2710 12989421 : for (i = 2; i < lx; i++)
2711 12988483 : if (!gequal0(gel(y, i))) return y;
2712 938 : setsigne(y, 0); return y;
2713 : }
2714 :
2715 : GEN
2716 0 : normalizepol_approx(GEN x, long lx)
2717 : {
2718 : long i;
2719 0 : for (i = lx-1; i>1; i--)
2720 0 : if (! gequal0(gel(x,i))) break;
2721 0 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + i+1));
2722 0 : setlg(x, i+1); setsigne(x, i!=1); return x;
2723 : }
2724 :
2725 : GEN
2726 606721720 : normalizepol_lg(GEN x, long lx)
2727 : {
2728 606721720 : long i, LX = 0;
2729 606721720 : GEN KEEP = NULL;
2730 :
2731 792269806 : for (i = lx-1; i>1; i--)
2732 : {
2733 727818356 : GEN z = gel(x,i);
2734 727818356 : if (! gequal0(z) ) {
2735 542588923 : if (!LX) LX = i+1;
2736 542588923 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2737 542641604 : x[0] = evaltyp(t_POL) | evallg(LX);
2738 542593894 : setsigne(x,1); return x;
2739 185287016 : } else if (!isexactzero(z)) {
2740 783553 : if (!LX) LX = i+1; /* to be kept as leading coeff */
2741 184768633 : } else if (!isrationalzero(z))
2742 832650 : KEEP = z; /* to be kept iff all other coeffs are exact 0s */
2743 : }
2744 64451450 : if (!LX) {
2745 64144647 : if (KEEP) { /* e.g. Pol(Mod(0,2)) */
2746 348365 : gel(x,2) = KEEP;
2747 348365 : LX = 3;
2748 : } else
2749 63796282 : LX = 2; /* Pol(0) */
2750 : }
2751 64451450 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2752 64401114 : x[0] = evaltyp(t_POL) | evallg(LX);
2753 64397317 : setsigne(x,0); return x;
2754 : }
2755 :
2756 : /* normalize polynomial x in place */
2757 : GEN
2758 59494536 : normalizepol(GEN x)
2759 : {
2760 59494536 : return normalizepol_lg(x, lg(x));
2761 : }
2762 :
2763 : int
2764 72712106 : gsigne(GEN x)
2765 : {
2766 72712106 : switch(typ(x))
2767 : {
2768 72322236 : case t_INT: case t_REAL: return signe(x);
2769 389235 : case t_FRAC: return signe(gel(x,1));
2770 623 : case t_QUAD:
2771 : {
2772 623 : pari_sp av = avma;
2773 623 : GEN T = gel(x,1), a = gel(x,2), b = gel(x,3);
2774 : long sa, sb;
2775 623 : if (signe(gel(T,2)) > 0) break;
2776 609 : a = gmul2n(a,1);
2777 609 : if (signe(gel(T,3))) a = gadd(a,b);
2778 : /* a + b sqrt(D) > 0 ? */
2779 609 : sa = gsigne(a);
2780 609 : sb = gsigne(b); if (sa == sb) return gc_int(av,sa);
2781 224 : if (sa == 0) return gc_int(av,sb);
2782 217 : if (sb == 0) return gc_int(av,sa);
2783 : /* different signs, take conjugate expression */
2784 210 : sb = gsigne(gsub(gsqr(a), gmul(quad_disc(x), gsqr(b))));
2785 210 : return gc_int(av, sb*sa);
2786 : }
2787 14 : case t_INFINITY: return inf_get_sign(x);
2788 : }
2789 12 : pari_err_TYPE("gsigne",x);
2790 : return 0; /* LCOV_EXCL_LINE */
2791 : }
2792 :
2793 : /*******************************************************************/
2794 : /* */
2795 : /* LISTS */
2796 : /* */
2797 : /*******************************************************************/
2798 : /* make sure L can hold l elements, at least doubling the previous max number
2799 : * of components. */
2800 : static void
2801 791217 : ensure_nb(GEN L, long l)
2802 : {
2803 791217 : long nmax = list_nmax(L), i, lw;
2804 : GEN v, w;
2805 791217 : if (l <= nmax) return;
2806 665 : if (nmax)
2807 : {
2808 273 : nmax <<= 1;
2809 273 : if (l > nmax) nmax = l;
2810 273 : w = list_data(L); lw = lg(w);
2811 273 : v = newblock(nmax+1);
2812 273 : v[0] = w[0];
2813 1045653 : for (i=1; i < lw; i++) gel(v,i) = gel(w, i);
2814 273 : killblock(w);
2815 : }
2816 : else /* unallocated */
2817 : {
2818 392 : nmax = 32;
2819 392 : if (list_data(L))
2820 0 : pari_err(e_MISC, "store list in variable before appending elements");
2821 392 : v = newblock(nmax+1);
2822 392 : v[0] = evaltyp(t_VEC) | _evallg(1);
2823 : }
2824 665 : list_data(L) = v;
2825 665 : L[1] = evaltyp(list_typ(L))|evallg(nmax);
2826 : }
2827 :
2828 : void
2829 7 : listkill(GEN L)
2830 : {
2831 :
2832 7 : if (typ(L) != t_LIST) pari_err_TYPE("listkill",L);
2833 7 : if (list_nmax(L)) {
2834 7 : GEN v = list_data(L);
2835 7 : long i, l = lg(v);
2836 49 : for (i=1; i<l; i++) gunclone_deep(gel(v,i));
2837 7 : killblock(v);
2838 7 : L[1] = evaltyp(list_typ(L));
2839 7 : list_data(L) = NULL;
2840 : }
2841 7 : }
2842 :
2843 : GEN
2844 6352 : mklist_typ(long t)
2845 : {
2846 6352 : GEN L = cgetg(3,t_LIST);
2847 6352 : L[1] = evaltyp(t);
2848 6352 : list_data(L) = NULL; return L;
2849 : }
2850 :
2851 : GEN
2852 6296 : mklist(void)
2853 : {
2854 6296 : return mklist_typ(t_LIST_RAW);
2855 : }
2856 :
2857 : GEN
2858 49 : mkmap(void)
2859 : {
2860 49 : return mklist_typ(t_LIST_MAP);
2861 : }
2862 :
2863 : /* return a list with single element x, allocated on stack */
2864 : GEN
2865 56 : mklistcopy(GEN x)
2866 : {
2867 56 : GEN y = mklist();
2868 56 : list_data(y) = mkveccopy(x);
2869 56 : return y;
2870 : }
2871 :
2872 : GEN
2873 7 : listcreate_gp(long n)
2874 : {
2875 7 : (void) n; return mklist();
2876 : }
2877 :
2878 : GEN
2879 756371 : listput(GEN L, GEN x, long index)
2880 : {
2881 : long l;
2882 : GEN z;
2883 :
2884 756371 : if (index < 0) pari_err_COMPONENT("listput", "<", gen_0, stoi(index));
2885 756364 : z = list_data(L);
2886 756364 : l = z? lg(z): 1;
2887 :
2888 756364 : x = gclone(x);
2889 756364 : if (!index || index >= l)
2890 : {
2891 756210 : ensure_nb(L, l);
2892 756210 : z = list_data(L); /* it may change ! */
2893 756210 : index = l;
2894 756210 : l++;
2895 : } else
2896 154 : gunclone_deep( gel(z, index) );
2897 756364 : gel(z,index) = x;
2898 756364 : z[0] = evaltyp(t_VEC) | evallg(l); /*must be after gel(z,index) is set*/
2899 756364 : return gel(z,index);
2900 : }
2901 :
2902 : GEN
2903 705208 : listput0(GEN L, GEN x, long index)
2904 : {
2905 705208 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2906 14 : pari_err_TYPE("listput",L);
2907 705194 : return listput(L, x, index);
2908 : }
2909 :
2910 : GEN
2911 35028 : listinsert(GEN L, GEN x, long index)
2912 : {
2913 : long l, i;
2914 : GEN z;
2915 :
2916 35028 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2917 14 : pari_err_TYPE("listinsert",L);
2918 35014 : z = list_data(L); l = z? lg(z): 1;
2919 35014 : if (index <= 0) pari_err_COMPONENT("listinsert", "<=", gen_0, stoi(index));
2920 35007 : if (index > l) index = l;
2921 35007 : ensure_nb(L, l);
2922 35007 : BLOCK_SIGINT_START
2923 35007 : z = list_data(L);
2924 87552507 : for (i=l; i > index; i--) gel(z,i) = gel(z,i-1);
2925 35007 : z[0] = evaltyp(t_VEC) | evallg(l+1);
2926 35007 : gel(z,index) = gclone(x);
2927 35007 : BLOCK_SIGINT_END
2928 35007 : return gel(z,index);
2929 : }
2930 :
2931 : void
2932 21917 : listpop(GEN L, long index)
2933 : {
2934 : long l, i;
2935 : GEN z;
2936 :
2937 21917 : if (typ(L) != t_LIST) pari_err_TYPE("listinsert",L);
2938 21917 : if (index < 0) pari_err_COMPONENT("listpop", "<", gen_0, stoi(index));
2939 21917 : z = list_data(L);
2940 21917 : if (!z || (l = lg(z)-1) == 0) return;
2941 :
2942 21903 : if (!index || index > l) index = l;
2943 21903 : BLOCK_SIGINT_START
2944 21903 : gunclone_deep( gel(z, index) );
2945 21903 : z[0] = evaltyp(t_VEC) | evallg(l);
2946 21910 : for (i=index; i < l; i++) z[i] = z[i+1];
2947 21903 : BLOCK_SIGINT_END
2948 : }
2949 :
2950 : void
2951 56 : listpop0(GEN L, long index)
2952 : {
2953 56 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2954 14 : pari_err_TYPE("listpop",L);
2955 42 : listpop(L, index);
2956 42 : }
2957 :
2958 : /* return a copy fully allocated on stack. gclone from changevalue is
2959 : * supposed to malloc() it */
2960 : GEN
2961 5524 : gtolist(GEN x)
2962 : {
2963 : GEN y;
2964 :
2965 5524 : if (!x) return mklist();
2966 349 : switch(typ(x))
2967 : {
2968 286 : case t_VEC: case t_COL:
2969 286 : y = mklist();
2970 286 : if (lg(x) == 1) return y;
2971 265 : list_data(y) = gcopy(x);
2972 265 : settyp(list_data(y), t_VEC);
2973 265 : return y;
2974 7 : case t_LIST:
2975 7 : y = mklist();
2976 7 : list_data(y) = list_data(x)? gcopy(list_data(x)): NULL;
2977 7 : return y;
2978 56 : default:
2979 56 : return mklistcopy(x);
2980 : }
2981 : }
2982 :
2983 : void
2984 21 : listsort(GEN L, long flag)
2985 : {
2986 : long i, l;
2987 21 : pari_sp av = avma;
2988 : GEN perm, v, vnew;
2989 :
2990 21 : if (typ(L) != t_LIST) pari_err_TYPE("listsort",L);
2991 21 : v = list_data(L); l = v? lg(v): 1;
2992 21 : if (l < 3) return;
2993 21 : if (flag)
2994 : {
2995 : long lnew;
2996 14 : perm = gen_indexsort_uniq(L, (void*)&cmp_universal, cmp_nodata);
2997 14 : lnew = lg(perm); /* may have changed since 'uniq' */
2998 14 : vnew = cgetg(lnew,t_VEC);
2999 56 : for (i=1; i<lnew; i++) {
3000 42 : long c = perm[i];
3001 42 : gel(vnew,i) = gel(v,c);
3002 42 : gel(v,c) = NULL;
3003 : }
3004 14 : if (l != lnew) { /* was shortened */
3005 105 : for (i=1; i<l; i++)
3006 91 : if (gel(v,i)) gunclone_deep(gel(v,i));
3007 14 : l = lnew;
3008 : }
3009 : }
3010 : else
3011 : {
3012 7 : perm = gen_indexsort(L, (void*)&cmp_universal, cmp_nodata);
3013 7 : vnew = cgetg(l,t_VEC);
3014 63 : for (i=1; i<l; i++) gel(vnew,i) = gel(v,perm[i]);
3015 : }
3016 119 : for (i=1; i<l; i++) gel(v,i) = gel(vnew,i);
3017 21 : v[0] = vnew[0]; set_avma(av);
3018 : }
|
