source: git/Singular/ipassign.cc @ d1aba5

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