source: git/Singular/ipassign.cc @ 83f9fe

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