source: git/Singular/ipassign.cc @ e8b6b3

fieker-DuValspielwiese
Last change on this file since e8b6b3 was e8b6b3, checked in by Hans Schoenemann <hannes@…>, 3 years ago
fix: attrib. handling in assignments
  • Property mode set to 100644
File size: 56.1 KB
Line 
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 =================*/
52static BOOLEAN jjECHO(leftv, leftv a)
53{
54  si_echo=(int)((long)(a->Data()));
55  return FALSE;
56}
57static BOOLEAN jjPRINTLEVEL(leftv, leftv a)
58{
59  printlevel=(int)((long)(a->Data()));
60  return FALSE;
61}
62static BOOLEAN jjCOLMAX(leftv, leftv a)
63{
64  colmax=(int)((long)(a->Data()));
65  return FALSE;
66}
67static BOOLEAN jjTIMER(leftv, leftv a)
68{
69  timerv=(int)((long)(a->Data()));
70  initTimer();
71  return FALSE;
72}
73#ifdef HAVE_GETTIMEOFDAY
74static BOOLEAN jjRTIMER(leftv, leftv a)
75{
76  rtimerv=(int)((long)(a->Data()));
77  initRTimer();
78  return FALSE;
79}
80#endif
81static 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}
90static 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}
99static BOOLEAN jjTRACE(leftv, leftv a)
100{
101  traceit=(int)((long)(a->Data()));
102  return FALSE;
103}
104static 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}
127static 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
175coeffs 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
242static 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
378static 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 =================*/
386static 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}
419static 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}
463static inline void jjCheck_FLAG_OTHER_RING(leftv res)
464{
465  if (Sy_inset(FLAG_OTHER_RING,res->flag))
466  {
467    if ((res-1)->data!=currRing)
468    {
469      if ((res-1)->data!=NULL)
470      {
471        ring rr=(ring)(res-1)->data;
472        rr->ref--;
473      }
474      (res-1)->data=currRing;
475      (res-1)->rtyp=RING_CMD;
476      currRing->ref++;
477    }
478  }
479}
480static BOOLEAN jiA_NUMBER(leftv res, leftv a, Subexpr)
481{
482  void *test_p=a->Data(); // can I access it (newstruct)?
483  if (errorreported) return TRUE;
484  jjCheck_FLAG_OTHER_RING(res);
485  number p=(number)a->CopyD(NUMBER_CMD);
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
493static 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}
543static 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}
591static 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}
615static 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}
642static 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
667static 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}
707static BOOLEAN jiA_LIST_RES(leftv res, leftv a,Subexpr)
708{
709  void *test_p=a->Data(); // can I access it (newstruct)?
710  if (errorreported) return TRUE;
711  jjCheck_FLAG_OTHER_RING(res);
712  syStrategy r=(syStrategy)a->CopyD(RESOLUTION_CMD);
713  if (res->data!=NULL) ((lists)res->data)->Clean();
714  int add_row_shift = 0;
715  intvec *weights=(intvec*)atGet(a,"isHomog",INTVEC_CMD);
716  if (weights!=NULL)  add_row_shift=weights->min_in();
717  res->data=(void *)syConvRes(r,TRUE,add_row_shift);
718  //jiAssignAttr(res,a);
719  return FALSE;
720}
721static BOOLEAN jiA_LIST(leftv res, leftv a,Subexpr)
722{
723  void *test_p=a->Data(); // can I access it (newstruct)?
724  if (errorreported) return TRUE;
725  // FLAG_OTHER_RING is only set for ring dep. types, so currRing!=NULL
726  jjCheck_FLAG_OTHER_RING(res);
727  lists l=(lists)a->CopyD(LIST_CMD);
728  if (res->data!=NULL) ((lists)res->data)->Clean();
729  res->data=(void *)l;
730  jiAssignAttr(res,a);
731  return FALSE;
732}
733static BOOLEAN jiA_POLY(leftv res, leftv a,Subexpr e)
734{
735  void *test_p=a->Data(); // can I access it (newstruct)?
736  if (errorreported) return TRUE;
737  jjCheck_FLAG_OTHER_RING(res);
738  poly p=(poly)a->CopyD(POLY_CMD);
739  pNormalize(p);
740  if (e==NULL)
741  {
742    if ((p!=NULL) && TEST_V_QRING && (currRing->qideal!=NULL)
743    && (!hasFlag(a,FLAG_QRING)))
744    {
745      p=jjNormalizeQRingP(p);
746      setFlag(res,FLAG_QRING);
747    }
748    if (res->data!=NULL) pDelete((poly*)&res->data);
749    res->data=(void*)p;
750    jiAssignAttr(res,a);
751  }
752  else
753  {
754    int i,j;
755    matrix m=(matrix)res->data;
756    i=e->start;
757    if (e->next==NULL)
758    {
759      j=i; i=1;
760      // for all ideal like data types: check indices
761      if (j>MATCOLS(m))
762      {
763        if (TEST_V_ALLWARN)
764        {
765          Warn("increase ideal %d -> %d in %s(%d):%s",MATCOLS(m),j,VoiceName(),VoiceLine(),my_yylinebuf);
766        }
767        pEnlargeSet(&(m->m),MATCOLS(m),j-MATCOLS(m));
768        MATCOLS(m)=j;
769      }
770      else if (j<=0)
771      {
772        Werror("index[%d] must be positive",j/*e->start*/);
773        return TRUE;
774      }
775    }
776    else
777    {
778      // for matrices: indices are correct (see ipExprArith3(..,'['..) )
779      j=e->next->start;
780    }
781    if ((p!=NULL) && TEST_V_QRING && (currRing->qideal!=NULL))
782    {
783      p=jjNormalizeQRingP(p);
784    }
785    if (res->rtyp==SMATRIX_CMD)
786    {
787      p=pSub(p,SMATELEM(m,i-1,j-1,currRing));
788      pSetCompP(p,i);
789      m->m[j-1]=pAdd(m->m[j-1],p);
790    }
791    else
792    {
793      pDelete(&MATELEM(m,i,j));
794      MATELEM(m,i,j)=p;
795      /* for module: update rank */
796      if ((p!=NULL) && (pGetComp(p)!=0))
797      {
798        m->rank=si_max(m->rank,pMaxComp(p));
799      }
800    }
801  }
802  return FALSE;
803}
804static BOOLEAN jiA_1x1INTMAT(leftv res, leftv a,Subexpr e)
805{
806  if (/*(*/ res->rtyp!=INTMAT_CMD /*)*/) /*|| (e!=NULL) - TRUE because of type int */
807  {
808    // no error message: assignment simply fails
809    return TRUE;
810  }
811  intvec* am=(intvec*)a->CopyD(INTMAT_CMD);
812  if ((am->rows()!=1) || (am->cols()!=1))
813  {
814    WerrorS("must be 1x1 intmat");
815    delete am;
816    return TRUE;
817  }
818  intvec* m=(intvec *)res->data;
819  // indices are correct (see ipExprArith3(..,'['..) )
820  int i=e->start;
821  int j=e->next->start;
822  IMATELEM(*m,i,j)=IMATELEM(*am,1,1);
823  delete am;
824  return FALSE;
825}
826static BOOLEAN jiA_1x1MATRIX(leftv res, leftv a,Subexpr e)
827{
828  if (/*(*/ res->rtyp!=MATRIX_CMD /*)*/) /*|| (e!=NULL) - TRUE because of type poly */
829  {
830    // no error message: assignment simply fails
831    return TRUE;
832  }
833  matrix am=(matrix)a->CopyD(MATRIX_CMD);
834  if ((MATROWS(am)!=1) || (MATCOLS(am)!=1))
835  {
836    WerrorS("must be 1x1 matrix");
837    idDelete((ideal *)&am);
838    return TRUE;
839  }
840  matrix m=(matrix)res->data;
841  // indices are correct (see ipExprArith3(..,'['..) )
842  int i=e->start;
843  int j=e->next->start;
844  pDelete(&MATELEM(m,i,j));
845  pNormalize(MATELEM(am,1,1));
846  MATELEM(m,i,j)=MATELEM(am,1,1);
847  MATELEM(am,1,1)=NULL;
848  idDelete((ideal *)&am);
849  return FALSE;
850}
851static BOOLEAN jiA_STRING(leftv res, leftv a, Subexpr e)
852{
853  if (e==NULL)
854  {
855    void* tmp = res->data;
856    res->data=(void *)a->CopyD(STRING_CMD);
857    jiAssignAttr(res,a);
858    omfree(tmp);
859  }
860  else
861  {
862    char *s=(char *)res->data;
863    if ((e->start>0)&&(e->start<=(int)strlen(s)))
864      s[e->start-1]=(char)(*((char *)a->Data()));
865    else
866    {
867      Werror("string index %d out of range 1..%d",e->start,(int)strlen(s));
868      return TRUE;
869    }
870  }
871  return FALSE;
872}
873static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr)
874{
875  extern procinfo *iiInitSingularProcinfo(procinfo *pi, const char *libname,
876                                          const char *procname, int line,
877                                          long pos, BOOLEAN pstatic=FALSE);
878  if(res->data!=NULL) piKill((procinfo *)res->data);
879  if(a->Typ()==STRING_CMD)
880  {
881    res->data = (void *)omAlloc0Bin(procinfo_bin);
882    ((procinfo *)(res->data))->language=LANG_NONE;
883    iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
884    ((procinfo *)res->data)->data.s.body=(char *)a->CopyD(STRING_CMD);
885  }
886  else
887    res->data=(void *)a->CopyD(PROC_CMD);
888  jiAssignAttr(res,a);
889  return FALSE;
890}
891static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr)
892{
893  //if ((res->data==NULL) || (res->Typ()==a->Typ()))
894  {
895    if (res->data!=NULL) delete ((intvec *)res->data);
896    res->data=(void *)a->CopyD(INTVEC_CMD);
897    jiAssignAttr(res,a);
898    return FALSE;
899  }
900#if 0
901  else
902  {
903    intvec *r=(intvec *)(res->data);
904    intvec *s=(intvec *)(a->Data());
905    int i=si_min(r->length(), s->length())-1;
906    for(;i>=0;i--)
907    {
908      (*r)[i]=(*s)[i];
909    }
910    return FALSE; //(r->length()< s->length());
911  }
912#endif
913}
914static BOOLEAN jiA_BIGINTMAT(leftv res, leftv a, Subexpr)
915{
916  if (res->data!=NULL) delete ((bigintmat *)res->data);
917  res->data=(void *)a->CopyD(BIGINTMAT_CMD);
918  jiAssignAttr(res,a);
919  return FALSE;
920}
921static BOOLEAN jiA_BUCKET(leftv res, leftv a, Subexpr e)
922// there should be no assign bucket:=bucket, here we have poly:=bucket
923{
924  void *test_p=a->Data(); // can I access it (newstruct)?
925  if (errorreported) return TRUE;
926  jjCheck_FLAG_OTHER_RING(res);
927  sBucket_pt b=(sBucket_pt)a->CopyD();
928  poly p; int l;
929  sBucketDestroyAdd(b,&p,&l);
930  sleftv tmp;
931  tmp.Init();
932  tmp.rtyp=POLY_CMD;
933  tmp.data=p;
934  return jiA_POLY(res,&tmp,e);
935}
936static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr)
937{
938  void *test_p=a->Data(); // can I access it (newstruct)?
939  if (errorreported) return TRUE;
940  jjCheck_FLAG_OTHER_RING(res);
941  if (res->data!=NULL) idDelete((ideal*)&res->data);
942  res->data=(void *)a->CopyD(MATRIX_CMD);
943  if (a->rtyp==IDHDL) id_Normalize((ideal)a->Data(), currRing);
944  else                id_Normalize((ideal)res->data, currRing);
945  jiAssignAttr(res,a);
946  if (((res->rtyp==IDEAL_CMD)||(res->rtyp==MODUL_CMD))
947  && (IDELEMS((ideal)(res->data))==1)
948  && (currRing->qideal==NULL)
949  && (!rIsPluralRing(currRing))
950  )
951  {
952    setFlag(res,FLAG_STD);
953  }
954  if (TEST_V_QRING && (currRing->qideal!=NULL))
955  {
956    if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
957    else                       jjNormalizeQRingId(res);
958  }
959  return FALSE;
960}
961static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr)
962{
963  void *test_p=a->Data(); // can I access it (newstruct)?
964  if (errorreported) return TRUE;
965  jjCheck_FLAG_OTHER_RING(res);
966  if (res->data!=NULL) syKillComputation((syStrategy)res->data);
967  res->data=(void *)a->CopyD(RESOLUTION_CMD);
968  jiAssignAttr(res,a);
969  return FALSE;
970}
971static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr)
972/* module = poly */
973{
974  void *test_p=a->Data(); // can I access it (newstruct)?
975  if (errorreported) return TRUE;
976  jjCheck_FLAG_OTHER_RING(res);
977  if (res->data!=NULL) idDelete((ideal*)&res->data);
978  ideal I=idInit(1,1);
979  I->m[0]=(poly)a->CopyD(POLY_CMD);
980  if (I->m[0]!=NULL) pSetCompP(I->m[0],1);
981  pNormalize(I->m[0]);
982  res->data=(void *)I;
983  if (TEST_V_QRING && (currRing->qideal!=NULL))
984  {
985    if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
986    else                       jjNormalizeQRingId(res);
987  }
988  return FALSE;
989}
990static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr)
991{
992  void *test_p=a->Data(); // can I access it (newstruct)?
993  if (errorreported) return TRUE;
994  jjCheck_FLAG_OTHER_RING(res);
995  if (res->data!=NULL) idDelete((ideal*)&res->data);
996  matrix m=(matrix)a->CopyD(MATRIX_CMD);
997  if (TEST_V_ALLWARN)
998    if (MATROWS(m)>1)
999      Warn("assign matrix with %d rows to an ideal in >>%s<<",MATROWS(m),my_yylinebuf);
1000  IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m);
1001  ((ideal)m)->rank=1;
1002  MATROWS(m)=1;
1003  id_Normalize((ideal)m, currRing);
1004  res->data=(void *)m;
1005  if (TEST_V_QRING && (currRing->qideal!=NULL))
1006  {
1007    if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
1008    else                       jjNormalizeQRingId(res);
1009  }
1010  return FALSE;
1011}
1012static BOOLEAN jiA_IDEAL_Mo(leftv res, leftv a, Subexpr)
1013{
1014  void *test_p=a->Data(); // can I access it (newstruct)?
1015  if (errorreported) return TRUE;
1016  jjCheck_FLAG_OTHER_RING(res);
1017  ideal m=(ideal)a->CopyD(MODUL_CMD);
1018  if (m->rank>1)
1019  {
1020    Werror("rank of module is %ld in assignment to ideal",m->rank);
1021    return TRUE;
1022  }
1023  if (res->data!=NULL) idDelete((ideal*)&res->data);
1024  id_Normalize(m, currRing);
1025  id_Shift(m,-1,currRing);
1026  m->rank=1;
1027  res->data=(void *)m;
1028  if (TEST_V_QRING && (currRing->qideal!=NULL))
1029  {
1030    if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
1031    else                       jjNormalizeQRingId(res);
1032  }
1033  return FALSE;
1034}
1035static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr)
1036{
1037  si_link l=(si_link)res->data;
1038
1039  if (l!=NULL) slCleanUp(l);
1040
1041  if (a->Typ() == STRING_CMD)
1042  {
1043    if (l == NULL)
1044    {
1045      l = (si_link) omAlloc0Bin(sip_link_bin);
1046      res->data = (void *) l;
1047    }
1048    return slInit(l, (char *) a->Data());
1049  }
1050  else if (a->Typ() == LINK_CMD)
1051  {
1052    if (l != NULL) omFreeBin(l, sip_link_bin);
1053    res->data = slCopy((si_link)a->Data());
1054    return FALSE;
1055  }
1056  return TRUE;
1057}
1058// assign map -> map
1059static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr)
1060{
1061  void *test_p=a->Data(); // can I access it (newstruct)?
1062  if (errorreported) return TRUE;
1063  jjCheck_FLAG_OTHER_RING(res);
1064  if (res->data!=NULL)
1065  {
1066    omFree((ADDRESS)((map)res->data)->preimage);
1067    ((map)res->data)->preimage=NULL;
1068    idDelete((ideal*)&res->data);
1069  }
1070  res->data=(void *)a->CopyD(MAP_CMD);
1071  jiAssignAttr(res,a);
1072  return FALSE;
1073}
1074// assign ideal -> map
1075static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr)
1076{
1077  void *test_p=a->Data(); // can I access it (newstruct)?
1078  if (errorreported) return TRUE;
1079  jjCheck_FLAG_OTHER_RING(res);
1080  map f=(map)res->data;
1081  char *rn=f->preimage; // save the old/already assigned preimage ring name
1082  f->preimage=NULL;
1083  idDelete((ideal *)&f);
1084  res->data=(void *)a->CopyD(IDEAL_CMD);
1085  f=(map)res->data;
1086  id_Normalize((ideal)f, currRing);
1087  f->preimage = rn;
1088  return FALSE;
1089}
1090static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
1091{
1092  // the follwing can only happen, if:
1093  //   - the left side is of type qring AND not an id
1094  if ((e!=NULL)||(res->rtyp!=IDHDL))
1095  {
1096    WerrorS("qring_id expected");
1097    return TRUE;
1098  }
1099  void *test_p=a->Data(); // can I access it (newstruct)?
1100  if (errorreported) return TRUE;
1101  jjCheck_FLAG_OTHER_RING(res);
1102
1103  ring old_ring=(ring)res->Data();
1104
1105  coeffs newcf = currRing->cf;
1106  ideal id = (ideal)a->Data(); //?
1107  const int cpos = idPosConstant(id);
1108  if(rField_is_Ring(currRing))
1109    if (cpos >= 0)
1110    {
1111        newcf = n_CoeffRingQuot1(p_GetCoeff(id->m[cpos], currRing), currRing->cf);
1112        if(newcf == NULL)
1113          return TRUE;
1114    }
1115  //qr=(ring)res->Data();
1116  //if (qr!=NULL) omFreeBin((ADDRESS)qr, ip_sring_bin);
1117  ring qr = rCopy(currRing);
1118  assume(qr->cf == currRing->cf);
1119
1120  if ( qr->cf != newcf )
1121  {
1122    nKillChar ( qr->cf ); // ???
1123    qr->cf = newcf;
1124  }
1125                 // we have to fill it, but the copy also allocates space
1126  idhdl h=(idhdl)res->data; // we have res->rtyp==IDHDL
1127  IDRING(h)=qr;
1128
1129  ideal qid;
1130
1131  if((rField_is_Ring(currRing)) && (cpos != -1))
1132  {
1133    int i, j;
1134    int *perm = (int *)omAlloc0((qr->N+1)*sizeof(int));
1135
1136    for(i=qr->N;i>0;i--)
1137      perm[i]=i;
1138
1139    nMapFunc nMap = n_SetMap(currRing->cf, newcf);
1140    qid = idInit(IDELEMS(id)-1,1);
1141    for(i = 0, j = 0; i<IDELEMS(id); i++)
1142      if( i != cpos )
1143        qid->m[j++] = p_PermPoly(id->m[i], perm, currRing, qr, nMap, NULL, 0);
1144  }
1145  else
1146    qid = idrCopyR(id,currRing,qr);
1147
1148  idSkipZeroes(qid);
1149  //idPrint(qid);
1150  if ((idElem(qid)>1) || rIsSCA(currRing) || (currRing->qideal!=NULL))
1151    assumeStdFlag(a);
1152
1153  if (currRing->qideal!=NULL) /* we are already in a qring! */
1154  {
1155    ideal tmp=idSimpleAdd(qid,currRing->qideal);
1156    // both ideals should be GB, so dSimpleAdd is sufficient
1157    idDelete(&qid);
1158    qid=tmp;
1159    // delete the qr copy of quotient ideal!!!
1160    idDelete(&qr->qideal);
1161  }
1162  if (idElem(qid)==0)
1163  {
1164    qr->qideal = NULL;
1165    id_Delete(&qid,currRing);
1166    IDTYP(h)=RING_CMD;
1167  }
1168  else
1169    qr->qideal = qid;
1170
1171  // qr is a copy of currRing with the new qideal!
1172  #ifdef HAVE_PLURAL
1173  if(rIsPluralRing(currRing) &&(qr->qideal!=NULL))
1174  {
1175    if (!hasFlag(a,FLAG_TWOSTD))
1176    {
1177      Warn("%s is no twosided standard basis",a->Name());
1178    }
1179
1180    if( nc_SetupQuotient(qr, currRing) )
1181    {
1182//      WarnS("error in nc_SetupQuotient");
1183    }
1184  }
1185  #endif
1186  //rWrite(qr);
1187  rSetHdl((idhdl)res->data);
1188  if (old_ring!=NULL)
1189  {
1190    rDelete(old_ring);
1191  }
1192  return FALSE;
1193}
1194
1195static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e)
1196{
1197  BOOLEAN have_id=TRUE;
1198  if ((e!=NULL)||(res->rtyp!=IDHDL))
1199  {
1200    //WerrorS("id expected");
1201    //return TRUE;
1202    have_id=FALSE;
1203  }
1204  ring r=(ring)a->Data();
1205  if ((r==NULL)||(r->cf==NULL)) return TRUE;
1206  if (have_id)
1207  {
1208    idhdl rl=(idhdl)res->data;
1209    if (IDRING(rl)!=NULL) rKill(rl);
1210    IDRING(rl)=r;
1211    if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing))
1212      currRingHdl=(idhdl)res->data;
1213  }
1214  else
1215  {
1216    if (e==NULL) res->data=(char *)r;
1217    else
1218    {
1219      WerrorS("id expected");
1220      return TRUE;
1221    }
1222  }
1223  r->ref++;
1224  jiAssignAttr(res,a);
1225  return FALSE;
1226}
1227static BOOLEAN jiA_PACKAGE(leftv res, leftv a, Subexpr)
1228{
1229  res->data=(void *)a->CopyD(PACKAGE_CMD);
1230  jiAssignAttr(res,a);
1231  return FALSE;
1232}
1233static BOOLEAN jiA_DEF(leftv res, leftv, Subexpr)
1234{
1235  res->data=(void *)0;
1236  return FALSE;
1237}
1238static BOOLEAN jiA_CRING(leftv res, leftv a, Subexpr)
1239{
1240  coeffs r=(coeffs)a->Data();
1241  if (r==NULL) return TRUE;
1242  if (res->data!=NULL) nKillChar((coeffs)res->data);
1243  res->data=(void *)a->CopyD(CRING_CMD);
1244  jiAssignAttr(res,a);
1245  return FALSE;
1246}
1247
1248/*=================== table =================*/
1249#define IPASSIGN
1250#define D(A)     A
1251#define NULL_VAL NULL
1252#include "table.h"
1253/*=================== operations ============================*/
1254/*2
1255* assign a = b
1256*/
1257static BOOLEAN jiAssign_1(leftv l, leftv r, int rt, BOOLEAN toplevel, BOOLEAN is_qring=FALSE)
1258{
1259  if (rt==0)
1260  {
1261    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
1262    return TRUE;
1263  }
1264
1265  int lt=l->Typ();
1266  if (lt==0)
1267  {
1268    if (!errorreported) Werror("left side `%s` is undefined",l->Fullname());
1269    return TRUE;
1270  }
1271  if(rt==NONE)
1272  {
1273    if ((!TEST_V_ASSIGN_NONE)||(lt!=DEF_CMD))
1274    {
1275      WarnS("right side is not a datum, assignment ignored");
1276      Warn("in line >>%s<<",my_yylinebuf);
1277      // if (!errorreported)
1278      //   WerrorS("right side is not a datum");
1279      //return TRUE;
1280    }
1281    return FALSE;
1282  }
1283
1284  if (lt==DEF_CMD)
1285  {
1286
1287    if (TEST_V_ALLWARN
1288    && (rt!=RING_CMD)
1289    && (l->name!=NULL)
1290    && (l->e==NULL)
1291    && (iiCurrArgs==NULL) /* not in proc header */
1292    )
1293    {
1294      Warn("use `%s` instead of `def` in %s:%d:%s",Tok2Cmdname(rt),
1295            currentVoice->filename,yylineno,my_yylinebuf);
1296    }
1297    if (l->rtyp==IDHDL)
1298    {
1299      if((currRingHdl==NULL) && RingDependend(rt))
1300      {
1301        WerrorS("basering required");
1302        return TRUE;
1303      }
1304      if (rt==BUCKET_CMD) IDTYP((idhdl)l->data)=POLY_CMD;
1305      else                IDTYP((idhdl)l->data)=rt;
1306    }
1307    else if (l->name!=NULL)
1308    {
1309      int rrt;
1310      if (rt==BUCKET_CMD) rrt=POLY_CMD;
1311      else                rrt=rt;
1312      sleftv ll;
1313      iiDeclCommand(&ll,l,myynest,rrt,&IDROOT);
1314      memcpy(l,&ll,sizeof(sleftv));
1315    }
1316    else
1317    {
1318      if (rt==BUCKET_CMD) l->rtyp=POLY_CMD;
1319      else                l->rtyp=rt;
1320    }
1321    lt=l->Typ();
1322  }
1323  else
1324  {
1325    if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
1326      return FALSE;
1327  }
1328  leftv ld=l;
1329  if (l->rtyp==IDHDL)
1330  {
1331    if (lt!=RING_CMD)
1332      ld=(leftv)l->data;
1333  }
1334  else if (toplevel)
1335  {
1336    WerrorS("error in assign: left side is not an l-value");
1337    return TRUE;
1338  }
1339  if (lt>MAX_TOK)
1340  {
1341    blackbox *bb=getBlackboxStuff(lt);
1342#ifdef BLACKBOX_DEVEL
1343    Print("bb-assign: bb=%lx\n",bb);
1344#endif
1345    return (bb==NULL) || bb->blackbox_Assign(l,r);
1346  }
1347  if ((is_qring)
1348  &&(lt==RING_CMD)
1349  &&(rt==RING_CMD))
1350  {
1351    Warn("qring .. = <ring>; is misleading in >>%s<<",my_yylinebuf);
1352  }
1353  int start=0;
1354  while ((dAssign[start].res!=lt)
1355      && (dAssign[start].res!=0)) start++;
1356  int i=start;
1357  while ((dAssign[i].res==lt)
1358      && (dAssign[i].arg!=rt)) i++;
1359  if (dAssign[i].res==lt)
1360  {
1361    if (traceit&TRACE_ASSIGN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt));
1362    BOOLEAN b;
1363    b=dAssign[i].p(ld,r,l->e);
1364    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
1365    {
1366      l->flag=ld->flag;
1367      l->attribute=ld->attribute;
1368    }
1369    return b;
1370  }
1371  // implicite type conversion ----------------------------------------------
1372  if (dAssign[i].res!=lt)
1373  {
1374    int ri;
1375    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1376    BOOLEAN failed=FALSE;
1377    i=start;
1378    //while ((dAssign[i].res!=lt)
1379    //  && (dAssign[i].res!=0)) i++;
1380    while (dAssign[i].res==lt)
1381    {
1382      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
1383      {
1384        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
1385        if(!failed)
1386        {
1387          failed= dAssign[i].p(ld,rn,l->e);
1388          if (traceit&TRACE_ASSIGN)
1389            Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed);
1390        }
1391        // everything done, clean up temp. variables
1392        rn->CleanUp();
1393        omFreeBin((ADDRESS)rn, sleftv_bin);
1394        if (failed)
1395        {
1396          // leave loop, goto error handling
1397          break;
1398        }
1399        else
1400        {
1401          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
1402          {
1403            l->flag=ld->flag;
1404            l->attribute=ld->attribute;
1405          }
1406          // everything ok, return
1407          return FALSE;
1408        }
1409     }
1410     i++;
1411    }
1412    // error handling ---------------------------------------------------
1413    if (!errorreported)
1414    {
1415      if ((l->rtyp==IDHDL) && (l->e==NULL))
1416        Werror("`%s`(%s) = `%s` is not supported",
1417          Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
1418      else
1419         Werror("`%s` = `%s` is not supported"
1420             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1421      if (BVERBOSE(V_SHOW_USE))
1422      {
1423        i=0;
1424        while ((dAssign[i].res!=lt)
1425          && (dAssign[i].res!=0)) i++;
1426        while (dAssign[i].res==lt)
1427        {
1428          Werror("expected `%s` = `%s`"
1429              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
1430          i++;
1431        }
1432      }
1433    }
1434  }
1435  return TRUE;
1436}
1437/*2
1438* assign sys_var = val
1439*/
1440static BOOLEAN iiAssign_sys(leftv l, leftv r)
1441{
1442  int rt=r->Typ();
1443
1444  if (rt==0)
1445  {
1446    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
1447    return TRUE;
1448  }
1449  int i=0;
1450  int lt=l->rtyp;
1451  while (((dAssign_sys[i].res!=lt)
1452      || (dAssign_sys[i].arg!=rt))
1453    && (dAssign_sys[i].res!=0)) i++;
1454  if (dAssign_sys[i].res!=0)
1455  {
1456    if (!dAssign_sys[i].p(l,r))
1457    {
1458      // everything ok, clean up
1459      return FALSE;
1460    }
1461  }
1462  // implicite type conversion ----------------------------------------------
1463  if (dAssign_sys[i].res==0)
1464  {
1465    int ri;
1466    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1467    BOOLEAN failed=FALSE;
1468    i=0;
1469    while ((dAssign_sys[i].res!=lt)
1470      && (dAssign_sys[i].res!=0)) i++;
1471    while (dAssign_sys[i].res==lt)
1472    {
1473      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
1474      {
1475        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
1476            || (dAssign_sys[i].p(l,rn)));
1477        // everything done, clean up temp. variables
1478        rn->CleanUp();
1479        omFreeBin((ADDRESS)rn, sleftv_bin);
1480        if (failed)
1481        {
1482          // leave loop, goto error handling
1483          break;
1484        }
1485        else
1486        {
1487          // everything ok, return
1488          return FALSE;
1489        }
1490     }
1491     i++;
1492    }
1493    // error handling ---------------------------------------------------
1494    if(!errorreported)
1495    {
1496      Werror("`%s` = `%s` is not supported"
1497             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1498      if (BVERBOSE(V_SHOW_USE))
1499      {
1500        i=0;
1501        while ((dAssign_sys[i].res!=lt)
1502          && (dAssign_sys[i].res!=0)) i++;
1503        while (dAssign_sys[i].res==lt)
1504        {
1505          Werror("expected `%s` = `%s`"
1506              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
1507          i++;
1508        }
1509      }
1510    }
1511  }
1512  return TRUE;
1513}
1514static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
1515{
1516  /* right side is intvec, left side is list (of int)*/
1517  BOOLEAN nok;
1518  int i=0;
1519  leftv l1=l;
1520  leftv h;
1521  sleftv t;
1522  intvec *iv=(intvec *)r->Data();
1523  memset(&t,0,sizeof(sleftv));
1524  t.rtyp=INT_CMD;
1525  while ((i<iv->length())&&(l!=NULL))
1526  {
1527    t.data=(char *)(long)(*iv)[i];
1528    h=l->next;
1529    l->next=NULL;
1530    nok=jiAssign_1(l,&t,INT_CMD,TRUE);
1531    l->next=h;
1532    if (nok) return TRUE;
1533    i++;
1534    l=h;
1535  }
1536  l1->CleanUp();
1537  r->CleanUp();
1538  return FALSE;
1539}
1540static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
1541{
1542  /* right side is vector, left side is list (of poly)*/
1543  BOOLEAN nok;
1544  leftv l1=l;
1545  ideal I=idVec2Ideal((poly)r->Data());
1546  leftv h;
1547  sleftv t;
1548  int i=0;
1549  memset(&t,0,sizeof(sleftv));
1550  while (l!=NULL)
1551  {
1552    t.rtyp=POLY_CMD;
1553    if (i>=IDELEMS(I))
1554    {
1555      t.data=NULL;
1556    }
1557    else
1558    {
1559      t.data=(char *)I->m[i];
1560      I->m[i]=NULL;
1561    }
1562    h=l->next;
1563    l->next=NULL;
1564    nok=jiAssign_1(l,&t,POLY_CMD,TRUE);
1565    l->next=h;
1566    t.CleanUp();
1567    if (nok)
1568    {
1569      idDelete(&I);
1570      return TRUE;
1571    }
1572    i++;
1573    l=h;
1574  }
1575  idDelete(&I);
1576  l1->CleanUp();
1577  r->CleanUp();
1578  //if (TEST_V_QRING && (currRing->qideal!=NULL)) l=jjNormalizeQRingP(l);
1579  return FALSE;
1580}
1581static BOOLEAN jjA_L_LIST(leftv l, leftv r)
1582/* left side: list/def, has to be a "real" variable
1583*  right side: expression list
1584*/
1585{
1586  int sl = r->listLength();
1587  lists L=(lists)omAllocBin(slists_bin);
1588  lists oldL;
1589  leftv h=NULL,o_r=r;
1590  int i;
1591  int rt;
1592
1593  L->Init(sl);
1594  for (i=0;i<sl;i++)
1595  {
1596    if (h!=NULL) { /* e.g. not in the first step:
1597                   * h is the pointer to the old sleftv,
1598                   * r is the pointer to the next sleftv
1599                   * (in this moment) */
1600                   h->next=r;
1601                 }
1602    h=r;
1603    r=r->next;
1604    h->next=NULL;
1605    rt=h->Typ();
1606    if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
1607    {
1608      L->Clean();
1609      Werror("`%s` is undefined",h->Fullname());
1610      //listall();
1611      goto err;
1612    }
1613    //if (rt==RING_CMD)
1614    //{
1615    //  L->m[i].rtyp=rt;
1616    //  L->m[i].data=h->Data();
1617    //  ((ring)L->m[i].data)->ref++;
1618    //}
1619    //else
1620      L->m[i].CleanUp();
1621      L->m[i].Copy(h);
1622      if(errorreported)
1623      {
1624        L->Clean();
1625        goto err;
1626      }
1627  }
1628  oldL=(lists)l->Data();
1629  if (oldL!=NULL) oldL->Clean();
1630  if (l->rtyp==IDHDL)
1631  {
1632    IDLIST((idhdl)l->data)=L;
1633    IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1634    if (lRingDependend(L)) ipMoveId((idhdl)l->data);
1635  }
1636  else
1637  {
1638    l->LData()->data=L;
1639    if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1640      l->rtyp=LIST_CMD;
1641  }
1642err:
1643  o_r->CleanUp();
1644  return errorreported;
1645}
1646static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1647{
1648  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1649  leftv hh=r;
1650  int i = 0;
1651  while (hh!=NULL)
1652  {
1653    if (i>=iv->length())
1654    {
1655      if (traceit&TRACE_ASSIGN)
1656      {
1657        Warn("expression list length(%d) does not match intmat size(%d)",
1658             iv->length()+exprlist_length(hh),iv->length());
1659      }
1660      break;
1661    }
1662    if (hh->Typ() == INT_CMD)
1663    {
1664      (*iv)[i++] = (int)((long)(hh->Data()));
1665    }
1666    else if ((hh->Typ() == INTVEC_CMD)
1667            ||(hh->Typ() == INTMAT_CMD))
1668    {
1669      intvec *ivv = (intvec *)(hh->Data());
1670      int ll = 0,l = si_min(ivv->length(),iv->length());
1671      for (; l>0; l--)
1672      {
1673        (*iv)[i++] = (*ivv)[ll++];
1674      }
1675    }
1676    else
1677    {
1678      delete iv;
1679      return TRUE;
1680    }
1681    hh = hh->next;
1682  }
1683  if (l->rtyp==IDHDL)
1684  {
1685    if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1686    IDINTVEC((idhdl)l->data)=iv;
1687  }
1688  else
1689  {
1690    if (l->data!=NULL) delete ((intvec*)l->data);
1691    l->data=(char*)iv;
1692  }
1693  return FALSE;
1694}
1695static BOOLEAN jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat *bim)
1696{
1697  /* left side is bigintmat, right side is list (of int,intvec,intmat)*/
1698  leftv hh=r;
1699  int i = 0;
1700  if (bim->length()==0) { WerrorS("bigintmat is 1x0"); delete bim; return TRUE; }
1701  while (hh!=NULL)
1702  {
1703    if (i>=bim->cols()*bim->rows())
1704    {
1705      if (traceit&TRACE_ASSIGN)
1706      {
1707        Warn("expression list length(%d) does not match bigintmat size(%d x %d)",
1708              exprlist_length(hh),bim->rows(),bim->cols());
1709      }
1710      break;
1711    }
1712    if (hh->Typ() == INT_CMD)
1713    {
1714      number tp = n_Init((int)((long)(hh->Data())), coeffs_BIGINT);
1715      bim->set(i++, tp);
1716      n_Delete(&tp, coeffs_BIGINT);
1717    }
1718    else if (hh->Typ() == BIGINT_CMD)
1719    {
1720      bim->set(i++, (number)(hh->Data()));
1721    }
1722    /*
1723    ((hh->Typ() == INTVEC_CMD)
1724            ||(hh->Typ() == INTMAT_CMD))
1725    {
1726      intvec *ivv = (intvec *)(hh->Data());
1727      int ll = 0,l = si_min(ivv->length(),iv->length());
1728      for (; l>0; l--)
1729      {
1730        (*iv)[i++] = (*ivv)[ll++];
1731      }
1732    }*/
1733    else
1734    {
1735      delete bim;
1736      return TRUE;
1737    }
1738    hh = hh->next;
1739  }
1740  if (IDBIMAT((idhdl)l->data)!=NULL) delete IDBIMAT((idhdl)l->data);
1741  IDBIMAT((idhdl)l->data)=bim;
1742  return FALSE;
1743}
1744static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1745{
1746  /* left side is string, right side is list of string*/
1747  leftv hh=r;
1748  int sl = 1;
1749  char *s;
1750  char *t;
1751  int tl;
1752  /* find the length */
1753  while (hh!=NULL)
1754  {
1755    if (hh->Typ()!= STRING_CMD)
1756    {
1757      return TRUE;
1758    }
1759    sl += strlen((char *)hh->Data());
1760    hh = hh->next;
1761  }
1762  s = (char * )omAlloc(sl);
1763  sl=0;
1764  hh = r;
1765  while (hh!=NULL)
1766  {
1767    t=(char *)hh->Data();
1768    tl=strlen(t);
1769    memcpy(s+sl,t,tl);
1770    sl+=tl;
1771    hh = hh->next;
1772  }
1773  s[sl]='\0';
1774  omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1775  IDDATA((idhdl)(l->data))=s;
1776  return FALSE;
1777}
1778static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1779{
1780  /* right side is matrix, left side is list (of poly)*/
1781  BOOLEAN nok=FALSE;
1782  int i;
1783  matrix m=(matrix)r->CopyD(MATRIX_CMD);
1784  leftv h;
1785  leftv ol=l;
1786  leftv o_r=r;
1787  sleftv t;
1788  memset(&t,0,sizeof(sleftv));
1789  t.rtyp=POLY_CMD;
1790  int mxn=MATROWS(m)*MATCOLS(m);
1791  loop
1792  {
1793    i=0;
1794    while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1795    {
1796      t.data=(char *)m->m[i];
1797      m->m[i]=NULL;
1798      h=l->next;
1799      l->next=NULL;
1800      idhdl hh=NULL;
1801      if ((l->rtyp==IDHDL)&&(l->Typ()==DEF_CMD)) hh=(idhdl)l->data;
1802      nok=jiAssign_1(l,&t,POLY_CMD,TRUE);
1803      if (hh!=NULL) { ipMoveId(hh);hh=NULL;}
1804      l->next=h;
1805      if (nok)
1806      {
1807        idDelete((ideal *)&m);
1808        goto ende;
1809      }
1810      i++;
1811      l=h;
1812    }
1813    idDelete((ideal *)&m);
1814    h=r;
1815    r=r->next;
1816    if (l==NULL)
1817    {
1818      if (r!=NULL)
1819      {
1820        WarnS("list length mismatch in assign (l>r)");
1821        nok=TRUE;
1822      }
1823      break;
1824    }
1825    else if (r==NULL)
1826    {
1827      WarnS("list length mismatch in assign (l<r)");
1828      nok=TRUE;
1829      break;
1830    }
1831    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1832    {
1833      m=(matrix)r->CopyD(MATRIX_CMD);
1834      mxn=MATROWS(m)*MATCOLS(m);
1835    }
1836    else if (r->Typ()==POLY_CMD)
1837    {
1838      m=mpNew(1,1);
1839      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1840      pNormalize(MATELEM(m,1,1));
1841      mxn=1;
1842    }
1843    else
1844    {
1845      nok=TRUE;
1846      break;
1847    }
1848  }
1849ende:
1850  o_r->CleanUp();
1851  ol->CleanUp();
1852  return nok;
1853}
1854static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1855{
1856  /*left side are strings, right side is a string*/
1857  /*e.g. s[2..3]="12" */
1858  /*the case s=t[1..4] is handled in iiAssign,
1859  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1860  BOOLEAN nok=FALSE;
1861  sleftv t;
1862  leftv h,l1=l;
1863  int i=0;
1864  char *ss;
1865  char *s=(char *)r->Data();
1866  int sl=strlen(s);
1867
1868  memset(&t,0,sizeof(sleftv));
1869  t.rtyp=STRING_CMD;
1870  while ((i<sl)&&(l!=NULL))
1871  {
1872    ss=(char *)omAlloc(2);
1873    ss[1]='\0';
1874    ss[0]=s[i];
1875    t.data=ss;
1876    h=l->next;
1877    l->next=NULL;
1878    nok=jiAssign_1(l,&t,STRING_CMD,TRUE);
1879    if (nok)
1880    {
1881      break;
1882    }
1883    i++;
1884    l=h;
1885  }
1886  r->CleanUp();
1887  l1->CleanUp();
1888  return nok;
1889}
1890static BOOLEAN jiAssign_list(leftv l, leftv r)
1891{
1892  int i=l->e->start-1;
1893  if (i<0)
1894  {
1895    Werror("index[%d] must be positive",i+1);
1896    return TRUE;
1897  }
1898  if(l->attribute!=NULL)
1899  {
1900    atKillAll((idhdl)l);
1901    l->attribute=NULL;
1902  }
1903  l->flag=0;
1904  lists li;
1905  if (l->rtyp==IDHDL)
1906  {
1907    li=IDLIST((idhdl)l->data);
1908  }
1909  else
1910  {
1911    li=(lists)l->data;
1912  }
1913  if (i>li->nr)
1914  {
1915    if (TEST_V_ALLWARN)
1916    {
1917      Warn("increase list %d -> %d in %s(%d):%s",li->nr,i,VoiceName(),VoiceLine(),my_yylinebuf);
1918    }
1919    li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1920    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1921    int j=li->nr+1;
1922    for(;j<=i;j++)
1923      li->m[j].rtyp=DEF_CMD;
1924    li->nr=i;
1925  }
1926  leftv ld=&(li->m[i]);
1927  ld->e=l->e->next;
1928  BOOLEAN b;
1929  sleftv tmp;
1930  memset(&tmp,0,sizeof(sleftv));
1931  //tmp.flag=ld->flag;
1932  if (/*(ld->rtyp!=LIST_CMD)
1933  &&*/(ld->e==NULL)
1934  && (ld->Typ()!=r->Typ()))
1935  {
1936    tmp.rtyp=DEF_CMD;
1937    b=iiAssign(&tmp,r,FALSE);
1938    ld->CleanUp();
1939    memcpy(ld,&tmp,sizeof(sleftv));
1940  }
1941  else if ((ld->e==NULL)
1942  && (ld->Typ()==r->Typ())
1943  && (ld->Typ()<MAX_TOK))
1944  {
1945    tmp.rtyp=r->Typ();
1946    tmp.data=(char*)idrecDataInit(r->Typ());
1947    b=iiAssign(&tmp,r,FALSE);
1948    ld->CleanUp();
1949    memcpy(ld,&tmp,sizeof(sleftv));
1950  }
1951  else
1952  {
1953    b=iiAssign(ld,r,FALSE);
1954    if (l->e!=NULL) l->e->next=ld->e;
1955    ld->e=NULL;
1956  }
1957  return b;
1958}
1959static BOOLEAN jiAssign_rec(leftv l, leftv r)
1960{
1961  leftv l1=l;
1962  leftv r1=r;
1963  leftv lrest;
1964  leftv rrest;
1965  BOOLEAN b;
1966  do
1967  {
1968    lrest=l->next;
1969    rrest=r->next;
1970    l->next=NULL;
1971    r->next=NULL;
1972    b=iiAssign(l,r);
1973    l->next=lrest;
1974    r->next=rrest;
1975    l=lrest;
1976    r=rrest;
1977  } while  ((!b)&&(l!=NULL));
1978  l1->CleanUp();
1979  r1->CleanUp();
1980  return b;
1981}
1982BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
1983{
1984  if (errorreported) return TRUE;
1985  int ll=l->listLength();
1986  int rl;
1987  int lt=l->Typ();
1988  int rt=NONE;
1989  int is_qring=FALSE;
1990  BOOLEAN b=FALSE;
1991  if (l->rtyp==ALIAS_CMD)
1992  {
1993    Werror("`%s` is read-only",l->Name());
1994  }
1995
1996  if (l->rtyp==IDHDL)
1997  {
1998    atKillAll((idhdl)l->data);
1999    is_qring=hasFlag((idhdl)l->data,FLAG_QRING_DEF);
2000    IDFLAG((idhdl)l->data)=0;
2001    l->attribute=NULL;
2002    toplevel=FALSE;
2003  }
2004  else if (l->attribute!=NULL)
2005    atKillAll((idhdl)l);
2006  if (ll==1)
2007  {
2008    /* l[..] = ... */
2009    if(l->e!=NULL)
2010    {
2011      BOOLEAN like_lists=0;
2012      blackbox *bb=NULL;
2013      int bt;
2014      if (((bt=l->rtyp)>MAX_TOK)
2015      || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
2016      {
2017        bb=getBlackboxStuff(bt);
2018        like_lists=BB_LIKE_LIST(bb); // bb like a list
2019      }
2020      else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
2021        || (l->rtyp==LIST_CMD))
2022      {
2023        like_lists=2; // bb in a list
2024      }
2025      if(like_lists)
2026      {
2027        if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
2028        if (like_lists==1)
2029        {
2030          // check blackbox/newtype type:
2031          if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
2032        }
2033        b=jiAssign_list(l,r);
2034        if((!b) && (like_lists==2))
2035        {
2036          //Print("jjA_L_LIST: - 2 \n");
2037          if((l->rtyp==IDHDL) && (l->data!=NULL))
2038          {
2039            ipMoveId((idhdl)l->data);
2040            l->attribute=IDATTR((idhdl)l->data);
2041            l->flag=IDFLAG((idhdl)l->data);
2042          }
2043        }
2044        r->CleanUp();
2045        Subexpr h;
2046        while (l->e!=NULL)
2047        {
2048          h=l->e->next;
2049          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
2050          l->e=h;
2051        }
2052        return b;
2053      }
2054    }
2055    if (lt>MAX_TOK)
2056    {
2057      blackbox *bb=getBlackboxStuff(lt);
2058#ifdef BLACKBOX_DEVEL
2059      Print("bb-assign: bb=%lx\n",bb);
2060#endif
2061      return (bb==NULL) || bb->blackbox_Assign(l,r);
2062    }
2063    // end of handling elems of list and similar
2064    rl=r->listLength();
2065    if (rl==1)
2066    {
2067      /* system variables = ... */
2068      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
2069      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
2070      {
2071        b=iiAssign_sys(l,r);
2072        r->CleanUp();
2073        //l->CleanUp();
2074        return b;
2075      }
2076      rt=r->Typ();
2077      /* a = ... */
2078      if ((lt!=MATRIX_CMD)
2079      &&(lt!=BIGINTMAT_CMD)
2080      &&(lt!=CMATRIX_CMD)
2081      &&(lt!=INTMAT_CMD)
2082      &&((lt==rt)||(lt!=LIST_CMD)))
2083      {
2084        b=jiAssign_1(l,r,rt,toplevel,is_qring);
2085        if (l->rtyp==IDHDL)
2086        {
2087          if ((lt==DEF_CMD)||(lt==LIST_CMD))
2088          {
2089            ipMoveId((idhdl)l->data);
2090          }
2091          l->attribute=IDATTR((idhdl)l->data);
2092          l->flag=IDFLAG((idhdl)l->data);
2093          l->CleanUp();
2094        }
2095        r->CleanUp();
2096        return b;
2097      }
2098      if (((lt!=LIST_CMD)
2099        &&((rt==MATRIX_CMD)
2100          ||(rt==BIGINTMAT_CMD)
2101          ||(rt==CMATRIX_CMD)
2102          ||(rt==INTMAT_CMD)
2103          ||(rt==INTVEC_CMD)
2104          ||(rt==MODUL_CMD)))
2105      ||((lt==LIST_CMD)
2106        &&(rt==RESOLUTION_CMD))
2107      )
2108      {
2109        b=jiAssign_1(l,r,rt,toplevel);
2110        if((l->rtyp==IDHDL)&&(l->data!=NULL))
2111        {
2112          if ((lt==DEF_CMD) || (lt==LIST_CMD))
2113          {
2114            //Print("ipAssign - 3.0\n");
2115            ipMoveId((idhdl)l->data);
2116          }
2117          l->attribute=IDATTR((idhdl)l->data);
2118          l->flag=IDFLAG((idhdl)l->data);
2119        }
2120        r->CleanUp();
2121        Subexpr h;
2122        while (l->e!=NULL)
2123        {
2124          h=l->e->next;
2125          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
2126          l->e=h;
2127        }
2128        return b;
2129      }
2130    }
2131    if (rt==NONE) rt=r->Typ();
2132  }
2133  else if (ll==(rl=r->listLength()))
2134  {
2135    b=jiAssign_rec(l,r);
2136    return b;
2137  }
2138  else
2139  {
2140    if (rt==NONE) rt=r->Typ();
2141    if (rt==INTVEC_CMD)
2142      return jiA_INTVEC_L(l,r);
2143    else if (rt==VECTOR_CMD)
2144      return jiA_VECTOR_L(l,r);
2145    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
2146      return jiA_MATRIX_L(l,r);
2147    else if ((rt==STRING_CMD)&&(rl==1))
2148      return jiA_STRING_L(l,r);
2149    Werror("length of lists in assignment does not match (l:%d,r:%d)",
2150      ll,rl);
2151    return TRUE;
2152  }
2153
2154  leftv hh=r;
2155  BOOLEAN map_assign=FALSE;
2156  switch (lt)
2157  {
2158    case INTVEC_CMD:
2159      b=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
2160      break;
2161    case INTMAT_CMD:
2162    {
2163      b=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
2164      break;
2165    }
2166    case BIGINTMAT_CMD:
2167    {
2168      b=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
2169      break;
2170    }
2171    case MAP_CMD:
2172    {
2173      // first element in the list sl (r) must be a ring
2174      if ((rt == RING_CMD)&&(r->e==NULL))
2175      {
2176        omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
2177        IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
2178        /* advance the expressionlist to get the next element after the ring */
2179        hh = r->next;
2180      }
2181      else
2182      {
2183        WerrorS("expected ring-name");
2184        b=TRUE;
2185        break;
2186      }
2187      if (hh==NULL) /* map-assign: map f=r; */
2188      {
2189        WerrorS("expected image ideal");
2190        b=TRUE;
2191        break;
2192      }
2193      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2194      {
2195        b=jiAssign_1(l,hh,IDEAL_CMD,toplevel); /* map-assign: map f=r,i; */
2196        omFreeBin(hh,sleftv_bin);
2197        return b;
2198      }
2199      //no break, handle the rest like an ideal:
2200      map_assign=TRUE; // and continue
2201    }
2202    case MATRIX_CMD:
2203    case IDEAL_CMD:
2204    case MODUL_CMD:
2205    {
2206      sleftv t;
2207      matrix olm = (matrix)l->Data();
2208      long rk;
2209      char *pr=((map)olm)->preimage;
2210      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2211      matrix lm ;
2212      long  num;
2213      int j,k;
2214      int i=0;
2215      int mtyp=MATRIX_CMD; /*Type of left side object*/
2216      int etyp=POLY_CMD;   /*Type of elements of left side object*/
2217
2218      if (lt /*l->Typ()*/==MATRIX_CMD)
2219      {
2220        rk=olm->rows();
2221        num=olm->cols()*rk /*olm->rows()*/;
2222        lm=mpNew(olm->rows(),olm->cols());
2223        int el;
2224        if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2225        {
2226          Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2227        }
2228      }
2229      else /* IDEAL_CMD or MODUL_CMD */
2230      {
2231        num=exprlist_length(hh);
2232        lm=(matrix)idInit(num,1);
2233        if (module_assign)
2234        {
2235          rk=0;
2236          mtyp=MODUL_CMD;
2237          etyp=VECTOR_CMD;
2238        }
2239        else
2240          rk=1;
2241      }
2242
2243      int ht;
2244      loop
2245      {
2246        if (hh==NULL)
2247          break;
2248        else
2249        {
2250          matrix rm;
2251          ht=hh->Typ();
2252          if ((j=iiTestConvert(ht,etyp))!=0)
2253          {
2254            b=iiConvert(ht,etyp,j,hh,&t);
2255            hh->next=t.next;
2256            if (b)
2257            { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(etyp));
2258               break;
2259            }
2260            lm->m[i]=(poly)t.CopyD(etyp);
2261            pNormalize(lm->m[i]);
2262            if (module_assign) rk=si_max(rk,pMaxComp(lm->m[i]));
2263            i++;
2264          }
2265          else
2266          if ((j=iiTestConvert(ht,mtyp))!=0)
2267          {
2268            b=iiConvert(ht,mtyp,j,hh,&t);
2269            hh->next=t.next;
2270            if (b)
2271            { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2272               break;
2273            }
2274            rm = (matrix)t.CopyD(mtyp);
2275            if (module_assign)
2276            {
2277              j = si_min((int)num,rm->cols());
2278              rk=si_max(rk,rm->rank);
2279            }
2280            else
2281              j = si_min(num-i,(long)rm->rows() * (long)rm->cols());
2282            for(k=0;k<j;k++,i++)
2283            {
2284              lm->m[i]=rm->m[k];
2285              pNormalize(lm->m[i]);
2286              rm->m[k]=NULL;
2287            }
2288            idDelete((ideal *)&rm);
2289          }
2290          else
2291          {
2292            b=TRUE;
2293            Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2294            break;
2295          }
2296          t.next=NULL;t.CleanUp();
2297          if (i==num) break;
2298          hh=hh->next;
2299        }
2300      }
2301      if (b)
2302        idDelete((ideal *)&lm);
2303      else
2304      {
2305        idDelete((ideal *)&olm);
2306        if (module_assign)   lm->rank=rk;
2307        else if (map_assign) ((map)lm)->preimage=pr;
2308        l=l->LData();
2309        if (l->rtyp==IDHDL)
2310          IDMATRIX((idhdl)l->data)=lm;
2311        else
2312          l->data=(char *)lm;
2313      }
2314      break;
2315    }
2316    case STRING_CMD:
2317      b=jjA_L_STRING(l,r);
2318      break;
2319    //case DEF_CMD:
2320    case LIST_CMD:
2321      b=jjA_L_LIST(l,r);
2322      break;
2323    case NONE:
2324    case 0:
2325      Werror("cannot assign to %s",l->Fullname());
2326      b=TRUE;
2327      break;
2328    default:
2329      WerrorS("assign not impl.");
2330      b=TRUE;
2331      break;
2332  } /* end switch: typ */
2333  if (b && (!errorreported)) WerrorS("incompatible type in list assignment");
2334  r->CleanUp();
2335  return b;
2336}
2337void jjNormalizeQRingId(leftv I)
2338{
2339  assume ((currRing->qideal!=NULL) && (!hasFlag(I,FLAG_QRING)));
2340  {
2341    if (I->e==NULL)
2342    {
2343      ideal I0=(ideal)I->Data();
2344      switch (I->Typ())
2345      {
2346        case IDEAL_CMD:
2347        case MODUL_CMD:
2348        {
2349          ideal F=idInit(1,1);
2350          ideal II=kNF(F,currRing->qideal,I0);
2351          idDelete(&F);
2352          if (I->rtyp!=IDHDL)
2353          {
2354            idDelete((ideal*)&(I0));
2355            I->data=II;
2356          }
2357          else
2358          {
2359            idhdl h=(idhdl)I->data;
2360            idDelete((ideal*)&IDIDEAL(h));
2361            IDIDEAL(h)=II;
2362            setFlag(h,FLAG_QRING);
2363          }
2364          break;
2365        }
2366        default: break;
2367      }
2368      setFlag(I,FLAG_QRING);
2369    }
2370  }
2371}
2372poly jj_NormalizeQRingP(poly p, const ring r)
2373{
2374  if((p!=NULL) && (r->qideal!=NULL))
2375  {
2376    ring save=currRing;
2377    if (r!=currRing) rChangeCurrRing(r);
2378    ideal F=idInit(1,1);
2379    poly p2=kNF(F,r->qideal,p);
2380    p_Normalize(p2,r);
2381    id_Delete(&F,r);
2382    p_Delete(&p,r);
2383    p=p2;
2384    if (r!=save) rChangeCurrRing(save);
2385  }
2386  return p;
2387}
2388BOOLEAN jjIMPORTFROM(leftv, leftv u, leftv v)
2389{
2390  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2391  assume(u->Typ()==PACKAGE_CMD);
2392  char *vn=(char *)v->Name();
2393  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2394  if (h!=NULL)
2395  {
2396    //check for existence
2397    if (((package)(u->Data()))==basePack)
2398    {
2399      WarnS("source and destination packages are identical");
2400      return FALSE;
2401    }
2402    idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2403    if (t!=NULL)
2404    {
2405      if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2406      killhdl(t);
2407    }
2408    sleftv tmp_expr;
2409    if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2410    sleftv h_expr;
2411    memset(&h_expr,0,sizeof(h_expr));
2412    h_expr.rtyp=IDHDL;
2413    h_expr.data=h;
2414    h_expr.name=vn;
2415    return iiAssign(&tmp_expr,&h_expr);
2416  }
2417  else
2418  {
2419    Werror("`%s` not found in `%s`",v->Name(), u->Name());
2420    return TRUE;
2421  }
2422  return FALSE;
2423}
Note: See TracBrowser for help on using the repository browser.