source: git/Singular/ipassign.cc @ d20dc6

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