/* $Id: gen1.c,v 1.176.2.1 2006/08/03 17:25:19 kb Exp $ Copyright (C) 2000 The PARI group. This file is part of the PARI/GP package. PARI/GP is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation. It is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY WHATSOEVER. Check the License for details. You should have received a copy of it, along with the package; see the file 'COPYING'. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /********************************************************************/ /** **/ /** GENERIC OPERATIONS **/ /** (first part) **/ /** **/ /********************************************************************/ #include "pari.h" #include "paripriv.h" #define fix_frac(z) if (signe(z[2])<0)\ {\ setsigne(z[1],-signe(z[1]));\ setsigne(z[2],1);\ } /* assume z[1] was created last */ #define fix_frac_if_int(z) if (is_pm1(z[2]))\ z = gerepileupto((pari_sp)(z+3), gel(z,1)); /* assume z[1] was created last */ #define fix_frac_if_int_GC(z,tetpil) { if (is_pm1(z[2]))\ z = gerepileupto((pari_sp)(z+3), gel(z,1));\ else\ gerepilecoeffssp((pari_sp)z, tetpil, z+1, 2); } static long kro_quad(GEN x, GEN y) { long k; pari_sp av=avma; x = subii(sqri(gel(x,3)), shifti(gel(x,2),2)); k = kronecker(x,y); avma=av; return k; } /* is -1 not a square in Zp, assume p prime */ INLINE int Zp_nosquare_m1(GEN p) { return (mod4(p) & 2); /* 2 or 3 mod 4 */ } static GEN addpp(GEN x, GEN y); static GEN mulpp(GEN x, GEN y); static GEN divpp(GEN x, GEN y); /* Argument codes for inline routines * c: complex, p: padic, q: quad, f: floating point (REAL, some complex) * R: without imaginary part (INT, REAL, INTMOD, FRAC, PADIC if -1 not square) * T: some type (to be converted to PADIC) */ static GEN addRc(GEN x, GEN y) { GEN z = cgetg(3,t_COMPLEX); gel(z,1) = gadd(x,gel(y,1)); gel(z,2) = gcopy(gel(y,2)); return z; } static GEN mulRc(GEN x, GEN y) { GEN z = cgetg(3,t_COMPLEX); gel(z,1) = gmul(x,gel(y,1)); gel(z,2) = gmul(x,gel(y,2)); return z; } static GEN divRc(GEN x, GEN y) { GEN a, b, N, z = cgetg(3,t_COMPLEX); pari_sp tetpil, av = avma; a = gmul(x, gel(y,1)); b = gmul(x, gel(y,2)); if(!gcmp0(b)) b = gneg_i(b); N = cxnorm(y); tetpil = avma; gel(z,1) = gdiv(a, N); gel(z,2) = gdiv(b, N); gerepilecoeffssp(av,tetpil,z+1,2); return z; } static GEN divcR(GEN x, GEN y) { GEN z = cgetg(3,t_COMPLEX); gel(z,1) = gdiv(gel(x,1), y); gel(z,2) = gdiv(gel(x,2), y); return z; } static GEN addRq(GEN x, GEN y) { GEN z = cgetg(4,t_QUAD); gel(z,1) = gcopy(gel(y,1)); gel(z,2) = gadd(x, gel(y,2)); gel(z,3) = gcopy(gel(y,3)); return z; } static GEN mulRq(GEN x, GEN y) { GEN z = cgetg(4,t_QUAD); gel(z,1) = gcopy(gel(y,1)); gel(z,2) = gmul(x,gel(y,2)); gel(z,3) = gmul(x,gel(y,3)); return z; } static GEN addqf(GEN x, GEN y, long prec) { pari_sp av = avma; long i = gexpo(x) - gexpo(y); if (i <= 0) i = 0; else i >>= TWOPOTBITS_IN_LONG; return gerepileupto(av, gadd(y, quadtoc(x, prec + i))); } static GEN mulqf(GEN x, GEN y, long prec) { pari_sp av = avma; return gerepileupto(av, gmul(y, quadtoc(x, prec))); } static GEN divqf(GEN x, GEN y, long prec) { pari_sp av = avma; return gerepileupto(av, gdiv(quadtoc(x,prec), y)); } static GEN divfq(GEN x, GEN y, long prec) { pari_sp av = avma; return gerepileupto(av, gdiv(x, quadtoc(y,prec))); } /* y PADIC, x + y by converting x to padic */ static GEN addTp(GEN x, GEN y) { pari_sp av = avma; GEN z; if (!valp(y)) z = cvtop2(x,y); else { long l = signe(y[4])? valp(y) + precp(y): valp(y); z = cvtop(x, gel(y,2), l); } return gerepileupto(av, addpp(z, y)); } /* y PADIC, x * y by converting x to padic */ static GEN mulTp(GEN x, GEN y) { pari_sp av = avma; return gerepileupto(av, mulpp(cvtop2(x,y), y)); } /* y PADIC, non zero x / y by converting x to padic */ static GEN divTp(GEN x, GEN y) { pari_sp av = avma; return gerepileupto(av, divpp(cvtop2(x,y), y)); } /* x PADIC, x / y by converting y to padic */ static GEN divpT(GEN x, GEN y) { pari_sp av = avma; return gerepileupto(av, divpp(x, cvtop2(y,x))); } /* z := Mod(x,X) + Mod(y,X) [ t_INTMOD preallocated ], x,y,X INT, 0 <= x,y < X * clean memory from z on */ static GEN add_intmod_same(GEN z, GEN X, GEN x, GEN y) { if (lgefint(X) == 3) { ulong u = Fl_add(itou(x),itou(y), X[2]); avma = (pari_sp)z; gel(z,2) = utoi(u); } else { GEN u = addii(x,y); if (cmpii(u, X) >= 0) u = subii(u, X); gel(z,2) = gerepileuptoint((pari_sp)z, u); } gel(z,1) = icopy(X); return z; } /* cf add_intmod_same */ static GEN mul_intmod_same(GEN z, GEN X, GEN x, GEN y) { if (lgefint(X) == 3) { ulong u = Fl_mul(itou(x),itou(y), X[2]); avma = (pari_sp)z; gel(z,2) = utoi(u); } else gel(z,2) = gerepileuptoint((pari_sp)z, remii(mulii(x,y), X) ); gel(z,1) = icopy(X); return z; } /* cf add_intmod_same */ static GEN div_intmod_same(GEN z, GEN X, GEN x, GEN y) { if (lgefint(X) == 3) { ulong m = (ulong)X[2], u = Fl_div(itou(x), itou(y), m); avma = (pari_sp)z; gel(z,2) = utoi(u); } else gel(z,2) = gerepileuptoint((pari_sp)z, remii(mulii(x, Fp_inv(y,X)), X) ); gel(z,1) = icopy(X); return z; } /*******************************************************************/ /* */ /* REDUCTION to IRREDUCIBLE TERMS (t_FRAC/t_RFRAC) */ /* */ /* (static routines are not memory clean, but OK for gerepileupto) */ /*******************************************************************/ /* d a t_POL, n a coprime t_POL of same var or "scalar". Not memory clean */ GEN gred_rfrac_simple(GEN n, GEN d) { GEN c, cn, cd, z; cd = content(d); cn = (typ(n) == t_POL && varn(n) == varn(d))? content(n): n; if (!gcmp1(cd)) { d = RgX_Rg_div(d,cd); if (!gcmp1(cn)) { if (gcmp0(cn)) { n = (cn != n)? RgX_Rg_div(n,cd): gdiv(n, cd); c = gen_1; } else { n = (cn != n)? RgX_Rg_div(n,cn): gen_1; c = gdiv(cn,cd); } } else c = ginv(cd); } else { if (!gcmp1(cn)) { if (gcmp0(cn)) { c = gen_1; } else { n = (cn != n)? RgX_Rg_div(n,cn): gen_1; c = cn; } } else { GEN y = cgetg(3,t_RFRAC); gel(y,1) = gcopy(n); gel(y,2) = gcopy(d); return y; } } if (typ(c) == t_POL) { z = c; do { z = content(z); } while (typ(z) == t_POL); cd = denom(z); cn = gmul(c, cd); } else { cn = numer(c); cd = denom(c); } z = cgetg(3,t_RFRAC); gel(z,1) = gmul(n, cn); gel(z,2) = gmul(d, cd); return z; } static GEN fix_rfrac(GEN x, long d) { GEN z, N, D; if (!d) return x; z = cgetg(3, t_RFRAC); N = gel(x,1); D = gel(x,2); if (d > 0) { gel(z, 1) = (typ(N)==t_POL && varn(N)==varn(D))? RgX_shift(N,d) : monomialcopy(N,d,varn(D)); gel(z, 2) = gcopy(D); } else { gel(z, 1) = gcopy(N); gel(z, 2) = RgX_shift(D, -d); } return z; } /* assume d != 0 */ static GEN gred_rfrac2_i(GEN n, GEN d) { GEN y, z; long tn, td, v; n = simplify_i(n); if (isexactzero(n)) return gcopy(n); d = simplify_i(d); tn = typ(n); td = typ(d); if (td!=t_POL) { if (tn!=t_POL) return gdiv(n,d); if (varncmp(gvar2(d), varn(n)) > 0) return RgX_Rg_div(n,d); pari_err(talker,"incompatible variables in gred"); } if (tn!=t_POL) { if (varncmp(varn(d), gvar2(n)) < 0) return gred_rfrac_simple(n,d); pari_err(talker,"incompatible variables in gred"); } if (varncmp(varn(d), varn(n)) < 0) return gred_rfrac_simple(n,d); if (varncmp(varn(d), varn(n)) > 0) return RgX_Rg_div(n,d); /* now n and d are t_POLs in the same variable */ v = polvaluation(n, &n) - polvaluation(d, &d); if (!degpol(d)) { n = RgX_Rg_div(n,gel(d,2)); return v? RgX_mulXn(n,v): n; } /* X does not divide gcd(n,d), deg(d) > 0 */ if (!isinexact(n) && !isinexact(d)) { y = RgX_divrem(n, d, &z); if (!signe(z)) return v? RgX_mulXn(y, v): y; z = srgcd(d, z); if (degpol(z)) { n = gdeuc(n,z); d = gdeuc(d,z); } } return fix_rfrac(gred_rfrac_simple(n,d), v); } GEN gred_rfrac2(GEN x1, GEN x2) { pari_sp av = avma; return gerepileupto(av, gred_rfrac2_i(x1, x2)); } /* x1,x2 t_INT, return x1/x2 in reduced form */ GEN gred_frac2(GEN x1, GEN x2) { GEN p1, y = dvmdii(x1,x2,&p1); pari_sp av; if (p1 == gen_0) return y; /* gen_0 intended */ av = avma; p1 = gcdii(x2,p1); if (is_pm1(p1)) { avma = av; y = cgetg(3,t_FRAC); gel(y,1) = icopy(x1); gel(y,2) = icopy(x2); } else { p1 = gclone(p1); avma = av; y = cgetg(3,t_FRAC); gel(y,1) = diviiexact(x1,p1); gel(y,2) = diviiexact(x2,p1); gunclone(p1); } fix_frac(y); return y; } /********************************************************************/ /** **/ /** SUBTRACTION **/ /** **/ /********************************************************************/ GEN gsub(GEN x, GEN y) { pari_sp tetpil, av = avma; y = gneg_i(y); tetpil = avma; return gerepile(av,tetpil, gadd(x,y)); } /********************************************************************/ /** **/ /** ADDITION **/ /** **/ /********************************************************************/ /* x, y compatible PADIC */ static GEN addpp(GEN x, GEN y) { pari_sp av = avma; long c,d,e,r,rx,ry; GEN u, z, mod, p = gel(x,2); (void)new_chunk(5 + lgefint(x[3]) + lgefint(y[3])); e = valp(x); r = valp(y); d = r-e; if (d < 0) { swap(x,y); e = r; d = -d; } rx = precp(x); ry = precp(y); if (d) /* v(x) < v(y) */ { r = d+ry; z = powiu(p,d); if (r < rx) mod = mulii(z,gel(y,3)); else { r = rx; mod = gel(x,3); } u = addii(gel(x,4), mulii(z,gel(y,4))); u = remii(u, mod); } else { if (ry < rx) { r=ry; mod = gel(y,3); } else { r=rx; mod = gel(x,3); } u = addii(gel(x,4), gel(y,4)); if (!signe(u) || (c = Z_pvalrem(u,p,&u)) >= r) { avma = av; return zeropadic(p, e+r); } if (c) { mod = diviiexact(mod, powiu(p,c)); r -= c; e += c; } u = remii(u, mod); } avma = av; z = cgetg(5,t_PADIC); z[1] = evalprecp(r) | evalvalp(e); gel(z,2) = icopy(p); gel(z,3) = icopy(mod); gel(z,4) = icopy(u); return z; } /* return x + y, where x is t_INT or t_FRAC(N), y t_PADIC */ static GEN addQp(GEN x, GEN y) { pari_sp av; long tx,vy,py,d,r,e; GEN z,q,p,p1,p2,mod,u; if (gcmp0(x)) return gcopy(y); av = avma; p = gel(y,2); tx = typ(x); e = (tx == t_INT)? Z_pvalrem(x,p,&p1) : Z_pvalrem(gel(x,1),p,&p1) - Z_pvalrem(gel(x,2),p,&p2); vy = valp(y); d = vy - e; py = precp(y); r = d + py; if (r <= 0) { avma = av; return gcopy(y); } mod = gel(y,3); u = gel(y,4); (void)new_chunk(5 + ((lgefint(mod) + lgefint(p)*labs(d)) << 1)); if (d > 0) { q = powiu(p,d); mod = mulii(mod, q); u = mulii(u, q); if (tx != t_INT && !is_pm1(p2)) p1 = mulii(p1, Fp_inv(p2,mod)); u = addii(u, p1); } else if (d < 0) { q = powiu(p,-d); if (tx != t_INT && !is_pm1(p2)) p1 = mulii(p1, Fp_inv(p2,mod)); p1 = mulii(p1, q); u = addii(u, p1); r = py; e = vy; } else { long c; if (tx != t_INT && !is_pm1(p2)) p1 = mulii(p1, Fp_inv(p2,mod)); u = addii(u, p1); if (!signe(u) || (c = Z_pvalrem(u,p,&u)) >= r) { avma = av; return zeropadic(p,e+r); } if (c) { mod = diviiexact(mod, powiu(p,c)); r -= c; e += c; } } u = modii(u, mod); avma = av; z = cgetg(5,t_PADIC); z[1] = evalprecp(r) | evalvalp(e); gel(z,2) = icopy(p); gel(z,3) = icopy(mod); gel(z,4) = icopy(u); return z; } /* Mod(x,X) + Mod(y,X) */ #define add_polmod_same add_polmod_scal /* Mod(x,X) + Mod(y,Y) */ static GEN add_polmod(GEN X, GEN Y, GEN x, GEN y) { long T[3] = { evaltyp(t_POLMOD) | _evallg(3),0,0 }; GEN z = cgetg(3,t_POLMOD); long vx = varn(X), vy = varn(Y); if (vx==vy) { pari_sp av; gel(z,1) = srgcd(X,Y); av = avma; gel(z,2) = gerepileupto(av, gmod(gadd(x, y), gel(z,1))); return z; } if (varncmp(vx, vy) < 0) { gel(z,1) = gcopy(X); gel(T,1) = Y; gel(T,2) = y; y = T; } else { gel(z,1) = gcopy(Y); gel(T,1) = X; gel(T,2) = x; x = T; } gel(z,2) = gadd(x, y); return z; } /* Mod(y, Y) + x, assuming x scalar or polynomial in same var and reduced degree */ static GEN add_polmod_scal(GEN Y, GEN y, GEN x) { GEN z = cgetg(3,t_POLMOD); gel(z,1) = gcopy(Y); gel(z,2) = gadd(x, y); return z; } /* check y[a..b-1] and set signe to 1 if one coeff is non-0, 0 otherwise * For t_POL and t_SER */ static GEN NORMALIZE_i(GEN y, long a, long b) { long i; for (i = a; i < b; i++) if (!gcmp0(gel(y,i))) { setsigne(y, 1); return y; } setsigne(y, 0); return y; } /* typ(y) == t_POL, varn(y) = vy, x "scalar" [e.g object in lower variable] */ static GEN add_pol_scal(GEN y, GEN x, long vy) { long i, ly = lg(y); GEN z; if (ly <= 3) { if (ly == 2) return isexactzero(x)? zeropol(vy): scalarpol(x,vy); z = cgetg(3, t_POL); z[1] = y[1]; gel(z,2) = gadd(x,gel(y,2)); if (gcmp0(gel(z,2))) { if (isexactzero(gel(z,2))) { avma = (pari_sp)(z+3); return zeropol(vy); } setsigne(z, 0); } return z; } z = cgetg(ly,t_POL); z[1] = y[1]; gel(z,2) = gadd(x,gel(y,2)); for (i = 3; i < ly; i++) gel(z,i) = gcopy(gel(y,i)); return NORMALIZE_i(z, 2, ly); } /* typ(y) == t_SER, varn(y) = vy, x "scalar" [e.g object in lower variable] * l = valp(y) */ static GEN add_ser_scal(GEN y, GEN x, long vy, long l) { long i, j, ly; pari_sp av; GEN z; if (isexactzero(x)) return gcopy(y); ly = lg(y); if (l < 3-ly) return gcopy(y); if (l < 0) { z = cgetg(ly,t_SER); z[1] = y[1]; for (i = 2; i <= 1-l; i++) gel(z,i) = gcopy(gel(y,i)); gel(z,i) = gadd(x,gel(y,i)); i++; for ( ; i < ly; i++) gel(z,i) = gcopy(gel(y,i)); return NORMALIZE_i(z, 2, ly); } if (l > 0) { ly += l; y -= l; z = cgetg(ly,t_SER); z[1] = evalsigne(1) | evalvalp(0) | evalvarn(vy); gel(z,2) = gcopy(x); for (i=3; i<=l+1; i++) gel(z,i) = gen_0; for ( ; i < ly; i++) gel(z,i) = gcopy(gel(y,i)); if (gcmp0(x)) return NORMALIZE_i(z, l+2, ly); return z; } /* l = 0, !isexactzero(x) */ if (ly==2) return zeroser(vy, 0); /* 1 + O(1) --> O(1) */ av = avma; z = cgetg(ly,t_SER); x = gadd(x, gel(y,2)); if (!isexactzero(x)) { z[1] = evalsigne(1) | evalvalp(0) | evalvarn(vy); gel(z,2) = x; for (i=3; i lx-2) return gcopy(x); z = cgetg(ly,t_SER); for (i=2; i<=l+1; i++) gel(z,i) = gcopy(gel(x,i)); for ( ; i < ly; i++) gel(z,i) = gadd(gel(x,i),gel(y,i-l)); } else { z = cgetg(ly,t_SER); for (i=2; i < ly; i++) gel(z,i) = gadd(gel(x,i),gel(y,i)); } z[1] = x[1]; return normalize(z); case t_RFRAC: vx = gvar(x); vy = gvar(y); if (vx != vy) { if (varncmp(vx, vy) < 0) return add_rfrac_scal(x, y); else return add_rfrac_scal(y, x); } return add_rfrac(x,y); case t_VEC: case t_COL: case t_MAT: ly = lg(y); if (ly != lg(x)) pari_err(operi,"+",x,y); z = cgetg(ly, ty); for (i = 1; i < ly; i++) gel(z,i) = gadd(gel(x,i),gel(y,i)); return z; default: pari_err(operf,"+",x,y); } /* tx != ty */ if (tx > ty) { swap(x,y); lswap(tx,ty); } if (is_const_t(ty)) switch(tx) /* tx < ty, is_const_t(tx) && is_const_t(ty) */ { case t_INT: switch(ty) { case t_REAL: return addir(x,y); case t_INTMOD: z = cgetg(3, t_INTMOD); return add_intmod_same(z, gel(y,1), gel(y,2), modii(x, gel(y,1))); case t_FRAC: z = cgetg(3,t_FRAC); gel(z,1) = gerepileuptoint((pari_sp)z, addii(gel(y,1), mulii(gel(y,2),x))); gel(z,2) = icopy(gel(y,2)); return z; case t_COMPLEX: return addRc(x, y); case t_PADIC: return addQp(x,y); case t_QUAD: return addRq(x, y); } case t_REAL: switch(ty) { case t_FRAC: if (!signe(y[1])) return rcopy(x); if (!signe(x)) { lx = expi(gel(y,1)) - expi(gel(y,2)) - expo(x); return lx <= 0? rcopy(x): fractor(y, nbits2prec(lx)); } av=avma; z=addir(gel(y,1),mulir(gel(y,2),x)); tetpil=avma; return gerepile(av,tetpil,divri(z,gel(y,2))); case t_COMPLEX: return addRc(x, y); case t_QUAD: return gcmp0(y)? rcopy(x): addqf(y, x, lg(x)); default: pari_err(operf,"+",x,y); } case t_INTMOD: switch(ty) { case t_FRAC: { GEN X = gel(x,1); z = cgetg(3, t_INTMOD); p1 = modii(mulii(gel(y,1), Fp_inv(gel(y,2),X)), X); return add_intmod_same(z, X, p1, gel(x,2)); } case t_COMPLEX: return addRc(x, y); case t_PADIC: { GEN X = gel(x,1); z = cgetg(3, t_INTMOD); return add_intmod_same(z, X, gel(x,2), padic_to_Fp(y, X)); } case t_QUAD: return addRq(x, y); } case t_FRAC: switch (ty) { case t_COMPLEX: return addRc(x, y); case t_PADIC: return addQp(x,y); case t_QUAD: return addRq(x, y); } case t_COMPLEX: switch(ty) { case t_PADIC: return Zp_nosquare_m1(gel(y,2))? addRc(y, x): addTp(x, y); case t_QUAD: lx = precision(x); if (!lx) pari_err(operi,"+",x,y); return gcmp0(y)? rcopy(x): addqf(y, x, lx); } case t_PADIC: /* ty == t_QUAD */ return (kro_quad(gel(y,1),gel(x,2)) == -1)? addRq(x, y): addTp(y, x); } /* tx < ty, !is_const_t(y) */ if (ty == t_MAT) { if (is_matvec_t(tx)) pari_err(operf,"+",x,y); if (isexactzero(x)) return gcopy(y); return gaddmat(x,y); } if (ty == t_POLMOD) /* is_const_t(tx) in this case */ return add_polmod_scal(gel(y,1), gel(y,2), x); vy = gvar(y); if (is_scalar_t(tx)) { if (tx == t_POLMOD) { vx = varn(x[1]); if (vx == vy) y = gmod(y, gel(x,1)); /* error if ty == t_SER */ else if (varncmp(vx,vy) > 0) return add_scal(y, x, ty, vy); return add_polmod_scal(gel(x,1), gel(x,2), y); } return add_scal(y, x, ty, vy); } /* x and y are not scalars, ty != t_MAT */ vx = gvar(x); if (vx != vy) { /* x or y is treated as a scalar */ if (is_vec_t(tx) || is_vec_t(ty)) pari_err(operf,"+",x,y); return (varncmp(vx, vy) < 0)? add_scal(x, y, tx, vx) : add_scal(y, x, ty, vy); } /* vx = vy */ switch(tx) { case t_POL: switch (ty) { case t_SER: if (lg(x) == 2) return gcopy(y); i = lg(y) + valp(y) - polvaluation(x, NULL); if (i < 3) return gcopy(y); p1 = greffe(x,i,0); y = gadd(p1,y); free(p1); return y; case t_RFRAC: return add_rfrac_scal(y, x); } break; case t_SER: if (ty == t_RFRAC) { GEN n, d; long vn, vd; n = gel(y,1); vn = gval(n, vy); d = gel(y,2); vd = polvaluation(d, &d); l = lg(x) + valp(x) - (vn - vd); if (l < 3) return gcopy(x); av = avma; /* take advantage of y = t^n ! */ if (degpol(d)) { y = gdiv(n, greffe(d,l,1)); } else { y = gdiv(n, gel(d,2)); if (gvar(y) == vy) y = greffe(y,l,1); else y = scalarser(y, vy, l); } setvalp(y, valp(y) - vd); return gerepileupto(av, gadd(y, x)); } break; } pari_err(operf,"+",x,y); return NULL; /* not reached */ } GEN gaddsg(long x, GEN y) { long ty = typ(y); GEN z; switch(ty) { case t_INT: return addsi(x,y); case t_REAL: return addsr(x,y); case t_INTMOD: z = cgetg(3, t_INTMOD); return add_intmod_same(z, gel(y,1), gel(y,2), modsi(x, gel(y,1))); case t_FRAC: z = cgetg(3,t_FRAC); gel(z,1) = gerepileuptoint((pari_sp)z, addii(gel(y,1), mulis(gel(y,2),x))); gel(z,2) = icopy(gel(y,2)); return z; case t_COMPLEX: z = cgetg(3, t_COMPLEX); gel(z,1) = gaddsg(x, gel(y,1)); gel(z,2) = gcopy(gel(y,2)); return z; default: return gadd(stoi(x), y); } } /********************************************************************/ /** **/ /** MULTIPLICATION **/ /** **/ /********************************************************************/ static GEN mul_ser_scal(GEN y, GEN x) { long ly, i; GEN z; if (isexactzero(x)) { long vy = varn(y); return zeropol(vy); } ly = lg(y); z = cgetg(ly,t_SER); z[1] = y[1]; for (i = 2; i < ly; i++) gel(z,i) = gmul(x,gel(y,i)); return normalize(z); } /* (n/d) * x, x "scalar" or polynomial in the same variable as d * [n/d a valid RFRAC] */ static GEN mul_rfrac_scal(GEN n, GEN d, GEN x) { pari_sp av = avma; GEN z = gred_rfrac2_i(x, d); n = simplify_i(n); if (typ(z) == t_RFRAC) z = gred_rfrac_simple(gmul(gel(z,1), n), gel(z,2)); else z = gmul(z, n); return gerepileupto(av, z); } static GEN mul_scal(GEN y, GEN x, long ty) { switch(ty) { case t_POL: return RgX_Rg_mul(y, x); case t_SER: return mul_ser_scal(y, x); case t_RFRAC: return mul_rfrac_scal(gel(y,1),gel(y,2), x); case t_QFI: case t_QFR: if (typ(x) == t_INT && gcmp1(x)) return gcopy(y); /* fall through */ } pari_err(operf,"*",x,y); return NULL; /* not reached */ } static GEN mul_gen_rfrac(GEN X, GEN Y) { GEN y1 = gel(Y,1), y2 = gel(Y,2); long vx = gvar(X), vy = varn(y2); return (varncmp(vx, vy) <= 0)? mul_scal(Y, X, typ(Y)): gred_rfrac_simple(gmul(y1,X), y2); } /* (x1/x2) * (y1/y2) */ static GEN mul_rfrac(GEN x1, GEN x2, GEN y1, GEN y2) { GEN z, X, Y; pari_sp av = avma; X = gred_rfrac2_i(x1, y2); Y = gred_rfrac2_i(y1, x2); if (typ(X) == t_RFRAC) { if (typ(Y) == t_RFRAC) { x1 = gel(X,1); x2 = gel(X,2); y1 = gel(Y,1); y2 = gel(Y,2); z = gred_rfrac_simple(gmul(x1,y1), gmul(x2,y2)); } else z = mul_gen_rfrac(Y, X); } else if (typ(Y) == t_RFRAC) z = mul_gen_rfrac(X, Y); else z = gmul(X, Y); return gerepileupto(av, z); } /* (x1/x2) /y2 */ static GEN div_rfrac_pol(GEN x1, GEN x2, GEN y2) { GEN z, X; pari_sp av = avma; X = gred_rfrac2_i(x1, y2); if (typ(X) == t_RFRAC) z = gred_rfrac_simple(gel(X,1), gmul(gel(X,2),x2)); else z = mul_gen_rfrac(X, mkrfrac(gen_1, x2)); return gerepileupto(av, z); } /* Mod(y, Y) * x, assuming x scalar */ static GEN mul_polmod_scal(GEN Y, GEN y, GEN x) { GEN z = cgetg(3,t_POLMOD); gel(z,1) = gcopy(Y); gel(z,2) = gmul(x,y); return z; } /* Mod(x,X) * Mod(y,X) */ static GEN mul_polmod_same(GEN X, GEN x, GEN y) { GEN t, z = cgetg(3,t_POLMOD); pari_sp av; long v; gel(z,1) = gcopy(X); av = avma; t = gmul(x, y); /* gmod(t, gel(z,1))) optimised */ if (typ(t) == t_POL && (v = varn(X)) == varn(t) && lg(t) >= lg(X)) gel(z,2) = gerepileupto(av, RgX_divrem(t, X, ONLY_REM)); else gel(z,2) = t; return z; } /* Mod(x,X) * Mod(y,Y) */ static GEN mul_polmod(GEN X, GEN Y, GEN x, GEN y) { long T[3] = { evaltyp(t_POLMOD) | _evallg(3),0,0 }; long vx = varn(X), vy = varn(Y); GEN z = cgetg(3,t_POLMOD); pari_sp av; if (vx==vy) { gel(z,1) = srgcd(X,Y); av = avma; gel(z,2) = gerepileupto(av, gmod(gmul(x, y), gel(z,1))); return z; } if (varncmp(vx, vy) < 0) { gel(z,1) = gcopy(X); gel(T,1) = Y; gel(T,2) = y; y = T; } else { gel(z,1) = gcopy(Y); gel(T,1) = X; gel(T,2) = x; x = T; } gel(z,2) = gmul(x, y); return z; } /* compatible t_VEC * t_COL, l = lg(x) = lg(y) */ static GEN VC_mul(GEN x, GEN y, long l) { pari_sp av = avma; GEN z = gen_0; long i; for (i=1; i1? lg(x[1]): 1 */ static GEN MC_mul(GEN x, GEN y, long l, long lz) { GEN z = cgetg(lz,t_COL); long i, j; for (i=1; i precp(y))? y: x; z = cgetp(t); setvalp(z,l); av = avma; affii(remii(mulii(gel(x,4),gel(y,4)), gel(t,3)), gel(z,4)); avma = av; return z; } /* x,y QUAD */ static GEN mulqq(GEN x, GEN y) { GEN p1,p2,p3,p4, z = cgetg(4,t_QUAD); pari_sp av, tetpil; p1 = gel(x,1); if (!gequal(p1, gel(y,1))) pari_err(operi,"*",x,y); gel(z,1) = gcopy(p1); av = avma; p2 = gmul(gel(x,2),gel(y,2)); p3 = gmul(gel(x,3),gel(y,3)); p4 = gmul(gneg_i(gel(p1,2)),p3); if (gcmp0(gel(p1,3))) { tetpil = avma; gel(z,2) = gerepile(av,tetpil,gadd(p4,p2)); av = avma; p2 = gmul(gel(x,2),gel(y,3)); p3 = gmul(gel(x,3),gel(y,2)); tetpil = avma; gel(z,3) = gerepile(av,tetpil,gadd(p2,p3)); return z; } p1 = gadd(gmul(gel(x,2),gel(y,3)), gmul(gel(x,3),gel(y,2))); tetpil = avma; gel(z,2) = gadd(p2,p4); gel(z,3) = gadd(p1,p3); gerepilecoeffssp(av,tetpil,z+2,2); return z; } GEN mulcxI(GEN x) { GEN z; if (typ(x) != t_COMPLEX) { z = cgetg(3,t_COMPLEX); gel(z,1) = gen_0; gel(z,2) = x; } else { if (isexactzero(gel(x,1))) return gneg(gel(x,2)); z = cgetg(3,t_COMPLEX); gel(z,1) = gneg(gel(x,2)); z[2] = x[1]; } return z; } GEN mulcxmI(GEN x) { GEN z; if (typ(x) != t_COMPLEX) { z = cgetg(3,t_COMPLEX); gel(z,1) = gen_0; gel(z,2) = gneg(x); } else { if (isexactzero(gel(x,1))) return gel(x,2); z = cgetg(3,t_COMPLEX); z[1] = x[2]; gel(z,2) = gneg(gel(x,1)); } return z; } GEN gmul(GEN x, GEN y) { long tx, ty, lx, ly, vx, vy, i, j, l; pari_sp av, tetpil; GEN z, p1, p2; if (x == y) return gsqr(x); tx = typ(x); ty = typ(y); if (tx == ty) switch(tx) { case t_INT: return mulii(x,y); case t_REAL: return mulrr(x,y); case t_INTMOD: { GEN X = gel(x,1), Y = gel(y,1); z = cgetg(3,t_INTMOD); if (X==Y || equalii(X,Y)) return mul_intmod_same(z, X, gel(x,2), gel(y,2)); gel(z,1) = gcdii(X,Y); av = avma; p1 = mulii(gel(x,2),gel(y,2)); gel(z,2) = gerepileuptoint(av, remii(p1, gel(z,1))); return z; } case t_FRAC: { GEN x1 = gel(x,1), x2 = gel(x,2); GEN y1 = gel(y,1), y2 = gel(y,2); z=cgetg(3,t_FRAC); p1 = gcdii(x1, y2); if (!is_pm1(p1)) { x1 = diviiexact(x1,p1); y2 = diviiexact(y2,p1); } p1 = gcdii(x2, y1); if (!is_pm1(p1)) { x2 = diviiexact(x2,p1); y1 = diviiexact(y1,p1); } tetpil = avma; gel(z,2) = mulii(x2,y2); gel(z,1) = mulii(x1,y1); fix_frac_if_int_GC(z,tetpil); return z; } case t_COMPLEX: return mulcc(x, y); case t_PADIC: return mulpp(x, y); case t_QUAD: return mulqq(x, y); case t_POLMOD: if (gequal(gel(x,1), gel(y,1))) return mul_polmod_same(gel(x,1), gel(x,2), gel(y,2)); return mul_polmod(gel(x,1), gel(y,1), gel(x,2), gel(y,2)); case t_POL: vx = varn(x); vy = varn(y); if (vx != vy) { if (varncmp(vx, vy) < 0) return RgX_Rg_mul(x, y); else return RgX_Rg_mul(y, x); } return RgX_mul(x, y); case t_SER: { long mix, miy; vx = varn(x); vy = varn(y); if (vx != vy) { if (varncmp(vx, vy) < 0) return mul_ser_scal(x, y); else return mul_ser_scal(y, x); } lx = lg(x); if (lx > lg(y)) { lx = lg(y); swap(x, y); } if (lx == 2) return zeroser(vx, valp(x)+valp(y)); z = cgetg(lx,t_SER); z[1] = evalvalp(valp(x)+valp(y)) | evalvarn(vx) | evalsigne(1); if (lx > 200) /* threshold for 32bit coeffs: 400, 512 bits: 100 */ { long ly; y = RgX_mul(ser2pol_i(x, lx), ser2pol_i(y, lx)); ly = lg(y); if (ly >= lx) { for (i = 2; i < lx; i++) z[i] = y[i]; } else { for (i = 2; i < ly; i++) z[i] = y[i]; for ( ; i < lx; i++) gel(z,i) = gen_0; } z = normalize(z); return gerepilecopy((pari_sp)(z + lx), z); } x += 2; y += 2; z += 2; lx -= 3; p2 = (GEN)gpmalloc((lx+1)*sizeof(long)); mix = miy = 0; for (i=0; i<=lx; i++) { p2[i] = !isexactzero(gel(y,i)); if (p2[i]) miy = i; if (!isexactzero(gel(x,i))) mix = i; p1 = gen_0; av = avma; for (j=i-mix; j<=min(i,miy); j++) if (p2[j]) p1 = gadd(p1, gmul(gel(y,j),gel(x,i-j))); gel(z,i) = gerepileupto(av,p1); } z -= 2; /* back to normalcy */ free(p2); return normalize(z); } case t_QFI: return compimag(x,y); case t_QFR: return compreal(x,y); case t_RFRAC: return mul_rfrac(gel(x,1),gel(x,2), gel(y,1),gel(y,2)); case t_MAT: ly = lg(y); if (ly == 1) return cgetg(1,t_MAT); lx = lg(x); if (lx != lg(y[1])) pari_err(operi,"*",x,y); z = cgetg(ly,t_MAT); l = (lx == 1)? 1: lg(x[1]); for (j=1; j= l) pari_err(operf,"*",x,y); z[i] = x[yi]; } return z; default: pari_err(operf,"*",x,y); } /* tx != ty */ if (is_const_t(ty) && is_const_t(tx)) { if (tx > ty) { swap(x,y); lswap(tx,ty); } switch(tx) { case t_INT: switch(ty) { case t_REAL: return mulir(x,y); case t_INTMOD: z = cgetg(3, t_INTMOD); return mul_intmod_same(z, gel(y,1), gel(y,2), modii(x, gel(y,1))); case t_FRAC: if (!signe(x)) return gen_0; z=cgetg(3,t_FRAC); p1 = gcdii(x,gel(y,2)); if (is_pm1(p1)) { avma = (pari_sp)z; gel(z,2) = icopy(gel(y,2)); gel(z,1) = mulii(gel(y,1), x); } else { x = diviiexact(x,p1); tetpil = avma; gel(z,2) = diviiexact(gel(y,2), p1); gel(z,1) = mulii(gel(y,1), x); fix_frac_if_int_GC(z,tetpil); } return z; case t_COMPLEX: return mulRc(x, y); case t_PADIC: return signe(x)? mulTp(x, y): gen_0; case t_QUAD: return mulRq(x,y); } case t_REAL: switch(ty) { case t_FRAC: if (!signe(y[1])) return gen_0; av = avma; return gerepileuptoleaf(av, divri(mulri(x,gel(y,1)), gel(y,2))); case t_COMPLEX: return mulRc(x, y); case t_QUAD: return mulqf(y, x, lg(x)); default: pari_err(operf,"*",x,y); } case t_INTMOD: switch(ty) { case t_FRAC: { GEN X = gel(x,1); z = cgetg(3, t_INTMOD); p1 = modii(mulii(gel(y,1), gel(x,2)), X); return div_intmod_same(z, X, p1, remii(gel(y,2), X)); } case t_COMPLEX: return mulRc(x, y); case t_PADIC: { GEN X = gel(x,1); z = cgetg(3, t_INTMOD); return mul_intmod_same(z, X, gel(x,2), padic_to_Fp(y, X)); } case t_QUAD: return mulRq(x, y); } case t_FRAC: switch(ty) { case t_COMPLEX: return mulRc(x, y); case t_PADIC: return signe(x[1])? mulTp(x, y): gen_0; case t_QUAD: return mulRq(x, y); } case t_COMPLEX: switch(ty) { case t_PADIC: return Zp_nosquare_m1(gel(y,2))? mulRc(y, x): mulTp(x, y); case t_QUAD: lx = precision(x); if (!lx) pari_err(operi,"*",x,y); return mulqf(y, x, lx); } case t_PADIC: /* ty == t_QUAD */ return (kro_quad(gel(y,1),gel(x,2))== -1)? mulRq(x, y): mulTp(y, x); } } if (is_matvec_t(ty)) { ly = lg(y); if (!is_matvec_t(tx)) { if (is_noncalc_t(tx)) pari_err(operf, "*",x,y); /* necessary if ly = 1 */ z = cgetg(ly,ty); for (i=1; i ty) { swap(x,y); lswap(tx,ty); } /* tx < ty, !ismatvec(x and y) */ if (ty == t_POLMOD) /* is_const_t(tx) in this case */ return mul_polmod_scal(gel(y,1), gel(y,2), x); if is_scalar_t(tx) { if (tx == t_POLMOD) { vx = varn(x[1]); vy = gvar(y); if (vx != vy) { if (varncmp(vx,vy) > 0) return mul_scal(y, x, ty); return mul_polmod_scal(gel(x,1), gel(x,2), y); } /* error if ty == t_SER */ av = avma; y = gmod(y, gel(x,1)); return gerepileupto(av, mul_polmod_same(gel(x,1), gel(x,2), y)); } return mul_scal(y, x, ty); } /* x and y are not scalars, nor matvec */ vx = gvar(x); vy = gvar(y); if (vx != vy) { /* x or y is treated as a scalar */ return (varncmp(vx, vy) < 0)? mul_scal(x, y, tx) : mul_scal(y, x, ty); } /* vx = vy */ switch(tx) { case t_POL: switch (ty) { case t_SER: { long vn; if (lg(x) == 2) return zeropol(vx); if (lg(y) == 2) return zeroser(vx, valp(y)+polvaluation(x,NULL)); av = avma; vn = polvaluation(x, &x); avma = av; /* take advantage of x = t^n ! */ if (degpol(x)) { p1 = greffe(x,lg(y),0); p2 = gmul(p1,y); free(p1); } else p2 = mul_ser_scal(y, gel(x,2)); setvalp(p2, valp(p2) + vn); return p2; } case t_RFRAC: return mul_rfrac_scal(gel(y,1),gel(y,2), x); } break; case t_SER: switch (ty) { case t_RFRAC: av = avma; return gerepileupto(av, gdiv(gmul(gel(y,1),x), gel(y,2))); } break; } pari_err(operf,"*",x,y); return NULL; /* not reached */ } int ff_poltype(GEN *x, GEN *p, GEN *pol) { GEN Q, P = *x, pr,p1,p2,y; long i, lx; if (!signe(P)) return 0; lx = lg(P); Q = *pol; for (i=2; i 2) pari_warn(warner,"different pointers in ff_poltype"); } } if (Q) { *x = P = to_Kronecker(P, Q); *pol = Q; lx = lg(P); } pr = *p; y = cgetg(lx, t_POL); for (i=lx-1; i>1; i--) { p1 = gel(P,i); switch(typ(p1)) { case t_INTMOD: break; case t_INT: if (*p) p1 = modii(p1, *p); gel(y,i) = p1; continue; default: return (Q && !pr)? 1: 0; } p2 = gel(p1,1); if (pr==NULL) pr = p2; else if (p2 != pr) { if (!equalii(p2, pr)) { if (DEBUGMEM) pari_warn(warner,"different modulus in ff_poltype"); return 0; } if (DEBUGMEM > 2) pari_warn(warner,"different pointers in ff_poltype"); } y[i] = p1[2]; } y[1] = P[1]; *x = y; *p = pr; return (Q || pr); } GEN gsqr(GEN x) { long tx=typ(x), lx, i, j, l; pari_sp av, tetpil; GEN z, p1, p2, p3, p4; if (is_scalar_t(tx)) switch(tx) { case t_INT: return sqri(x); case t_REAL: return mulrr(x,x); case t_INTMOD: { GEN X = gel(x,1); z = cgetg(3,t_INTMOD); gel(z,2) = gerepileuptoint((pari_sp)z, remii(sqri(gel(x,2)), X)); gel(z,1) = icopy(X); return z; } case t_FRAC: z=cgetg(3,t_FRAC); gel(z,1) = sqri(gel(x,1)); gel(z,2) = sqri(gel(x,2)); return z; case t_COMPLEX: if (isexactzero(gel(x,1))) { av = avma; return gerepileupto(av, gneg(gsqr(gel(x,2)))); } z = cgetg(3,t_COMPLEX); av = avma; p1 = gadd(gel(x,1),gel(x,2)); p2 = gadd(gel(x,1), gneg_i(gel(x,2))); p3 = gmul(gel(x,1),gel(x,2)); tetpil = avma; gel(z,1) = gmul(p1,p2); gel(z,2) = gshift(p3,1); gerepilecoeffssp(av,tetpil,z+1,2); return z; case t_PADIC: z = cgetg(5,t_PADIC); i = (equaliu(gel(x,2), 2) && signe(x[4]))? 1: 0; if (i && precp(x) == 1) i = 2; /* (1 + O(2))^2 = 1 + O(2^3) */ z[1] = evalprecp(precp(x)+i) | evalvalp(valp(x) << 1); gel(z,2) = icopy(gel(x,2)); gel(z,3) = shifti(gel(x,3), i); av = avma; gel(z,4) = gerepileuptoint(av, remii(sqri(gel(x,4)), gel(z,3))); return z; case t_QUAD: z = cgetg(4,t_QUAD); p1 = gel(x,1); gel(z,1) = gcopy(p1); av = avma; p2 = gsqr(gel(x,2)); p3 = gsqr(gel(x,3)); p4 = gmul(gneg_i(gel(p1,2)),p3); if (gcmp0(gel(p1,3))) { tetpil = avma; gel(z,2) = gerepile(av,tetpil,gadd(p4,p2)); av = avma; p2 = gmul(gel(x,2),gel(x,3)); tetpil = avma; gel(z,3) = gerepile(av,tetpil,gmul2n(p2,1)); return z; } p1 = gmul2n(gmul(gel(x,2),gel(x,3)), 1); tetpil = avma; gel(z,2) = gadd(p2,p4); gel(z,3) = gadd(p1,p3); gerepilecoeffssp(av,tetpil,z+2,2); return z; case t_POLMOD: z=cgetg(3,t_POLMOD); gel(z,1) = gcopy(gel(x,1)); av=avma; p1=gsqr(gel(x,2)); tetpil=avma; gel(z,2) = gerepile(av,tetpil, grem(p1,gel(z,1))); return z; } switch(tx) { case t_POL: { GEN a = x, p = NULL, pol = NULL; long vx = varn(x); av = avma; if (ff_poltype(&x,&p,&pol)) { z = FpX_sqr(x, p); if (p) z = FpX_to_mod(z,p); if (pol) z = from_Kronecker(z,pol); z = gerepileupto(av, z); } else { avma = av; z = RgX_sqr(a); } setvarn(z, vx); return z; } case t_SER: { long mi; lx = lg(x); if (lx == 2) return zeroser(varn(x), 2*valp(x)); z = cgetg(lx, t_SER); z[1] = evalvalp(2*valp(x)) | evalvarn(varn(x)); x += 2; z += 2; lx -= 3; p2 = (GEN)gpmalloc((lx+1)*sizeof(long)); mi = 0; for (i=0; i<=lx; i++) { p2[i] = !isexactzero(gel(x,i)); if (p2[i]) mi = i; p1=gen_0; av=avma; l=((i+1)>>1) - 1; for (j=i-mi; j<=min(l,mi); j++) if (p2[j] && p2[i-j]) p1 = gadd(p1, gmul(gel(x,j),gel(x,i-j))); p1 = gshift(p1,1); if ((i&1) == 0 && p2[i>>1]) p1 = gadd(p1, gsqr((GEN)x[i>>1])); gel(z,i) = gerepileupto(av,p1); } z -= 2; free(p2); return normalize(z); } case t_RFRAC: z = cgetg(3,t_RFRAC); gel(z,1) = gsqr(gel(x,1)); gel(z,2) = gsqr(gel(x,2)); return z; case t_MAT: lx = lg(x); if (lx!=1 && lx != lg(x[1])) pari_err(operi,"*",x,x); z = cgetg(lx, t_MAT); for (j=1; j= l) pari_err(operf,"*",x,x); z[i] = x[xi]; } return z; } pari_err(operf,"*",x,x); return NULL; /* not reached */ } /********************************************************************/ /** **/ /** DIVISION **/ /** **/ /********************************************************************/ static GEN div_rfrac_scal(GEN x, GEN y) { pari_sp av = avma; return gerepileupto(av, gred_rfrac_simple(gel(x,1),gmul(y, gel(x,2)))); } static GEN div_scal_rfrac(GEN x, GEN y) { GEN y1 = gel(y,1), y2 = gel(y,2); pari_sp av = avma; if (typ(y1) == t_POL && varn(y2) == varn(y1) && degpol(y1) > 0) return gerepileupto(av, gred_rfrac_simple(gmul(x, y2), y1)); return RgX_Rg_mul(y2, gdiv(x,y1)); } static GEN div_rfrac(GEN x, GEN y) { return mul_rfrac(gel(x,1),gel(x,2), gel(y,2),gel(y,1)); } static GEN div_ser_scal(GEN x, GEN y) { long i, lx = lg(x); GEN z = cgetg_copy(lx, x); z[1] = x[1]; for (i=2; i b) { M = gel(y,3); } else { M = gel(x,3); b = a; } z = cgetg(5, t_PADIC); z[1] = evalprecp(b) | evalvalp(valp(x) - valp(y)); gel(z,2) = icopy(gel(x,2)); gel(z,3) = icopy(M); av = avma; gel(z,4) = gerepileuptoint(av, remii(mulii(gel(x,4), Fp_inv(gel(y,4), M)), M) ); return z; } GEN gdiv(GEN x, GEN y) { long tx = typ(x), ty = typ(y), lx, ly, vx, vy, i; pari_sp av, tetpil; GEN z, p1, p2; if (tx == ty) switch(tx) { case t_INT: if (is_pm1(y)) return (signe(y) < 0)? negi(x): icopy(x); if (is_pm1(x)) { long s = signe(y); if (!s) pari_err(gdiver); if (signe(x) < 0) s = -s; z = cgetg(3, t_FRAC); gel(z,1) = s<0? gen_m1: gen_1; gel(z,2) = absi(y); return z; } return gred_frac2(x,y); case t_REAL: return divrr(x,y); case t_INTMOD: { GEN X = gel(x,1), Y = gel(y,1); z = cgetg(3,t_INTMOD); if (X==Y || equalii(X,Y)) return div_intmod_same(z, X, gel(x,2), gel(y,2)); gel(z,1) = gcdii(X,Y); av = avma; p1 = mulii(gel(x,2), Fp_inv(gel(y,2), gel(z,1))); gel(z,2) = gerepileuptoint(av, remii(p1, gel(z,1))); return z; } case t_FRAC: { GEN x1 = gel(x,1), x2 = gel(x,2); GEN y1 = gel(y,1), y2 = gel(y,2); z = cgetg(3, t_FRAC); p1 = gcdii(x1, y1); if (!is_pm1(p1)) { x1 = diviiexact(x1,p1); y1 = diviiexact(y1,p1); } p1 = gcdii(x2, y2); if (!is_pm1(p1)) { x2 = diviiexact(x2,p1); y2 = diviiexact(y2,p1); } tetpil = avma; gel(z,2) = mulii(x2,y1); gel(z,1) = mulii(x1,y2); fix_frac(z); fix_frac_if_int_GC(z,tetpil); return z; } case t_COMPLEX: av=avma; p1 = cxnorm(y); p2 = mulcc(x, gconj(y)); tetpil = avma; return gerepile(av, tetpil, gdiv(p2,p1)); case t_PADIC: if (!equalii(gel(x,2),gel(y,2))) pari_err(operi,"/",x,y); return divpp(x, y); case t_QUAD: if (!gequal(gel(x,1),gel(y,1))) pari_err(operi,"/",x,y); av = avma; p1 = quadnorm(y); p2 = mulqq(x, gconj(y)); tetpil = avma; return gerepile(av, tetpil, gdiv(p2,p1)); case t_POLMOD: av = avma; if (gequal(gel(x,1), gel(y,1))) { GEN X = gel(x,1); x = gel(x,2); y = gel(y,2); if (degpol(X) == 2) { /* optimized for speed */ z = mul_polmod_same(X, x, quad_polmod_conj(y, X)); return gdiv(z, quad_polmod_norm(y, X)); } y = ginvmod(y, X); z = mul_polmod_same(X, x, y); } else z = gmul(x, ginv(y)); return gerepileupto(av, z); case t_POL: vx = varn(x); vy = varn(y); if (vx != vy) { if (varncmp(vx, vy) < 0) return RgX_Rg_div(x, y); else return div_scal_pol(x, y); } if (!signe(y)) pari_err(gdiver); if (lg(y) == 3) return RgX_Rg_div(x,gel(y,2)); if (isexactzero(x)) return zeropol(vy); return gred_rfrac2(x,y); case t_SER: vx = varn(x); vy = varn(y); if (vx != vy) { if (varncmp(vx, vy) < 0) return div_ser_scal(x, y); else return div_scal_ser(x, y); } return div_ser(x, y, vx); case t_RFRAC: vx = gvar(x); vy = gvar(y); if (vx != vy) { if (varncmp(vx, vy) < 0) return div_rfrac_scal(x, y); else return div_scal_rfrac(x, y); } return div_rfrac(x,y); case t_QFI: av = avma; return gerepileupto(av, compimag(x, ginv(y))); case t_QFR: av = avma; return gerepileupto(av, compreal(x, ginv(y))); case t_MAT: av = avma; return gerepileupto(av, gmul(x, invmat(y))); default: pari_err(operf,"/",x,y); } if (tx==t_INT && is_const_t(ty)) /* optimized for speed */ { long s = signe(x); if (!s) { if (gcmp0(y)) pari_err(gdiver); if (ty != t_INTMOD) return gen_0; z = cgetg(3,t_INTMOD); gel(z,1) = icopy(gel(y,1)); gel(z,2) = gen_0; return z; } if (is_pm1(x)) { if (s > 0) return ginv(y); av = avma; return gerepileupto(av, ginv(gneg(y))); } switch(ty) { case t_REAL: return divir(x,y); case t_INTMOD: z = cgetg(3, t_INTMOD); return div_intmod_same(z, gel(y,1), modii(x, gel(y,1)), gel(y,2)); case t_FRAC: z = cgetg(3,t_FRAC); p1 = gcdii(x,gel(y,1)); if (is_pm1(p1)) { avma = (pari_sp)z; gel(z,2) = icopy(gel(y,1)); gel(z,1) = mulii(gel(y,2), x); fix_frac(z); fix_frac_if_int(z); } else { x = diviiexact(x,p1); tetpil = avma; gel(z,2) = diviiexact(gel(y,1), p1); gel(z,1) = mulii(gel(y,2), x); fix_frac(z); fix_frac_if_int_GC(z,tetpil); } return z; case t_COMPLEX: return divRc(x,y); case t_PADIC: return divTp(x, y); case t_QUAD: av = avma; p1 = quadnorm(y); p2 = mulRq(x, gconj(y)); tetpil = avma; return gerepile(av, tetpil, gdiv(p2,p1)); } } if (gcmp0(y) && ty != t_MAT) pari_err(gdiver); if (is_const_t(tx) && is_const_t(ty)) switch(tx) { case t_REAL: switch(ty) { case t_INT: return divri(x,y); case t_FRAC: av = avma; z = divri(mulri(x,gel(y,2)), gel(y,1)); return gerepileuptoleaf(av, z); case t_COMPLEX: return divRc(x, y); case t_QUAD: return divfq(x, y, lg(x)); default: pari_err(operf,"/",x,y); } case t_INTMOD: switch(ty) { case t_INT: z = cgetg(3, t_INTMOD); return div_intmod_same(z, gel(x,1), gel(x,2), modii(y, gel(x,1))); case t_FRAC: { GEN X = gel(x,1); z = cgetg(3,t_INTMOD); p1 = remii(mulii(gel(y,2), gel(x,2)), X); return div_intmod_same(z, X, p1, modii(gel(y,1), X)); } case t_COMPLEX: av = avma; p1 = cxnorm(y); p2 = mulRc(x, gconj(y)); tetpil = avma; return gerepile(av,tetpil, gdiv(p2,p1)); case t_QUAD: av = avma; p1 = quadnorm(y); p2 = gmul(x,gconj(y)); tetpil = avma; return gerepile(av,tetpil, gdiv(p2,p1)); case t_PADIC: { GEN X = gel(x,1); z = cgetg(3, t_INTMOD); return div_intmod_same(z, X, gel(x,2), padic_to_Fp(y, X)); } case t_REAL: pari_err(operf,"/",x,y); } case t_FRAC: switch(ty) { case t_INT: z = cgetg(3, t_FRAC); p1 = gcdii(y,gel(x,1)); if (is_pm1(p1)) { avma = (pari_sp)z; tetpil = 0; gel(z,1) = icopy(gel(x,1)); } else { y = diviiexact(y,p1); tetpil = avma; gel(z,1) = diviiexact(gel(x,1), p1); } gel(z,2) = mulii(gel(x,2),y); fix_frac(z); if (tetpil) fix_frac_if_int_GC(z,tetpil); return z; case t_REAL: av=avma; p1=mulri(y,gel(x,2)); tetpil=avma; return gerepile(av, tetpil, divir(gel(x,1), p1)); case t_INTMOD: { GEN Y = gel(y,1); z = cgetg(3,t_INTMOD); p1 = remii(mulii(gel(y,2),gel(x,2)), Y); return div_intmod_same(z, Y, gel(x,1), p1); } case t_COMPLEX: return divRc(x, y); case t_PADIC: if (!signe(x[1])) return gen_0; return divTp(x, y); case t_QUAD: av=avma; p1=quadnorm(y); p2=gmul(x,gconj(y)); tetpil=avma; return gerepile(av,tetpil,gdiv(p2,p1)); } case t_COMPLEX: switch(ty) { case t_INT: case t_REAL: case t_INTMOD: case t_FRAC: return divcR(x,y); case t_PADIC: return Zp_nosquare_m1(gel(y,2))? divcR(x,y): divTp(x, y); case t_QUAD: lx = precision(x); if (!lx) pari_err(operi,"/",x,y); return divfq(x, y, lx); } case t_PADIC: switch(ty) { case t_INT: case t_FRAC: { GEN p = gel(x,2); return signe(x[4])? divpT(x, y) : zeropadic(p, valp(x) - ggval(y,p)); } case t_INTMOD: { GEN Y = gel(y,1); z = cgetg(3, t_INTMOD); return div_intmod_same(z, Y, padic_to_Fp(x, Y), gel(y,2)); } case t_COMPLEX: case t_QUAD: av=avma; p1=gmul(x,gconj(y)); p2=gnorm(y); tetpil=avma; return gerepile(av,tetpil,gdiv(p1,p2)); case t_REAL: pari_err(operf,"/",x,y); } case t_QUAD: switch (ty) { case t_INT: case t_INTMOD: case t_FRAC: z = cgetg(4,t_QUAD); gel(z,1) = gcopy(gel(x,1)); gel(z,2) = gdiv(gel(x,2), y); gel(z,3) = gdiv(gel(x,3), y); return z; case t_REAL: return divqf(x, y, lg(y)); case t_PADIC: return divTp(x, y); case t_COMPLEX: ly = precision(y); if (!ly) pari_err(operi,"/",x,y); return divqf(x, y, ly); } } switch(ty) { case t_REAL: case t_INTMOD: case t_PADIC: case t_POLMOD: return gmul(x, ginv(y)); /* missing gerepile, for speed */ case t_MAT: av = avma; return gerepileupto(av, gmul(x, invmat(y))); } if (is_matvec_t(tx)) { lx = lg(x); z = cgetg_copy(lx, x); for (i=1; i 0) return div_scal_T(x, y, ty); z = cgetg(3,t_POLMOD); gel(z,1) = gcopy(X); gel(z,2) = gdiv(gel(x,2), y); return z; } /* y is POL, SER or RFRAC */ av = avma; y = ginvmod(gmod(y,X), X); return gerepileupto(av, mul_polmod_same(X, gel(x,2), y)); } /* x and y are not both is_scalar_t. If one of them is scalar, it's not a * POLMOD (done already), hence its variable is BIGINT. If the other has * variable BIGINT, then the operation is incorrect */ vx = gvar(x); if (vx != vy) { /* includes cases where one is scalar */ if (varncmp(vx, vy) < 0) return div_T_scal(x, y, tx); else return div_scal_T(x, y, ty); } switch(tx) { case t_POL: switch(ty) { case t_SER: if (lg(y) == 2) return zeroser(vx, polvaluation(x,NULL) - valp(y)); p1 = greffe(x,lg(y),0); p2 = div_ser(p1, y, vx); free(p1); return p2; case t_RFRAC: { GEN y1 = gel(y,1), y2 = gel(y,2); if (typ(y1) == t_POL && varn(y1) == vx) return mul_rfrac_scal(y2, y1, x); av = avma; return gerepileupto(av, RgX_Rg_div(RgX_mul(y2, x), y1)); } } break; case t_SER: switch(ty) { case t_POL: if (lg(x) == 2) return zeroser(vx, valp(x) - polvaluation(y,NULL)); p1 = greffe(y,lg(x),0); p2 = div_ser(x, p1, vx); free(p1); return p2; case t_RFRAC: av = avma; return gerepileupto(av, gdiv(gmul(x,gel(y,2)), gel(y,1))); } break; case t_RFRAC: switch(ty) { case t_POL: return div_rfrac_pol(gel(x,1),gel(x,2), y); case t_SER: av = avma; return gerepileupto(av, gdiv(gel(x,1), gmul(gel(x,2),y))); } break; } pari_err(operf,"/",x,y); return NULL; /* not reached */ } /********************************************************************/ /** **/ /** SIMPLE MULTIPLICATION **/ /** **/ /********************************************************************/ GEN gmulsg(long s, GEN y) { long ty = typ(y), ly, i; pari_sp av; GEN z; switch(ty) { case t_INT: return mulsi(s,y); case t_REAL: return mulsr(s,y); case t_INTMOD: { GEN p = gel(y,1); z = cgetg(3,t_INTMOD); gel(z,2) = gerepileuptoint((pari_sp)z, modii(mulsi(s,gel(y,2)), p)); gel(z,1) = icopy(p); return z; } case t_FRAC: if (!s) return gen_0; z = cgetg(3,t_FRAC); i = cgcd(s, smodis(gel(y,2), s)); if (i == 1) { gel(z,2) = icopy(gel(y,2)); gel(z,1) = mulis(gel(y,1), s); } else { gel(z,2) = divis(gel(y,2), i); gel(z,1) = mulis(gel(y,1), s/i); fix_frac_if_int(z); } return z; case t_COMPLEX: z = cgetg(3, t_COMPLEX); gel(z,1) = gmulsg(s,gel(y,1)); gel(z,2) = gmulsg(s,gel(y,2)); return z; case t_PADIC: if (!s) return gen_0; av = avma; return gerepileupto(av, mulpp(cvtop2(stoi(s),y), y)); case t_QUAD: z = cgetg(4, t_QUAD); gel(z,1) = gcopy(gel(y,1)); gel(z,2) = gmulsg(s,gel(y,2)); gel(z,3) = gmulsg(s,gel(y,3)); return z; case t_POLMOD: z = cgetg(3, t_POLMOD); gel(z,1) = gcopy(gel(y,1)); gel(z,2) = gmulsg(s,gel(y,2)); return z; case t_POL: if (!s || !signe(y)) return zeropol(varn(y)); ly = lg(y); z = cgetg(ly,t_POL); z[1]=y[1]; for (i=2; i=0) return shifti(x,n); if (!signe(x)) return gen_0; l = vali(x); n = -n; if (n<=l) return shifti(x,-n); z = cgetg(3,t_FRAC); gel(z,1) = shifti(x,-l); gel(z,2) = int2n(n-l); return z; case t_REAL: return shiftr(x,n); case t_INTMOD: b = gel(x,1); a = gel(x,2); z = cgetg(3,t_INTMOD); if (n <= 0) return div_intmod_same(z, b, a, modii(int2n(-n), b)); gel(z,2) = gerepileuptoint((pari_sp)z, modii(shifti(a,n), b)); gel(z,1) = icopy(b); return z; case t_FRAC: a = gel(x,1); b = gel(x,2); l = vali(a); k = vali(b); if (n+l >= k) { if (expi(b) == k) return shifti(a,n-k); /* b power of 2 */ l = n-k; k = -k; } else { k = -(l+n); l = -l; } z = cgetg(3,t_FRAC); gel(z,1) = shifti(a,l); gel(z,2) = shifti(b,k); return z; case t_QUAD: z = cgetg(4,t_QUAD); gel(z,1) = gcopy(gel(x,1)); gel(z,2) = gmul2n(gel(x,2),n); gel(z,3) = gmul2n(gel(x,3),n); return z; case t_POLMOD: z = cgetg(3,t_POLMOD); gel(z,1) = gcopy(gel(x,1)); gel(z,2) = gmul2n(gel(x,2),n); return z; case t_POL: z = init_gen_op(x, tx, &lx, &i); for (; i