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; }