source: git/Singular/ipassign.cc @ d22802

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