1 /****************************************
2 *  Computer Algebra System SINGULAR     *
3 ****************************************/
4 
5 /*
6 * ABSTRACT: attributes to leftv and idhdl
7 */
8 
9 #include "kernel/mod2.h"
10 
11 #include "misc/options.h"
12 #include "misc/intvec.h"
13 
14 #include "polys/matpol.h"
15 
16 #include "kernel/polys.h"
17 #include "kernel/ideals.h"
18 
19 #include "Singular/tok.h"
20 #include "Singular/ipid.h"
21 #include "Singular/ipshell.h"
22 #include "Singular/attrib.h"
23 
24 STATIC_VAR omBin sattr_bin = omGetSpecBin(sizeof(sattr));
25 
Print()26 void sattr::Print()
27 {
28   omCheckAddrSize(this,sizeof(sattr));
29   ::Print("attr:%s, type %s \n",name,Tok2Cmdname(atyp));
30   if (next!=NULL) next->Print();
31 }
32 
Copy()33 attr sattr::Copy()
34 {
35   assume (this!=NULL);
36 
37   omCheckAddrSize(this,sizeof(sattr));
38   attr n=(attr)omAlloc0Bin(sattr_bin);
39   n->atyp=atyp;
40   if (name!=NULL) n->name=omStrDup(name);
41   n->data=CopyA();
42   if (next!=NULL)
43   {
44     n->next=next->Copy();
45   }
46   return n;
47 }
48 
49 // in subexr.cc:
50 //void * sattr::CopyA()
51 //{
52 //  omCheckAddrSize(this,sizeof(sattr));
53 //  return s_internalCopy(atyp,data);
54 //}
55 
attr_free(attr h,const ring r=currRing)56 static void attr_free(attr h, const ring r=currRing)
57 {
58   if (h->name!=NULL)
59   {
60     omFree(h->name);
61     h->name=NULL;
62   }
63   if (h->data!=NULL) /*avoid assume failure */
64   {
65     s_internalDelete(h->atyp,h->data,r);
66     h->data=NULL;
67   }
68 }
69 
set(char * s,void * d,int t)70 attr sattr::set(char * s, void * d, int t)
71 {
72   attr h = get(s);
73   attr result=this;
74   if (h!=NULL)
75   {
76     attr_free(h);
77   }
78   else
79   {
80     h = (attr)omAlloc0Bin(sattr_bin);
81     h->next = this;
82     result=h;
83   }
84   h->name = s;
85   h->data = d;
86   h->atyp = t;
87 #ifdef TEST
88   //::Print("set attr >>%s<< of type %s\n",h->name, Tok2Cmdname(t));
89 #endif
90   return  result;
91 }
92 
get(const char * s)93 attr sattr::get(const char * s)
94 {
95   attr h = this;
96   while (h!=NULL)
97   {
98     if (0 == strcmp(s,h->name))
99     {
100 #ifdef TEST
101       //::Print("get attr >>%s<< of type %s\n",h->name, Tok2Cmdname(h->atyp));
102 #endif
103       return h;
104     }
105     h = h->next;
106   }
107   return NULL;
108 }
109 
110 #if 0
111 void * atGet(idhdl root,const char * name)
112 {
113   attr temp = root->attribute->get(name);
114   if (temp!=NULL)
115     return temp->data;
116   else
117     return NULL;
118 }
119 
120 void * atGet(leftv root,const char * name)
121 {
122   attr temp;
123   attr a=*(root->Attribute());
124   temp = a->get(name);
125   if (temp!=NULL)
126     return temp->data;
127   else
128     return NULL;
129 }
130 #endif
131 
atGet(idhdl root,const char * name,int t,void * defaultReturnValue)132 void * atGet(idhdl root,const char * name, int t, void *defaultReturnValue)
133 {
134   attr temp = root->attribute->get(name);
135   if ((temp!=NULL) && (temp->atyp==t))
136     return temp->data;
137   else
138     return defaultReturnValue;
139 }
140 
atGet(leftv root,const char * name,int t)141 void * atGet(leftv root,const char * name, int t)
142 {
143   attr *a=(root->Attribute());
144   if (a!=NULL)
145   {
146     attr temp = (*a)->get(name);
147     if ((temp!=NULL) && (temp->atyp==t))
148       return temp->data;
149   }
150   return NULL;
151 }
152 
atSet(idhdl root,char * name,void * data,int typ)153 void atSet(idhdl root, char * name,void * data,int typ)
154 {
155   if (root!=NULL)
156   {
157     if ((IDTYP(root)!=RING_CMD)
158     && (!RingDependend(IDTYP(root)))&&(RingDependend(typ)))
159       WerrorS("cannot set ring-dependend objects at this type");
160     else
161       root->attribute=root->attribute->set(name,data,typ);
162   }
163 }
164 
atSet(leftv root,char * name,void * data,int typ)165 void atSet(leftv root, char * name,void * data,int typ)
166 {
167   if (root!=NULL)
168   {
169     attr *a=root->Attribute();
170     int rt=root->Typ();
171     if (a==NULL)
172       WerrorS("cannot set attributes of this object");
173     else if ((rt!=RING_CMD)
174     && (!RingDependend(rt))&&(RingDependend(typ)))
175       WerrorS("cannot set ring-dependend objects at this type");
176     else
177     {
178       *a=(*a)->set(name,data,typ);
179     }
180   }
181 }
182 
kill(const ring r)183 void sattr::kill(const ring r)
184 {
185   attr_free(this,r);
186   omFreeBin((ADDRESS)this, sattr_bin);
187 }
188 
killAll(const ring r)189 void sattr::killAll(const ring r)
190 {
191   attr temp = this,temp1;
192 
193   while (temp!=NULL)
194   {
195     temp1 = temp->next;
196     omCheckAddr(temp);
197     temp->kill(r);
198     temp = temp1;
199   }
200 }
201 
at_Kill(idhdl root,const char * name,const ring r)202 void at_Kill(idhdl root,const char * name, const ring r)
203 {
204   attr temp = root->attribute->get(name);
205   if (temp!=NULL)
206   {
207     attr N = temp->next;
208     attr temp1 = root->attribute;
209     if (temp1==temp)
210     {
211       root->attribute = N;
212     }
213     else
214     {
215       while (temp1->next!=temp) temp1 = temp1->next;
216       temp1->next = N;
217     }
218     temp->kill(r);
219   }
220 }
221 
at_KillAll(idhdl root,const ring r)222 void at_KillAll(idhdl root, const ring r)
223 {
224   root->attribute->killAll(r);
225   root->attribute = NULL;
226 }
227 
at_KillAll(leftv root,const ring r)228 void at_KillAll(leftv root, const ring r)
229 {
230   root->attribute->killAll(r);
231   root->attribute = NULL;
232 }
233 
atATTRIB1(leftv res,leftv v)234 BOOLEAN atATTRIB1(leftv res,leftv v)
235 {
236   attr *aa=(v->Attribute());
237   if (aa==NULL)
238   {
239     WerrorS("this object cannot have attributes");
240     return TRUE;
241   }
242   attr a=*aa;
243   BOOLEAN haveNoAttribute=TRUE;
244   if (v->e==NULL)
245   {
246     if (hasFlag(v,FLAG_STD))
247     {
248       PrintS("attr:isSB, type int\n");
249       haveNoAttribute=FALSE;
250     }
251     if (hasFlag(v,FLAG_QRING))
252     {
253       PrintS("attr:qringNF, type int\n");
254       haveNoAttribute=FALSE;
255     }
256     if (v->Typ()==RING_CMD)
257     {
258       PrintS("attr:cf_class, type int\n");
259       PrintS("attr:global, type int\n");
260       PrintS("attr:maxExp, type int\n");
261       PrintS("attr:ring_cf, type int\n");
262       #ifdef HAVE_SHIFTBBA
263       PrintS("attr:isLetterplaceRing, type int\n");
264       if (rIsLPRing((ring)v->Data()))
265         PrintS("attr:ncgenCount, type int\n");
266       #endif
267 
268       haveNoAttribute=FALSE;
269     }
270   }
271   else
272   {
273     leftv at=v->LData();
274     return atATTRIB1(res,at);
275   }
276   if (a!=NULL)                    a->Print();
277   else  if(haveNoAttribute)       PrintS("no attributes\n");
278   return FALSE;
279 }
atATTRIB2(leftv res,leftv v,leftv b)280 BOOLEAN atATTRIB2(leftv res,leftv v,leftv b)
281 {
282   char *name=(char *)b->Data();
283   int t=v->Typ();
284   leftv at=NULL;
285   if (v->e!=NULL)
286     at=v->LData();
287   if (strcmp(name,"isSB")==0)
288   {
289     res->rtyp=INT_CMD;
290     res->data=(void *)(long)hasFlag(v,FLAG_STD);
291     if (at!=NULL) res->data=(void *)(long)(hasFlag(v,FLAG_STD)||(hasFlag(at,FLAG_STD)));
292   }
293   else if ((strcmp(name,"rank")==0)&&(/*v->Typ()*/t==MODUL_CMD))
294   {
295     res->rtyp=INT_CMD;
296     res->data=(void *)(((ideal)v->Data())->rank);
297   }
298   else if ((strcmp(name,"global")==0)
299   &&(/*v->Typ()*/t==RING_CMD))
300   {
301     res->rtyp=INT_CMD;
302     res->data=(void *)(((ring)v->Data())->OrdSgn==1);
303   }
304   else if ((strcmp(name,"maxExp")==0)
305   &&(/*v->Typ()*/t==RING_CMD))
306   {
307     res->rtyp=INT_CMD;
308     res->data=(void *)(long)(((ring)v->Data())->bitmask);
309   }
310   else if ((strcmp(name,"ring_cf")==0)
311   &&(/*v->Typ()*/t==RING_CMD))
312   {
313     res->rtyp=INT_CMD;
314     res->data=(void *)(long)(rField_is_Ring((ring)v->Data()));
315   }
316   else if ((strcmp(name,"cf_class")==0)
317   &&(/*v->Typ()*/t==RING_CMD))
318   {
319     res->rtyp=INT_CMD;
320     coeffs cf;
321     if (t==RING_CMD) cf=((ring)v->Data())->cf;
322     else             cf=(coeffs)v->Data();
323     res->data=(void *)(long)(cf->type);
324   }
325   else if (strcmp(name,"qringNF")==0)
326   {
327     res->rtyp=INT_CMD;
328     res->data=(void *)(long)hasFlag(v,FLAG_QRING);
329     if (at!=NULL) res->data=(void *)(long)(hasFlag(v,FLAG_QRING)||(hasFlag(at,FLAG_QRING)));
330   }
331 #ifdef HAVE_SHIFTBBA
332   else if ((strcmp(name,"isLetterplaceRing")==0)
333   &&(/*v->Typ()*/t==RING_CMD))
334   {
335     res->rtyp=INT_CMD;
336     res->data=(void *)(long)(((ring)v->Data())->isLPring);
337   }
338   else if ((strcmp(name,"ncgenCount")==0)
339   &&(/*v->Typ()*/t==RING_CMD))
340   {
341     res->rtyp=INT_CMD;
342     res->data=(void *)(long)(((ring)v->Data())->LPncGenCount);
343   }
344 #endif
345   else
346   {
347     attr *aa=v->Attribute();
348     if (aa==NULL)
349     {
350       WerrorS("this object cannot have attributes");
351       return TRUE;
352     }
353     attr a=*aa;
354     a=a->get(name);
355     if (a!=NULL)
356     {
357       res->rtyp=a->atyp;
358       res->data=a->CopyA();
359     }
360     else
361     {
362       res->rtyp=STRING_CMD;
363       res->data=omStrDup("");
364     }
365   }
366   return FALSE;
367 }
atATTRIB3(leftv,leftv v,leftv b,leftv c)368 BOOLEAN atATTRIB3(leftv /*res*/,leftv v,leftv b,leftv c)
369 {
370   idhdl h=(idhdl)v->data;
371   if (v->e!=NULL)
372   {
373     v=v->LData();
374     if (v==NULL) return TRUE;
375     h=NULL;
376   }
377   else if (v->rtyp!=IDHDL) h=NULL;
378   int t=v->Typ();
379 
380   char *name=(char *)b->Data();
381   if (strcmp(name,"isSB")==0)
382   {
383     if (c->Typ()!=INT_CMD)
384     {
385       WerrorS("attribute isSB must be int");
386       return TRUE;
387     }
388     if (((long)c->Data())!=0L)
389     {
390       if (h!=NULL) setFlag(h,FLAG_STD);
391       setFlag(v,FLAG_STD);
392     }
393     else
394     {
395       if (h!=NULL) resetFlag(h,FLAG_STD);
396       resetFlag(v,FLAG_STD);
397     }
398   }
399   else if (strcmp(name,"qringNF")==0)
400   {
401     if (c->Typ()!=INT_CMD)
402     {
403       WerrorS("attribute qringNF must be int");
404       return TRUE;
405     }
406     if (((long)c->Data())!=0L)
407     {
408       if (h!=NULL) setFlag(h,FLAG_QRING);
409       setFlag(v,FLAG_QRING);
410     }
411     else
412     {
413       if (h!=NULL) resetFlag(h,FLAG_QRING);
414       resetFlag(v,FLAG_QRING);
415     }
416   }
417   else if ((strcmp(name,"rank")==0)&&(/*v->Typ()*/t==MODUL_CMD))
418   {
419     if (c->Typ()!=INT_CMD)
420     {
421       WerrorS("attribute `rank` must be int");
422       return TRUE;
423     }
424     ideal I=(ideal)v->Data();
425     int rk=id_RankFreeModule(I,currRing);
426     I->rank=si_max(rk,(int)((long)c->Data()));
427   }
428   else if (((strcmp(name,"global")==0)
429     || (strcmp(name,"cf_class")==0)
430     || (strcmp(name,"ring_cf")==0)
431     || (strcmp(name,"maxExp")==0))
432   &&(/*v->Typ()*/t==RING_CMD))
433   {
434     Werror("can not set attribute `%s`",name);
435     return TRUE;
436   }
437 #ifdef HAVE_SHIFTBBA
438   else if ((strcmp(name,"isLetterplaceRing")==0)
439   &&(/*v->Typ()*/t==RING_CMD))
440   {
441     if (c->Typ()==INT_CMD)
442       ((ring)v->Data())->isLPring=(int)(long)c->Data();
443     else
444     {
445       WerrorS("attribute `isLetterplaceRing` must be int");
446       return TRUE;
447     }
448   }
449   else if ((strcmp(name,"ncgenCount")==0)
450   &&(/*v->Typ()*/t==RING_CMD))
451   {
452     if (c->Typ()==INT_CMD)
453       ((ring)v->Data())->LPncGenCount=(int)(long)c->Data();
454     else
455     {
456       WerrorS("attribute `ncgenCount` must be int");
457       return TRUE;
458     }
459   }
460 #endif
461   else
462   {
463     int typ=c->Typ();
464     if (h!=NULL) atSet(h,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/);
465     else         atSet(v,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/);
466   }
467   return FALSE;
468 }
469 
atKILLATTR1(leftv,leftv a)470 BOOLEAN atKILLATTR1(leftv /*res*/,leftv a)
471 {
472   idhdl h=NULL;
473   if ((a->rtyp==IDHDL)&&(a->e==NULL))
474   {
475     h=(idhdl)a->data;
476     resetFlag((idhdl)a->data,FLAG_STD);
477   }
478   resetFlag(a,FLAG_STD);
479   if (h->attribute!=NULL)
480   {
481     atKillAll(h);
482     a->attribute=NULL;
483   }
484   else atKillAll(a);
485   return FALSE;
486 }
atKILLATTR2(leftv,leftv a,leftv b)487 BOOLEAN atKILLATTR2(leftv /*res*/,leftv a,leftv b)
488 {
489   if ((a->rtyp!=IDHDL)||(a->e!=NULL))
490   {
491     WerrorS("object must have a name");
492     return TRUE;
493   }
494   char *name=(char *)b->Data();
495   if (strcmp(name,"isSB")==0)
496   {
497     resetFlag(a,FLAG_STD);
498     resetFlag((idhdl)a->data,FLAG_STD);
499   }
500   else if (strcmp(name,"global")==0)
501   {
502     WerrorS("can not set attribut `global`");
503     return TRUE;
504   }
505   else
506   {
507     atKill((idhdl)a->data,name);
508   }
509   return FALSE;
510 }
511 
512