source: git/Singular/attrib.cc @ 210bd9

spielwiese
Last change on this file since 210bd9 was 210bd9, checked in by Hans Schönemann <hannes@…>, 14 years ago
moved option marcos to options.h git-svn-id: file:///usr/local/Singular/svn/trunk@12467 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 8.2 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 "mod2.h"
17#include "omalloc.h"
18#include "options.h"
19#include "tok.h"
20#include "ipid.h"
21#include "intvec.h"
22#include "polys.h"
23#include "ideals.h"
24#include "matpol.h"
25#include "ipshell.h"
26#include "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  omCheckAddrSize(this,sizeof(sattr));
40  attr n=(attr)omAlloc0Bin(sattr_bin);
41  n->atyp=atyp;
42  if (name!=NULL) n->name=omStrDup(name);
43  n->data=CopyA();
44  if (next!=NULL)
45  {
46    n->next=next->Copy();
47  }
48  return n;
49}
50
51// in subexr.cc:
52//void * sattr::CopyA()
53//{
54//  omCheckAddrSize(this,sizeof(sattr));
55//  return s_internalCopy(atyp,data);
56//}
57
58static void attr_free(attr h, const ring r=currRing)
59{
60  switch (h->atyp)
61  {
62  case INTVEC_CMD:
63  case INTMAT_CMD:
64    delete (intvec *)(h->data);
65    break;
66  case IDEAL_CMD:
67  case MODUL_CMD:
68  case MATRIX_CMD:
69    id_Delete((ideal *)&(h->data),r);
70    break;
71  case POLY_CMD:
72  case VECTOR_CMD:
73    p_Delete((poly *)&(h->data),r);
74    break;
75  case INT_CMD:
76    break;
77  case STRING_CMD:
78    omFree((ADDRESS)(h->data));
79    break;
80#ifdef TEST
81  default:
82    ::Print("atKill: unknown type(%d)\n",h->atyp);  /* DEBUG */
83#endif
84  } /* end switch: (atyp) */
85  h->data=NULL;
86}
87
88attr sattr::set(const char * s, void * data, int t)
89{
90  attr h = get(s);
91  attr result=this;
92  if (h!=NULL)
93  {
94    attr_free(h);
95  }
96  else
97  {
98    h = (attr)omAlloc0Bin(sattr_bin);
99    h->next = this;
100    result=h;
101  }
102  h->name = s;
103  h->data = data;
104  h->atyp = t;
105  //::Print("set attr >>%s<< of type %d\n",h->name,t);
106  return  result;
107}
108
109attr sattr::get(const char * s)
110{
111  attr h = this;
112  while (h!=NULL)
113  {
114    if (0 == strcmp(s,h->name)) return h;
115    h = h->next;
116  }
117  return NULL;
118}
119
120void * atGet(idhdl root,const char * name)
121{
122  attr temp = root->attribute->get(name);
123  if (temp!=NULL)
124    return temp->data;
125  else
126    return NULL;
127}
128
129void * atGet(leftv root,const char * name)
130{
131  attr temp;
132  if (root->e==NULL)
133    temp = root->attribute->get(name);
134  else
135    temp = (root->LData())->attribute->get(name);
136  if ((temp==NULL) && (root->rtyp==IDHDL))
137  {
138    idhdl h=(idhdl)root->data;
139    temp=h->attribute->get(name);
140  }
141  if (temp!=NULL)
142    return temp->data;
143  else
144    return NULL;
145}
146
147void * atGet(idhdl root,const char * name, int t)
148{
149  attr temp = root->attribute->get(name);
150  if ((temp!=NULL) && (temp->atyp==t))
151    return temp->data;
152  else
153    return NULL;
154}
155
156void * atGet(leftv root,const char * name, int t)
157{
158  attr temp = root->attribute->get(name);
159  if ((temp==NULL) && (root->rtyp==IDHDL))
160  {
161    idhdl h=(idhdl)root->data;
162    temp=h->attribute->get(name);
163  }
164  if ((temp!=NULL) && (temp->atyp==t))
165    return temp->data;
166  else
167    return NULL;
168}
169
170void atSet(idhdl root,const char * name,void * data,int typ)
171{
172  if (root!=NULL)
173  {
174    root->attribute=root->attribute->set(name,data,typ);
175  }
176}
177
178void atSet(leftv root,const char * name,void * data,int typ)
179{
180  if (root!=NULL)
181  {
182    if (root->e!=NULL)
183    {
184      Werror("object must have a name for attrib %s",name);
185    }
186    else
187    {
188      if (root->rtyp==IDHDL)
189      {
190        idhdl h=(idhdl)root->data;
191        h->attribute=h->attribute->set(name,data,typ);
192        root->attribute=h->attribute;
193      }
194      else
195      {
196        root->attribute=root->attribute->set(name,data,typ);
197      }
198    }
199  }
200}
201
202void sattr::kill(const ring r)
203{
204  omFree((ADDRESS)name);
205  name=NULL;
206  attr_free(this,r);
207  omFreeBin((ADDRESS)this, sattr_bin);
208}
209
210void sattr::killAll(const ring r)
211{
212  attr temp = this,temp1;
213
214  while (temp!=NULL)
215  {
216    temp1 = temp->next;
217    temp->kill(r);
218    temp = temp1;
219  }
220}
221
222void at_Kill(idhdl root,const char * name, const ring r)
223{
224  attr temp = root->attribute->get(name);
225  if (temp!=NULL)
226  {
227    attr N = temp->next;
228    attr temp1 = root->attribute;
229    if (temp1==temp)
230    {
231      root->attribute = N;
232    }
233    else
234    {
235      while (temp1->next!=temp) temp1 = temp1->next;
236      temp1->next = N;
237    }
238    temp->kill(r);
239  }
240}
241
242void at_KillAll(idhdl root, const ring r)
243{
244  root->attribute->killAll(r);
245  root->attribute = NULL;
246}
247
248BOOLEAN atATTRIB1(leftv res,leftv a)
249{
250  leftv v=a;
251  int t;
252  if (a->e!=NULL)
253  {
254    v=a->LData();
255    if (v==NULL) return TRUE;
256  }
257  attr at=v->attribute;
258  BOOLEAN haveNoAttribute=TRUE;
259  if (hasFlag(v,FLAG_STD))
260  {
261    PrintS("attr:isSB, type int\n");
262    haveNoAttribute=FALSE;
263  }
264  else if (((t=v->Typ())==RING_CMD)||(t==QRING_CMD))
265  {
266    PrintS("attr:global, type int\n");
267    haveNoAttribute=FALSE;
268  }
269  if (at!=NULL)                    at->Print();
270  else  if(haveNoAttribute)        PrintS("no attributes\n");
271  return FALSE;
272}
273BOOLEAN atATTRIB2(leftv res,leftv a,leftv b)
274{
275  char *name=(char *)b->Data();
276  int t;
277  leftv v=a;
278  if (a->e!=NULL)
279  {
280    v=a->LData();
281    if (v==NULL) return TRUE;
282  }
283  if (strcmp(name,"isSB")==0)
284  {
285    res->rtyp=INT_CMD;
286    res->data=(void *)(long)hasFlag(v,FLAG_STD);
287  }
288  else if ((strcmp(name,"rank")==0)&&(v->Typ()==MODUL_CMD))
289  {
290    res->rtyp=INT_CMD;
291    res->data=(void *)(((ideal)v->Data())->rank);
292  }
293  else if ((strcmp(name,"global")==0)
294  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
295  {
296    res->rtyp=INT_CMD;
297    res->data=(void *)(((ring)v->Data())->OrdSgn==1);
298  }
299#ifdef HAVE_SHIFTBBA
300  else if ((strcmp(name,"isLPring")==0)
301  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
302  {
303    res->rtyp=INT_CMD;
304    res->data=(void *)(long)(((ring)v->Data())->isLPring);
305  }
306#endif
307  else
308  {
309    attr at=v->attribute->get(name);
310    if (at!=NULL)
311    {
312      res->rtyp=at->atyp;
313      res->data=at->CopyA();
314    }
315    else
316    {
317      res->rtyp=STRING_CMD;
318      res->data=omStrDup("");
319    }
320  }
321  return FALSE;
322}
323BOOLEAN atATTRIB3(leftv res,leftv a,leftv b,leftv c)
324{
325  idhdl h=(idhdl)a->data;
326  int t;
327  leftv v=a;
328  if (a->e!=NULL)
329  {
330    v=a->LData();
331    if (v==NULL) return TRUE;
332    h=NULL;
333  }
334  attr *at=&(v->attribute);
335  char *name=(char *)b->Data();
336  if (strcmp(name,"isSB")==0)
337  {
338    if (c->Typ()!=INT_CMD)
339    {
340      WerrorS("attribute isSB must be int");
341      return TRUE;
342    }
343    if (((long)c->Data())!=0L)
344    {
345      if (h!=NULL) setFlag(h,FLAG_STD);
346      setFlag(v,FLAG_STD);
347    }
348    else
349    {
350      if (h!=NULL) resetFlag(h,FLAG_STD);
351      resetFlag(v,FLAG_STD);
352    }
353  }
354  else if ((strcmp(name,"rank")==0)&&(v->Typ()==MODUL_CMD))
355  {
356    if (c->Typ()!=INT_CMD)
357    {
358      WerrorS("attribute `rank` must be int");
359      return TRUE;
360    }
361    ideal I=(ideal)v->Data();
362    I->rank=si_max((int)I->rank,(int)((long)c->Data()));
363  }
364  else if ((strcmp(name,"global")==0)
365  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
366  {
367    WerrorS("can not set attribute `global`");
368    return TRUE;
369  }
370#ifdef HAVE_SHIFTBBA
371  else if ((strcmp(name,"isLPring")==0)
372  &&(((t=v->Typ())==RING_CMD)||(t==QRING_CMD)))
373  {
374    if (c->Typ()==INT_CMD)
375      ((ring)v->Data())->isLPring=(int)(long)c->Data();
376    else
377    {
378      WerrorS("attribute `isLPring` must be int");
379      return TRUE;
380    }
381  }
382#endif
383  else
384  {
385    int typ=c->Typ();
386    atSet(v,omStrDup(name),c->CopyD(typ),typ/*c->T(yp()*/);
387    if (h!=NULL) IDATTR(h)=v->attribute;
388  }
389  return FALSE;
390}
391
392BOOLEAN atKILLATTR1(leftv res,leftv a)
393{
394  if ((a->rtyp!=IDHDL)||(a->e!=NULL))
395  {
396    WerrorS("object must have a name");
397    return TRUE;
398  }
399  resetFlag(a,FLAG_STD);
400  resetFlag((idhdl)a->data,FLAG_STD);
401  if (a->attribute!=NULL)
402  {
403    atKillAll((idhdl)a->data);
404    a->attribute=NULL;
405  }
406  return FALSE;
407}
408BOOLEAN atKILLATTR2(leftv res,leftv a,leftv b)
409{
410  if ((a->rtyp!=IDHDL)||(a->e!=NULL))
411  {
412    WerrorS("object must have a name");
413    return TRUE;
414  }
415  char *name=(char *)b->Data();
416  if (strcmp(name,"isSB")==0)
417  {
418    resetFlag(a,FLAG_STD);
419    resetFlag((idhdl)a->data,FLAG_STD);
420  }
421  else if (strcmp(name,"global")==0)
422  {
423    WerrorS("can not set attribut `global`");
424    return TRUE;
425  }
426  else
427  {
428    atKill((idhdl)a->data,name);
429  }
430  return FALSE;
431}
432
Note: See TracBrowser for help on using the repository browser.