source: git/Singular/ipassign.cc @ 7d4e42

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