source: git/Singular/attrib.cc @ c90500

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