source: git/Singular/ipassign.cc @ 34ac5c

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