source: git/Singular/ipassign.cc @ 5de33f4

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