source: git/Singular/ipassign.cc @ 0647c5

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