source: git/Singular/ipassign.cc @ 291c20

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