GaussElimComputation::GaussElimComputation(const Matrix *m, int collsyz, int nsyz)
: row(m->n_rows()-1),
R(m->get_ring()),
gens(m),
n_gb(0),
n_pairs(0),
n_syz(0),
collect_syz(collsyz)
{
int i;
typedef struct gm_elem *gm_elem_ptr;
reduce_list = newarray(gm_elem_ptr,m->n_rows());
gb_list = newarray(gm_elem_ptr,m->n_rows());
for (i=0; i<m->n_rows(); i++)
{
reduce_list[i] = NULL;
gb_list[i] = NULL;
}
if (nsyz < 0 || nsyz > m->n_cols())
nsyz = m->n_cols();
n_comps_per_syz = nsyz;
Fsyz = m->cols()->sub_space(nsyz);
for (i=0; i<m->n_cols(); i++)
{
gm_elem *p = new_gen(i);
insert(p);
}
}
static void caselabel(Swtch swp, long val, int lab) {
int k;
if (swp->ncases >= swp->size)
{
long *vals = swp->values;
Symbol *labs = swp->labels;
swp->size *= 2;
swp->values = newarray(swp->size, sizeof *swp->values, FUNC);
swp->labels = newarray(swp->size, sizeof *swp->labels, FUNC);
for (k = 0; k < swp->ncases; k++) {
swp->values[k] = vals[k];
swp->labels[k] = labs[k];
}
}
k = swp->ncases;
for ( ; k > 0 && swp->values[k-1] >= val; k--) {
swp->values[k] = swp->values[k-1];
swp->labels[k] = swp->labels[k-1];
}
if (k < swp->ncases && swp->values[k] == val)
error("duplicate case label `%d'\n", val);
swp->values[k] = val;
swp->labels[k] = findlabel(lab);
++swp->ncases;
if (Aflag >= 2 && swp->ncases == 258)
warning("more than 257 cases in a switch\n");
}
static void swstmt(int loop, int lab, int lev) {
Tree e;
struct swtch sw;
Code head, tail;
t = gettok();
expect('(');
definept(NULL);
e = expr(')');
if (!isint(e->type)) {
error("illegal type `%t' in switch expression\n",
e->type);
e = retype(e, inttype);
}
e = cast(e, promote(e->type));
if (generic(e->op) == INDIR && isaddrop(e->kids[0]->op)
&& e->kids[0]->u.sym->type == e->type
&& !isvolatile(e->kids[0]->u.sym->type)) {
sw.sym = e->kids[0]->u.sym;
walk(NULL, 0, 0);
} else {
sw.sym = genident(REGISTER, e->type, level);
addlocal(sw.sym);
walk(asgn(sw.sym, e), 0, 0);
}
head = code(Switch);
sw.lab = lab;
sw.deflab = NULL;
sw.ncases = 0;
sw.size = SWSIZE;
sw.values = newarray(SWSIZE, sizeof *sw.values, FUNC);
sw.labels = newarray(SWSIZE, sizeof *sw.labels, FUNC);
refinc /= 10.0;
statement(loop, &sw, lev);
if (sw.deflab == NULL) {
sw.deflab = findlabel(lab);
definelab(lab);
if (sw.ncases == 0)
warning("switch statement with no cases\n");
}
if (findlabel(lab + 1)->ref)
definelab(lab + 1);
tail = codelist;
codelist = head->prev;
codelist->next = head->prev = NULL;
if (sw.ncases > 0)
swgen(&sw);
branch(lab);
head->next->prev = codelist;
codelist->next = head->next;
codelist = tail;
}
void interntype(node t){
assert(t->tag == type_tag);
if (numtypes >= typelistsize) {
if (typelistsize == 0) {
typelistsize = 800;
typelist = newarray(node,typelistsize);
}
else {
int newtypelistsize = 2 * typelistsize;
node *newtypelist = newarray(node,newtypelistsize);
int i;
for (i=0; i<numtypes; i++) newtypelist[i] = typelist[i];
typelist = newtypelist;
typelistsize = newtypelistsize;
}
}
typelist[numtypes] = t;
t->body.type.seqno = numtypes;
numtypes++;
if (isortype(t)) {
int i, nonnulls = 0;
node m;
node commons = NULL;
for (i=1; ; i++) {
node common = NULL;
for (m = typedeftail(t); m != NULL; m = CDR(m)) {
node n, u = CAR(m);
if (u == null_T) goto out;
if (!(isobjecttype(u) || istaggedobjecttype(u))) goto out;
n = typedeftail(u);
if (i > length(n)) goto out;
u = nth(n,i);
if (common == NULL) common = u;
else if (!equal(common,u)) {
goto out;
}
}
if (common == NULL) break;
push(commons,common);
}
out:
commons = reverse(commons);
t->body.type.commons = commons;
for (m = typedeftail(t); m != NULL; m = CDR(m)) {
if (CAR(m) != null_T) nonnulls ++;
}
if (nonnulls >= 2) t->body.type.flags |= composite_F;
}
}
scontext * scontextCreate(arithInfo * arithinfo,int size,int escmax,int totmax,int inc,bool noesc)
{
scontext *sc;
int i;
/* malloc scontext structure and array for frequencies */
if ( ! (sc = new(scontext)) ) return NULL;
if ( ! (sc->tree = newarray(uword,size)) )
{ free(sc); return(NULL); }
sc->arith = arithinfo;
sc->total = 0;
sc->escape = 1;
sc->size = size;
sc->nzero = size;
sc->inc = max(inc,1);
sc->totmax = max(totmax,size+3);
sc->escmax = min(max(escmax,3),(size>>2)+2);
sc->noesc = noesc;
if ( noesc ) {
for(i=0;i<size;i++) sc->tree[i] = 1;
sc->nzero = sc->escape = 0;
sc->total = size;
}
return sc;
}
void expand(uint64_t const newsize)
{
array_ptr_type newarray(new array_type(newsize));
for ( uint64_t i = 0; i < fill; ++i )
(*newarray)[i] = UNIQUE_PTR_MOVE((*array)[i]);
array = UNIQUE_PTR_MOVE(newarray);
}
static MonomialIdeal *wrapperFrobbyAlexanderDual(const MonomialIdeal *I,
const M2_arrayint top)
// Assumption: top is an array of at least the number of variables of I
// whose v-th entry is at least as large as the v-th exp of any mingen of I
{
// Create a Frobby Ideal containing I.
int nv = I->topvar() + 1;
if (nv == 0)
{
INTERNAL_ERROR("attempting to use frobby with zero variables");
return 0;
}
mpz_t *topvec = 0;
if (top->len > 0)
{
topvec = newarray(mpz_t, top->len);
for (int i = 0; i < top->len; i++)
mpz_init_set_si(topvec[i], top->array[i]);
}
MonomialIdeal *result = FrobbyAlexanderDual(I, topvec);
// Clean up
if (topvec != 0)
{
for (int i = 0; i < top->len; i++) mpz_clear(topvec[i]);
deletearray(topvec);
}
return result;
}
rungO1 * rungO1Create(arithInfo *ari,int nc)
{
rungO1 * ro1;
int i;
assert(ari && nc > 0 );
ro1 = new(rungO1);
if ( ! ro1 ) return NULL;
ro1->numContexts = nc;
ro1->ari = ari;
ro1->rungs = newarray(rung_t,nc);
if ( ! ro1->rungs ) {
destroy(ro1);
return NULL;
}
for(i=0; i<nc; i++)
{
rungModelInit(&(ro1->rungs[i]));
}
return ro1;
}
void MonomialHashTable<ValueType>::initialize(int logsize0)
{
logsize = logsize0;
size = (1<<logsize);
//threshold = size/3; // was 2*size/3
threshold = 2*size/3; // was 2*size/3
hashtab = newarray(value, size);
hashmask = size-1;
reset();
}
void swgen(Swtch swp) {
int *buckets, k, n;
long *v = swp->values;
buckets = newarray(swp->ncases + 1,
sizeof *buckets, FUNC);
for (n = k = 0; k < swp->ncases; k++, n++) {
buckets[n] = k;
while (n > 0 && den(n-1, k) >= density)
n--;
}
buckets[n] = swp->ncases;
swcode(swp, buckets, 0, n - 1);
}
//opérateur somme
Array Array::operator+(const Array array2){
Array newarray(size_+array2.size());
for (int i=0; i<size_;i++){
newarray[i]=data_[i];
}
for (int i=size_; i<(size_+array2.size());i++){
newarray[i]=array2.data()[i-size_];
}
return newarray;
}
// TODO: should increase_capacity set the degree?? I don't think so...
void ARingTower::increase_capacity(int newdeg, poly &f) const
{
assert(f != 0);
if (f->len <= newdeg)
{
poly *newelems = newarray(poly, newdeg + 1);
poly *fp = f->polys;
for (int i = 0; i <= f->deg; i++) newelems[i] = fp[i];
for (int i = f->deg + 1; i < newdeg + 1; i++) newelems[i] = 0;
delete[] fp;
f->polys = newelems;
f->len = newdeg + 1;
f->deg = newdeg;
}
}
void DPoly::initialize(long p, int nvars0, const_poly *ext0)
{
charac = p;
nvars = nvars0;
nlevels = nvars0;
extensions = newarray(poly, nlevels);
if (ext0 == 0)
for (int i=0; i<nlevels; i++)
extensions[i] = 0;
else
for (int i=0; i<nlevels; i++)
{
extensions[i] = copy(nlevels-1, ext0[i]);
down_level(i, nlevels-1, extensions[i]);
}
}
soz * sozCreate(arithInfo * arithinfo,int size,int totmax,int inc)
{
soz *sc;
/* malloc soz structure and array for frequencies */
if ( ! (sc = new(soz)) ) return NULL;
if ( ! (sc->tree = newarray(uword,size)) )
{ free(sc); return(NULL); }
sc->arith = arithinfo;
sc->size = size;
sc->inc = max(inc,1);
sc->totmax = max(totmax,size+3);
sozReset(sc);
return sc;
}
void uniqArray(Array<type>& array) {
Array<type> newarray(array.getSize());
newarray.setSize(0);
if (array.getSize() <= 1) {
// nothing to do
return;
}
newarray.append(array[0]);
int i;
for (i=1; i<array.getSize(); i++) {
if (array[i] == array[i-1]) {
continue;
}
newarray.append(array[i]);
}
array = newarray;
}
void F4GB::show_new_rows_matrix()
{
int ncols = INTSIZE(mat->columns);
int nrows = 0;
for (int nr=0; nr<mat->rows.size(); nr++)
if (is_new_GB_row(nr)) nrows++;
MutableMatrix *gbM = IM2_MutableMatrix_make(KK->get_ring(), nrows, ncols, false);
int r = -1;
for (int nr=0; nr<mat->rows.size(); nr++)
if (is_new_GB_row(nr))
{
r++;
row_elem &row = mat->rows[nr];
ring_elem *rowelems = newarray(ring_elem, row.len);
if (row.coeffs == 0)
{
if (row.monom == 0)
KK->to_ringelem_array(row.len, gens[row.elem]->f.coeffs, rowelems);
else
KK->to_ringelem_array(row.len, gb[row.elem]->f.coeffs, rowelems);
}
else
{
KK->to_ringelem_array(row.len, row.coeffs, rowelems);
}
for (int i=0; i<row.len; i++)
{
int c = row.comps[i];
gbM->set_entry(r,c,rowelems[i]);
}
deletearray(rowelems);
}
buffer o;
gbM->text_out(o);
emit(o.str());
}
void totypesRec(node e) {
int i, j;
/*
e is a list of TYPEs to be defined recursively
The recursion is handled through the type fields of the symbols
involved, which are assumed to be already set, or through TYPEs.
TYPEs have no POSITIONs in them.
Any type which turns out to be equivalent to a prior one has the
address of the prior one inserted into its value field.
We assume that the value fields have been run through ExpandType,
so that each value field is an expression constructed from other
TYPEs.
This routine probably has bugs, with the result that the order of
declarations makes a difference.
*/
numnewtypes = length(e);
newtypeslist = newarray(node,numnewtypes);
ttable = newarray(struct DISTIN *, numnewtypes);
/* we could perform some hashing first */
for (i=0; i<numnewtypes; i++) {
node t = nth(e,i+1);
assert(istype(t));
newtypeslist[i] = t;
assert(t->tag == type_tag);
assert(!(t->body.type.flags & deferred_F));
t->body.type.seqno = i + numtypes;
ttable[i] = newarray(struct DISTIN,numtypes+numnewtypes);
for (j=0; j<numtypes+numnewtypes; j++) {
ttable[i][j].listp = NULL;
ttable[i][j].distinguishable = FALSE;
}
}
for (i=numtypes; i<numnewtypes+numtypes; i++) {
for (j=0; j<i; j++) {
struct DISTIN *dd = table(i,j);
node t = thetype(i), u = thetype(j), tval, uval, th, uh;
assertpos(istype(t),t);
assertpos(istype(u),u);
if ((t->body.type.flags & basic_type_F) || (u->body.type.flags & basic_type_F)) {
assert(t != u);
differ: mark(i,j);
continue;
}
tval = t -> body.type.definition;
uval = u -> body.type.definition;
assertpos(tval != NULL,t);
assertpos(uval != NULL,u);
if (equal(tval,uval)) continue;
assertpos(iscons(tval),t);
assertpos(iscons(uval),u);
assert(! dd->distinguishable );
th = car(tval);
uh = car(uval);
tval = cdr(tval);
uval = cdr(uval);
if (th != uh) goto differ;
if (th == or_K) {
for (;tval != NULL && uval != NULL;
tval = cdr(tval), uval = cdr(uval)) {
node ti = typeforward(car(tval));
node tj = typeforward(car(uval));
int ii = typeseqno(ti);
int jj = typeseqno(tj);
if (ti == tj) continue;
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
if (distinguishable(ii,jj)) goto differ;
appendlt(ii,jj,i,j);
}
if (tval != NULL || uval != NULL) goto differ;
}
else if (th == object__K || th == tagged_object_K) {
for (;tval != NULL && uval != NULL;
tval = cdr(tval), uval = cdr(uval)) {
node tmem = car(tval);
node umem = car(uval);
int ii, jj;
node tt, uu;
if (car(tmem) != car(umem)) goto differ;
ii = typeseqno(tt=typeforward(cadr(tmem)));
jj = typeseqno(uu=typeforward(cadr(umem)));
if (tt==uu) continue;
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
if (distinguishable(ii,jj)) goto differ;
appendlt(ii,jj,i,j);
}
if (tval != NULL || uval != NULL) goto differ;
}
else if (th == array_K || th == tarray_K) {
node tt,uu;
int ii = typeseqno(tt=typeforward(car(tval)));
int jj = typeseqno(uu=typeforward(car(uval)));
if (tt!=uu) {
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
else if (distinguishable(ii,jj)) goto differ;
else if (!equal(cdr(tval),cdr(uval))) goto differ;
else appendlt(ii,jj,i,j);
}
else {
if (!equal(cdr(tval),cdr(uval))) goto differ;
}
}
else if (th == function_S) {
node ttt,uuu;
node targs = car(tval);
node uargs = car(uval);
int iii = typeseqno(ttt=typeforward(cadr(tval)));
int jjj = typeseqno(uuu=typeforward(cadr(uval)));
if (ttt!=uuu) {
if (iii == -1 || jjj == -1) goto differ; /* not defined yet... */
if (distinguishable(iii,jjj)) goto differ;
}
for (;targs != NULL && uargs != NULL;
targs = cdr(targs), uargs = cdr(uargs)) {
node tt,uu;
int ii = typeseqno(tt=typeforward(car(targs)));
int jj = typeseqno(uu=typeforward(car(uargs)));
if (tt==uu) continue;
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
if (distinguishable(ii,jj)) goto differ;
}
if (targs != NULL || uargs != NULL) goto differ;
}
else {
assert(FALSE); return;
}
}
}
for (i=0; i<numnewtypes; i++) {
for (j=0;j<i+numtypes;j++) {
if (!distinguishable(i+numtypes,j)) {
/* indistinguishable types are identified here */
node t = newtypeslist[i];
node n = t->body.type.name;
if (n != NULL) {
assert(n->tag == symbol_tag);
n->body.symbol.value = thetype(j);
}
t->body.type.forward = thetype(j);
t->body.type.flags = identified_F;
newtypeslist[i] = NULL;
break;
}
}
}
for (i=0; i<numnewtypes; i++) {
if (newtypeslist[i] != NULL) {
node t = newtypeslist[i];
interntype(t);
}
}
}
DetComputation::DetComputation(const Matrix *M0, int p0,
bool do_exterior0,
int strategy0)
: R(M0->get_ring()),
M(M0),
done(false),
p(p0),
do_exterior(do_exterior0),
strategy(strategy0),
row_set(NULL),
col_set(NULL),
this_row(0),
this_col(0),
D(0)
{
if (do_exterior)
{
F = M->rows()->exterior(p);
FreeModule *G = M->cols()->exterior(p);
int *deg = R->degree_monoid()->make_new(M->degree_shift());
R->degree_monoid()->power(deg, p, deg);
result = MatrixConstructor(F,G,deg);
R->degree_monoid()->remove(deg);
}
else
{
F = R->make_FreeModule(1);
result = MatrixConstructor(F,0);
}
// Handle trivial cases
if (p < 0)
{
// In either case, want a zero matrix
done = true;
return;
}
if (p == 0)
{
// We want a single element which is '1'
if (do_exterior)
result.set_entry(0,0,R->one());
else
result.append(R->make_vec(0,R->one()));
done = true;
return;
}
if (p > M->n_rows() || p > M->n_cols())
{
// Zero matrix in either case
done = true;
return;
}
done = false;
row_set = newarray_atomic(size_t,p);
col_set = newarray_atomic(size_t,p);
for (size_t i=0; i<p; i++)
{
row_set[i] = i;
col_set[i] = i;
}
D = newarray(ring_elem *,p);
for (size_t i=0; i<p; i++)
{
D[i] = newarray(ring_elem,p);
for (size_t j=0; j<p;j++) D[i][j] = ZERO_RINGELEM;
}
}
static void *uid2type(int uid) {
assert(uid >= 0 && uid < nuids);
if (itemmap[uid] == NULL) {
Type ty;
rcc_type_ty type = (void *)items[uid];
assert(items[uid]);
assert(items[uid]->uid == uid);
assert(items[uid]->kind == rcc_Type_enum);
type = items[uid]->v.rcc_Type.type;
assert(type);
switch (type->kind) {
case rcc_INT_enum:
ty = btot(INT, type->size);
assert(ty->align == type->align);
break;
case rcc_UNSIGNED_enum:
ty = btot(UNSIGNED, type->size);
assert(ty->align == type->align);
break;
case rcc_FLOAT_enum:
ty = btot(FLOAT, type->size);
assert(ty->align == type->align);
break;
case rcc_VOID_enum:
ty = voidtype;
break;
case rcc_POINTER_enum:
ty = ptr(uid2type(type->v.rcc_POINTER.type));
break;
case rcc_ARRAY_enum:
ty = uid2type(type->v.rcc_ARRAY.type);
assert(ty->size > 0);
ty = array(ty, type->size/ty->size, 0);
break;
case rcc_CONST_enum:
ty = qual(CONST, uid2type(type->v.rcc_CONST.type));
break;
case rcc_VOLATILE_enum:
ty = qual(VOLATILE, uid2type(type->v.rcc_VOLATILE.type));
break;
case rcc_ENUM_enum: {
int i, n = Seq_length(type->v.rcc_ENUM.ids);
ty = newstruct(ENUM, string(type->v.rcc_ENUM.tag));
ty->type = inttype;
ty->size = ty->type->size;
ty->align = ty->type->align;
ty->u.sym->u.idlist = newarray(n + 1, sizeof *ty->u.sym->u.idlist, PERM);
for (i = 0; i < n; i++) {
rcc_enum__ty e = Seq_remlo(type->v.rcc_ENUM.ids);
Symbol p = install(e->id, &identifiers, GLOBAL, PERM);
p->type = ty;
p->sclass = ENUM;
p->u.value = e->value;
ty->u.sym->u.idlist[i] = p;
free(e);
}
ty->u.sym->u.idlist[i] = NULL;
Seq_free(&type->v.rcc_ENUM.ids);
break;
}
case rcc_STRUCT_enum: case rcc_UNION_enum: {
int i, n;
Field *tail;
list_ty fields;
if (type->kind == rcc_STRUCT_enum) {
ty = newstruct(STRUCT, string(type->v.rcc_STRUCT.tag));
fields = type->v.rcc_STRUCT.fields;
} else {
ty = newstruct(UNION, string(type->v.rcc_UNION.tag));
fields = type->v.rcc_UNION.fields;
}
itemmap[uid] = ty; /* recursive types */
ty->size = type->size;
ty->align = type->align;
tail = &ty->u.sym->u.s.flist;
n = Seq_length(fields);
for (i = 0; i < n; i++) {
rcc_field_ty field = Seq_remlo(fields);
NEW0(*tail, PERM);
(*tail)->name = (char *)field->id;
(*tail)->type = uid2type(field->type);
(*tail)->offset = field->offset;
(*tail)->bitsize = field->bitsize;
(*tail)->lsb = field->lsb;
if (isconst((*tail)->type))
ty->u.sym->u.s.cfields = 1;
if (isvolatile((*tail)->type))
ty->u.sym->u.s.vfields = 1;
tail = &(*tail)->link;
free(field);
}
Seq_free(&fields);
break;
}
case rcc_FUNCTION_enum: {
int n = Seq_length(type->v.rcc_FUNCTION.formals);
if (n > 0) {
int i;
Type *proto = newarray(n + 1, sizeof *proto, PERM);
for (i = 0; i < n; i++) {
int *formal = Seq_remlo(type->v.rcc_FUNCTION.formals);
proto[i] = uid2type(*formal);
free(formal);
}
proto[i] = NULL;
ty = func(uid2type(type->v.rcc_FUNCTION.type), proto, 0);
} else
ty = func(uid2type(type->v.rcc_FUNCTION.type), NULL, 1);
Seq_free(&type->v.rcc_FUNCTION.formals);
break;
}
default: assert(0);
}
if (itemmap[uid] == NULL) {
itemmap[uid] = ty;
free(type);
free(items[uid]);
items[uid] = NULL;
} else
assert(itemmap[uid] == ty);
}
return itemmap[uid];
}
void gbres_comp::setup(const Matrix *m,
int length,
int origsyz,
int strategy)
{
int i;
originalR = m->get_ring()->cast_to_PolynomialRing();
if (originalR == NULL) assert(0);
GR = originalR->get_gb_ring();
mi_stash = new stash("res mi nodes", sizeof(Nmi_node));
FreeModule *Fsyz = originalR->make_Schreyer_FreeModule();
if (length <= 0)
{
ERROR("resolution length must be at least 1");
length = 1;
}
// If origsyz, and length>1, create Fsyz as a Schreyer free
// if origsyz is smaller, truncate this module...
if (length > 1 && origsyz > 0)
{
if (origsyz > m->n_cols())
origsyz = m->n_cols();
int *one = originalR->getMonoid()->make_one();
const int *mon;
for (i=0; i<origsyz; i++)
{
if ((*m)[i] == NULL)
mon = one;
else
{
Nterm *t = (*m)[i]->coeff;
mon = t->monom;
}
Fsyz->append_schreyer(m->cols()->degree(i), mon, i);
}
originalR->getMonoid()->remove(one);
}
lo_degree = m->cols()->lowest_primary_degree();
last_completed_degree = lo_degree-1;
n_nodes = length + 1;
nodes = newarray(gb_node_ptr,n_nodes);
nodes[0] = new gb_emitter(m);
nodes[1] = new gb2_comp(Fsyz,mi_stash,nodes[0],lo_degree,origsyz,1,strategy);
nodes[0]->set_output(nodes[1]);
if (n_nodes == 2)
{
// Don't compute syzygies at all.
nodes[1]->set_output(NULL);
}
else if (n_nodes >= 3)
{
// Compute a resolution to length 'length', with last being
// a gb node.
int deg = lo_degree+1;
if (origsyz > 0) deg--;
for (i=2; i<n_nodes-1; i++)
{
FreeModule *F = originalR->make_Schreyer_FreeModule();
nodes[i] = new gb2_comp(F,mi_stash,nodes[i-1],deg++,-1,i,strategy);
nodes[i-1]->set_output(nodes[i]);
}
FreeModule *F = originalR->make_Schreyer_FreeModule();
nodes[n_nodes-1] = new gb2_comp(F,mi_stash,nodes[n_nodes-2],deg++,0,n_nodes-1,strategy);
nodes[n_nodes-1]->set_output(NULL);
}
strategy_flags = strategy;
}
