1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /*
5 * ABSTRACT: interpreter:
6 * assignment of expressions and lists to objects or lists
7 */
8
9 #include "kernel/mod2.h"
10
11 #define TRANSEXT_PRIVATES
12 #include "polys/ext_fields/transext.h"
13
14 #include "misc/options.h"
15 #include "misc/intvec.h"
16
17 #include "coeffs/coeffs.h"
18 #include "coeffs/numbers.h"
19 #include "coeffs/bigintmat.h"
20
21
22 #include "polys/ext_fields/algext.h"
23
24 #include "polys/monomials/ring.h"
25 #include "polys/matpol.h"
26 #include "polys/monomials/maps.h"
27 #include "polys/nc/nc.h"
28 #include "polys/nc/sca.h"
29 #include "polys/prCopy.h"
30
31 #include "kernel/polys.h"
32 #include "kernel/ideals.h"
33 #include "kernel/GBEngine/kstd1.h"
34 #include "kernel/oswrapper/timer.h"
35 #include "kernel/combinatorics/stairc.h"
36 #include "kernel/GBEngine/syz.h"
37
38 //#include "weight.h"
39 #include "tok.h"
40 #include "ipid.h"
41 #include "idrec.h"
42 #include "subexpr.h"
43 #include "lists.h"
44 #include "ipconv.h"
45 #include "attrib.h"
46 #include "links/silink.h"
47 #include "ipshell.h"
48 #include "blackbox.h"
49 #include "Singular/number2.h"
50
51 /*=================== proc =================*/
jjECHO(leftv,leftv a)52 static BOOLEAN jjECHO(leftv, leftv a)
53 {
54 si_echo=(int)((long)(a->Data()));
55 return FALSE;
56 }
jjPRINTLEVEL(leftv,leftv a)57 static BOOLEAN jjPRINTLEVEL(leftv, leftv a)
58 {
59 printlevel=(int)((long)(a->Data()));
60 return FALSE;
61 }
jjCOLMAX(leftv,leftv a)62 static BOOLEAN jjCOLMAX(leftv, leftv a)
63 {
64 colmax=(int)((long)(a->Data()));
65 return FALSE;
66 }
jjTIMER(leftv,leftv a)67 static BOOLEAN jjTIMER(leftv, leftv a)
68 {
69 timerv=(int)((long)(a->Data()));
70 initTimer();
71 return FALSE;
72 }
73 #ifdef HAVE_GETTIMEOFDAY
jjRTIMER(leftv,leftv a)74 static BOOLEAN jjRTIMER(leftv, leftv a)
75 {
76 rtimerv=(int)((long)(a->Data()));
77 initRTimer();
78 return FALSE;
79 }
80 #endif
jjMAXDEG(leftv,leftv a)81 static BOOLEAN jjMAXDEG(leftv, leftv a)
82 {
83 Kstd1_deg=(int)((long)(a->Data()));
84 if (Kstd1_deg!=0)
85 si_opt_1 |=Sy_bit(OPT_DEGBOUND);
86 else
87 si_opt_1 &=(~Sy_bit(OPT_DEGBOUND));
88 return FALSE;
89 }
jjMAXMULT(leftv,leftv a)90 static BOOLEAN jjMAXMULT(leftv, leftv a)
91 {
92 Kstd1_mu=(int)((long)(a->Data()));
93 if (Kstd1_mu!=0)
94 si_opt_1 |=Sy_bit(OPT_MULTBOUND);
95 else
96 si_opt_1 &=(~Sy_bit(OPT_MULTBOUND));
97 return FALSE;
98 }
jjTRACE(leftv,leftv a)99 static BOOLEAN jjTRACE(leftv, leftv a)
100 {
101 traceit=(int)((long)(a->Data()));
102 return FALSE;
103 }
jjSHORTOUT(leftv,leftv a)104 static BOOLEAN jjSHORTOUT(leftv, leftv a)
105 {
106 if (currRing != NULL)
107 {
108 BOOLEAN shortOut = (BOOLEAN)((long)a->Data());
109 if (shortOut==0)
110 currRing->ShortOut = 0;
111 else
112 {
113 if (currRing->CanShortOut)
114 currRing->ShortOut = 1;
115 }
116 shortOut = currRing->ShortOut;
117 coeffs cf = currRing->cf;
118 while (nCoeff_is_Extension(cf))
119 {
120 cf->extRing->ShortOut = shortOut;
121 assume(cf->extRing != NULL);
122 cf = cf->extRing->cf;
123 }
124 }
125 return FALSE;
126 }
jjMINPOLY_red(idhdl h)127 static void jjMINPOLY_red(idhdl h)
128 {
129 switch(IDTYP(h))
130 {
131 case NUMBER_CMD:
132 {
133 number n=(number)IDDATA(h);
134 number one = nInit(1);
135 number nn=nMult(n,one);
136 nDelete(&n);nDelete(&one);
137 IDDATA(h)=(char*)nn;
138 break;
139 }
140 case VECTOR_CMD:
141 case POLY_CMD:
142 {
143 poly p=(poly)IDDATA(h);
144 IDDATA(h)=(char*)p_MinPolyNormalize(p, currRing);
145 break;
146 }
147 case IDEAL_CMD:
148 case MODUL_CMD:
149 case MAP_CMD:
150 case MATRIX_CMD:
151 {
152 int i;
153 ideal I=(ideal)IDDATA(h);
154 for(i=IDELEMS(I)-1;i>=0;i--)
155 I->m[i]=p_MinPolyNormalize(I->m[i], currRing);
156 break;
157 }
158 case LIST_CMD:
159 {
160 lists L=(lists)IDDATA(h);
161 int i=L->nr;
162 for(;i>=0;i--)
163 {
164 jjMINPOLY_red((idhdl)&(L->m[i]));
165 }
166 break;
167 }
168 default:
169 //case RESOLUTION_CMD:
170 Werror("type %d too complex...set minpoly before",IDTYP(h)); break;
171 }
172 }
173 // change the coeff cf=K[x] (of type n_transExt) to K[x]/a
174 // return NULL in error case
jjSetMinpoly(coeffs cf,number a)175 coeffs jjSetMinpoly(coeffs cf, number a)
176 {
177 if ( !nCoeff_is_transExt(cf) )
178 {
179 if(!nCoeff_is_algExt(cf) )
180 {
181 WerrorS("cannot set minpoly for these coeffients");
182 return NULL;
183 }
184 }
185 if (rVar(cf->extRing)!=1)
186 {
187 WerrorS("only univariate minpoly allowed");
188 return NULL;
189 }
190
191 number p = n_Copy(a,cf);
192 n_Normalize(p, cf);
193
194 if (n_IsZero(p, cf))
195 {
196 n_Delete(&p, cf);
197 return cf;
198 }
199
200 AlgExtInfo A;
201
202 A.r = rCopy(cf->extRing); // Copy ground field!
203 // if minpoly was already set:
204 if( cf->extRing->qideal != NULL ) id_Delete(&(A.r->qideal),A.r);
205 ideal q = idInit(1,1);
206 if ((p==NULL) ||(NUM((fraction)p)==NULL))
207 {
208 WerrorS("Could not construct the alg. extension: minpoly==0");
209 // cleanup A: TODO
210 rDelete( A.r );
211 return NULL;
212 }
213 if (DEN((fraction)(p)) != NULL) // minpoly must be a fraction with poly numerator...!!
214 {
215 poly n=DEN((fraction)(p));
216 if(!p_IsConstant(n,cf->extRing))
217 {
218 WarnS("denominator must be constant - ignoring it");
219 }
220 p_Delete(&n,cf->extRing);
221 DEN((fraction)(p))=NULL;
222 }
223
224 q->m[0] = NUM((fraction)p);
225 A.r->qideal = q;
226
227 EXTERN_VAR omBin fractionObjectBin;
228 NUM((fractionObject *)p) = NULL; // not necessary, but still...
229 omFreeBin((ADDRESS)p, fractionObjectBin);
230
231 coeffs new_cf = nInitChar(n_algExt, &A);
232 if (new_cf==NULL)
233 {
234 WerrorS("Could not construct the alg. extension: illegal minpoly?");
235 // cleanup A: TODO
236 rDelete( A.r );
237 return NULL;
238 }
239 return new_cf;
240 }
241
jjMINPOLY(leftv,leftv a)242 static BOOLEAN jjMINPOLY(leftv, leftv a)
243 {
244 if( !nCoeff_is_transExt(currRing->cf) && (currRing->idroot == NULL) && n_IsZero((number)a->Data(), currRing->cf) )
245 {
246 #ifndef SING_NDEBUG
247 WarnS("Set minpoly over non-transcendental ground field to 0?!");
248 Warn("in >>%s<<",my_yylinebuf);
249 #endif
250 return FALSE;
251 }
252
253
254 if ( !nCoeff_is_transExt(currRing->cf) )
255 {
256 WarnS("Trying to set minpoly over non-transcendental ground field...");
257 if(!nCoeff_is_algExt(currRing->cf) )
258 {
259 WerrorS("cannot set minpoly for these coeffients");
260 return TRUE;
261 }
262 }
263 if ((rVar(currRing->cf->extRing)!=1)
264 && !n_IsZero((number)a->Data(), currRing->cf) )
265 {
266 WerrorS("only univarite minpoly allowed");
267 return TRUE;
268 }
269
270 BOOLEAN redefine_from_algext=FALSE;
271 if ( currRing->idroot != NULL )
272 {
273 redefine_from_algext=(currRing->cf->extRing->qideal!=NULL);
274 // return TRUE;
275 #ifndef SING_NDEBUG
276 idhdl p = currRing->idroot;
277
278 WarnS("no minpoly allowed if there are local objects belonging to the basering: ");
279
280 while(p != NULL)
281 {
282 PrintS(p->String(TRUE)); Print("(%s)\n",IDID(p));
283 p = p->next;
284 }
285 #endif
286 }
287
288 // assume (currRing->idroot==NULL);
289
290 number p = (number)a->CopyD(NUMBER_CMD);
291 n_Normalize(p, currRing->cf);
292
293 if (n_IsZero(p, currRing->cf))
294 {
295 n_Delete(&p, currRing->cf);
296 if( nCoeff_is_transExt(currRing->cf) )
297 {
298 #ifndef SING_NDEBUG
299 WarnS("minpoly is already 0...");
300 #endif
301 return FALSE;
302 }
303 WarnS("cannot set minpoly to 0 / alg. extension?");
304 return TRUE;
305 }
306
307 // remove all object currently in the ring
308 while(currRing->idroot!=NULL)
309 {
310 #ifndef SING_NDEBUG
311 Warn("killing a local object due to minpoly change: %s", IDID(currRing->idroot));
312 #endif
313 killhdl2(currRing->idroot,&(currRing->idroot),currRing);
314 }
315
316 AlgExtInfo A;
317
318 A.r = rCopy(currRing->cf->extRing); // Copy ground field!
319 // if minpoly was already set:
320 if( currRing->cf->extRing->qideal != NULL ) id_Delete(&(A.r->qideal),A.r);
321 ideal q = idInit(1,1);
322 if ((p==NULL) ||(NUM((fraction)p)==NULL))
323 {
324 WerrorS("Could not construct the alg. extension: minpoly==0");
325 // cleanup A: TODO
326 rDelete( A.r );
327 return TRUE;
328 }
329 if (!redefine_from_algext && (DEN((fraction)(p)) != NULL)) // minpoly must be a fraction with poly numerator...!!
330 {
331 poly n=DEN((fraction)(p));
332 if(!p_IsConstant(n,currRing->cf->extRing))
333 {
334 WarnS("denominator must be constant - ignoring it");
335 }
336 p_Delete(&n,currRing->cf->extRing);
337 DEN((fraction)(p))=NULL;
338 }
339
340 if (redefine_from_algext) q->m[0]=(poly)p;
341 else q->m[0] = NUM((fraction)p);
342 A.r->qideal = q;
343
344 #if 0
345 PrintS("\nTrying to conver the currRing into an algebraic field: ");
346 PrintS("Ground poly. ring: \n");
347 rWrite( A.r );
348 PrintS("\nGiven MinPOLY: ");
349 p_Write( A.i->m[0], A.r );
350 #endif
351
352 // :(
353 // NUM((fractionObject *)p) = NULL; // makes 0/ NULL fraction - which should not happen!
354 // n_Delete(&p, currRing->cf); // doesn't expect 0/ NULL :(
355 if (!redefine_from_algext)
356 {
357 EXTERN_VAR omBin fractionObjectBin;
358 NUM((fractionObject *)p) = NULL; // not necessary, but still...
359 omFreeBin((ADDRESS)p, fractionObjectBin);
360 }
361
362 coeffs new_cf = nInitChar(n_algExt, &A);
363 if (new_cf==NULL)
364 {
365 WerrorS("Could not construct the alg. extension: llegal minpoly?");
366 // cleanup A: TODO
367 rDelete( A.r );
368 return TRUE;
369 }
370 else
371 {
372 nKillChar(currRing->cf); currRing->cf=new_cf;
373 }
374 return FALSE;
375 }
376
377
jjNOETHER(leftv,leftv a)378 static BOOLEAN jjNOETHER(leftv, leftv a)
379 {
380 poly p=(poly)a->CopyD(POLY_CMD);
381 pDelete(&(currRing->ppNoether));
382 (currRing->ppNoether)=p;
383 return FALSE;
384 }
385 /*=================== proc =================*/
jiAssignAttr(leftv l,leftv r)386 static void jiAssignAttr(leftv l,leftv r)
387 {
388 // get the attribute of th right side
389 // and set it to l
390 leftv rv=r->LData();
391 if (rv!=NULL)
392 {
393 if (rv->e==NULL)
394 {
395 if (rv->attribute!=NULL)
396 {
397 attr la;
398 if (r->rtyp!=IDHDL)
399 {
400 la=rv->attribute;
401 rv->attribute=NULL;
402 }
403 else
404 {
405 la=rv->attribute->Copy();
406 }
407 l->attribute=la;
408 }
409 l->flag=rv->flag;
410 }
411 }
412 if (l->rtyp==IDHDL)
413 {
414 idhdl h=(idhdl)l->data;
415 IDATTR(h)=l->attribute;
416 IDFLAG(h)=l->flag;
417 }
418 }
jiA_INT(leftv res,leftv a,Subexpr e)419 static BOOLEAN jiA_INT(leftv res, leftv a, Subexpr e)
420 {
421 if (e==NULL)
422 {
423 res->data=(void *)a->Data();
424 jiAssignAttr(res,a);
425 }
426 else
427 {
428 int i=e->start-1;
429 if (i<0)
430 {
431 Werror("index[%d] must be positive",i+1);
432 return TRUE;
433 }
434 intvec *iv=(intvec *)res->data;
435 if (e->next==NULL)
436 {
437 if (i>=iv->length())
438 {
439 intvec *iv1=new intvec(i+1);
440 (*iv1)[i]=(int)((long)(a->Data()));
441 intvec *ivn=ivAdd(iv,iv1);
442 delete iv;
443 delete iv1;
444 res->data=(void *)ivn;
445 }
446 else
447 (*iv)[i]=(int)((long)(a->Data()));
448 }
449 else
450 {
451 int c=e->next->start;
452 if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
453 {
454 Werror("wrong range [%d,%d] in intmat %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
455 return TRUE;
456 }
457 else
458 IMATELEM(*iv,i+1,c) = (int)((long)(a->Data()));
459 }
460 }
461 return FALSE;
462 }
jjCheck_FLAG_OTHER_RING(leftv res)463 static inline ring jjCheck_FLAG_OTHER_RING(leftv res)
464 {
465 ring old_r=currRing;
466 if (Sy_inset(FLAG_RING,res->flag))
467 {
468 if ((res-1)->data!=currRing)
469 {
470 if ((res-1)->data!=NULL)
471 {
472 old_r=(ring)(res-1)->data;
473 rDecRefCnt(old_r);
474 }
475 (res-1)->data=rIncRefCnt(currRing);
476 (res-1)->rtyp=RING_CMD;
477 }
478 }
479 res->flag &= ~(Sy_bit(FLAG_OTHER_RING) |Sy_bit(FLAG_RING));
480 return old_r;
481 }
jiA_NUMBER(leftv res,leftv a,Subexpr)482 static BOOLEAN jiA_NUMBER(leftv res, leftv a, Subexpr)
483 {
484 number p=(number)a->CopyD(NUMBER_CMD);
485 if (errorreported) return TRUE;
486 if (res->data!=NULL) nDelete((number *)&res->data);
487 nNormalize(p);
488 res->data=(void *)p;
489 jiAssignAttr(res,a);
490 return FALSE;
491 }
492 #ifdef SINGULAR_4_2
jiA_NUMBER2(leftv res,leftv a,Subexpr e)493 static BOOLEAN jiA_NUMBER2(leftv res, leftv a, Subexpr e)
494 {
495 number2 n=(number2)a->CopyD(CNUMBER_CMD);
496 if (e==NULL)
497 {
498 if (res->data!=NULL)
499 {
500 number2 nn=(number2)res->data;
501 n2Delete(nn);
502 }
503 res->data=(void *)n;
504 jiAssignAttr(res,a);
505 }
506 else
507 {
508 int i=e->start-1;
509 if (i<0)
510 {
511 Werror("index[%d] must be positive",i+1);
512 return TRUE;
513 }
514 bigintmat *iv=(bigintmat *)res->data;
515 if (e->next==NULL)
516 {
517 WerrorS("only one index given");
518 return TRUE;
519 }
520 else
521 {
522 int c=e->next->start;
523 if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
524 {
525 Werror("wrong range [%d,%d] in cmatrix %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
526 return TRUE;
527 }
528 else if (iv->basecoeffs()==n->cf)
529 {
530 n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
531 BIMATELEM(*iv,i+1,c) = n->n;
532 }
533 else
534 {
535 WerrorS("different base");
536 return TRUE;
537 }
538 }
539 }
540 jiAssignAttr(res,a);
541 return FALSE;
542 }
jiA_NUMBER2_I(leftv res,leftv a,Subexpr e)543 static BOOLEAN jiA_NUMBER2_I(leftv res, leftv a, Subexpr e)
544 {
545 if (e==NULL)
546 {
547 if (res->data!=NULL)
548 {
549 number2 nn=(number2)res->data;
550 number2 n=n2Init((long)a->Data(),nn->cf);
551 n2Delete(nn);
552 res->data=(void *)n;
553 }
554 else
555 {
556 WerrorS("no Ring avialable for conversion from int");
557 return TRUE;
558 }
559 }
560 else
561 {
562 int i=e->start-1;
563 if (i<0)
564 {
565 Werror("index[%d] must be positive",i+1);
566 return TRUE;
567 }
568 bigintmat *iv=(bigintmat *)res->data;
569 if (e->next==NULL)
570 {
571 WerrorS("only one index given");
572 return TRUE;
573 }
574 else
575 {
576 int c=e->next->start;
577 if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
578 {
579 Werror("wrong range [%d,%d] in cmatrix %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
580 return TRUE;
581 }
582 else
583 {
584 n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
585 BIMATELEM(*iv,i+1,c) = n_Init((long)a->Data(),iv->basecoeffs());
586 }
587 }
588 }
589 return FALSE;
590 }
jiA_NUMBER2_N(leftv res,leftv a,Subexpr e)591 static BOOLEAN jiA_NUMBER2_N(leftv res, leftv a, Subexpr e)
592 {
593 if (e==NULL)
594 {
595 if (res->data!=NULL)
596 {
597 number2 nn=(number2)res->data;
598 number2 n=(number2)omAlloc(sizeof(*n));
599 n->cf=currRing->cf; n->cf->ref++;
600 n->n=(number)a->CopyD(NUMBER_CMD);
601 n2Delete(nn);
602 res->data=(void *)n;
603 }
604 else
605 {
606 number2 n=(number2)omAlloc(sizeof(*n));
607 n->cf=currRing->cf; n->cf->ref++;
608 n->n=(number)a->CopyD(NUMBER_CMD);
609 res->data=(void *)n;
610 }
611 }
612 else return TRUE; // TODO: list elements
613 return FALSE;
614 }
jiA_POLY2(leftv res,leftv a,Subexpr e)615 static BOOLEAN jiA_POLY2(leftv res, leftv a, Subexpr e)
616 {
617 poly2 n=(poly2)a->CopyD(CPOLY_CMD);
618 if (e==NULL)
619 {
620 if (res->data!=NULL)
621 {
622 poly2 nn=(poly2)res->data;
623 p2Delete(nn);
624 }
625 res->data=(void *)n;
626 jiAssignAttr(res,a);
627 }
628 else
629 {
630 int i=e->start-1;
631 if (i<0)
632 {
633 Werror("index[%d] must be positive",i+1);
634 return TRUE;
635 }
636 WerrorS("not yet"); // TODO: list elem
637 return TRUE;
638 }
639 jiAssignAttr(res,a);
640 return FALSE;
641 }
jiA_POLY2_P(leftv res,leftv a,Subexpr e)642 static BOOLEAN jiA_POLY2_P(leftv res, leftv a, Subexpr e)
643 {
644 if (e==NULL)
645 {
646 if (res->data!=NULL)
647 {
648 poly2 nn=(poly2)res->data;
649 poly2 n=(poly2)omAlloc(sizeof(*n));
650 n->cf=currRing; n->cf->ref++;
651 n->n=(poly)a->CopyD(POLY_CMD);
652 p2Delete(nn);
653 res->data=(void *)n;
654 }
655 else
656 {
657 poly2 n=(poly2)omAlloc(sizeof(*n));
658 n->cf=currRing; n->cf->ref++;
659 n->n=(poly)a->CopyD(POLY_CMD);
660 res->data=(void *)n;
661 }
662 }
663 else return TRUE; // TODO: list elements
664 return FALSE;
665 }
666 #endif
jiA_BIGINT(leftv res,leftv a,Subexpr e)667 static BOOLEAN jiA_BIGINT(leftv res, leftv a, Subexpr e)
668 {
669 number p=(number)a->CopyD(BIGINT_CMD);
670 if (e==NULL)
671 {
672 if (res->data!=NULL) n_Delete((number *)&res->data,coeffs_BIGINT);
673 res->data=(void *)p;
674 }
675 else
676 {
677 int i=e->start-1;
678 if (i<0)
679 {
680 Werror("index[%d] must be positive",i+1);
681 return TRUE;
682 }
683 bigintmat *iv=(bigintmat *)res->data;
684 if (e->next==NULL)
685 {
686 WerrorS("only one index given");
687 return TRUE;
688 }
689 else
690 {
691 int c=e->next->start;
692 if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
693 {
694 Werror("wrong range [%d,%d] in bigintmat %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
695 return TRUE;
696 }
697 else
698 {
699 n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
700 BIMATELEM(*iv,i+1,c) = p;
701 }
702 }
703 }
704 jiAssignAttr(res,a);
705 return FALSE;
706 }
jiA_LIST_RES(leftv res,leftv a,Subexpr)707 static BOOLEAN jiA_LIST_RES(leftv res, leftv a,Subexpr)
708 {
709 syStrategy r=(syStrategy)a->CopyD(RESOLUTION_CMD);
710 if (errorreported) return TRUE;
711 if (res->data!=NULL) ((lists)res->data)->Clean();
712 int add_row_shift = 0;
713 intvec *weights=(intvec*)atGet(a,"isHomog",INTVEC_CMD);
714 if (weights!=NULL) add_row_shift=weights->min_in();
715 res->data=(void *)syConvRes(r,TRUE,add_row_shift);
716 //jiAssignAttr(res,a);
717 return FALSE;
718 }
jiA_LIST(leftv res,leftv a,Subexpr)719 static BOOLEAN jiA_LIST(leftv res, leftv a,Subexpr)
720 {
721 lists l=(lists)a->CopyD(LIST_CMD);
722 if (errorreported) return TRUE;
723 if (res->data!=NULL) ((lists)res->data)->Clean();
724 res->data=(void *)l;
725 jiAssignAttr(res,a);
726 return FALSE;
727 }
jiA_POLY(leftv res,leftv a,Subexpr e)728 static BOOLEAN jiA_POLY(leftv res, leftv a,Subexpr e)
729 {
730 poly p=(poly)a->CopyD(POLY_CMD);
731 if (errorreported) return TRUE;
732 pNormalize(p);
733 if (e==NULL)
734 {
735 if ((p!=NULL) && TEST_V_QRING && (currRing->qideal!=NULL)
736 && (!hasFlag(a,FLAG_QRING)))
737 {
738 p=jjNormalizeQRingP(p);
739 setFlag(res,FLAG_QRING);
740 }
741 if (res->data!=NULL) pDelete((poly*)&res->data);
742 res->data=(void*)p;
743 jiAssignAttr(res,a);
744 }
745 else
746 {
747 int i,j;
748 matrix m=(matrix)res->data;
749 i=e->start;
750 if (e->next==NULL)
751 {
752 j=i; i=1;
753 // for all ideal like data types: check indices
754 if (j>MATCOLS(m))
755 {
756 if (TEST_V_ALLWARN)
757 {
758 Warn("increase ideal %d -> %d in %s(%d):%s",MATCOLS(m),j,VoiceName(),VoiceLine(),my_yylinebuf);
759 }
760 pEnlargeSet(&(m->m),MATCOLS(m),j-MATCOLS(m));
761 MATCOLS(m)=j;
762 }
763 else if (j<=0)
764 {
765 Werror("index[%d] must be positive",j/*e->start*/);
766 return TRUE;
767 }
768 }
769 else
770 {
771 // for matrices: indices are correct (see ipExprArith3(..,'['..) )
772 j=e->next->start;
773 }
774 if ((p!=NULL) && TEST_V_QRING && (currRing->qideal!=NULL))
775 {
776 p=jjNormalizeQRingP(p);
777 }
778 if (res->rtyp==SMATRIX_CMD)
779 {
780 p=pSub(p,SMATELEM(m,i-1,j-1,currRing));
781 pSetCompP(p,i);
782 m->m[j-1]=pAdd(m->m[j-1],p);
783 }
784 else
785 {
786 pDelete(&MATELEM(m,i,j));
787 MATELEM(m,i,j)=p;
788 /* for module: update rank */
789 if ((p!=NULL) && (pGetComp(p)!=0))
790 {
791 m->rank=si_max(m->rank,pMaxComp(p));
792 }
793 }
794 }
795 return FALSE;
796 }
jiA_1x1INTMAT(leftv res,leftv a,Subexpr e)797 static BOOLEAN jiA_1x1INTMAT(leftv res, leftv a,Subexpr e)
798 {
799 if (/*(*/ res->rtyp!=INTMAT_CMD /*)*/) /*|| (e!=NULL) - TRUE because of type int */
800 {
801 // no error message: assignment simply fails
802 return TRUE;
803 }
804 intvec* am=(intvec*)a->CopyD(INTMAT_CMD);
805 if ((am->rows()!=1) || (am->cols()!=1))
806 {
807 WerrorS("must be 1x1 intmat");
808 delete am;
809 return TRUE;
810 }
811 intvec* m=(intvec *)res->data;
812 // indices are correct (see ipExprArith3(..,'['..) )
813 int i=e->start;
814 int j=e->next->start;
815 IMATELEM(*m,i,j)=IMATELEM(*am,1,1);
816 delete am;
817 return FALSE;
818 }
jiA_1x1MATRIX(leftv res,leftv a,Subexpr e)819 static BOOLEAN jiA_1x1MATRIX(leftv res, leftv a,Subexpr e)
820 {
821 if (/*(*/ res->rtyp!=MATRIX_CMD /*)*/) /*|| (e!=NULL) - TRUE because of type poly */
822 {
823 // no error message: assignment simply fails
824 return TRUE;
825 }
826 matrix am=(matrix)a->CopyD(MATRIX_CMD);
827 if (errorreported) return TRUE;
828 if ((MATROWS(am)!=1) || (MATCOLS(am)!=1))
829 {
830 WerrorS("must be 1x1 matrix");
831 idDelete((ideal *)&am);
832 return TRUE;
833 }
834 matrix m=(matrix)res->data;
835 // indices are correct (see ipExprArith3(..,'['..) )
836 int i=e->start;
837 int j=e->next->start;
838 pDelete(&MATELEM(m,i,j));
839 pNormalize(MATELEM(am,1,1));
840 MATELEM(m,i,j)=MATELEM(am,1,1);
841 MATELEM(am,1,1)=NULL;
842 idDelete((ideal *)&am);
843 return FALSE;
844 }
jiA_STRING(leftv res,leftv a,Subexpr e)845 static BOOLEAN jiA_STRING(leftv res, leftv a, Subexpr e)
846 {
847 if (e==NULL)
848 {
849 void* tmp = res->data;
850 res->data=(void *)a->CopyD(STRING_CMD);
851 jiAssignAttr(res,a);
852 omfree(tmp);
853 }
854 else
855 {
856 char *s=(char *)res->data;
857 if ((e->start>0)&&(e->start<=(int)strlen(s)))
858 s[e->start-1]=(char)(*((char *)a->Data()));
859 else
860 {
861 Werror("string index %d out of range 1..%d",e->start,(int)strlen(s));
862 return TRUE;
863 }
864 }
865 return FALSE;
866 }
jiA_PROC(leftv res,leftv a,Subexpr)867 static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr)
868 {
869 extern procinfo *iiInitSingularProcinfo(procinfo *pi, const char *libname,
870 const char *procname, int line,
871 long pos, BOOLEAN pstatic=FALSE);
872 if(res->data!=NULL) piKill((procinfo *)res->data);
873 if(a->Typ()==STRING_CMD)
874 {
875 res->data = (void *)omAlloc0Bin(procinfo_bin);
876 ((procinfo *)(res->data))->language=LANG_NONE;
877 iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
878 ((procinfo *)res->data)->data.s.body=(char *)a->CopyD(STRING_CMD);
879 }
880 else
881 res->data=(void *)a->CopyD(PROC_CMD);
882 jiAssignAttr(res,a);
883 return FALSE;
884 }
jiA_INTVEC(leftv res,leftv a,Subexpr)885 static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr)
886 {
887 //if ((res->data==NULL) || (res->Typ()==a->Typ()))
888 {
889 if (res->data!=NULL) delete ((intvec *)res->data);
890 res->data=(void *)a->CopyD(INTVEC_CMD);
891 jiAssignAttr(res,a);
892 return FALSE;
893 }
894 #if 0
895 else
896 {
897 intvec *r=(intvec *)(res->data);
898 intvec *s=(intvec *)(a->Data());
899 int i=si_min(r->length(), s->length())-1;
900 for(;i>=0;i--)
901 {
902 (*r)[i]=(*s)[i];
903 }
904 return FALSE; //(r->length()< s->length());
905 }
906 #endif
907 }
jiA_BIGINTMAT(leftv res,leftv a,Subexpr)908 static BOOLEAN jiA_BIGINTMAT(leftv res, leftv a, Subexpr)
909 {
910 if (res->data!=NULL) delete ((bigintmat *)res->data);
911 res->data=(void *)a->CopyD(BIGINTMAT_CMD);
912 jiAssignAttr(res,a);
913 return FALSE;
914 }
jiA_BUCKET(leftv res,leftv a,Subexpr e)915 static BOOLEAN jiA_BUCKET(leftv res, leftv a, Subexpr e)
916 // there should be no assign bucket:=bucket, here we have poly:=bucket
917 {
918 sBucket_pt b=(sBucket_pt)a->CopyD();
919 if (errorreported) return TRUE;
920 poly p; int l;
921 sBucketDestroyAdd(b,&p,&l);
922 sleftv tmp;
923 tmp.Init();
924 tmp.rtyp=POLY_CMD;
925 tmp.data=p;
926 return jiA_POLY(res,&tmp,e);
927 }
jiA_IDEAL(leftv res,leftv a,Subexpr)928 static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr)
929 {
930 ideal I=(ideal)a->CopyD(MATRIX_CMD);
931 if (errorreported) return TRUE;
932 if (res->data!=NULL) idDelete((ideal*)&res->data);
933 res->data=(void*)I;
934 if (a->rtyp==IDHDL) id_Normalize((ideal)a->Data(), currRing);
935 else id_Normalize(I/*(ideal)res->data*/, currRing);
936 jiAssignAttr(res,a);
937 if (((res->rtyp==IDEAL_CMD)||(res->rtyp==MODUL_CMD))
938 && (IDELEMS(I/*(ideal)(res->data)*/)==1)
939 && (currRing->qideal==NULL)
940 && (!rIsPluralRing(currRing))
941 )
942 {
943 setFlag(res,FLAG_STD);
944 }
945 if (TEST_V_QRING && (currRing->qideal!=NULL))
946 {
947 if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
948 else jjNormalizeQRingId(res);
949 }
950 return FALSE;
951 }
jiA_RESOLUTION(leftv res,leftv a,Subexpr)952 static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr)
953 {
954 syStrategy R=(syStrategy)a->CopyD(RESOLUTION_CMD);
955 if (errorreported) return TRUE;
956 if (res->data!=NULL) syKillComputation((syStrategy)res->data);
957 res->data=(void*)R;
958 jiAssignAttr(res,a);
959 return FALSE;
960 }
jiA_MODUL_P(leftv res,leftv a,Subexpr)961 static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr)
962 /* module = poly */
963 {
964 ideal I=idInit(1,1);
965 I->m[0]=(poly)a->CopyD(POLY_CMD);
966 if (errorreported) return TRUE;
967 if (I->m[0]!=NULL) pSetCompP(I->m[0],1);
968 pNormalize(I->m[0]);
969 if (res->data!=NULL) idDelete((ideal*)&res->data);
970 res->data=(void *)I;
971 if (TEST_V_QRING && (currRing->qideal!=NULL))
972 {
973 if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
974 else jjNormalizeQRingId(res);
975 }
976 return FALSE;
977 }
jiA_IDEAL_M(leftv res,leftv a,Subexpr)978 static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr)
979 {
980 matrix m=(matrix)a->CopyD(MATRIX_CMD);
981 if (errorreported) return TRUE;
982 if (TEST_V_ALLWARN)
983 if (MATROWS(m)>1)
984 Warn("assign matrix with %d rows to an ideal in >>%s<<",MATROWS(m),my_yylinebuf);
985 IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m);
986 ((ideal)m)->rank=1;
987 MATROWS(m)=1;
988 id_Normalize((ideal)m, currRing);
989 if (res->data!=NULL) idDelete((ideal*)&res->data);
990 res->data=(void *)m;
991 if (TEST_V_QRING && (currRing->qideal!=NULL))
992 {
993 if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
994 else jjNormalizeQRingId(res);
995 }
996 return FALSE;
997 }
jiA_IDEAL_Mo(leftv res,leftv a,Subexpr)998 static BOOLEAN jiA_IDEAL_Mo(leftv res, leftv a, Subexpr)
999 {
1000 ideal m=(ideal)a->CopyD(MODUL_CMD);
1001 if (errorreported) return TRUE;
1002 if (m->rank>1)
1003 {
1004 Werror("rank of module is %ld in assignment to ideal",m->rank);
1005 return TRUE;
1006 }
1007 if (res->data!=NULL) idDelete((ideal*)&res->data);
1008 id_Normalize(m, currRing);
1009 id_Shift(m,-1,currRing);
1010 m->rank=1;
1011 res->data=(void *)m;
1012 if (TEST_V_QRING && (currRing->qideal!=NULL))
1013 {
1014 if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
1015 else jjNormalizeQRingId(res);
1016 }
1017 return FALSE;
1018 }
jiA_LINK(leftv res,leftv a,Subexpr)1019 static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr)
1020 {
1021 si_link l=(si_link)res->data;
1022
1023 if (l!=NULL) slCleanUp(l);
1024
1025 if (a->Typ() == STRING_CMD)
1026 {
1027 if (l == NULL)
1028 {
1029 l = (si_link) omAlloc0Bin(sip_link_bin);
1030 res->data = (void *) l;
1031 }
1032 return slInit(l, (char *) a->Data());
1033 }
1034 else if (a->Typ() == LINK_CMD)
1035 {
1036 if (l != NULL) omFreeBin(l, sip_link_bin);
1037 res->data = slCopy((si_link)a->Data());
1038 return FALSE;
1039 }
1040 return TRUE;
1041 }
1042 // assign map -> map
jiA_MAP(leftv res,leftv a,Subexpr)1043 static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr)
1044 {
1045 if (res->data!=NULL)
1046 {
1047 omFree((ADDRESS)((map)res->data)->preimage);
1048 ((map)res->data)->preimage=NULL;
1049 idDelete((ideal*)&res->data);
1050 }
1051 res->data=(void *)a->CopyD(MAP_CMD);
1052 if (errorreported) return TRUE;
1053 jiAssignAttr(res,a);
1054 return FALSE;
1055 }
1056 // assign ideal -> map
jiA_MAP_ID(leftv res,leftv a,Subexpr)1057 static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr)
1058 {
1059 map f=(map)res->data;
1060 char *rn=f->preimage; // save the old/already assigned preimage ring name
1061 f->preimage=NULL;
1062 idDelete((ideal *)&f);
1063 res->data=(void *)a->CopyD(IDEAL_CMD);
1064 if (errorreported) return TRUE;
1065 f=(map)res->data;
1066 id_Normalize((ideal)f, currRing);
1067 f->preimage = rn;
1068 return FALSE;
1069 }
jiA_QRING(leftv res,leftv a,Subexpr e)1070 static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
1071 {
1072 // the follwing can only happen, if:
1073 // - the left side is of type qring AND not an id
1074 if ((e!=NULL)||(res->rtyp!=IDHDL))
1075 {
1076 WerrorS("qring_id expected");
1077 return TRUE;
1078 }
1079
1080 ring old_ring=(ring)res->Data();
1081
1082 coeffs newcf = currRing->cf;
1083 ideal id = (ideal)a->Data(); //?
1084 if (errorreported) return TRUE;
1085 const int cpos = idPosConstant(id);
1086 if(rField_is_Ring(currRing))
1087 if (cpos >= 0)
1088 {
1089 newcf = n_CoeffRingQuot1(p_GetCoeff(id->m[cpos], currRing), currRing->cf);
1090 if(newcf == NULL)
1091 return TRUE;
1092 }
1093 //qr=(ring)res->Data();
1094 //if (qr!=NULL) omFreeBin((ADDRESS)qr, ip_sring_bin);
1095 ring qr = rCopy(currRing);
1096 assume(qr->cf == currRing->cf);
1097
1098 if ( qr->cf != newcf )
1099 {
1100 nKillChar ( qr->cf ); // ???
1101 qr->cf = newcf;
1102 }
1103 // we have to fill it, but the copy also allocates space
1104 idhdl h=(idhdl)res->data; // we have res->rtyp==IDHDL
1105 IDRING(h)=qr;
1106
1107 ideal qid;
1108
1109 if((rField_is_Ring(currRing)) && (cpos != -1))
1110 {
1111 int i, j;
1112 int *perm = (int *)omAlloc0((qr->N+1)*sizeof(int));
1113
1114 for(i=qr->N;i>0;i--)
1115 perm[i]=i;
1116
1117 nMapFunc nMap = n_SetMap(currRing->cf, newcf);
1118 qid = idInit(IDELEMS(id)-1,1);
1119 for(i = 0, j = 0; i<IDELEMS(id); i++)
1120 if( i != cpos )
1121 qid->m[j++] = p_PermPoly(id->m[i], perm, currRing, qr, nMap, NULL, 0);
1122 }
1123 else
1124 qid = idrCopyR(id,currRing,qr);
1125
1126 idSkipZeroes(qid);
1127 //idPrint(qid);
1128 if ((idElem(qid)>1) || rIsSCA(currRing) || (currRing->qideal!=NULL))
1129 assumeStdFlag(a);
1130
1131 if (currRing->qideal!=NULL) /* we are already in a qring! */
1132 {
1133 ideal tmp=idSimpleAdd(qid,currRing->qideal);
1134 // both ideals should be GB, so dSimpleAdd is sufficient
1135 idDelete(&qid);
1136 qid=tmp;
1137 // delete the qr copy of quotient ideal!!!
1138 idDelete(&qr->qideal);
1139 }
1140 if (idElem(qid)==0)
1141 {
1142 qr->qideal = NULL;
1143 id_Delete(&qid,currRing);
1144 IDTYP(h)=RING_CMD;
1145 }
1146 else
1147 qr->qideal = qid;
1148
1149 // qr is a copy of currRing with the new qideal!
1150 #ifdef HAVE_PLURAL
1151 if(rIsPluralRing(currRing) &&(qr->qideal!=NULL))
1152 {
1153 if (!hasFlag(a,FLAG_TWOSTD))
1154 {
1155 Warn("%s is no twosided standard basis",a->Name());
1156 }
1157
1158 if( nc_SetupQuotient(qr, currRing) )
1159 {
1160 // WarnS("error in nc_SetupQuotient");
1161 }
1162 }
1163 #endif
1164 //rWrite(qr);
1165 rSetHdl((idhdl)res->data);
1166 if (old_ring!=NULL)
1167 {
1168 rDelete(old_ring);
1169 }
1170 return FALSE;
1171 }
1172
jiA_RING(leftv res,leftv a,Subexpr e)1173 static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e)
1174 {
1175 BOOLEAN have_id=TRUE;
1176 if ((e!=NULL)||(res->rtyp!=IDHDL))
1177 {
1178 //WerrorS("id expected");
1179 //return TRUE;
1180 have_id=FALSE;
1181 }
1182 ring r=(ring)a->Data();
1183 if ((r==NULL)||(r->cf==NULL)) return TRUE;
1184 if (have_id)
1185 {
1186 idhdl rl=(idhdl)res->data;
1187 if (IDRING(rl)!=NULL) rKill(rl);
1188 IDRING(rl)=r;
1189 if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing))
1190 currRingHdl=(idhdl)res->data;
1191 }
1192 else
1193 {
1194 if (e==NULL) res->data=(char *)r;
1195 else
1196 {
1197 WerrorS("id expected");
1198 return TRUE;
1199 }
1200 }
1201 rIncRefCnt(r);
1202 jiAssignAttr(res,a);
1203 return FALSE;
1204 }
jiA_PACKAGE(leftv res,leftv a,Subexpr)1205 static BOOLEAN jiA_PACKAGE(leftv res, leftv a, Subexpr)
1206 {
1207 res->data=(void *)a->CopyD(PACKAGE_CMD);
1208 jiAssignAttr(res,a);
1209 return FALSE;
1210 }
jiA_DEF(leftv res,leftv,Subexpr)1211 static BOOLEAN jiA_DEF(leftv res, leftv, Subexpr)
1212 {
1213 res->data=(void *)0;
1214 return FALSE;
1215 }
jiA_CRING(leftv res,leftv a,Subexpr)1216 static BOOLEAN jiA_CRING(leftv res, leftv a, Subexpr)
1217 {
1218 coeffs r=(coeffs)a->Data();
1219 if (errorreported) return TRUE;
1220 if (r==NULL) return TRUE;
1221 if (res->data!=NULL) nKillChar((coeffs)res->data);
1222 res->data=(void *)a->CopyD(CRING_CMD);
1223 jiAssignAttr(res,a);
1224 return FALSE;
1225 }
1226
1227 /*=================== table =================*/
1228 #define IPASSIGN
1229 #define D(A) A
1230 #define NULL_VAL NULL
1231 #include "table.h"
1232 /*=================== operations ============================*/
1233 /*2
1234 * assign a = b
1235 */
jiAssign_1(leftv l,leftv r,int rt,BOOLEAN toplevel,BOOLEAN is_qring=FALSE)1236 static BOOLEAN jiAssign_1(leftv l, leftv r, int rt, BOOLEAN toplevel, BOOLEAN is_qring=FALSE)
1237 {
1238 if (rt==0)
1239 {
1240 if (!errorreported) Werror("`%s` is undefined",r->Fullname());
1241 return TRUE;
1242 }
1243
1244 int lt=l->Typ();
1245 if (lt==0)
1246 {
1247 if (!errorreported) Werror("left side `%s` is undefined",l->Fullname());
1248 return TRUE;
1249 }
1250 if(rt==NONE)
1251 {
1252 if ((!TEST_V_ASSIGN_NONE)||(lt!=DEF_CMD))
1253 {
1254 WarnS("right side is not a datum, assignment ignored");
1255 Warn("in line >>%s<<",my_yylinebuf);
1256 // if (!errorreported)
1257 // WerrorS("right side is not a datum");
1258 //return TRUE;
1259 }
1260 return FALSE;
1261 }
1262
1263 if (lt==DEF_CMD)
1264 {
1265
1266 if (TEST_V_ALLWARN
1267 && (rt!=RING_CMD)
1268 && (l->name!=NULL)
1269 && (l->e==NULL)
1270 && (iiCurrArgs==NULL) /* not in proc header */
1271 )
1272 {
1273 Warn("use `%s` instead of `def` in %s:%d:%s",Tok2Cmdname(rt),
1274 currentVoice->filename,yylineno,my_yylinebuf);
1275 }
1276 if (l->rtyp==IDHDL)
1277 {
1278 if((currRingHdl==NULL) && RingDependend(rt))
1279 {
1280 WerrorS("basering required");
1281 return TRUE;
1282 }
1283 if (rt==BUCKET_CMD) IDTYP((idhdl)l->data)=POLY_CMD;
1284 else IDTYP((idhdl)l->data)=rt;
1285 }
1286 else if (l->name!=NULL)
1287 {
1288 int rrt;
1289 if (rt==BUCKET_CMD) rrt=POLY_CMD;
1290 else rrt=rt;
1291 sleftv ll;
1292 iiDeclCommand(&ll,l,myynest,rrt,&IDROOT);
1293 memcpy(l,&ll,sizeof(sleftv));
1294 }
1295 else
1296 {
1297 if (rt==BUCKET_CMD) l->rtyp=POLY_CMD;
1298 else l->rtyp=rt;
1299 }
1300 lt=l->Typ();
1301 }
1302 else
1303 {
1304 if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
1305 return FALSE;
1306 }
1307 leftv ld=l;
1308 if (l->rtyp==IDHDL)
1309 {
1310 if (lt!=RING_CMD)
1311 ld=(leftv)l->data;
1312 }
1313 else if (toplevel)
1314 {
1315 WerrorS("error in assign: left side is not an l-value");
1316 return TRUE;
1317 }
1318 if (lt>MAX_TOK)
1319 {
1320 blackbox *bb=getBlackboxStuff(lt);
1321 #ifdef BLACKBOX_DEVEL
1322 Print("bb-assign: bb=%lx\n",bb);
1323 #endif
1324 return (bb==NULL) || bb->blackbox_Assign(l,r);
1325 }
1326 if ((is_qring)
1327 &&(lt==RING_CMD)
1328 &&(rt==RING_CMD))
1329 {
1330 Warn("qring .. = <ring>; is misleading in >>%s<<",my_yylinebuf);
1331 }
1332 int start=0;
1333 while ((dAssign[start].res!=lt)
1334 && (dAssign[start].res!=0)) start++;
1335 int i=start;
1336 while ((dAssign[i].res==lt)
1337 && (dAssign[i].arg!=rt)) i++;
1338 if (dAssign[i].res==lt)
1339 {
1340 if (traceit&TRACE_ASSIGN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt));
1341 BOOLEAN b;
1342 b=dAssign[i].p(ld,r,l->e);
1343 if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
1344 {
1345 l->flag=ld->flag;
1346 l->attribute=ld->attribute;
1347 }
1348 return b;
1349 }
1350 // implicite type conversion ----------------------------------------------
1351 if (dAssign[i].res!=lt)
1352 {
1353 int ri;
1354 leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1355 BOOLEAN failed=FALSE;
1356 i=start;
1357 //while ((dAssign[i].res!=lt)
1358 // && (dAssign[i].res!=0)) i++;
1359 while (dAssign[i].res==lt)
1360 {
1361 if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
1362 {
1363 failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
1364 if(!failed)
1365 {
1366 failed= dAssign[i].p(ld,rn,l->e);
1367 if (traceit&TRACE_ASSIGN)
1368 Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed);
1369 }
1370 // everything done, clean up temp. variables
1371 rn->CleanUp();
1372 omFreeBin((ADDRESS)rn, sleftv_bin);
1373 if (failed)
1374 {
1375 // leave loop, goto error handling
1376 break;
1377 }
1378 else
1379 {
1380 if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
1381 {
1382 l->flag=ld->flag;
1383 l->attribute=ld->attribute;
1384 }
1385 // everything ok, return
1386 return FALSE;
1387 }
1388 }
1389 i++;
1390 }
1391 // error handling ---------------------------------------------------
1392 if (!errorreported)
1393 {
1394 if ((l->rtyp==IDHDL) && (l->e==NULL))
1395 Werror("`%s`(%s) = `%s` is not supported",
1396 Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
1397 else
1398 Werror("`%s` = `%s` is not supported"
1399 ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1400 if (BVERBOSE(V_SHOW_USE))
1401 {
1402 i=0;
1403 while ((dAssign[i].res!=lt)
1404 && (dAssign[i].res!=0)) i++;
1405 while (dAssign[i].res==lt)
1406 {
1407 Werror("expected `%s` = `%s`"
1408 ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
1409 i++;
1410 }
1411 }
1412 }
1413 }
1414 return TRUE;
1415 }
1416 /*2
1417 * assign sys_var = val
1418 */
iiAssign_sys(leftv l,leftv r)1419 static BOOLEAN iiAssign_sys(leftv l, leftv r)
1420 {
1421 int rt=r->Typ();
1422
1423 if (rt==0)
1424 {
1425 if (!errorreported) Werror("`%s` is undefined",r->Fullname());
1426 return TRUE;
1427 }
1428 int i=0;
1429 int lt=l->rtyp;
1430 while (((dAssign_sys[i].res!=lt)
1431 || (dAssign_sys[i].arg!=rt))
1432 && (dAssign_sys[i].res!=0)) i++;
1433 if (dAssign_sys[i].res!=0)
1434 {
1435 if (!dAssign_sys[i].p(l,r))
1436 {
1437 // everything ok, clean up
1438 return FALSE;
1439 }
1440 }
1441 // implicite type conversion ----------------------------------------------
1442 if (dAssign_sys[i].res==0)
1443 {
1444 int ri;
1445 leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1446 BOOLEAN failed=FALSE;
1447 i=0;
1448 while ((dAssign_sys[i].res!=lt)
1449 && (dAssign_sys[i].res!=0)) i++;
1450 while (dAssign_sys[i].res==lt)
1451 {
1452 if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
1453 {
1454 failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
1455 || (dAssign_sys[i].p(l,rn)));
1456 // everything done, clean up temp. variables
1457 rn->CleanUp();
1458 omFreeBin((ADDRESS)rn, sleftv_bin);
1459 if (failed)
1460 {
1461 // leave loop, goto error handling
1462 break;
1463 }
1464 else
1465 {
1466 // everything ok, return
1467 return FALSE;
1468 }
1469 }
1470 i++;
1471 }
1472 // error handling ---------------------------------------------------
1473 if(!errorreported)
1474 {
1475 Werror("`%s` = `%s` is not supported"
1476 ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1477 if (BVERBOSE(V_SHOW_USE))
1478 {
1479 i=0;
1480 while ((dAssign_sys[i].res!=lt)
1481 && (dAssign_sys[i].res!=0)) i++;
1482 while (dAssign_sys[i].res==lt)
1483 {
1484 Werror("expected `%s` = `%s`"
1485 ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
1486 i++;
1487 }
1488 }
1489 }
1490 }
1491 return TRUE;
1492 }
jiA_INTVEC_L(leftv l,leftv r)1493 static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
1494 {
1495 /* right side is intvec, left side is list (of int)*/
1496 BOOLEAN nok;
1497 int i=0;
1498 leftv l1=l;
1499 leftv h;
1500 sleftv t;
1501 intvec *iv=(intvec *)r->Data();
1502 memset(&t,0,sizeof(sleftv));
1503 t.rtyp=INT_CMD;
1504 while ((i<iv->length())&&(l!=NULL))
1505 {
1506 t.data=(char *)(long)(*iv)[i];
1507 h=l->next;
1508 l->next=NULL;
1509 nok=jiAssign_1(l,&t,INT_CMD,TRUE);
1510 l->next=h;
1511 if (nok) return TRUE;
1512 i++;
1513 l=h;
1514 }
1515 l1->CleanUp();
1516 r->CleanUp();
1517 return FALSE;
1518 }
jiA_VECTOR_L(leftv l,leftv r)1519 static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
1520 {
1521 /* right side is vector, left side is list (of poly)*/
1522 BOOLEAN nok;
1523 leftv l1=l;
1524 ideal I=idVec2Ideal((poly)r->Data());
1525 leftv h;
1526 sleftv t;
1527 int i=0;
1528 memset(&t,0,sizeof(sleftv));
1529 while (l!=NULL)
1530 {
1531 t.rtyp=POLY_CMD;
1532 if (i>=IDELEMS(I))
1533 {
1534 t.data=NULL;
1535 }
1536 else
1537 {
1538 t.data=(char *)I->m[i];
1539 I->m[i]=NULL;
1540 }
1541 h=l->next;
1542 l->next=NULL;
1543 nok=jiAssign_1(l,&t,POLY_CMD,TRUE);
1544 l->next=h;
1545 t.CleanUp();
1546 if (nok)
1547 {
1548 idDelete(&I);
1549 return TRUE;
1550 }
1551 i++;
1552 l=h;
1553 }
1554 idDelete(&I);
1555 l1->CleanUp();
1556 r->CleanUp();
1557 //if (TEST_V_QRING && (currRing->qideal!=NULL)) l=jjNormalizeQRingP(l);
1558 return FALSE;
1559 }
jjA_L_LIST(leftv l,leftv r)1560 static BOOLEAN jjA_L_LIST(leftv l, leftv r)
1561 /* left side: list/def, has to be a "real" variable
1562 * right side: expression list
1563 */
1564 {
1565 int sl = r->listLength();
1566 lists L=(lists)omAllocBin(slists_bin);
1567 lists oldL;
1568 leftv h=NULL,o_r=r;
1569 int i;
1570 int rt;
1571
1572 L->Init(sl);
1573 for (i=0;i<sl;i++)
1574 {
1575 if (h!=NULL) { /* e.g. not in the first step:
1576 * h is the pointer to the old sleftv,
1577 * r is the pointer to the next sleftv
1578 * (in this moment) */
1579 h->next=r;
1580 }
1581 h=r;
1582 r=r->next;
1583 h->next=NULL;
1584 rt=h->Typ();
1585 if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
1586 {
1587 L->Clean();
1588 Werror("`%s` is undefined",h->Fullname());
1589 //listall();
1590 goto err;
1591 }
1592 //if (rt==RING_CMD)
1593 //{
1594 // L->m[i].rtyp=rt;
1595 // L->m[i].data=h->Data();
1596 // ((ring)L->m[i].data)->ref++;
1597 //}
1598 //else
1599 L->m[i].CleanUp();
1600 L->m[i].Copy(h);
1601 if(errorreported)
1602 {
1603 L->Clean();
1604 goto err;
1605 }
1606 }
1607 oldL=(lists)l->Data();
1608 if (oldL!=NULL) oldL->Clean();
1609 if (l->rtyp==IDHDL)
1610 {
1611 IDLIST((idhdl)l->data)=L;
1612 IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1613 if (lRingDependend(L)) ipMoveId((idhdl)l->data);
1614 }
1615 else
1616 {
1617 l->LData()->data=L;
1618 if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1619 l->rtyp=LIST_CMD;
1620 }
1621 err:
1622 o_r->CleanUp();
1623 return errorreported;
1624 }
jjA_L_INTVEC(leftv l,leftv r,intvec * iv)1625 static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1626 {
1627 /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1628 leftv hh=r;
1629 int i = 0;
1630 while (hh!=NULL)
1631 {
1632 if (i>=iv->length())
1633 {
1634 if (traceit&TRACE_ASSIGN)
1635 {
1636 Warn("expression list length(%d) does not match intmat size(%d)",
1637 iv->length()+exprlist_length(hh),iv->length());
1638 }
1639 break;
1640 }
1641 if (hh->Typ() == INT_CMD)
1642 {
1643 (*iv)[i++] = (int)((long)(hh->Data()));
1644 }
1645 else if ((hh->Typ() == INTVEC_CMD)
1646 ||(hh->Typ() == INTMAT_CMD))
1647 {
1648 intvec *ivv = (intvec *)(hh->Data());
1649 int ll = 0,l = si_min(ivv->length(),iv->length());
1650 for (; l>0; l--)
1651 {
1652 (*iv)[i++] = (*ivv)[ll++];
1653 }
1654 }
1655 else
1656 {
1657 delete iv;
1658 return TRUE;
1659 }
1660 hh = hh->next;
1661 }
1662 if (l->rtyp==IDHDL)
1663 {
1664 if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1665 IDINTVEC((idhdl)l->data)=iv;
1666 }
1667 else
1668 {
1669 if (l->data!=NULL) delete ((intvec*)l->data);
1670 l->data=(char*)iv;
1671 }
1672 return FALSE;
1673 }
jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat * bim)1674 static BOOLEAN jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat *bim)
1675 {
1676 /* left side is bigintmat, right side is list (of int,intvec,intmat)*/
1677 leftv hh=r;
1678 int i = 0;
1679 if (bim->length()==0) { WerrorS("bigintmat is 1x0"); delete bim; return TRUE; }
1680 while (hh!=NULL)
1681 {
1682 if (i>=bim->cols()*bim->rows())
1683 {
1684 if (traceit&TRACE_ASSIGN)
1685 {
1686 Warn("expression list length(%d) does not match bigintmat size(%d x %d)",
1687 exprlist_length(hh),bim->rows(),bim->cols());
1688 }
1689 break;
1690 }
1691 if (hh->Typ() == INT_CMD)
1692 {
1693 number tp = n_Init((int)((long)(hh->Data())), coeffs_BIGINT);
1694 bim->set(i++, tp);
1695 n_Delete(&tp, coeffs_BIGINT);
1696 }
1697 else if (hh->Typ() == BIGINT_CMD)
1698 {
1699 bim->set(i++, (number)(hh->Data()));
1700 }
1701 /*
1702 ((hh->Typ() == INTVEC_CMD)
1703 ||(hh->Typ() == INTMAT_CMD))
1704 {
1705 intvec *ivv = (intvec *)(hh->Data());
1706 int ll = 0,l = si_min(ivv->length(),iv->length());
1707 for (; l>0; l--)
1708 {
1709 (*iv)[i++] = (*ivv)[ll++];
1710 }
1711 }*/
1712 else
1713 {
1714 delete bim;
1715 return TRUE;
1716 }
1717 hh = hh->next;
1718 }
1719 if (IDBIMAT((idhdl)l->data)!=NULL) delete IDBIMAT((idhdl)l->data);
1720 IDBIMAT((idhdl)l->data)=bim;
1721 return FALSE;
1722 }
jjA_L_STRING(leftv l,leftv r)1723 static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1724 {
1725 /* left side is string, right side is list of string*/
1726 leftv hh=r;
1727 int sl = 1;
1728 char *s;
1729 char *t;
1730 int tl;
1731 /* find the length */
1732 while (hh!=NULL)
1733 {
1734 if (hh->Typ()!= STRING_CMD)
1735 {
1736 return TRUE;
1737 }
1738 sl += strlen((char *)hh->Data());
1739 hh = hh->next;
1740 }
1741 s = (char * )omAlloc(sl);
1742 sl=0;
1743 hh = r;
1744 while (hh!=NULL)
1745 {
1746 t=(char *)hh->Data();
1747 tl=strlen(t);
1748 memcpy(s+sl,t,tl);
1749 sl+=tl;
1750 hh = hh->next;
1751 }
1752 s[sl]='\0';
1753 omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1754 IDDATA((idhdl)(l->data))=s;
1755 return FALSE;
1756 }
jiA_MATRIX_L(leftv l,leftv r)1757 static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1758 {
1759 /* right side is matrix, left side is list (of poly)*/
1760 BOOLEAN nok=FALSE;
1761 int i;
1762 matrix m=(matrix)r->CopyD(MATRIX_CMD);
1763 leftv h;
1764 leftv ol=l;
1765 leftv o_r=r;
1766 sleftv t;
1767 memset(&t,0,sizeof(sleftv));
1768 t.rtyp=POLY_CMD;
1769 int mxn=MATROWS(m)*MATCOLS(m);
1770 loop
1771 {
1772 i=0;
1773 while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1774 {
1775 t.data=(char *)m->m[i];
1776 m->m[i]=NULL;
1777 h=l->next;
1778 l->next=NULL;
1779 idhdl hh=NULL;
1780 if ((l->rtyp==IDHDL)&&(l->Typ()==DEF_CMD)) hh=(idhdl)l->data;
1781 nok=jiAssign_1(l,&t,POLY_CMD,TRUE);
1782 if (hh!=NULL) { ipMoveId(hh);hh=NULL;}
1783 l->next=h;
1784 if (nok)
1785 {
1786 idDelete((ideal *)&m);
1787 goto ende;
1788 }
1789 i++;
1790 l=h;
1791 }
1792 idDelete((ideal *)&m);
1793 h=r;
1794 r=r->next;
1795 if (l==NULL)
1796 {
1797 if (r!=NULL)
1798 {
1799 WarnS("list length mismatch in assign (l>r)");
1800 nok=TRUE;
1801 }
1802 break;
1803 }
1804 else if (r==NULL)
1805 {
1806 WarnS("list length mismatch in assign (l<r)");
1807 nok=TRUE;
1808 break;
1809 }
1810 if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1811 {
1812 m=(matrix)r->CopyD(MATRIX_CMD);
1813 mxn=MATROWS(m)*MATCOLS(m);
1814 }
1815 else if (r->Typ()==POLY_CMD)
1816 {
1817 m=mpNew(1,1);
1818 MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1819 pNormalize(MATELEM(m,1,1));
1820 mxn=1;
1821 }
1822 else
1823 {
1824 nok=TRUE;
1825 break;
1826 }
1827 }
1828 ende:
1829 o_r->CleanUp();
1830 ol->CleanUp();
1831 return nok;
1832 }
jiA_STRING_L(leftv l,leftv r)1833 static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1834 {
1835 /*left side are strings, right side is a string*/
1836 /*e.g. s[2..3]="12" */
1837 /*the case s=t[1..4] is handled in iiAssign,
1838 * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1839 BOOLEAN nok=FALSE;
1840 sleftv t;
1841 leftv h,l1=l;
1842 int i=0;
1843 char *ss;
1844 char *s=(char *)r->Data();
1845 int sl=strlen(s);
1846
1847 memset(&t,0,sizeof(sleftv));
1848 t.rtyp=STRING_CMD;
1849 while ((i<sl)&&(l!=NULL))
1850 {
1851 ss=(char *)omAlloc(2);
1852 ss[1]='\0';
1853 ss[0]=s[i];
1854 t.data=ss;
1855 h=l->next;
1856 l->next=NULL;
1857 nok=jiAssign_1(l,&t,STRING_CMD,TRUE);
1858 if (nok)
1859 {
1860 break;
1861 }
1862 i++;
1863 l=h;
1864 }
1865 r->CleanUp();
1866 l1->CleanUp();
1867 return nok;
1868 }
jiAssign_list(leftv l,leftv r)1869 static BOOLEAN jiAssign_list(leftv l, leftv r)
1870 {
1871 int i=l->e->start-1;
1872 if (i<0)
1873 {
1874 Werror("index[%d] must be positive",i+1);
1875 return TRUE;
1876 }
1877 if(l->attribute!=NULL)
1878 {
1879 atKillAll((idhdl)l);
1880 l->attribute=NULL;
1881 }
1882 l->flag=0;
1883 lists li;
1884 if (l->rtyp==IDHDL)
1885 {
1886 li=IDLIST((idhdl)l->data);
1887 }
1888 else
1889 {
1890 li=(lists)l->data;
1891 }
1892 if (i>li->nr)
1893 {
1894 if (TEST_V_ALLWARN)
1895 {
1896 Warn("increase list %d -> %d in %s(%d):%s",li->nr,i,VoiceName(),VoiceLine(),my_yylinebuf);
1897 }
1898 li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1899 memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1900 int j=li->nr+1;
1901 for(;j<=i;j++)
1902 li->m[j].rtyp=DEF_CMD;
1903 li->nr=i;
1904 }
1905 leftv ld=&(li->m[i]);
1906 ld->e=l->e->next;
1907 BOOLEAN b;
1908 sleftv tmp;
1909 memset(&tmp,0,sizeof(sleftv));
1910 if (/*(ld->rtyp!=LIST_CMD)
1911 &&*/(ld->e==NULL)
1912 && (ld->Typ()!=r->Typ()))
1913 {
1914 ring old_r=jjCheck_FLAG_OTHER_RING(ld);
1915 tmp.rtyp=DEF_CMD;
1916 tmp.flag=ld->flag;
1917 b=iiAssign(&tmp,r,FALSE);
1918 ld->CleanUp(old_r);
1919 memcpy(ld,&tmp,sizeof(sleftv));
1920 }
1921 else if ((ld->e==NULL)
1922 && (ld->Typ()==r->Typ())
1923 && (ld->Typ()<MAX_TOK))
1924 {
1925 ring old_r=jjCheck_FLAG_OTHER_RING(ld);
1926 tmp.rtyp=r->Typ();
1927 tmp.flag=ld->flag;
1928 tmp.data=(char*)idrecDataInit(r->Typ());
1929 b=iiAssign(&tmp,r,FALSE);
1930 ld->CleanUp(old_r);
1931 memcpy(ld,&tmp,sizeof(sleftv));
1932 }
1933 else
1934 {
1935 b=iiAssign(ld,r,FALSE);
1936 if (l->e!=NULL) l->e->next=ld->e;
1937 ld->e=NULL;
1938 }
1939 return b;
1940 }
jiAssign_rec(leftv l,leftv r)1941 static BOOLEAN jiAssign_rec(leftv l, leftv r)
1942 {
1943 leftv l1=l;
1944 leftv r1=r;
1945 leftv lrest;
1946 leftv rrest;
1947 BOOLEAN b;
1948 do
1949 {
1950 lrest=l->next;
1951 rrest=r->next;
1952 l->next=NULL;
1953 r->next=NULL;
1954 b=iiAssign(l,r);
1955 l->next=lrest;
1956 r->next=rrest;
1957 l=lrest;
1958 r=rrest;
1959 } while ((!b)&&(l!=NULL));
1960 l1->CleanUp();
1961 r1->CleanUp();
1962 return b;
1963 }
iiAssign(leftv l,leftv r,BOOLEAN toplevel)1964 BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
1965 {
1966 if (errorreported) return TRUE;
1967 int ll=l->listLength();
1968 int rl;
1969 int lt=l->Typ();
1970 int rt=NONE;
1971 int is_qring=FALSE;
1972 BOOLEAN b=FALSE;
1973 if (l->rtyp==ALIAS_CMD)
1974 {
1975 Werror("`%s` is read-only",l->Name());
1976 }
1977
1978 if (l->rtyp==IDHDL)
1979 {
1980 atKillAll((idhdl)l->data);
1981 is_qring=hasFlag((idhdl)l->data,FLAG_QRING_DEF);
1982 IDFLAG((idhdl)l->data)=0;
1983 l->attribute=NULL;
1984 toplevel=FALSE;
1985 }
1986 else if (l->attribute!=NULL)
1987 atKillAll((idhdl)l);
1988 if (ll==1)
1989 {
1990 /* l[..] = ... */
1991 if(l->e!=NULL)
1992 {
1993 BOOLEAN like_lists=0;
1994 blackbox *bb=NULL;
1995 int bt;
1996 if (((bt=l->rtyp)>MAX_TOK)
1997 || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1998 {
1999 bb=getBlackboxStuff(bt);
2000 like_lists=BB_LIKE_LIST(bb); // bb like a list
2001 }
2002 else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
2003 || (l->rtyp==LIST_CMD))
2004 {
2005 like_lists=2; // bb in a list
2006 }
2007 if(like_lists)
2008 {
2009 if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
2010 if (like_lists==1)
2011 {
2012 // check blackbox/newtype type:
2013 if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
2014 }
2015 b=jiAssign_list(l,r);
2016 if((!b) && (like_lists==2))
2017 {
2018 //Print("jjA_L_LIST: - 2 \n");
2019 if((l->rtyp==IDHDL) && (l->data!=NULL))
2020 {
2021 ipMoveId((idhdl)l->data);
2022 l->attribute=IDATTR((idhdl)l->data);
2023 l->flag=IDFLAG((idhdl)l->data);
2024 }
2025 }
2026 r->CleanUp();
2027 Subexpr h;
2028 while (l->e!=NULL)
2029 {
2030 h=l->e->next;
2031 omFreeBin((ADDRESS)l->e, sSubexpr_bin);
2032 l->e=h;
2033 }
2034 return b;
2035 }
2036 }
2037 if (lt>MAX_TOK)
2038 {
2039 blackbox *bb=getBlackboxStuff(lt);
2040 #ifdef BLACKBOX_DEVEL
2041 Print("bb-assign: bb=%lx\n",bb);
2042 #endif
2043 return (bb==NULL) || bb->blackbox_Assign(l,r);
2044 }
2045 // end of handling elems of list and similar
2046 rl=r->listLength();
2047 if (rl==1)
2048 {
2049 /* system variables = ... */
2050 if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
2051 ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
2052 {
2053 b=iiAssign_sys(l,r);
2054 r->CleanUp();
2055 //l->CleanUp();
2056 return b;
2057 }
2058 rt=r->Typ();
2059 /* a = ... */
2060 if ((lt!=MATRIX_CMD)
2061 &&(lt!=BIGINTMAT_CMD)
2062 &&(lt!=CMATRIX_CMD)
2063 &&(lt!=INTMAT_CMD)
2064 &&((lt==rt)||(lt!=LIST_CMD)))
2065 {
2066 b=jiAssign_1(l,r,rt,toplevel,is_qring);
2067 if (l->rtyp==IDHDL)
2068 {
2069 if ((lt==DEF_CMD)||(lt==LIST_CMD))
2070 {
2071 ipMoveId((idhdl)l->data);
2072 }
2073 l->attribute=IDATTR((idhdl)l->data);
2074 l->flag=IDFLAG((idhdl)l->data);
2075 l->CleanUp();
2076 }
2077 r->CleanUp();
2078 return b;
2079 }
2080 if (((lt!=LIST_CMD)
2081 &&((rt==MATRIX_CMD)
2082 ||(rt==BIGINTMAT_CMD)
2083 ||(rt==CMATRIX_CMD)
2084 ||(rt==INTMAT_CMD)
2085 ||(rt==INTVEC_CMD)
2086 ||(rt==MODUL_CMD)))
2087 ||((lt==LIST_CMD)
2088 &&(rt==RESOLUTION_CMD))
2089 )
2090 {
2091 b=jiAssign_1(l,r,rt,toplevel);
2092 if((l->rtyp==IDHDL)&&(l->data!=NULL))
2093 {
2094 if ((lt==DEF_CMD) || (lt==LIST_CMD))
2095 {
2096 //Print("ipAssign - 3.0\n");
2097 ipMoveId((idhdl)l->data);
2098 }
2099 l->attribute=IDATTR((idhdl)l->data);
2100 l->flag=IDFLAG((idhdl)l->data);
2101 }
2102 r->CleanUp();
2103 Subexpr h;
2104 while (l->e!=NULL)
2105 {
2106 h=l->e->next;
2107 omFreeBin((ADDRESS)l->e, sSubexpr_bin);
2108 l->e=h;
2109 }
2110 return b;
2111 }
2112 }
2113 if (rt==NONE) rt=r->Typ();
2114 }
2115 else if (ll==(rl=r->listLength()))
2116 {
2117 b=jiAssign_rec(l,r);
2118 return b;
2119 }
2120 else
2121 {
2122 if (rt==NONE) rt=r->Typ();
2123 if (rt==INTVEC_CMD)
2124 return jiA_INTVEC_L(l,r);
2125 else if (rt==VECTOR_CMD)
2126 return jiA_VECTOR_L(l,r);
2127 else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
2128 return jiA_MATRIX_L(l,r);
2129 else if ((rt==STRING_CMD)&&(rl==1))
2130 return jiA_STRING_L(l,r);
2131 Werror("length of lists in assignment does not match (l:%d,r:%d)",
2132 ll,rl);
2133 return TRUE;
2134 }
2135
2136 leftv hh=r;
2137 BOOLEAN map_assign=FALSE;
2138 switch (lt)
2139 {
2140 case INTVEC_CMD:
2141 b=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
2142 break;
2143 case INTMAT_CMD:
2144 {
2145 b=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
2146 break;
2147 }
2148 case BIGINTMAT_CMD:
2149 {
2150 b=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
2151 break;
2152 }
2153 case MAP_CMD:
2154 {
2155 // first element in the list sl (r) must be a ring
2156 if ((rt == RING_CMD)&&(r->e==NULL))
2157 {
2158 omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
2159 IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
2160 /* advance the expressionlist to get the next element after the ring */
2161 hh = r->next;
2162 }
2163 else
2164 {
2165 WerrorS("expected ring-name");
2166 b=TRUE;
2167 break;
2168 }
2169 if (hh==NULL) /* map-assign: map f=r; */
2170 {
2171 WerrorS("expected image ideal");
2172 b=TRUE;
2173 break;
2174 }
2175 if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2176 {
2177 b=jiAssign_1(l,hh,IDEAL_CMD,toplevel); /* map-assign: map f=r,i; */
2178 omFreeBin(hh,sleftv_bin);
2179 return b;
2180 }
2181 //no break, handle the rest like an ideal:
2182 map_assign=TRUE; // and continue
2183 }
2184 case MATRIX_CMD:
2185 case IDEAL_CMD:
2186 case MODUL_CMD:
2187 {
2188 sleftv t;
2189 matrix olm = (matrix)l->Data();
2190 long rk;
2191 char *pr=((map)olm)->preimage;
2192 BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2193 matrix lm ;
2194 long num;
2195 int j,k;
2196 int i=0;
2197 int mtyp=MATRIX_CMD; /*Type of left side object*/
2198 int etyp=POLY_CMD; /*Type of elements of left side object*/
2199
2200 if (lt /*l->Typ()*/==MATRIX_CMD)
2201 {
2202 rk=olm->rows();
2203 num=olm->cols()*rk /*olm->rows()*/;
2204 lm=mpNew(olm->rows(),olm->cols());
2205 int el;
2206 if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2207 {
2208 Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2209 }
2210 }
2211 else /* IDEAL_CMD or MODUL_CMD */
2212 {
2213 num=exprlist_length(hh);
2214 lm=(matrix)idInit(num,1);
2215 if (module_assign)
2216 {
2217 rk=0;
2218 mtyp=MODUL_CMD;
2219 etyp=VECTOR_CMD;
2220 }
2221 else
2222 rk=1;
2223 }
2224
2225 int ht;
2226 loop
2227 {
2228 if (hh==NULL)
2229 break;
2230 else
2231 {
2232 matrix rm;
2233 ht=hh->Typ();
2234 if ((j=iiTestConvert(ht,etyp))!=0)
2235 {
2236 b=iiConvert(ht,etyp,j,hh,&t);
2237 hh->next=t.next;
2238 if (b)
2239 { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(etyp));
2240 break;
2241 }
2242 lm->m[i]=(poly)t.CopyD(etyp);
2243 pNormalize(lm->m[i]);
2244 if (module_assign) rk=si_max(rk,pMaxComp(lm->m[i]));
2245 i++;
2246 }
2247 else
2248 if ((j=iiTestConvert(ht,mtyp))!=0)
2249 {
2250 b=iiConvert(ht,mtyp,j,hh,&t);
2251 hh->next=t.next;
2252 if (b)
2253 { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2254 break;
2255 }
2256 rm = (matrix)t.CopyD(mtyp);
2257 if (module_assign)
2258 {
2259 j = si_min((int)num,rm->cols());
2260 rk=si_max(rk,rm->rank);
2261 }
2262 else
2263 j = si_min(num-i,(long)rm->rows() * (long)rm->cols());
2264 for(k=0;k<j;k++,i++)
2265 {
2266 lm->m[i]=rm->m[k];
2267 pNormalize(lm->m[i]);
2268 rm->m[k]=NULL;
2269 }
2270 idDelete((ideal *)&rm);
2271 }
2272 else
2273 {
2274 b=TRUE;
2275 Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2276 break;
2277 }
2278 t.next=NULL;t.CleanUp();
2279 if (i==num) break;
2280 hh=hh->next;
2281 }
2282 }
2283 if (b)
2284 idDelete((ideal *)&lm);
2285 else
2286 {
2287 idDelete((ideal *)&olm);
2288 if (module_assign) lm->rank=rk;
2289 else if (map_assign) ((map)lm)->preimage=pr;
2290 l=l->LData();
2291 if (l->rtyp==IDHDL)
2292 IDMATRIX((idhdl)l->data)=lm;
2293 else
2294 l->data=(char *)lm;
2295 }
2296 break;
2297 }
2298 case STRING_CMD:
2299 b=jjA_L_STRING(l,r);
2300 break;
2301 //case DEF_CMD:
2302 case LIST_CMD:
2303 b=jjA_L_LIST(l,r);
2304 break;
2305 case NONE:
2306 case 0:
2307 Werror("cannot assign to %s",l->Fullname());
2308 b=TRUE;
2309 break;
2310 default:
2311 WerrorS("assign not impl.");
2312 b=TRUE;
2313 break;
2314 } /* end switch: typ */
2315 if (b && (!errorreported)) WerrorS("incompatible type in list assignment");
2316 r->CleanUp();
2317 return b;
2318 }
jjNormalizeQRingId(leftv I)2319 void jjNormalizeQRingId(leftv I)
2320 {
2321 assume ((currRing->qideal!=NULL) && (!hasFlag(I,FLAG_QRING)));
2322 {
2323 if (I->e==NULL)
2324 {
2325 ideal I0=(ideal)I->Data();
2326 switch (I->Typ())
2327 {
2328 case IDEAL_CMD:
2329 case MODUL_CMD:
2330 {
2331 ideal F=idInit(1,1);
2332 ideal II=kNF(F,currRing->qideal,I0);
2333 idDelete(&F);
2334 if (I->rtyp!=IDHDL)
2335 {
2336 idDelete((ideal*)&(I0));
2337 I->data=II;
2338 }
2339 else
2340 {
2341 idhdl h=(idhdl)I->data;
2342 idDelete((ideal*)&IDIDEAL(h));
2343 IDIDEAL(h)=II;
2344 setFlag(h,FLAG_QRING);
2345 }
2346 break;
2347 }
2348 default: break;
2349 }
2350 setFlag(I,FLAG_QRING);
2351 }
2352 }
2353 }
jj_NormalizeQRingP(poly p,const ring r)2354 poly jj_NormalizeQRingP(poly p, const ring r)
2355 {
2356 if((p!=NULL) && (r->qideal!=NULL))
2357 {
2358 ring save=currRing;
2359 if (r!=currRing) rChangeCurrRing(r);
2360 ideal F=idInit(1,1);
2361 poly p2=kNF(F,r->qideal,p);
2362 p_Normalize(p2,r);
2363 id_Delete(&F,r);
2364 p_Delete(&p,r);
2365 p=p2;
2366 if (r!=save) rChangeCurrRing(save);
2367 }
2368 return p;
2369 }
jjIMPORTFROM(leftv,leftv u,leftv v)2370 BOOLEAN jjIMPORTFROM(leftv, leftv u, leftv v)
2371 {
2372 //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2373 assume(u->Typ()==PACKAGE_CMD);
2374 char *vn=(char *)v->Name();
2375 idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2376 if (h!=NULL)
2377 {
2378 //check for existence
2379 if (((package)(u->Data()))==basePack)
2380 {
2381 WarnS("source and destination packages are identical");
2382 return FALSE;
2383 }
2384 idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2385 if (t!=NULL)
2386 {
2387 if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2388 killhdl(t);
2389 }
2390 sleftv tmp_expr;
2391 if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2392 sleftv h_expr;
2393 memset(&h_expr,0,sizeof(h_expr));
2394 h_expr.rtyp=IDHDL;
2395 h_expr.data=h;
2396 h_expr.name=vn;
2397 return iiAssign(&tmp_expr,&h_expr);
2398 }
2399 else
2400 {
2401 Werror("`%s` not found in `%s`",v->Name(), u->Name());
2402 return TRUE;
2403 }
2404 return FALSE;
2405 }
2406