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