/**************************************** * Computer Algebra System SINGULAR * ****************************************/ /* $Id$ */ /* * ABSTRACT: interpreter: * assignment of expressions and lists to objects or lists */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include //#include "weight.h" #include #include #include #include #include #ifdef HAVE_FANS #include #endif /*=================== proc =================*/ static BOOLEAN jjECHO(leftv res, leftv a) { si_echo=(int)((long)(a->Data())); return FALSE; } static BOOLEAN jjPRINTLEVEL(leftv res, leftv a) { printlevel=(int)((long)(a->Data())); return FALSE; } static BOOLEAN jjCOLMAX(leftv res, leftv a) { colmax=(int)((long)(a->Data())); return FALSE; } static BOOLEAN jjTIMER(leftv res, leftv a) { timerv=(int)((long)(a->Data())); initTimer(); return FALSE; } #ifdef HAVE_GETTIMEOFDAY static BOOLEAN jjRTIMER(leftv res, leftv a) { rtimerv=(int)((long)(a->Data())); initRTimer(); return FALSE; } #endif static BOOLEAN jjMAXDEG(leftv res, leftv a) { Kstd1_deg=(int)((long)(a->Data())); if (Kstd1_deg!=0) test |=Sy_bit(OPT_DEGBOUND); else test &=(~Sy_bit(OPT_DEGBOUND)); return FALSE; } static BOOLEAN jjMAXMULT(leftv res, leftv a) { Kstd1_mu=(int)((long)(a->Data())); if (Kstd1_mu!=0) test |=Sy_bit(OPT_MULTBOUND); else test &=(~Sy_bit(OPT_MULTBOUND)); return FALSE; } static BOOLEAN jjTRACE(leftv res, leftv a) { traceit=(int)((long)(a->Data())); return FALSE; } static BOOLEAN jjSHORTOUT(leftv res, leftv a) { if (currRing != NULL) { BOOLEAN shortOut = (BOOLEAN)((long)a->Data()); #if HAVE_CAN_SHORT_OUT if (!shortOut) currRing->ShortOut = 0; else { if (currRing->CanShortOut) currRing->ShortOut = 1; } #else currRing->ShortOut = shortOut; #endif } return FALSE; } static void jjMINPOLY_red(idhdl h) { switch(IDTYP(h)) { case NUMBER_CMD: { number n=(number)IDDATA(h); number one = nInit(1); number nn=nMult(n,one); nDelete(&n);nDelete(&one); IDDATA(h)=(char*)nn; break; } case VECTOR_CMD: case POLY_CMD: { poly p=(poly)IDDATA(h); IDDATA(h)=(char*)pMinPolyNormalize(p); break; } case IDEAL_CMD: case MODUL_CMD: case MAP_CMD: case MATRIX_CMD: { int i; ideal I=(ideal)IDDATA(h); for(i=IDELEMS(I)-1;i>=0;i--) I->m[i]=pMinPolyNormalize(I->m[i]); break; } case LIST_CMD: { lists L=(lists)IDDATA(h); int i=L->nr; for(;i>=0;i--) { jjMINPOLY_red((idhdl)&(L->m[i])); } } default: //case RESOLUTION_CMD: Werror("type %d too complex...set minpoly before",IDTYP(h)); break; } } static BOOLEAN jjMINPOLY(leftv res, leftv a) { number p=(number)a->CopyD(NUMBER_CMD); if (nIsZero(p)) { currRing->minpoly=NULL; naMinimalPoly=NULL; } else { if ((rPar(currRing)!=1) || (rField_is_GF())) { WerrorS("no minpoly allowed"); return TRUE; } if (currRing->minpoly!=NULL) { WerrorS("minpoly already set"); return TRUE; } nNormalize(p); currRing->minpoly=p; naMinimalPoly=((lnumber)currRing->minpoly)->z; if (p_GetExp(((lnumber)currRing->minpoly)->z,1,currRing->algring)==0) { Werror("minpoly must not be constant"); currRing->minpoly=NULL; naMinimalPoly=NULL; nDelete(&p); } // and now, normalize all already defined objects in this ring idhdl h=currRing->idroot; while(h!=NULL) { jjMINPOLY_red(h); h=IDNEXT(h); } } return FALSE; } static BOOLEAN jjNOETHER(leftv res, leftv a) { poly p=(poly)a->CopyD(POLY_CMD); pDelete(&ppNoether); ppNoether=p; return FALSE; } /*=================== proc =================*/ static void jiAssignAttr(leftv l,leftv r) { // get the attribute of th right side // and set it to l leftv rv=r->LData(); if (rv!=NULL) { if (rv->e==NULL) { if (rv->attribute!=NULL) { attr la; if (r->rtyp!=IDHDL) { la=rv->attribute; rv->attribute=NULL; } else { la=rv->attribute->Copy(); } l->attribute=la; } l->flag=rv->flag; } } if (l->rtyp==IDHDL) { idhdl h=(idhdl)l->data; IDATTR(h)=l->attribute; IDFLAG(h)=l->flag; } } static BOOLEAN jiA_INT(leftv res, leftv a, Subexpr e) { if (e==NULL) { res->data=(void *)a->Data(); jiAssignAttr(res,a); } else { int i=e->start-1; if (i<0) { Werror("index[%d] must be positive",i+1); return TRUE; } intvec *iv=(intvec *)res->data; if (e->next==NULL) { if (i>=iv->length()) { intvec *iv1=new intvec(i+1); (*iv1)[i]=(int)((long)(a->Data())); intvec *ivn=ivAdd(iv,iv1); delete iv; delete iv1; res->data=(void *)ivn; } else (*iv)[i]=(int)((long)(a->Data())); } else { int c=e->next->start; if ((i>=iv->rows())||(c<1)||(c>iv->cols())) { Werror("wrong range [%d,%d] in intmat (%d,%d)",i+1,c,iv->rows(),iv->cols()); return TRUE; } else IMATELEM(*iv,i+1,c) = (int)((long)(a->Data())); } } return FALSE; } static BOOLEAN jiA_NUMBER(leftv res, leftv a, Subexpr e) { number p=(number)a->CopyD(NUMBER_CMD); if (res->data!=NULL) nDelete((number *)&res->data); nNormalize(p); res->data=(void *)p; jiAssignAttr(res,a); return FALSE; } static BOOLEAN jiA_BIGINT(leftv res, leftv a, Subexpr e) { number p=(number)a->CopyD(BIGINT_CMD); if (res->data!=NULL) nlDelete((number *)&res->data,NULL); res->data=(void *)p; jiAssignAttr(res,a); return FALSE; } static BOOLEAN jiA_LIST_RES(leftv res, leftv a,Subexpr e) { syStrategy r=(syStrategy)a->CopyD(RESOLUTION_CMD); if (res->data!=NULL) ((lists)res->data)->Clean(); int add_row_shift = 0; intvec *weights=(intvec*)atGet(a,"isHomog",INTVEC_CMD); if (weights!=NULL) add_row_shift=weights->min_in(); res->data=(void *)syConvRes(r,TRUE,add_row_shift); //jiAssignAttr(res,a); return FALSE; } static BOOLEAN jiA_LIST(leftv res, leftv a,Subexpr e) { lists l=(lists)a->CopyD(LIST_CMD); if (res->data!=NULL) ((lists)res->data)->Clean(); res->data=(void *)l; jiAssignAttr(res,a); return FALSE; } #ifdef HAVE_FANS /* static BOOLEAN jiA_FAN(leftv res, leftv a, Subexpr e) { if (e != NULL) { WerrorS("unexpectedly encountered subexpression in jiA_FAN"); return TRUE; } if (res->data!=NULL) { Fan* fff = (Fan*)res->data; res->data = NULL; delete fff; } Fan* fff = (Fan*)a->CopyD(FAN_CMD); res->data=(void*)fff; return FALSE; }*/ static BOOLEAN jiA_CONE(leftv res, leftv a, Subexpr e) { if (e != NULL) { WerrorS("unexpectedly encountered subexpression in jiA_CONE"); return TRUE; } if (res->data!=NULL) { gfan::ZCone* zc = (gfan::ZCone*)res->data; res->data = NULL; delete zc; } gfan::ZCone* zc = (gfan::ZCone*)a->CopyD(CONE_CMD); res->data=(void*)zc; return FALSE; } #endif /* HAVE_FANS */ static BOOLEAN jiA_POLY(leftv res, leftv a,Subexpr e) { poly p=(poly)a->CopyD(POLY_CMD); pNormalize(p); if (e==NULL) { if (res->data!=NULL) pDelete((poly*)&res->data); res->data=(void*)p; jiAssignAttr(res,a); } else { int i,j; matrix m=(matrix)res->data; i=e->start; if (e->next==NULL) { j=i; i=1; // for all ideal like data types: check indices if (j>MATCOLS(m)) { pEnlargeSet(&(m->m),MATCOLS(m),j-MATCOLS(m)); MATCOLS(m)=j; } else if (j<=0) { Werror("index[%d] must be positive",j/*e->start*/); return TRUE; } } else { // for matrices: indices are correct (see ipExprArith3(..,'['..) ) j=e->next->start; } pDelete(&MATELEM(m,i,j)); MATELEM(m,i,j)=p; /* for module: update rank */ if ((p!=NULL) && (pGetComp(p)!=0)) { m->rank=si_max(m->rank,pMaxComp(p)); } } //if ((TEST_V_QRING) && (currQuotient!=NULL)) jjNormalizeQRingP(res); return FALSE; } static BOOLEAN jiA_1x1INTMAT(leftv res, leftv a,Subexpr e) { if ((res->rtyp!=INTMAT_CMD) /*|| (e!=NULL) - TRUE because of type int */) { // no error message: assignment simply fails return TRUE; } intvec* am=(intvec*)a->CopyD(INTMAT_CMD); if ((am->rows()!=1) || (am->cols()!=1)) { WerrorS("must be 1x1 intmat"); delete am; return TRUE; } intvec* m=(intvec *)res->data; // indices are correct (see ipExprArith3(..,'['..) ) int i=e->start; int j=e->next->start; IMATELEM(*m,i,j)=IMATELEM(*am,1,1); delete am; return FALSE; } static BOOLEAN jiA_1x1MATRIX(leftv res, leftv a,Subexpr e) { if ((res->rtyp!=MATRIX_CMD) /*|| (e!=NULL) - TRUE because of type poly */) { // no error message: assignment simply fails return TRUE; } matrix am=(matrix)a->CopyD(MATRIX_CMD); if ((MATROWS(am)!=1) || (MATCOLS(am)!=1)) { WerrorS("must be 1x1 matrix"); idDelete((ideal *)&am); return TRUE; } matrix m=(matrix)res->data; // indices are correct (see ipExprArith3(..,'['..) ) int i=e->start; int j=e->next->start; pDelete(&MATELEM(m,i,j)); pNormalize(MATELEM(am,1,1)); MATELEM(m,i,j)=MATELEM(am,1,1); MATELEM(am,1,1)=NULL; idDelete((ideal *)&am); return FALSE; } static BOOLEAN jiA_STRING(leftv res, leftv a, Subexpr e) { if (e==NULL) { void* tmp = res->data; res->data=(void *)a->CopyD(STRING_CMD); jiAssignAttr(res,a); omfree(tmp); } else { char *s=(char *)res->data; if ((e->start>0)&&(e->start<=(int)strlen(s))) s[e->start-1]=(char)(*((char *)a->Data())); else { Werror("string index %d out of range 1..%d",e->start,(int)strlen(s)); return TRUE; } } return FALSE; } static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr e) { extern procinfo *iiInitSingularProcinfo(procinfo *pi, const char *libname, const char *procname, int line, long pos, BOOLEAN pstatic=FALSE); extern void piCleanUp(procinfov pi); if(res->data!=NULL) piCleanUp((procinfo *)res->data); if(a->rtyp==STRING_CMD) { res->data = (void *)omAlloc0Bin(procinfo_bin); ((procinfo *)(res->data))->language=LANG_NONE; iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0); ((procinfo *)res->data)->data.s.body=(char *)a->CopyD(STRING_CMD); } else res->data=(void *)a->CopyD(PROC_CMD); jiAssignAttr(res,a); return FALSE; } static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr e) { //if ((res->data==NULL) || (res->Typ()==a->Typ())) { if (res->data!=NULL) delete ((intvec *)res->data); res->data=(void *)a->CopyD(INTVEC_CMD); jiAssignAttr(res,a); return FALSE; } #if 0 else { intvec *r=(intvec *)(res->data); intvec *s=(intvec *)(a->Data()); int i=si_min(r->length(), s->length())-1; for(;i>=0;i--) { (*r)[i]=(*s)[i]; } return FALSE; //(r->length()< s->length()); } #endif } static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr e) { if (res->data!=NULL) idDelete((ideal*)&res->data); res->data=(void *)a->CopyD(MATRIX_CMD); if (a->rtyp==IDHDL) idNormalize((ideal)a->Data()); else idNormalize((ideal)res->data); jiAssignAttr(res,a); if (((res->rtyp==IDEAL_CMD)||(res->rtyp==MODUL_CMD)) && (IDELEMS((ideal)(res->data))==1) && (currRing->qideal==NULL) && (!rIsPluralRing(currRing)) ) { setFlag(res,FLAG_STD); } //if ((TEST_V_QRING) && (currQuotient!=NULL)) jjNormalizeQRingId(res); return FALSE; } static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr e) { if (res->data!=NULL) syKillComputation((syStrategy)res->data); res->data=(void *)a->CopyD(RESOLUTION_CMD); jiAssignAttr(res,a); return FALSE; } static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr e) { if (res->data!=NULL) idDelete((ideal*)&res->data); ideal I=idInit(1,1); I->m[0]=(poly)a->CopyD(POLY_CMD); if (I->m[0]!=NULL) pSetCompP(I->m[0],1); pNormalize(I->m[0]); res->data=(void *)I; //if ((TEST_V_QRING) && (currQuotient!=NULL)) jjNormalizeQRingId(res); return FALSE; } static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr e) { if (res->data!=NULL) idDelete((ideal*)&res->data); matrix m=(matrix)a->CopyD(MATRIX_CMD); IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m); ((ideal)m)->rank=1; MATROWS(m)=1; idNormalize((ideal)m); res->data=(void *)m; //if ((TEST_V_QRING) && (currQuotient!=NULL)) jjNormalizeQRingId(res); return FALSE; } static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr e) { si_link l=(si_link)res->data; if (l!=NULL) slCleanUp(l); if (a->Typ() == STRING_CMD) { if (l == NULL) { l = (si_link) omAlloc0Bin(sip_link_bin); res->data = (void *) l; } return slInit(l, (char *) a->Data()); } else if (a->Typ() == LINK_CMD) { if (l != NULL) omFreeBin(l, sip_link_bin); res->data = slCopy((si_link)a->Data()); return FALSE; } return TRUE; } // assign map -> map static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr e) { if (res->data!=NULL) { omFree((ADDRESS)((map)res->data)->preimage); ((map)res->data)->preimage=NULL; idDelete((ideal*)&res->data); } res->data=(void *)a->CopyD(MAP_CMD); jiAssignAttr(res,a); return FALSE; } // assign ideal -> map static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr e) { map f=(map)res->data; char *rn=f->preimage; // save the old/already assigned preimage ring name f->preimage=NULL; idDelete((ideal *)&f); res->data=(void *)a->CopyD(IDEAL_CMD); f=(map)res->data; idNormalize((ideal)f); f->preimage = rn; return FALSE; } static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e) { // the follwing can only happen, if: // - the left side is of type qring AND not an id if ((e!=NULL)||(res->rtyp!=IDHDL)) { WerrorS("qring_id expected"); return TRUE; } ring qr; //qr=(ring)res->Data(); //if (qr!=NULL) omFreeBin((ADDRESS)qr, ip_sring_bin); assume(res->Data()==NULL); qr=rCopy(currRing); // we have to fill it, but the copy also allocates space idhdl h=(idhdl)res->data; // we have res->rtyp==IDHDL IDRING(h)=qr; ideal id=(ideal)a->CopyD(IDEAL_CMD); if ((idElem(id)>1) || rIsSCA(currRing) || (currRing->qideal!=NULL)) assumeStdFlag(a); if (currRing->qideal!=NULL) /* we are already in a qring! */ { ideal tmp=idSimpleAdd(id,currRing->qideal); // both ideals should be GB, so dSimpleAdd is sufficient idDelete(&id); id=tmp; // delete the qr copy of quotient ideal!!! idDelete(&qr->qideal); } qr->qideal = id; // qr is a copy of currRing with the new qideal! #ifdef HAVE_PLURAL if(rIsPluralRing(currRing)) { if (!hasFlag(a,FLAG_TWOSTD)) { Warn("%s is no twosided standard basis",a->Name()); } if( nc_SetupQuotient(qr, currRing) ) { // WarnS("error in nc_SetupQuotient"); } } #endif rSetHdl((idhdl)res->data); return FALSE; } static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e) { BOOLEAN have_id=TRUE; if ((e!=NULL)||(res->rtyp!=IDHDL)) { //WerrorS("id expected"); //return TRUE; have_id=FALSE; } ring r=(ring)a->Data(); if (have_id) { idhdl rl=(idhdl)res->data; if (IDRING(rl)!=NULL) rKill(rl); IDRING(rl)=r; if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing)) currRingHdl=(idhdl)res->data; } else { if (e==NULL) res->data=(char *)r; else { WerrorS("id expected"); return TRUE; } } r->ref++; jiAssignAttr(res,a); return FALSE; } static BOOLEAN jiA_PACKAGE(leftv res, leftv a, Subexpr e) { res->data=(void *)a->CopyD(PACKAGE_CMD); jiAssignAttr(res,a); return FALSE; } /*=================== table =================*/ #define IPASSIGN #define D(A) A #include /*=================== operations ============================*/ /*2 * assign a = b */ static BOOLEAN jiAssign_1(leftv l, leftv r) { int rt=r->Typ(); if (rt==0) { if (!errorreported) Werror("`%s` is undefined",r->Fullname()); return TRUE; } int lt=l->Typ(); if((lt==0)/*&&(l->name!=NULL)*/) { if (!errorreported) Werror("left side `%s` is undefined",l->Fullname()); return TRUE; } if((rt==DEF_CMD)||(rt==NONE)) { WarnS("right side is not a datum, assignment ignored"); // if (!errorreported) // WerrorS("right side is not a datum"); //return TRUE; return FALSE; } int i=0; BOOLEAN nok=FALSE; if (lt==DEF_CMD) { if (l->rtyp==IDHDL) { IDTYP((idhdl)l->data)=rt; } else if (l->name!=NULL) { sleftv ll; iiDeclCommand(&ll,l,myynest,rt,&IDROOT); memcpy(l,&ll,sizeof(sleftv)); } else { l->rtyp=rt; } lt=rt; } else { if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL)) return FALSE; } leftv ld=l; if ((l->rtyp==IDHDL)&&(lt!=QRING_CMD)&&(lt!=RING_CMD)) ld=(leftv)l->data; while (((dAssign[i].res!=lt) || (dAssign[i].arg!=rt)) && (dAssign[i].res!=0)) i++; if (dAssign[i].res!=0) { if (TEST_V_ALLWARN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt)); BOOLEAN b; b=dAssign[i].p(ld,r,l->e); if(l!=ld) /* i.e. l is IDHDL, l->data is ld */ { l->flag=ld->flag; l->attribute=ld->attribute; } return b; } // implicite type conversion ---------------------------------------------- if (dAssign[i].res==0) { int ri; leftv rn = (leftv)omAlloc0Bin(sleftv_bin); BOOLEAN failed=FALSE; i=0; while ((dAssign[i].res!=lt) && (dAssign[i].res!=0)) i++; while (dAssign[i].res==lt) { if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0) { failed= iiConvert(rt,dAssign[i].arg,ri,r,rn); if(!failed) { failed= dAssign[i].p(ld,rn,l->e); if (TEST_V_ALLWARN) Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed); } // everything done, clean up temp. variables rn->CleanUp(); omFreeBin((ADDRESS)rn, sleftv_bin); if (failed) { // leave loop, goto error handling break; } else { if(l!=ld) /* i.e. l is IDHDL, l->data is ld */ { l->flag=ld->flag; l->attribute=ld->attribute; } // everything ok, return return FALSE; } } i++; } // error handling --------------------------------------------------- if (!errorreported) { if ((l->rtyp==IDHDL) && (l->e==NULL)) Werror("`%s`(%s) = `%s` is not supported", Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt)); else Werror("`%s` = `%s` is not supported" ,Tok2Cmdname(lt),Tok2Cmdname(rt)); if (BVERBOSE(V_SHOW_USE)) { i=0; while ((dAssign[i].res!=lt) && (dAssign[i].res!=0)) i++; while (dAssign[i].res==lt) { Werror("expected `%s` = `%s`" ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg)); i++; } } } } return TRUE; } /*2 * assign sys_var = val */ static BOOLEAN iiAssign_sys(leftv l, leftv r) { int rt=r->Typ(); if (rt==0) { if (!errorreported) Werror("`%s` is undefined",r->Fullname()); return TRUE; } int i=0; int lt=l->rtyp; while (((dAssign_sys[i].res!=lt) || (dAssign_sys[i].arg!=rt)) && (dAssign_sys[i].res!=0)) i++; if (dAssign_sys[i].res!=0) { if (!dAssign_sys[i].p(l,r)) { // everything ok, clean up return FALSE; } } // implicite type conversion ---------------------------------------------- if (dAssign_sys[i].res==0) { int ri; leftv rn = (leftv)omAlloc0Bin(sleftv_bin); BOOLEAN failed=FALSE; i=0; while ((dAssign_sys[i].res!=lt) && (dAssign_sys[i].res!=0)) i++; while (dAssign_sys[i].res==lt) { if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0) { failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn)) || (dAssign_sys[i].p(l,rn))); // everything done, clean up temp. variables rn->CleanUp(); omFreeBin((ADDRESS)rn, sleftv_bin); if (failed) { // leave loop, goto error handling break; } else { // everything ok, return return FALSE; } } i++; } // error handling --------------------------------------------------- if(!errorreported) { Werror("`%s` = `%s` is not supported" ,Tok2Cmdname(lt),Tok2Cmdname(rt)); if (BVERBOSE(V_SHOW_USE)) { i=0; while ((dAssign_sys[i].res!=lt) && (dAssign_sys[i].res!=0)) i++; while (dAssign_sys[i].res==lt) { Werror("expected `%s` = `%s`" ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg)); i++; } } } } return TRUE; } static BOOLEAN jiA_INTVEC_L(leftv l,leftv r) { /* right side is intvec, left side is list (of int)*/ BOOLEAN nok; int i=0; leftv l1=l; leftv h; sleftv t; intvec *iv=(intvec *)r->Data(); memset(&t,0,sizeof(sleftv)); t.rtyp=INT_CMD; while ((ilength())&&(l!=NULL)) { t.data=(char *)(*iv)[i]; h=l->next; l->next=NULL; nok=jiAssign_1(l,&t); if (nok) return TRUE; i++; l=h; } l1->CleanUp(); r->CleanUp(); return FALSE; } static BOOLEAN jiA_VECTOR_L(leftv l,leftv r) { /* right side is vector, left side is list (of poly)*/ BOOLEAN nok; leftv l1=l; ideal I=idVec2Ideal((poly)r->Data()); leftv h; sleftv t; int i=0; while (l!=NULL) { memset(&t,0,sizeof(sleftv)); t.rtyp=POLY_CMD; if (i>=IDELEMS(I)) { t.data=NULL; } else { t.data=(char *)I->m[i]; I->m[i]=NULL; } h=l->next; l->next=NULL; nok=jiAssign_1(l,&t); t.CleanUp(); if (nok) { idDelete(&I); return TRUE; } i++; l=h; } idDelete(&I); l1->CleanUp(); r->CleanUp(); //if ((TEST_V_QRING) && (currQuotient!=NULL)) jjNormalizeQRingP(l); return FALSE; } static BOOLEAN jjA_L_LIST(leftv l, leftv r) /* left side: list/def, has to be a "real" variable * right side: expression list */ { int sl = r->listLength(); lists L=(lists)omAllocBin(slists_bin); lists oldL; leftv h=NULL,o_r=r; int i; int rt; L->Init(sl); for (i=0;inext=r; } h=r; r=r->next; h->next=NULL; rt=h->Typ(); if ((rt==0)||(rt==NONE)||(rt==DEF_CMD)) { L->Clean(); Werror("`%s` is undefined",h->Fullname()); //listall(); goto err; } //if ((rt==RING_CMD)||(rt==QRING_CMD)) //{ // L->m[i].rtyp=rt; // L->m[i].data=h->Data(); // ((ring)L->m[i].data)->ref++; //} //else L->m[i].CleanUp(); L->m[i].Copy(h); if(errorreported) { L->Clean(); goto err; } } oldL=(lists)l->Data(); if (oldL!=NULL) oldL->Clean(); if (l->rtyp==IDHDL) { IDLIST((idhdl)l->data)=L; IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD ipMoveId((idhdl)l->data); } else { l->LData()->data=L; if ((l->e!=NULL) && (l->rtyp==DEF_CMD)) l->rtyp=LIST_CMD; } err: o_r->CleanUp(); return errorreported; } static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv) { /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/ leftv hh=r; int i = 0; while (hh!=NULL) { if (i>=iv->length()) break; if (hh->Typ() == INT_CMD) { (*iv)[i++] = (int)((long)(hh->Data())); } else if ((hh->Typ() == INTVEC_CMD) ||(hh->Typ() == INTMAT_CMD)) { intvec *ivv = (intvec *)(hh->Data()); int ll = 0,l = si_min(ivv->length(),iv->length()); for (; l>0; l--) { (*iv)[i++] = (*ivv)[ll++]; } } else { delete iv; return TRUE; } hh = hh->next; } if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data); IDINTVEC((idhdl)l->data)=iv; return FALSE; } static BOOLEAN jjA_L_STRING(leftv l,leftv r) { /* left side is string, right side is list of string*/ leftv hh=r; int sl = 1; char *s; char *t; int tl; /* find the length */ while (hh!=NULL) { if (hh->Typ()!= STRING_CMD) { return TRUE; } sl += strlen((char *)hh->Data()); hh = hh->next; } s = (char * )omAlloc(sl); sl=0; hh = r; while (hh!=NULL) { t=(char *)hh->Data(); tl=strlen(t); memcpy(s+sl,t,tl); sl+=tl; hh = hh->next; } s[sl]='\0'; omFree((ADDRESS)IDDATA((idhdl)(l->data))); IDDATA((idhdl)(l->data))=s; return FALSE; } static BOOLEAN jjA_LIST_L(leftv l,leftv r) { /*left side are something, right side are lists*/ /*e.g. a,b,c=l */ //int ll=l->listLength(); if (l->listLength()==1) return jiAssign_1(l,r); BOOLEAN nok; sleftv t; leftv h; lists L=(lists)r->Data(); int rl=L->nr; int i=0; memset(&t,0,sizeof(sleftv)); while ((i<=rl)&&(l!=NULL)) { memset(&t,0,sizeof(sleftv)); t.Copy(&L->m[i]); h=l->next; l->next=NULL; nok=jiAssign_1(l,&t); if (nok) return TRUE; i++; l=h; } r->CleanUp(); return FALSE; } static BOOLEAN jiA_MATRIX_L(leftv l,leftv r) { /* right side is matrix, left side is list (of poly)*/ BOOLEAN nok=FALSE; int i; matrix m=(matrix)r->CopyD(MATRIX_CMD); leftv h; leftv ol=l; leftv o_r=r; sleftv t; memset(&t,0,sizeof(sleftv)); t.rtyp=POLY_CMD; int mxn=MATROWS(m)*MATCOLS(m); loop { i=0; while ((im[i]; m->m[i]=NULL; h=l->next; l->next=NULL; nok=jiAssign_1(l,&t); l->next=h; if (nok) { idDelete((ideal *)&m); goto ende; } i++; l=h; } idDelete((ideal *)&m); h=r; r=r->next; if (l==NULL) { if (r!=NULL) { Warn("list length mismatch in assign (l>r)"); nok=TRUE; } break; } else if (r==NULL) { Warn("list length mismatch in assign (lTyp()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD)) { m=(matrix)r->CopyD(MATRIX_CMD); mxn=MATROWS(m)*MATCOLS(m); } else if (r->Typ()==POLY_CMD) { m=mpNew(1,1); MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD); pNormalize(MATELEM(m,1,1)); mxn=1; } else { nok=TRUE; break; } } ende: o_r->CleanUp(); ol->CleanUp(); return nok; } static BOOLEAN jiA_STRING_L(leftv l,leftv r) { /*left side are strings, right side is a string*/ /*e.g. s[2..3]="12" */ /*the case s=t[1..4] is handled in iiAssign, * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/ int ll=l->listLength(); int rl=r->listLength(); BOOLEAN nok=FALSE; sleftv t; leftv h,l1=l; int i=0; char *ss; char *s=(char *)r->Data(); int sl=strlen(s); memset(&t,0,sizeof(sleftv)); t.rtyp=STRING_CMD; while ((inext; l->next=NULL; nok=jiAssign_1(l,&t); if (nok) { break; } i++; l=h; } r->CleanUp(); l1->CleanUp(); return nok; } static BOOLEAN jiAssign_list(leftv l, leftv r) { int i=l->e->start-1; if (i<0) { Werror("index[%d] must be positive",i+1); return TRUE; } if(l->attribute!=NULL) { atKillAll((idhdl)l); l->attribute=NULL; } l->flag=0; lists li; if (l->rtyp==IDHDL) { li=IDLIST((idhdl)l->data); } else { li=(lists)l->data; } if (i>li->nr) { li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv)); memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv)); int j=li->nr+1; for(;j<=i;j++) li->m[j].rtyp=DEF_CMD; li->nr=i; } leftv ld=&(li->m[i]); ld->e=l->e->next; BOOLEAN b; if (/*(ld->rtyp!=LIST_CMD) &&*/(ld->e==NULL) &&(ld->Typ()!=r->Typ())) { sleftv tmp; memset(&tmp,0,sizeof(sleftv)); tmp.rtyp=DEF_CMD; b=iiAssign(&tmp,r); ld->CleanUp(); memcpy(ld,&tmp,sizeof(sleftv)); } else { b=iiAssign(ld,r); if (l->e!=NULL) l->e->next=ld->e; ld->e=NULL; } return b; } static BOOLEAN jiAssign_rec(leftv l, leftv r) { leftv l1=l; leftv r1=r; leftv lrest; leftv rrest; BOOLEAN b; do { lrest=l->next; rrest=r->next; l->next=NULL; r->next=NULL; b=iiAssign(l,r); l->next=lrest; r->next=rrest; l=lrest; r=rrest; } while ((!b)&&(l!=NULL)); l1->CleanUp(); r1->CleanUp(); return b; } #ifdef HAVE_FANS /* BOOLEAN jjAssignFan(leftv l, leftv r) {*/ /* method for generating a fan; valid parametrizations: (intmat or 0, intmat or 0, intmat or 0), The intmat's capture the maximal rays, facet normals and the lineality space of the new fan. Any of the arguments may be the int 0. But either the 1st or 2nd argument must be an intmat, thus not both simultaneously the int 0. Errors will be invoked in the following cases: - 1st and 2nd argument simultaneously the int 0, - numbers of rows in 1st, 2nd, and/or 3rd argument intmat disagree */ // intvec* maxRays = NULL; /* maximal rays */ // intvec* facetNs = NULL; /* facet normals */ // intvec* linSpace = NULL; /* lineality space */ /* leftv x = r; if (x->Typ() == INTMAT_CMD) maxRays = (intvec*)x->Data(); else if ((x->Typ() != INT_CMD) || ((x->Typ() == INT_CMD) && ((int)(long)x->Data() != 0))) { WerrorS("expected '0' or an intmat as 1st argument"); return TRUE; } x = x->next; if (x->Typ() == INTMAT_CMD) facetNs = (intvec*)x->Data(); else if ((x->Typ() != INT_CMD) || ((x->Typ() == INT_CMD) && ((int)(long)x->Data() != 0))) { WerrorS("expected '0' or an intmat as 2nd argument"); return TRUE; } if ((maxRays == NULL) && (facetNs == NULL)) { WerrorS("expected 1st or 2nd argument to be a valid intmat"); return TRUE; } x = x->next; if (x->Typ() == INTMAT_CMD) linSpace = (intvec*)x->Data(); else if ((x->Typ() != INT_CMD) || ((x->Typ() == INT_CMD) && ((int)(long)x->Data() != 0))) { WerrorS("expected '0' or an intmat as 3rd argument"); return TRUE; } if ((maxRays != NULL) && (facetNs != NULL) && (maxRays->rows() != facetNs->rows())) { WerrorS("vector space dims do not agree (1st vs. 2nd argument)"); return TRUE; } if ((maxRays != NULL) && (linSpace != NULL) && (maxRays->rows() != linSpace->rows())) { WerrorS("vector space dims do not agree (1st vs. 3rd argument)"); return TRUE; } if (IDDATA((idhdl)l->data) != NULL) { Fan* fff = (Fan*)IDDATA((idhdl)l->data); delete fff; } Fan* fff = new Fan(maxRays, facetNs, linSpace); IDDATA((idhdl)l->data) = (char*)fff; return FALSE; }*/ BOOLEAN jjAssignCone(leftv l, leftv r) { /* method for generating a cone; valid parametrizations: int (ambient dimension), Errors will be invoked in the following cases: - argument < 0 */ if (r->Typ() != INT_CMD) { WerrorS("expected an int as argument"); return TRUE; } int ambientDim = (int)(long)r->Data(); if (ambientDim < 0) { Werror("expected an int >= 0, but got %d", ambientDim); return TRUE; } if (IDDATA((idhdl)l->data) != NULL) { gfan::ZCone* zc = (gfan::ZCone*)IDDATA((idhdl)l->data); delete zc; } gfan::ZCone* zc = new gfan::ZCone(ambientDim); IDDATA((idhdl)l->data) = (char*)zc; return FALSE; } #endif /* HAVE_FANS */ BOOLEAN iiAssign(leftv l, leftv r) { if (errorreported) return TRUE; int ll=l->listLength(); int rl; int lt=l->Typ(); int rt=NONE; BOOLEAN b; if (l->rtyp==ALIAS_CMD) { Werror("`%s` is read-only",l->Name()); } if(l->attribute!=NULL) { if (l->rtyp==IDHDL) { atKillAll((idhdl)l->data); l->attribute=NULL; } else atKillAll((idhdl)l); } if(l->rtyp==IDHDL) { IDFLAG((idhdl)l->data)=0; } l->flag=0; if (ll==1) { /* l[..] = ... */ if((l->e!=NULL) && (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD)) || (l->rtyp==LIST_CMD))) { if (TEST_V_ALLWARN) PrintS("assign list[..]=...\n"); b=jiAssign_list(l,r); if(!b) { //Print("jjA_L_LIST: - 2 \n"); if((l->rtyp==IDHDL) && (l->data!=NULL)) { ipMoveId((idhdl)l->data); l->attribute=IDATTR((idhdl)l->data); l->flag=IDFLAG((idhdl)l->data); } } r->CleanUp(); Subexpr h; while (l->e!=NULL) { h=l->e->next; omFreeBin((ADDRESS)l->e, sSubexpr_bin); l->e=h; } return b; } rl=r->listLength(); if (rl==1) { #ifdef HAVE_FANS if ((l->Typ() == CONE_CMD) && (r->Typ() == INT_CMD)) return jjAssignCone(l, r); #endif /* system variables = ... */ if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL)) ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY))) { b=iiAssign_sys(l,r); r->CleanUp(); //l->CleanUp(); return b; } rt=r->Typ(); /* a = ... */ if ((lt!=MATRIX_CMD) &&(lt!=INTMAT_CMD) &&((lt==rt)||(lt!=LIST_CMD))) { b=jiAssign_1(l,r); if (l->rtyp==IDHDL) { if ((lt==DEF_CMD)||(lt==LIST_CMD)) { ipMoveId((idhdl)l->data); } l->attribute=IDATTR((idhdl)l->data); l->flag=IDFLAG((idhdl)l->data); l->CleanUp(); } r->CleanUp(); return b; } if (((lt!=LIST_CMD) &&((rt==MATRIX_CMD) ||(rt==INTMAT_CMD) ||(rt==INTVEC_CMD) ||(rt==MODUL_CMD))) ||((lt==LIST_CMD) &&(rt==RESOLUTION_CMD)) ) { b=jiAssign_1(l,r); if((l->rtyp==IDHDL)&&(l->data!=NULL)) { if ((lt==DEF_CMD) || (lt==LIST_CMD)) { //Print("ipAssign - 3.0\n"); ipMoveId((idhdl)l->data); } l->attribute=IDATTR((idhdl)l->data); l->flag=IDFLAG((idhdl)l->data); } r->CleanUp(); Subexpr h; while (l->e!=NULL) { h=l->e->next; omFreeBin((ADDRESS)l->e, sSubexpr_bin); l->e=h; } return b; } } #ifdef HAVE_FANS /* else if ((lt == FAN_CMD) && (rl == 3)) { return jjAssignFan(l, r); }*/ #endif /* HAVE_FANS */ if (rt==NONE) rt=r->Typ(); } else if (ll==(rl=r->listLength())) { b=jiAssign_rec(l,r); return b; } else { if (rt==NONE) rt=r->Typ(); if (rt==INTVEC_CMD) return jiA_INTVEC_L(l,r); else if (rt==VECTOR_CMD) return jiA_VECTOR_L(l,r); else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD)) return jiA_MATRIX_L(l,r); else if ((rt==STRING_CMD)&&(rl==1)) return jiA_STRING_L(l,r); Werror("length of lists in assignment does not match (l:%d,r:%d)", ll,rl); return TRUE; } leftv hh=r; BOOLEAN nok=FALSE; BOOLEAN map_assign=FALSE; switch (lt) { case INTVEC_CMD: nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r))); break; case INTMAT_CMD: { nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data))); break; } case MAP_CMD: { // first element in the list sl (r) must be a ring if (((rt == RING_CMD)||(rt == QRING_CMD))&&(r->e==NULL)) { omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage); IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname()); /* advance the expressionlist to get the next element after the ring */ hh = r->next; //r=hh; } else { WerrorS("expected ring-name"); nok=TRUE; break; } if (hh==NULL) /* map-assign: map f=r; */ { WerrorS("expected image ideal"); nok=TRUE; break; } if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD)) return jiAssign_1(l,hh); /* map-assign: map f=r,i; */ //no break, handle the rest like an ideal: map_assign=TRUE; } case MATRIX_CMD: case IDEAL_CMD: case MODUL_CMD: { sleftv t; matrix olm = (matrix)l->Data(); int rk=olm->rank; char *pr=((map)olm)->preimage; BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD); matrix lm ; int num; int j,k; int i=0; int mtyp=MATRIX_CMD; /*Type of left side object*/ int etyp=POLY_CMD; /*Type of elements of left side object*/ if (lt /*l->Typ()*/==MATRIX_CMD) { num=olm->cols()*olm->rows(); lm=mpNew(olm->rows(),olm->cols()); } else /* IDEAL_CMD or MODUL_CMD */ { num=exprlist_length(hh); lm=(matrix)idInit(num,1); rk=1; if (module_assign) { mtyp=MODUL_CMD; etyp=VECTOR_CMD; } } int ht; loop { if (hh==NULL) break; else { matrix rm; ht=hh->Typ(); if ((j=iiTestConvert(ht,etyp))!=0) { nok=iiConvert(ht,etyp,j,hh,&t); hh->next=t.next; if (nok) break; lm->m[i]=(poly)t.CopyD(etyp); pNormalize(lm->m[i]); if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i])); i++; } else if ((j=iiTestConvert(ht,mtyp))!=0) { nok=iiConvert(ht,mtyp,j,hh,&t); hh->next=t.next; if (nok) break; rm = (matrix)t.CopyD(mtyp); if (module_assign) { j = si_min(num,rm->cols()); rk=si_max(rk,(int)rm->rank); } else j = si_min(num-i,rm->rows() * rm->cols()); for(k=0;km[i]=rm->m[k]; pNormalize(lm->m[i]); rm->m[k]=NULL; } idDelete((ideal *)&rm); } else { nok=TRUE; break; } t.next=NULL;t.CleanUp(); if (i==num) break; hh=hh->next; } } if (nok) idDelete((ideal *)&lm); else { idDelete((ideal *)&olm); if (module_assign) lm->rank=rk; else if (map_assign) ((map)lm)->preimage=pr; l=l->LData(); if (l->rtyp==IDHDL) IDMATRIX((idhdl)l->data)=lm; else l->data=(char *)lm; } break; } case STRING_CMD: nok=jjA_L_STRING(l,r); break; case DEF_CMD: case LIST_CMD: nok=jjA_L_LIST(l,r); break; case NONE: case 0: Werror("cannot assign to %s",l->Fullname()); nok=TRUE; break; default: WerrorS("assign not impl."); nok=TRUE; break; } /* end switch: typ */ if (nok && (!errorreported)) WerrorS("incompatible type in list assignment"); r->CleanUp(); return nok; } void jjNormalizeQRingId(leftv I) { if ((currQuotient!=NULL) && (!hasFlag(I,FLAG_QRING))) { if (I->e==NULL) { ideal F=idInit(1,1); ideal I0=(ideal)I->Data(); ideal II=kNF(F,currQuotient,I0); idDelete(&F); if ((I->rtyp==IDEAL_CMD) || (I->rtyp==MODUL_CMD) ) { idDelete((ideal*)&(I0)); I->data=II; } else if (I->rtyp==IDHDL) { idhdl h=(idhdl)I->data; idDelete((ideal*)&IDIDEAL(h)); IDIDEAL(h)=II; setFlag(h,FLAG_QRING); } else { idDelete(&II); } setFlag(I,FLAG_QRING); } } } void jjNormalizeQRingP(leftv I) { if ((currQuotient!=NULL) && (!hasFlag(I,FLAG_QRING))) { if (I->e==NULL) { ideal F=idInit(1,1); poly II=kNF(F,currQuotient,(poly)I->Data()); idDelete(&F); if ((I->rtyp==POLY_CMD) || (I->rtyp==VECTOR_CMD)) { pDelete((poly*)&(I->data)); I->data=II; } else if (I->rtyp==IDHDL) { idhdl h=(idhdl)I->data; pDelete((poly*)&IDPOLY(h)); IDPOLY(h)=II; setFlag(h,FLAG_QRING); } else { pDelete(&II); } setFlag(I,FLAG_QRING); } } } BOOLEAN jjIMPORTFROM(leftv res, leftv u, leftv v) { //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() ); assume(u->Typ()==PACKAGE_CMD); char *vn=(char *)v->Name(); idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest); if (h!=NULL) { //check for existence if (((package)(u->Data()))==basePack) { WarnS("source and destination packages are identical"); return FALSE; } idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest); if (t!=NULL) { Warn("redefining `%s`",vn); killhdl(t); } sleftv tmp_expr; if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE; sleftv h_expr; memset(&h_expr,0,sizeof(h_expr)); h_expr.rtyp=IDHDL; h_expr.data=h; h_expr.name=vn; return iiAssign(&tmp_expr,&h_expr); } else { Werror("`%s` not found in `%s`",v->Name(), u->Name()); return TRUE; } return FALSE; }