/**************************************** * Computer Algebra System SINGULAR * ****************************************/ /* $Id$ */ /* * ABSTRACT: attributes to leftv and idhdl */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include static omBin sattr_bin = omGetSpecBin(sizeof(sattr)); void sattr::Print() { omCheckAddrSize(this,sizeof(sattr)); ::Print("attr:%s, type %s \n",name,Tok2Cmdname(atyp)); if (next!=NULL) next->Print(); } attr sattr::Copy() { if (this!=NULL) { omCheckAddrSize(this,sizeof(sattr)); attr n=(attr)omAlloc0Bin(sattr_bin); n->atyp=atyp; if (name!=NULL) n->name=omStrDup(name); n->data=CopyA(); if (next!=NULL) { n->next=next->Copy(); } return n; } else return NULL; } // in subexr.cc: //void * sattr::CopyA() //{ // omCheckAddrSize(this,sizeof(sattr)); // return s_internalCopy(atyp,data); //} static void attr_free(attr h, const ring r=currRing) { s_internalDelete(h->atyp,h->data,r); h->data=NULL; } attr sattr::set(const char * s, void * d, int t) { attr h = get(s); attr result=this; if (h!=NULL) { attr_free(h); } else { h = (attr)omAlloc0Bin(sattr_bin); h->next = this; result=h; } h->name = s; h->data = d; h->atyp = t; #ifdef TEST //::Print("set attr >>%s<< of type %s\n",h->name, Tok2Cmdname(t)); #endif return result; } attr sattr::get(const char * s) { attr h = this; while (h!=NULL) { if (0 == strcmp(s,h->name)) { #ifdef TEST //::Print("get attr >>%s<< of type %s\n",h->name, Tok2Cmdname(h->atyp)); #endif return h; } h = h->next; } return NULL; } void * atGet(idhdl root,const char * name) { attr temp = root->attribute->get(name); if (temp!=NULL) return temp->data; else return NULL; } void * atGet(leftv root,const char * name) { attr temp; attr a=*(root->Attribute()); temp = a->get(name); if (temp!=NULL) return temp->data; else return NULL; } void * atGet(idhdl root,const char * name, int t) { attr temp = root->attribute->get(name); if ((temp!=NULL) && (temp->atyp==t)) return temp->data; else return NULL; } void * atGet(leftv root,const char * name, int t) { attr a=*(root->Attribute()); attr temp = a->get(name); if ((temp!=NULL) && (temp->atyp==t)) return temp->data; else return NULL; } void atSet(idhdl root,const char * name,void * data,int typ) { if (root!=NULL) { if ((IDTYP(root)!=RING_CMD) && (IDTYP(root)!=QRING_CMD) && (!RingDependend(IDTYP(root)))&&(RingDependend(typ))) WerrorS("cannot set ring-dependend objects at this type"); else root->attribute=root->attribute->set(name,data,typ); } } void atSet(leftv root,const char * name,void * data,int typ) { if (root!=NULL) { attr *a=root->Attribute(); int rt=root->Typ(); if ((rt!=RING_CMD) && (rt!=QRING_CMD) && (!RingDependend(rt))&&(RingDependend(typ))) WerrorS("cannot set ring-dependend objects at this type"); else { *a=(*a)->set(name,data,typ); } } } void sattr::kill(const ring r) { attr_free(this,r); omFree((ADDRESS)name); name=NULL; omFreeBin((ADDRESS)this, sattr_bin); } void sattr::killAll(const ring r) { attr temp = this,temp1; while (temp!=NULL) { temp1 = temp->next; omCheckAddr(temp); temp->kill(r); temp = temp1; } } void at_Kill(idhdl root,const char * name, const ring r) { attr temp = root->attribute->get(name); if (temp!=NULL) { attr N = temp->next; attr temp1 = root->attribute; if (temp1==temp) { root->attribute = N; } else { while (temp1->next!=temp) temp1 = temp1->next; temp1->next = N; } temp->kill(r); } } void at_KillAll(idhdl root, const ring r) { root->attribute->killAll(r); root->attribute = NULL; } void at_KillAll(leftv root, const ring r) { root->attribute->killAll(r); root->attribute = NULL; } BOOLEAN atATTRIB1(leftv res,leftv v) { int t; attr *aa=(v->Attribute()); if (aa==NULL) { WerrorS("this object cannot have attributes"); return TRUE; } attr a=*aa; BOOLEAN haveNoAttribute=TRUE; if (v->e==NULL) { if (hasFlag(v,FLAG_STD)) { PrintS("attr:isSB, type int\n"); haveNoAttribute=FALSE; } if (hasFlag(v,FLAG_QRING)) { PrintS("attr:qringNF, type int\n"); haveNoAttribute=FALSE; } if (((t=v->Typ())==RING_CMD)||(t==QRING_CMD)) { PrintS("attr:global, type int\n"); haveNoAttribute=FALSE; } } else { leftv at=v->LData(); return atATTRIB1(res,at); } if (a!=NULL) a->Print(); else if(haveNoAttribute) PrintS("no attributes\n"); return FALSE; } BOOLEAN atATTRIB2(leftv res,leftv v,leftv b) { char *name=(char *)b->Data(); int t; leftv at=NULL; if (v->e!=NULL) at=v->LData(); if (strcmp(name,"isSB")==0) { res->rtyp=INT_CMD; res->data=(void *)(long)hasFlag(v,FLAG_STD); if (at!=NULL) res->data=(void *)(long)(hasFlag(v,FLAG_STD)||(hasFlag(at,FLAG_STD))); } else if ((strcmp(name,"rank")==0)&&(v->Typ()==MODUL_CMD)) { res->rtyp=INT_CMD; res->data=(void *)(((ideal)v->Data())->rank); } else if ((strcmp(name,"global")==0) &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD))) { res->rtyp=INT_CMD; res->data=(void *)(((ring)v->Data())->OrdSgn==1); } else if (strcmp(name,"qringNF")==0) { res->rtyp=INT_CMD; res->data=(void *)(long)hasFlag(v,FLAG_QRING); if (at!=NULL) res->data=(void *)(long)(hasFlag(v,FLAG_QRING)||(hasFlag(at,FLAG_QRING))); } #ifdef HAVE_SHIFTBBA else if ((strcmp(name,"isLPring")==0) &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD))) { res->rtyp=INT_CMD; res->data=(void *)(long)(((ring)v->Data())->isLPring); } #endif else { attr *aa=v->Attribute(); if (aa==NULL) { WerrorS("this object cannot have attributes"); return TRUE; } attr a=*aa; a=a->get(name); if (a!=NULL) { res->rtyp=a->atyp; res->data=a->CopyA(); } else { res->rtyp=STRING_CMD; res->data=omStrDup(""); } } return FALSE; } BOOLEAN atATTRIB3(leftv res,leftv v,leftv b,leftv c) { idhdl h=(idhdl)v->data; int t; if (v->e!=NULL) { v=v->LData(); if (v==NULL) return TRUE; h=NULL; } else if (v->rtyp!=IDHDL) h=NULL; char *name=(char *)b->Data(); if (strcmp(name,"isSB")==0) { if (c->Typ()!=INT_CMD) { WerrorS("attribute isSB must be int"); return TRUE; } if (((long)c->Data())!=0L) { if (h!=NULL) setFlag(h,FLAG_STD); setFlag(v,FLAG_STD); } else { if (h!=NULL) resetFlag(h,FLAG_STD); resetFlag(v,FLAG_STD); } } else if (strcmp(name,"qringNF")==0) { if (c->Typ()!=INT_CMD) { WerrorS("attribute qringNF must be int"); return TRUE; } if (((long)c->Data())!=0L) { if (h!=NULL) setFlag(h,FLAG_QRING); setFlag(v,FLAG_QRING); } else { if (h!=NULL) resetFlag(h,FLAG_QRING); resetFlag(v,FLAG_QRING); } } else if ((strcmp(name,"rank")==0)&&(v->Typ()==MODUL_CMD)) { if (c->Typ()!=INT_CMD) { WerrorS("attribute `rank` must be int"); return TRUE; } ideal I=(ideal)v->Data(); I->rank=si_max((int)I->rank,(int)((long)c->Data())); } else if ((strcmp(name,"global")==0) &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD))) { WerrorS("can not set attribute `global`"); return TRUE; } #ifdef HAVE_SHIFTBBA else if ((strcmp(name,"isLPring")==0) &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD))) { if (c->Typ()==INT_CMD) ((ring)v->Data())->isLPring=(int)(long)c->Data(); else { WerrorS("attribute `isLPring` must be int"); return TRUE; } } #endif else { int typ=c->Typ(); if (h!=NULL) atSet(h,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/); else atSet(v,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/); } return FALSE; } BOOLEAN atKILLATTR1(leftv res,leftv a) { idhdl h=NULL; if ((a->rtyp==IDHDL)&&(a->e==NULL)) { h=(idhdl)a->data; resetFlag((idhdl)a->data,FLAG_STD); } resetFlag(a,FLAG_STD); if (h->attribute!=NULL) { atKillAll(h); a->attribute=NULL; } else atKillAll(a); return FALSE; } BOOLEAN atKILLATTR2(leftv res,leftv a,leftv b) { if ((a->rtyp!=IDHDL)||(a->e!=NULL)) { WerrorS("object must have a name"); return TRUE; } char *name=(char *)b->Data(); if (strcmp(name,"isSB")==0) { resetFlag(a,FLAG_STD); resetFlag((idhdl)a->data,FLAG_STD); } else if (strcmp(name,"global")==0) { WerrorS("can not set attribut `global`"); return TRUE; } else { atKill((idhdl)a->data,name); } return FALSE; }