source: git/Singular/ipassign.cc @ 44ca2f

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