source: git/Singular/ipassign.cc @ 584b82

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