GEN
nffactormod(GEN nf, GEN x, GEN pr)
{
long j, l, vx = varn(x), vn;
pari_sp av = avma;
GEN F, E, rep, xrd, modpr, T, p;
nf = checknf(nf);
vn = varn(nf[1]);
if (typ(x)!=t_POL) pari_err(typeer,"nffactormod");
if (varncmp(vx,vn) >= 0)
pari_err(talker,"polynomial variable must have highest priority in nffactormod");
modpr = nf_to_ff_init(nf, &pr, &T, &p);
xrd = modprX(x, nf, modpr);
rep = FqX_factor(xrd,T,p);
settyp(rep, t_MAT);
F = gel(rep,1); l = lg(F);
E = gel(rep,2); settyp(E, t_COL);
for (j = 1; j < l; j++) {
gel(F,j) = modprX_lift(gel(F,j), modpr);
gel(E,j) = stoi(E[j]);
}
return gerepilecopy(av, rep);
}
void
arginit(void)
{
int i;
lastadj = Fadj;
lastverb = Fverb;
indchar = typ(TIND, types[TCHAR]);
memset(flagbits, Fnone, sizeof(flagbits));
for(i='0'; i<='9'; i++)
argflag(i, Fignor);
argflag('.', Fignor);
argflag('#', Fignor);
argflag('u', Fignor);
argflag('+', Fignor);
argflag('-', Fignor);
argflag('*', Fstar);
argflag('l', Fl);
argflag('o', Fverb);
flagbits['x'] = flagbits['o'];
flagbits['X'] = flagbits['o'];
}
static GEN
bound_for_coeff(long m, GEN rr, GEN *maxroot)
{
long i,r1, lrr=lg(rr);
GEN p1,b1,b2,B,M, C = matpascal(m-1);
for (r1=1; r1 < lrr; r1++)
if (typ(rr[r1]) != t_REAL) break;
r1--;
rr = gabs(rr,0); *maxroot = vecmax(rr);
for (i=1; i<lrr; i++)
if (gcmp(gel(rr,i), gen_1) < 0) gel(rr,i) = gen_1;
for (b1=gen_1,i=1; i<=r1; i++) b1 = gmul(b1, gel(rr,i));
for (b2=gen_1 ; i<lrr; i++) b2 = gmul(b2, gel(rr,i));
B = gmul(b1, gsqr(b2)); /* Mahler measure */
M = cgetg(m+2, t_VEC); gel(M,1) = gel(M,2) = gen_0; /* unused */
for (i=1; i<m; i++)
{
p1 = gadd(gmul(gcoeff(C, m, i+1), B),/* binom(m-1, i) */
gcoeff(C, m, i)); /* binom(m-1, i-1) */
gel(M,i+2) = ceil_safe(p1);
}
return M;
}
static GEN
F2xqE_dbl_slope(GEN P, GEN a, GEN T, GEN *slope)
{
GEN x, y, Q;
if (ell_is_inf(P)) return ellinf();
x = gel(P,1); y = gel(P,2);
if (typ(a)==t_VECSMALL)
{
GEN a2 = a;
if (!lgpol(gel(P,1))) return ellinf();
*slope = F2x_add(x, F2xq_div(y, x, T));
Q = cgetg(3,t_VEC);
gel(Q, 1) = F2x_add(F2xq_sqr(*slope, T), F2x_add(*slope, a2));
gel(Q, 2) = F2x_add(F2xq_mul(*slope, F2x_add(x, gel(Q, 1)), T), F2x_add(y, gel(Q, 1)));
}
else
{
GEN a3 = gel(a,1), a4 = gel(a,2), a3i = gel(a,3);
*slope = F2xq_mul(F2x_add(a4, F2xq_sqr(x, T)), a3i, T);
Q = cgetg(3,t_VEC);
gel(Q, 1) = F2xq_sqr(*slope, T);
gel(Q, 2) = F2x_add(F2xq_mul(*slope, F2x_add(x, gel(Q, 1)), T), F2x_add(y, a3));
}
return Q;
}
static void
commands(long n)
{
long i;
entree *ep;
char **t_L;
pari_stack s_L;
pari_stack_init(&s_L, sizeof(*t_L), (void**)&t_L);
for (i = 0; i < functions_tblsz; i++)
for (ep = functions_hash[i]; ep; ep = ep->next)
{
long m;
switch (EpVALENCE(ep))
{
case EpVAR:
if (typ((GEN)ep->value) == t_CLOSURE) break;
/* fall through */
case EpNEW: continue;
}
m = ep->menu;
if (m == n || (n < 0 && m && m <= MAX_SECTION))
pari_stack_pushp(&s_L, (void*)ep->name);
}
pari_stack_pushp(&s_L, NULL);
print_fun_list(t_L, term_height()-4);
pari_stack_delete(&s_L);
}
GEN
bnflogdegree(GEN nf, GEN A, GEN ell)
{
pari_sp av = avma;
GEN AZ, A0Z, NA0;
long vAZ;
if (typ(ell) != t_INT) pari_err_TYPE("bnflogdegree", ell);
nf = checknf(nf);
A = idealhnf(nf, A);
AZ = gcoeff(A,1,1);
vAZ = Z_pvalrem(AZ, ell, &A0Z);
if (is_pm1(A0Z))
NA0 = gen_1;
else
(void)Z_pvalrem(idealnorm(nf,A), ell, &NA0);
if (vAZ)
{
GEN Aell = ZM_hnfmodid(A, powiu(ell,vAZ));
GEN S = idealprimedec(nf, ell), T;
long l, i, s = 0;
T = padicfact(nf, S, 100);
l = lg(S);
for (i = 1; i < l; i++)
{
GEN P = gel(S,i);
long v = idealval(nf, Aell, P);
if (v) s += v * ftilde(nf, P, gel(T,i));
}
if (s) NA0 = gmul(NA0, gpowgs(ell1(ell), s));
}
return gerepileupto(av, NA0);
}
static GEN
polsimplify(GEN x)
{
long i,lx = lg(x);
for (i=2; i<lx; i++)
if (typ(x[i]) == t_POL) gel(x,i) = constant_term(gel(x,i));
return x;
}
static GEN
F2xqE_neg_i(GEN P, GEN a)
{
GEN LHS;
if (ell_is_inf(P)) return P;
LHS = typ(a)==t_VECSMALL ? gel(P,1): gel(a,1);
return mkvec2(gel(P,1), F2x_add(LHS, gel(P,2)));
}
/* min(v, v(Log_p Norm_{F_\p/Q_p}(x))) */
static long
vlognorm(GEN nf, GEN T, GEN x, GEN p, long v)
{
GEN a = nf_to_scalar_or_alg(nf, x);
GEN N = RgXQ_norm(a, T);
if (typ(N) != t_PADIC) N = cvtop(N, p, v);
return minss(v, valp( Qp_log(N) ));
}
static long
vnorm_x(GEN nf, GEN x, GEN ell)
{
x = nf_to_scalar_or_alg(nf,x);
if (typ(x) != t_POL) return 0;
x = Q_primpart(x);
return Q_pval(nfnorm(nf,x), ell);
}
GEN
F2xqE_neg(GEN P, GEN a, GEN T)
{
GEN LHS;
(void) T;
if (ell_is_inf(P)) return ellinf();
LHS = typ(a)==t_VECSMALL ? gel(P,1): gel(a,1);
return mkvec2(gcopy(gel(P,1)), F2x_add(LHS, gel(P,2)));
}
long
nfislocalpower(GEN nf, GEN pr, GEN a, GEN n)
{
pari_sp av = avma;
long r;
if (typ(n) != t_INT) pari_err_TYPE("nfislocalpower",n);
r = nfislocalpower_i(nf, pr, a, n);
avma = av; return r;
}
/* assume x is squarefree */
int
nfissplit(GEN nf, GEN x)
{
pari_sp av = avma;
long l;
if (typ(x) != t_POL) pari_err(typeer, "nfissplit");
l = lg(nfsqff(checknf(nf), x, 2));
avma = av; return l != 1;
}
GEN
strtor(const char *s, long prec)
{
pari_sp av = avma;
GEN y = int_read_dec(&s);
y = real_read(av, &s, y, prec);
if (typ(y) == t_REAL) return y;
return gerepileuptoleaf(av, itor(y, prec));
}
static long
vtilde_prec_x(GEN nf, GEN x, GEN ell)
{
long i, l, v;
GEN G;
if (typ(x) != t_MAT) return vnorm_x(nf,x,ell);
G = gel(x,1); l = lg(G); v = 0;
for (i = 1; i < l; i++) v = maxss(v, vnorm_x(nf,gel(G,i),ell));
return v;
}
static GEN
nf_to_Zq(GEN x, GEN T, GEN pk, GEN pks2, GEN proj)
{
GEN y;
if (typ(x) != t_COL) return centermodii(x, pk, pks2);
y = gmul(proj, x);
if (!T) return centermodii(y, pk, pks2);
y = RgV_to_RgX(y, varn(T));
return centermod_i(FpX_rem(y, T, pk), pk, pks2);
}
/* assume x in Fq[X], return Tr_{Fq[X]/Fp[X]}(x), varn(X) = 0 */
static GEN
poltrace(GEN x, GEN Trq, GEN p)
{
long i,l;
GEN y;
if (typ(x) == t_INT || varn(x) != 0) return trace(x, Trq, p);
l = lg(x); y = cgetg(l,t_POL); y[1]=x[1];
for (i=2; i<l; i++) gel(y,i) = trace(gel(x,i),Trq,p);
return y;
}
/* We want to be able to reconstruct x, |x|^2 < C, from x mod pr^k */
static double
bestlift_bound(GEN C, long d, double alpha, GEN Npr)
{
const double y = 1 / (alpha - 0.25); /* = 2 if alpha = 3/4 */
double t;
if (typ(C) != t_REAL) C = gmul(C, real_1(DEFAULTPREC));
setlg(C, DEFAULTPREC);
t = rtodbl(mplog(gmul2n(divrs(C,d), 4))) * 0.5 + (d-1) * log(1.5 * sqrt(y));
return ceil((t * d) / log(gtodouble(Npr)));
}
static GEN
unifpol0(GEN nf,GEN x,long flag)
{
switch(typ(x))
{
case t_INT: case t_FRAC:
return gcopy(x);
case t_POLMOD:
x = gel(x,2); /* fall through */
if (typ(x) != t_POL) return gcopy(x); /* scalar */
case t_POL:
if (!degpol(x)) return gcopy(constant_term(x));
return (flag == t_COL)? algtobasis(nf, x): gmodulo(x, gel(nf,1));
default: /* t_COL */
return (flag == t_COL)? gcopy(x): basistoalg(nf, x);
}
}
/* Return a subfield, gen_0 [ change p ] or NULL [ not a subfield ] */
static GEN
subfield(GEN A, blockdata *B)
{
long N, i, j, d, lf, m = lg(A)-1;
GEN M, pe, pol, fhk, g, e, d_1_term, delta, listdelta, whichdelta;
GEN T = B->S->T, p = B->S->p, firstroot = B->S->firstroot;
pol= (GEN)B->DATA[1]; N = degpol(pol); d = N/m; /* m | N */
pe = (GEN)B->DATA[2];
fhk= (GEN)B->DATA[3];
M = (GEN)B->DATA[8];
delta = cgetg(m+1,t_VEC);
whichdelta = cgetg(N+1, t_VECSMALL);
d_1_term = gen_0;
for (i=1; i<=m; i++)
{
GEN Ai = gel(A,i), p1 = (GEN)fhk[Ai[1]];
for (j=2; j<=d; j++)
p1 = Fq_mul(p1, (GEN)fhk[Ai[j]], T, pe);
gel(delta,i) = p1;
if (DEBUGLEVEL>2) fprintferr("delta[%ld] = %Z\n",i,p1);
/* g = prod (X - delta[i])
* if g o h = 0 (pol), we'll have h(Ai[j]) = delta[i] for all j */
/* fk[k] belongs to block number whichdelta[k] */
for (j=1; j<=d; j++) whichdelta[Ai[j]] = i;
if (typ(p1) == t_POL) p1 = constant_term(p1);
d_1_term = addii(d_1_term, p1);
}
d_1_term = centermod(d_1_term, pe); /* Tr(g) */
if (absi_cmp(d_1_term, gel(M,3)) > 0) {
if (DEBUGLEVEL>1) fprintferr("d-1 test failed\n");
return NULL;
}
g = FqV_roots_to_pol(delta, T, pe, 0);
g = centermod(polsimplify(g), pe); /* assume g in Z[X] */
if (DEBUGLEVEL>2) fprintferr("pol. found = %Z\n",g);
if (!ok_coeffs(g,M)) {
if (DEBUGLEVEL>1) fprintferr("coeff too big for pol g(x)\n");
return NULL;
}
if (!FpX_is_squarefree(g, p)) {
if (DEBUGLEVEL>1) fprintferr("changing f(x): p divides disc(g)\n");
compute_data(B);
return subfield(A, B);
}
lf = lg(firstroot); listdelta = cgetg(lf, t_VEC);
for (i=1; i<lf; i++) listdelta[i] = delta[whichdelta[firstroot[i]]];
if (DEBUGLEVEL) fprintferr("candidate = %Z\n", g);
e = embedding(g, B->DATA, B->S, B->PD->den, listdelta);
if (!e) return NULL;
if (DEBUGLEVEL) fprintferr("embedding = %Z\n", e);
return _subfield(g, e);
}
/* return d = gcd(a,b), sets u, v such that au + bv = gcd(a,b) */
GEN
extgcd(GEN A, GEN B, GEN *U, GEN *V)
{
pari_sp av = avma;
GEN ux = gen_1, vx = gen_0, a = A, b = B;
if (typ(a) != t_INT) pari_err_TYPE("extgcd",a);
if (typ(b) != t_INT) pari_err_TYPE("extgcd",b);
if (signe(a) < 0) { a = negi(a); ux = negi(ux); }
while (!gequal0(b))
{
GEN r, q = dvmdii(a, b, &r), v = vx;
vx = subii(ux, mulii(q, vx));
ux = v; a = b; b = r;
}
*U = ux;
*V = diviiexact( subii(a, mulii(A,ux)), B );
gerepileall(av, 3, &a, U, V); return a;
}
static GEN
vtilde(GEN K, GEN x, GEN T, GEN deg, GEN ell, long prec)
{
GEN G, E, vG;
long i, l;
if (typ(x) != t_MAT) return vtilde_i(K,x,T,deg,ell,prec);
G = gel(x,1); vG = cgetg_copy(G, &l);
E = gel(x,2);
for (i = 1; i < l; i++) gel(vG, i) = vtilde_i(K, gel(G,i),T,deg,ell,prec);
return RgV_dotproduct(E, vG);
}
/* assume A or B is a t_LIST */
static GEN
listconcat(GEN A, GEN B)
{
long i, l1, lx;
GEN L, z, L1, L2;
if (typ(A) != t_LIST) {
if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L2 = list_data(B);
if (!L2) return mklistcopy(A);
lx = lg(L2) + 1;
z = listcreate();
list_data(z) = L = cgetg(lx, t_VEC);
for (i = 2; i < lx; i++) gel(L,i) = gcopy(gel(L2,i-1));
gel(L,1) = gcopy(A); return z;
} else if (typ(B) != t_LIST) {
if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
L1 = list_data(A);
if (!L1) return mklistcopy(B);
lx = lg(L1) + 1;
z = listcreate();
list_data(z) = L = cgetg(lx, t_VEC);
for (i = 1; i < lx-1; i++) gel(L,i) = gcopy(gel(L1,i));
gel(L,i) = gcopy(B); return z;
}
/* A, B both t_LISTs */
if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L1 = list_data(A); if (!L1) return listcopy(B);
L2 = list_data(B); if (!L2) return listcopy(A);
l1 = lg(L1);
lx = l1-1 + lg(L2);
z = cgetg(3, t_LIST);
z[1] = 0UL;
list_data(z) = L = cgetg(lx, t_VEC);
L2 -= l1-1;
for (i=1; i<l1; i++) gel(L,i) = gclone(gel(L1,i));
for ( ; i<lx; i++) gel(L,i) = gclone(gel(L2,i));
return z;
}
static GEN
subfieldsall(GEN nf)
{
pari_sp av = avma;
long N, ld, i, v0;
GEN G, pol, dg, LSB, NLSB;
poldata PD;
primedata S;
blockdata B;
/* much easier if nf is Galois (WSS) */
G = galoisconj4(nf, NULL, 1);
if (typ(G) != t_INT)
{
GEN L, S, p;
long l;
pol = get_nfpol(nf, &nf);
L = lift_intern( galoissubfields(G, 0, varn(pol)) );
l = lg(L);
S = cgetg(l, t_VECSMALL);
for (i=1; i<l; i++) S[i] = lg(gmael(L,i,1));
p = vecsmall_indexsort(S);
return gerepilecopy(av, vecpermute(L, p));
}
subfields_poldata(nf, &PD);
pol = PD.pol;
v0 = varn(pol); N = degpol(pol);
dg = divisors(utoipos(N)); ld = lg(dg)-1;
if (DEBUGLEVEL) fprintferr("\n***** Entering subfields\n\npol = %Z\n",pol);
LSB = _subfield(pol, pol_x[0]);
if (ld > 2)
{
B.PD = &PD;
B.S = &S;
B.N = N;
choose_prime(&S, PD.pol, PD.dis);
for (i=2; i<ld; i++)
{
B.size = itos(gel(dg,i));
B.d = N / B.size;
NLSB = subfields_of_given_degree(&B);
if (NLSB) { LSB = concat(LSB, NLSB); gunclone(NLSB); }
}
(void)delete_var(); /* from choose_prime */
}
LSB = shallowconcat(LSB, _subfield(pol_x[0], pol));
if (DEBUGLEVEL) fprintferr("\n***** Leaving subfields\n\n");
return fix_var(gerepilecopy(av, LSB), v0);
}
/* Let x be a polynomial with coefficients in Z or nf (vectors or polymods)
* return the same polynomial with coefficients expressed:
* if flag=t_COL: as vectors (on the integral basis).
* if flag=t_POLMOD: as polmods.
*/
GEN
unifpol(GEN nf, GEN x, long flag)
{
if (typ(x)==t_POL && varncmp(varn(x), varn(nf[1])) < 0)
{
long i, d = lg(x);
GEN y = cgetg(d,t_POL); y[1] = x[1];
for (i=2; i<d; i++) gel(y,i) = unifpol0(nf, gel(x,i), flag);
return y;
}
return unifpol0(nf, x, flag);
}
/* assume x in Fq, return Tr_{Fq/Fp}(x) as a t_INT */
static GEN
trace(GEN x, GEN Trq, GEN p)
{
long i, l;
GEN s;
if (typ(x) == t_INT) return modii(mulii(x, gel(Trq,1)), p);
l = lg(x)-1; if (l == 1) return gen_0;
x++; s = mulii(gel(x,1), gel(Trq,1));
for (i=2; i<l; i++)
s = addii(s, mulii(gel(x,i), gel(Trq,i)));
return modii(s, p);
}
// <vardeclaration> ::= <identifier>{ ,<identifier> } : <typ>
void SyntaxAnalyzer::varDeclaration()
{
accept(ident);
while (symbol == comma) {
accept(comma);
accept(ident);
}
accept(colon);
typ();
} // vardeclaration( )
GEN
shallowextract(GEN x, GEN L)
{
long i,j, tl = typ(L), tx = typ(x), lx = lg(x);
GEN y;
switch(tx)
{
case t_VEC:
case t_COL:
case t_MAT:
case t_VECSMALL: break;
default: pari_err_TYPE("extract",x);
}
if (tl==t_INT)
{ /* extract components of x as per the bits of mask L */
long k, l, ix, iy, maxj;
GEN Ld;
if (!signe(L)) return cgetg(1,tx);
y = new_chunk(lx);
l = lgefint(L)-1; ix = iy = 1;
maxj = BITS_IN_LONG - bfffo(*int_MSW(L));
if ((l-2) * BITS_IN_LONG + maxj >= lx)
pari_err_TYPE("vecextract [mask too large]", L);
for (k = 2, Ld = int_LSW(L); k < l; k++, Ld = int_nextW(Ld))
{
ulong B = *Ld;
for (j = 0; j < BITS_IN_LONG; j++, B >>= 1, ix++)
if (B & 1) y[iy++] = x[ix];
}
{ /* k = l */
ulong B = *Ld;
for (j = 0; j < maxj; j++, B >>= 1, ix++)
if (B & 1) y[iy++] = x[ix];
}
y[0] = evaltyp(tx) | evallg(iy);
return y;
}
GEN
shallowconcat1(GEN x)
{
pari_sp av = avma;
long lx, t, i;
GEN z;
switch(typ(x))
{
case t_VEC:
lx = lg(x);
if (lx==1) pari_err_DOMAIN("concat","vector","=",x,x);
break;
case t_LIST:
if (list_typ(x)!=t_LIST_RAW) pari_err_TYPE("concat",x);
if (!list_data(x)) pari_err_DOMAIN("concat","vector","=",x,x);
x = list_data(x); lx = lg(x);
break;
default:
pari_err_TYPE("concat",x);
return NULL; /* not reached */
}
if (lx==2) return gel(x,1);
z = gel(x,1); t = typ(z); i = 2;
if (is_matvec_t(t) || t == t_VECSMALL || t == t_STR)
{ /* detect a "homogeneous" object: catmany is faster */
for (; i<lx; i++)
if (typ(gel(x,i)) != t) break;
z = catmany(x + 1, x + i-1, t);
}
for (; i<lx; i++) {
z = shallowconcat(z, gel(x,i));
if (gc_needed(av,3))
{
if (DEBUGMEM>1) pari_warn(warnmem,"concat: i = %ld", i);
z = gerepilecopy(av, z);
}
}
return z;
}
GEN
gpolvar(GEN x)
{
long v;
if (!x) {
GEN h = hash_values(h_polvar);
return vars_to_RgXV(vars_sort_inplace(h));
}
if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
v = gvar(x);
if (v==NO_VARIABLE) return gen_0;
return pol_x(v);
}
