source: git/Singular/attrib.cc @ 3ec6bba

spielwiese
Last change on this file since 3ec6bba was 0fb34ba, checked in by Hans Schoenemann <hannes@…>, 13 years ago
start with dir Singular: fix includes and makefile
  • Property mode set to 100644
File size: 8.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: attributes to leftv and idhdl
8*/
9
10#include <stdlib.h>
11#include <stdio.h>
12#include <string.h>
13#include <ctype.h>
14#include <unistd.h>
15
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 <polys/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)
130{
131  attr temp = root->attribute->get(name);
132  if ((temp!=NULL) && (temp->atyp==t))
133    return temp->data;
134  else
135    return NULL;
136}
137
138void * atGet(leftv root,const char * name, int t)
139{
140  attr a=*(root->Attribute());
141  attr temp = a->get(name);
142  if ((temp!=NULL) && (temp->atyp==t))
143    return temp->data;
144  else
145    return NULL;
146}
147
148void atSet(idhdl root,const char * name,void * data,int typ)
149{
150  if (root!=NULL)
151  {
152    if ((IDTYP(root)!=RING_CMD)
153    && (IDTYP(root)!=QRING_CMD)
154    && (!RingDependend(IDTYP(root)))&&(RingDependend(typ)))
155      WerrorS("cannot set ring-dependend objects at this type");
156    else
157      root->attribute=root->attribute->set(name,data,typ);
158  }
159}
160
161void atSet(leftv root,const char * name,void * data,int typ)
162{
163  if (root!=NULL)
164  {
165    attr *a=root->Attribute();
166    int rt=root->Typ();
167    if ((rt!=RING_CMD)
168    && (rt!=QRING_CMD)
169    && (!RingDependend(rt))&&(RingDependend(typ)))
170      WerrorS("cannot set ring-dependend objects at this type");
171    else
172    {
173      *a=(*a)->set(name,data,typ);
174    }
175  }
176}
177
178void sattr::kill(const ring r)
179{
180  attr_free(this,r);
181  omFree((ADDRESS)name);
182  name=NULL;
183  omFreeBin((ADDRESS)this, sattr_bin);
184}
185
186void sattr::killAll(const ring r)
187{
188  attr temp = this,temp1;
189
190  while (temp!=NULL)
191  {
192    temp1 = temp->next;
193    omCheckAddr(temp);
194    temp->kill(r);
195    temp = temp1;
196  }
197}
198
199void at_Kill(idhdl root,const char * name, const ring r)
200{
201  attr temp = root->attribute->get(name);
202  if (temp!=NULL)
203  {
204    attr N = temp->next;
205    attr temp1 = root->attribute;
206    if (temp1==temp)
207    {
208      root->attribute = N;
209    }
210    else
211    {
212      while (temp1->next!=temp) temp1 = temp1->next;
213      temp1->next = N;
214    }
215    temp->kill(r);
216  }
217}
218
219void at_KillAll(idhdl root, const ring r)
220{
221  root->attribute->killAll(r);
222  root->attribute = NULL;
223}
224void at_KillAll(leftv root, const ring r)
225{
226  root->attribute->killAll(r);
227  root->attribute = NULL;
228}
229
230BOOLEAN atATTRIB1(leftv res,leftv v)
231{
232  int t;
233  attr *aa=(v->Attribute());
234  if (aa==NULL)
235  {
236    WerrorS("this object cannot have attributes");
237    return TRUE;
238  }
239  attr a=*aa;
240  BOOLEAN haveNoAttribute=TRUE;
241  if (v->e==NULL)
242  {
243    if (hasFlag(v,FLAG_STD))
244    {
245      PrintS("attr:isSB, type int\n");
246      haveNoAttribute=FALSE;
247    }
248    if (hasFlag(v,FLAG_QRING))
249    {
250      PrintS("attr:qringNF, type int\n");
251      haveNoAttribute=FALSE;
252    }
253    if (((t=v->Typ())==RING_CMD)||(t==QRING_CMD))
254    {
255      PrintS("attr:global, type int\n");
256      haveNoAttribute=FALSE;
257    }
258  }
259  else
260  {
261    leftv at=v->LData();
262    return atATTRIB1(res,at);
263  }
264  if (a!=NULL)                    a->Print();
265  else  if(haveNoAttribute)       PrintS("no attributes\n");
266  return FALSE;
267}
268BOOLEAN atATTRIB2(leftv res,leftv v,leftv b)
269{
270  char *name=(char *)b->Data();
271  int t;
272  leftv at=NULL;
273  if (v->e!=NULL)
274    at=v->LData();
275  if (strcmp(name,"isSB")==0)
276  {
277    res->rtyp=INT_CMD;
278    res->data=(void *)(long)hasFlag(v,FLAG_STD);
279    if (at!=NULL) res->data=(void *)(long)(hasFlag(v,FLAG_STD)||(hasFlag(at,FLAG_STD)));
280  }
281  else if ((strcmp(name,"rank")==0)&&(v->Typ()==MODUL_CMD))
282  {
283    res->rtyp=INT_CMD;
284    res->data=(void *)(((ideal)v->Data())->rank);
285  }
286  else if ((strcmp(name,"global")==0)
287  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
288  {
289    res->rtyp=INT_CMD;
290    res->data=(void *)(((ring)v->Data())->OrdSgn==1);
291  }
292  else if (strcmp(name,"qringNF")==0)
293  {
294    res->rtyp=INT_CMD;
295    res->data=(void *)(long)hasFlag(v,FLAG_QRING);
296    if (at!=NULL) res->data=(void *)(long)(hasFlag(v,FLAG_QRING)||(hasFlag(at,FLAG_QRING)));
297  }
298#ifdef HAVE_SHIFTBBA
299  else if ((strcmp(name,"isLPring")==0)
300  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
301  {
302    res->rtyp=INT_CMD;
303    res->data=(void *)(long)(((ring)v->Data())->isLPring);
304  }
305#endif
306  else
307  {
308    attr *aa=v->Attribute();
309    if (aa==NULL)
310    {
311      WerrorS("this object cannot have attributes");
312      return TRUE;
313    }
314    attr a=*aa;
315    a=a->get(name);
316    if (a!=NULL)
317    {
318      res->rtyp=a->atyp;
319      res->data=a->CopyA();
320    }
321    else
322    {
323      res->rtyp=STRING_CMD;
324      res->data=omStrDup("");
325    }
326  }
327  return FALSE;
328}
329BOOLEAN atATTRIB3(leftv res,leftv v,leftv b,leftv c)
330{
331  idhdl h=(idhdl)v->data;
332  int t;
333  if (v->e!=NULL)
334  {
335    v=v->LData();
336    if (v==NULL) return TRUE;
337    h=NULL;
338  }
339  else if (v->rtyp!=IDHDL) h=NULL;
340
341  char *name=(char *)b->Data();
342  if (strcmp(name,"isSB")==0)
343  {
344    if (c->Typ()!=INT_CMD)
345    {
346      WerrorS("attribute isSB must be int");
347      return TRUE;
348    }
349    if (((long)c->Data())!=0L)
350    {
351      if (h!=NULL) setFlag(h,FLAG_STD);
352      setFlag(v,FLAG_STD);
353    }
354    else
355    {
356      if (h!=NULL) resetFlag(h,FLAG_STD);
357      resetFlag(v,FLAG_STD);
358    }
359  }
360  else if (strcmp(name,"qringNF")==0)
361  {
362    if (c->Typ()!=INT_CMD)
363    {
364      WerrorS("attribute qringNF must be int");
365      return TRUE;
366    }
367    if (((long)c->Data())!=0L)
368    {
369      if (h!=NULL) setFlag(h,FLAG_QRING);
370      setFlag(v,FLAG_QRING);
371    }
372    else
373    {
374      if (h!=NULL) resetFlag(h,FLAG_QRING);
375      resetFlag(v,FLAG_QRING);
376    }
377  }
378  else if ((strcmp(name,"rank")==0)&&(v->Typ()==MODUL_CMD))
379  {
380    if (c->Typ()!=INT_CMD)
381    {
382      WerrorS("attribute `rank` must be int");
383      return TRUE;
384    }
385    ideal I=(ideal)v->Data();
386    I->rank=si_max((int)I->rank,(int)((long)c->Data()));
387  }
388  else if ((strcmp(name,"global")==0)
389  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
390  {
391    WerrorS("can not set attribute `global`");
392    return TRUE;
393  }
394#ifdef HAVE_SHIFTBBA
395  else if ((strcmp(name,"isLPring")==0)
396  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
397  {
398    if (c->Typ()==INT_CMD)
399      ((ring)v->Data())->isLPring=(int)(long)c->Data();
400    else
401    {
402      WerrorS("attribute `isLPring` must be int");
403      return TRUE;
404    }
405  }
406#endif
407  else
408  {
409    int typ=c->Typ();
410    if (h!=NULL) atSet(h,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/);
411    else         atSet(v,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/);
412  }
413  return FALSE;
414}
415
416BOOLEAN atKILLATTR1(leftv res,leftv a)
417{
418  idhdl h=NULL;
419  if ((a->rtyp==IDHDL)&&(a->e==NULL))
420  {
421    h=(idhdl)a->data;
422    resetFlag((idhdl)a->data,FLAG_STD);
423  }
424  resetFlag(a,FLAG_STD);
425  if (h->attribute!=NULL)
426  {
427    atKillAll(h);
428    a->attribute=NULL;
429  }
430  else atKillAll(a);
431  return FALSE;
432}
433BOOLEAN atKILLATTR2(leftv res,leftv a,leftv b)
434{
435  if ((a->rtyp!=IDHDL)||(a->e!=NULL))
436  {
437    WerrorS("object must have a name");
438    return TRUE;
439  }
440  char *name=(char *)b->Data();
441  if (strcmp(name,"isSB")==0)
442  {
443    resetFlag(a,FLAG_STD);
444    resetFlag((idhdl)a->data,FLAG_STD);
445  }
446  else if (strcmp(name,"global")==0)
447  {
448    WerrorS("can not set attribut `global`");
449    return TRUE;
450  }
451  else
452  {
453    atKill((idhdl)a->data,name);
454  }
455  return FALSE;
456}
457
Note: See TracBrowser for help on using the repository browser.