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);
}
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;
}
long
group_ident(GEN G, GEN S)
{
pari_sp av = avma;
long idx = group_ident_i(G, S);
if (idx < 0) pari_err_TYPE("group_ident [not a group]", G);
if (!idx) pari_err_IMPL("galoisidentify for groups of order > 127");
avma = av; return idx;
}
/* 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;
}
/* 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;
}
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
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;
}
static GEN
_matsize(GEN x)
{
long t = typ(x), L = lg(x) - 1;
switch(t)
{ /* matsize */
case t_VEC: return mkvecsmall2(1, L);
case t_COL: return mkvecsmall2(L, 1);
case t_MAT: return mkvecsmall2(L? nbrows(x): 0, L);
default:
if (is_noncalc_t(t)) pari_err_TYPE("_matsize", x);
return mkvecsmall2(1, 1);
}
}
GEN
gtrans(GEN x)
{
long i, dx, lx;
GEN y;
switch(typ(x))
{
case t_VEC: y = gcopy(x); settyp(y,t_COL); break;
case t_COL: y = gcopy(x); settyp(y,t_VEC); break;
case t_MAT:
lx = lg(x); if (lx==1) return cgetg(1,t_MAT);
dx = lgcols(x); y = cgetg(dx,t_MAT);
for (i = 1; i < dx; i++) gel(y,i) = row_transposecopy(x,i);
break;
default: pari_err_TYPE("gtrans",x); return NULL;
}
return y;
}
// Digit reversal
GEN
rev(GEN n, long B)
{
pari_sp av = avma;
if (typ(n) != t_INT)
pari_err_TYPE("rev", n);
GEN m = modis(n, B);
n = divis(n, B);
pari_sp btop = avma, st_lim = stack_lim(btop, 1);
while (signe(n)) {
m = addis(mulis(m, B), smodis(n, B));
n = divis(n, B);
if (low_stack(st_lim, stack_lim(btop, 1)))
gerepileall(btop, 2, &m, &n);
}
m = gerepilecopy(av, m);
return m;
}
GEN
vecsum(GEN v)
{
pari_sp av = avma;
long i, l;
GEN p;
if (!is_vec_t(typ(v)))
pari_err_TYPE("vecsum", v);
l = lg(v);
if (l == 1) return gen_0;
p = gel(v,1);
if (l == 2) return gcopy(p);
for (i=2; i<l; i++)
{
p = gadd(p, gel(v,i));
if (gc_needed(av, 2))
{
if (DEBUGMEM>1) pari_warn(warnmem,"sum");
p = gerepileupto(av, p);
}
}
return gerepileupto(av, p);
}
GEN
shallowmatconcat(GEN v)
{
long i, j, h, l = lg(v), L = 0, H = 0;
GEN M, maxh, maxl;
if (l == 1) return cgetg(1,t_MAT);
switch(typ(v))
{
case t_VEC:
for (i = 1; i < l; i++)
{
GEN c = gel(v,i);
GEN s = _matsize(c);
H = maxss(H, s[1]);
L += s[2];
}
M = zeromatcopy(H, L);
L = 0;
for (i = 1; i < l; i++)
{
GEN c = gel(v,i);
GEN s = _matsize(c);
matfill(M, c, 0, L, 1);
L += s[2];
}
return M;
case t_COL:
for (i = 1; i < l; i++)
{
GEN c = gel(v,i);
GEN s = _matsize(c);
H += s[1];
L = maxss(L, s[2]);
}
M = zeromatcopy(H, L);
H = 0;
for (i = 1; i < l; i++)
{
GEN c = gel(v,i);
GEN s = _matsize(c);
matfill(M, c, H, 0, 1);
H += s[1];
}
return M;
case t_MAT:
h = lgcols(v);
maxh = zero_zv(h-1);
maxl = zero_zv(l-1);
for (j = 1; j < l; j++)
for (i = 1; i < h; i++)
{
GEN c = gcoeff(v,i,j);
GEN s = _matsize(c);
if (s[1] > maxh[i]) maxh[i] = s[1];
if (s[2] > maxl[j]) maxl[j] = s[2];
}
for (i = 1, H = 0; i < h; i++) H += maxh[i];
for (j = 1, L = 0; j < l; j++) L += maxl[j];
M = zeromatcopy(H, L);
for (j = 1, L = 0; j < l; j++)
{
for (i = 1, H = 0; i < h; i++)
{
GEN c = gcoeff(v,i,j);
matfill(M, c, H, L, minss(maxh[i], maxl[j]));
H += maxh[i];
}
L += maxl[j];
}
return M;
default:
pari_err_TYPE("shallowmatconcat", v);
return NULL;
}
}
long
eval_mnemonic(GEN str, const char *tmplate)
{
pari_sp av=avma;
ulong retval = 0;
const char *etmplate = NULL;
const char *arg;
if (typ(str)==t_INT) return itos(str);
if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
arg=GSTR(str);
etmplate = strchr(tmplate, '\n');
if (!etmplate)
etmplate = tmplate + strlen(tmplate);
while (1)
{
long numarg;
const char *e, *id;
const char *negated; /* action found with 'no'-ID */
int negate; /* Arg has 'no' prefix removed */
ulong l, action = 0, first = 1, singleton = 0;
char *buf, *inibuf;
static char b[80];
while (isspace((int)*arg)) arg++;
if (!*arg)
break;
e = arg;
while (IS_ID(*e)) e++;
/* Now the ID is whatever is between arg and e. */
l = e - arg;
if (l >= sizeof(b))
pari_err(e_MISC,"id too long in a stringified flag");
if (!l) /* Garbage after whitespace? */
pari_err(e_MISC,"a stringified flag does not start with an id");
strncpy(b, arg, l);
b[l] = 0;
arg = e;
e = inibuf = buf = b;
while (('0' <= *e) && (*e <= '9'))
e++;
if (*e == 0)
pari_err(e_MISC,"numeric id in a stringified flag");
negate = 0;
negated = NULL;
find:
id = tmplate;
while ((id = strstr(id, buf)) && id < etmplate)
{
if (IS_ID(id[l])) { /* We do not allow abbreviations yet */
id += l; /* False positive */
continue;
}
if ((id >= tmplate + 2) && (IS_ID(id[-1])))
{
const char *s = id;
if ( !negate && s >= tmplate+3
&& ((id[-1] == '_') || (id[-1] == '-')) )
s--;
/* Check whether we are preceeded by "no" */
if ( negate /* buf initially started with "no" */
|| (s < tmplate+2) || (s[-1] != 'o') || (s[-2] != 'n')
|| (s >= tmplate+3 && IS_ID(s[-3]))) {
id += l; /* False positive */
continue;
}
/* Found noID in the template! */
id += l;
negated = id;
continue; /* Try to find without 'no'. */
}
/* Found as is */
id += l;
break;
}
if ( !id && !negated && !negate
&& (l > 2) && buf[0] == 'n' && buf[1] == 'o' ) {
/* Try to find the flag without the prefix "no". */
buf += 2; l -= 2;
if ((buf[0] == '_') || (buf[0] == '-')) { buf++; l--; }
negate = 1;
if (buf[0])
goto find;
}
if (!id && negated) /* Negated and AS_IS forms, prefer AS_IS */
{
id = negated; /* Otherwise, use negated form */
negate = 1;
}
if (!id)
pari_err(e_MISC,"Unrecognized id '%s' in a stringified flag", inibuf);
if (singleton && !first)
pari_err(e_MISC,"Singleton id non-single in a stringified flag");
if (id[0] == '=') {
if (negate)
pari_err(e_MISC,"Cannot negate id=value in a stringified flag");
if (!first)
pari_err(e_MISC,"Assign action should be first in a stringified flag");
action = A_ACTION_ASSIGN;
id++;
if (id[0] == '=') {
singleton = 1;
id++;
}
} else if (id[0] == '^') {
if (id[1] != '~')
pari_err(e_MISC, "Unrecognized action in a template");
id += 2;
if (negate)
action = A_ACTION_SET;
else
action = A_ACTION_UNSET;
} else if (id[0] == '|') {
id++;
if (negate)
action = A_ACTION_UNSET;
else
action = A_ACTION_SET;
}
e = id;
while ((*e >= '0' && *e <= '9')) e++;
while (isspace((int)*e))
e++;
if (*e && (*e != ';') && (*e != ','))
pari_err(e_MISC, "Non-numeric argument of an action in a template");
numarg = atol(id); /* Now it is safe to get it... */
switch (action) {
case A_ACTION_SET:
retval |= numarg;
break;
case A_ACTION_UNSET:
retval &= ~numarg;
break;
case A_ACTION_ASSIGN:
retval = numarg;
break;
default:
pari_err(e_MISC,"error in parse_option_string");
}
first = 0;
while (isspace((int)*arg))
arg++;
if (*arg && !(ispunct((int)*arg) && *arg != '-'))
pari_err(e_MISC,"Junk after an id in a stringified flag");
/* Skip punctuation */
if (*arg)
arg++;
}
avma=av;
return retval;
}
