source: git/Singular/ipassign.cc @ c90500

spielwiese
Last change on this file since c90500 was d30a399, checked in by Hans Schoenemann <hannes@…>, 12 years ago
chg: option handling: test,verbose renamed to si_opt_1,si_opt_2
  • 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 "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#include "table.h"
824/*=================== operations ============================*/
825/*2
826* assign a = b
827*/
828static BOOLEAN jiAssign_1(leftv l, leftv r)
829{
830  int rt=r->Typ();
831  if (rt==0)
832  {
833    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
834    return TRUE;
835  }
836
837  int lt=l->Typ();
838  if((lt==0)/*&&(l->name!=NULL)*/)
839  {
840    if (!errorreported) Werror("left side `%s` is undefined",l->Fullname());
841    return TRUE;
842  }
843  if((rt==DEF_CMD)||(rt==NONE))
844  {
845    WarnS("right side is not a datum, assignment ignored");
846    // if (!errorreported)
847    //   WerrorS("right side is not a datum");
848    //return TRUE;
849    return FALSE;
850  }
851
852  int i=0;
853  if (lt==DEF_CMD)
854  {
855    if (l->rtyp==IDHDL)
856    {
857      IDTYP((idhdl)l->data)=rt;
858    }
859    else if (l->name!=NULL)
860    {
861      sleftv ll;
862      iiDeclCommand(&ll,l,myynest,rt,&IDROOT);
863      memcpy(l,&ll,sizeof(sleftv));
864    }
865    else
866    {
867      l->rtyp=rt;
868    }
869    lt=rt;
870  }
871  else
872  {
873    if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
874      return FALSE;
875  }
876  leftv ld=l;
877  if ((l->rtyp==IDHDL)&&(lt!=QRING_CMD)&&(lt!=RING_CMD))
878    ld=(leftv)l->data;
879  if (lt>MAX_TOK)
880  {
881    blackbox *bb=getBlackboxStuff(lt);
882#ifdef BLACKBOX_DEVEL
883    Print("bb-assign: bb=%lx\n",bb);
884#endif
885    return (bb==NULL) || bb->blackbox_Assign(l,r);
886  }
887  while (((dAssign[i].res!=lt)
888      || (dAssign[i].arg!=rt))
889    && (dAssign[i].res!=0)) i++;
890  if (dAssign[i].res!=0)
891  {
892    if (TEST_V_ALLWARN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt));
893    BOOLEAN b;
894    b=dAssign[i].p(ld,r,l->e);
895    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
896    {
897      l->flag=ld->flag;
898      l->attribute=ld->attribute;
899    }
900    return b;
901  }
902  // implicite type conversion ----------------------------------------------
903  if (dAssign[i].res==0)
904  {
905    int ri;
906    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
907    BOOLEAN failed=FALSE;
908    i=0;
909    while ((dAssign[i].res!=lt)
910      && (dAssign[i].res!=0)) i++;
911    while (dAssign[i].res==lt)
912    {
913      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
914      {
915        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
916        if(!failed)
917        {
918          failed= dAssign[i].p(ld,rn,l->e);
919          if (TEST_V_ALLWARN)
920            Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed);
921        }
922        // everything done, clean up temp. variables
923        rn->CleanUp();
924        omFreeBin((ADDRESS)rn, sleftv_bin);
925        if (failed)
926        {
927          // leave loop, goto error handling
928          break;
929        }
930        else
931        {
932          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
933          {
934            l->flag=ld->flag;
935            l->attribute=ld->attribute;
936          }
937          // everything ok, return
938          return FALSE;
939        }
940     }
941     i++;
942    }
943    // error handling ---------------------------------------------------
944    if (!errorreported)
945    {
946      if ((l->rtyp==IDHDL) && (l->e==NULL))
947        Werror("`%s`(%s) = `%s` is not supported",
948          Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
949      else
950         Werror("`%s` = `%s` is not supported"
951             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
952      if (BVERBOSE(V_SHOW_USE))
953      {
954        i=0;
955        while ((dAssign[i].res!=lt)
956          && (dAssign[i].res!=0)) i++;
957        while (dAssign[i].res==lt)
958        {
959          Werror("expected `%s` = `%s`"
960              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
961          i++;
962        }
963      }
964    }
965  }
966  return TRUE;
967}
968/*2
969* assign sys_var = val
970*/
971static BOOLEAN iiAssign_sys(leftv l, leftv r)
972{
973  int rt=r->Typ();
974
975  if (rt==0)
976  {
977    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
978    return TRUE;
979  }
980  int i=0;
981  int lt=l->rtyp;
982  while (((dAssign_sys[i].res!=lt)
983      || (dAssign_sys[i].arg!=rt))
984    && (dAssign_sys[i].res!=0)) i++;
985  if (dAssign_sys[i].res!=0)
986  {
987    if (!dAssign_sys[i].p(l,r))
988    {
989      // everything ok, clean up
990      return FALSE;
991    }
992  }
993  // implicite type conversion ----------------------------------------------
994  if (dAssign_sys[i].res==0)
995  {
996    int ri;
997    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
998    BOOLEAN failed=FALSE;
999    i=0;
1000    while ((dAssign_sys[i].res!=lt)
1001      && (dAssign_sys[i].res!=0)) i++;
1002    while (dAssign_sys[i].res==lt)
1003    {
1004      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
1005      {
1006        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
1007            || (dAssign_sys[i].p(l,rn)));
1008        // everything done, clean up temp. variables
1009        rn->CleanUp();
1010        omFreeBin((ADDRESS)rn, sleftv_bin);
1011        if (failed)
1012        {
1013          // leave loop, goto error handling
1014          break;
1015        }
1016        else
1017        {
1018          // everything ok, return
1019          return FALSE;
1020        }
1021     }
1022     i++;
1023    }
1024    // error handling ---------------------------------------------------
1025    if(!errorreported)
1026    {
1027      Werror("`%s` = `%s` is not supported"
1028             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1029      if (BVERBOSE(V_SHOW_USE))
1030      {
1031        i=0;
1032        while ((dAssign_sys[i].res!=lt)
1033          && (dAssign_sys[i].res!=0)) i++;
1034        while (dAssign_sys[i].res==lt)
1035        {
1036          Werror("expected `%s` = `%s`"
1037              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
1038          i++;
1039        }
1040      }
1041    }
1042  }
1043  return TRUE;
1044}
1045static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
1046{
1047  /* right side is intvec, left side is list (of int)*/
1048  BOOLEAN nok;
1049  int i=0;
1050  leftv l1=l;
1051  leftv h;
1052  sleftv t;
1053  intvec *iv=(intvec *)r->Data();
1054  memset(&t,0,sizeof(sleftv));
1055  t.rtyp=INT_CMD;
1056  while ((i<iv->length())&&(l!=NULL))
1057  {
1058    t.data=(char *)(*iv)[i];
1059    h=l->next;
1060    l->next=NULL;
1061    nok=jiAssign_1(l,&t);
1062    l->next=h;
1063    if (nok) return TRUE;
1064    i++;
1065    l=h;
1066  }
1067  l1->CleanUp();
1068  r->CleanUp();
1069  return FALSE;
1070}
1071static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
1072{
1073  /* right side is vector, left side is list (of poly)*/
1074  BOOLEAN nok;
1075  leftv l1=l;
1076  ideal I=idVec2Ideal((poly)r->Data());
1077  leftv h;
1078  sleftv t;
1079  int i=0;
1080  while (l!=NULL)
1081  {
1082    memset(&t,0,sizeof(sleftv));
1083    t.rtyp=POLY_CMD;
1084    if (i>=IDELEMS(I))
1085    {
1086      t.data=NULL;
1087    }
1088    else
1089    {
1090      t.data=(char *)I->m[i];
1091      I->m[i]=NULL;
1092    }
1093    h=l->next;
1094    l->next=NULL;
1095    nok=jiAssign_1(l,&t);
1096    l->next=h;
1097    t.CleanUp();
1098    if (nok)
1099    {
1100      idDelete(&I);
1101      return TRUE;
1102    }
1103    i++;
1104    l=h;
1105  }
1106  idDelete(&I);
1107  l1->CleanUp();
1108  r->CleanUp();
1109  //if (TEST_V_QRING && (currQuotient!=NULL)) jjNormalizeQRingP(l);
1110  return FALSE;
1111}
1112static BOOLEAN jjA_L_LIST(leftv l, leftv r)
1113/* left side: list/def, has to be a "real" variable
1114*  right side: expression list
1115*/
1116{
1117  int sl = r->listLength();
1118  lists L=(lists)omAllocBin(slists_bin);
1119  lists oldL;
1120  leftv h=NULL,o_r=r;
1121  int i;
1122  int rt;
1123
1124  L->Init(sl);
1125  for (i=0;i<sl;i++)
1126  {
1127    if (h!=NULL) { /* e.g. not in the first step:
1128                   * h is the pointer to the old sleftv,
1129                   * r is the pointer to the next sleftv
1130                   * (in this moment) */
1131                   h->next=r;
1132                 }
1133    h=r;
1134    r=r->next;
1135    h->next=NULL;
1136    rt=h->Typ();
1137    if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
1138    {
1139      L->Clean();
1140      Werror("`%s` is undefined",h->Fullname());
1141      //listall();
1142      goto err;
1143    }
1144    //if ((rt==RING_CMD)||(rt==QRING_CMD))
1145    //{
1146    //  L->m[i].rtyp=rt;
1147    //  L->m[i].data=h->Data();
1148    //  ((ring)L->m[i].data)->ref++;
1149    //}
1150    //else
1151      L->m[i].CleanUp();
1152      L->m[i].Copy(h);
1153      if(errorreported)
1154      {
1155        L->Clean();
1156        goto err;
1157      }
1158  }
1159  oldL=(lists)l->Data();
1160  if (oldL!=NULL) oldL->Clean();
1161  if (l->rtyp==IDHDL)
1162  {
1163    IDLIST((idhdl)l->data)=L;
1164    IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1165    ipMoveId((idhdl)l->data);
1166  }
1167  else
1168  {
1169    l->LData()->data=L;
1170    if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1171      l->rtyp=LIST_CMD;
1172  }
1173err:
1174  o_r->CleanUp();
1175  return errorreported;
1176}
1177static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1178{
1179  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1180  leftv hh=r;
1181  int i = 0;
1182  while (hh!=NULL)
1183  {
1184    if (i>=iv->length())
1185    {
1186      if (TEST_V_ALLWARN)
1187      {
1188        Warn("expression list length(%d) does not match intmat size(%d)",
1189             iv->length()+exprlist_length(hh),iv->length());
1190      }
1191      break;
1192    }
1193    if (hh->Typ() == INT_CMD)
1194    {
1195      (*iv)[i++] = (int)((long)(hh->Data()));
1196    }
1197    else if ((hh->Typ() == INTVEC_CMD)
1198            ||(hh->Typ() == INTMAT_CMD))
1199    {
1200      intvec *ivv = (intvec *)(hh->Data());
1201      int ll = 0,l = si_min(ivv->length(),iv->length());
1202      for (; l>0; l--)
1203      {
1204        (*iv)[i++] = (*ivv)[ll++];
1205      }
1206    }
1207    else
1208    {
1209      delete iv;
1210      return TRUE;
1211    }
1212    hh = hh->next;
1213  }
1214  if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1215  IDINTVEC((idhdl)l->data)=iv;
1216  return FALSE;
1217}
1218static BOOLEAN jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat *bim)
1219{
1220  /* left side is bigintmat, right side is list (of int,intvec,intmat)*/
1221  leftv hh=r;
1222  int i = 0;
1223  if (bim->length()==0) { WerrorS("bigintmat is 1x0"); delete bim; return TRUE; }
1224  while (hh!=NULL)
1225  {
1226    if (i>=bim->cols()*bim->rows())
1227    {
1228      if (TEST_V_ALLWARN)
1229      {
1230        Warn("expression list length(%d) does not match bigintmat size(%d x %d)",
1231              exprlist_length(hh),bim->rows(),bim->cols());
1232      }
1233      break;
1234    }
1235    if (hh->Typ() == INT_CMD)
1236    {
1237      number tp = n_Init((int)((long)(hh->Data())), coeffs_BIGINT);
1238      bim->set(i++, tp);
1239      n_Delete(&tp, coeffs_BIGINT);
1240    }
1241    else if (hh->Typ() == BIGINT_CMD)
1242    {
1243      bim->set(i++, (number)(hh->Data()));
1244    }
1245    /*
1246    ((hh->Typ() == INTVEC_CMD)
1247            ||(hh->Typ() == INTMAT_CMD))
1248    {
1249      intvec *ivv = (intvec *)(hh->Data());
1250      int ll = 0,l = si_min(ivv->length(),iv->length());
1251      for (; l>0; l--)
1252      {
1253        (*iv)[i++] = (*ivv)[ll++];
1254      }
1255    }*/
1256    else
1257    {
1258      delete bim;
1259      return TRUE;
1260    }
1261    hh = hh->next;
1262  }
1263  if (IDBIMAT((idhdl)l->data)!=NULL) delete IDBIMAT((idhdl)l->data);
1264  IDBIMAT((idhdl)l->data)=bim;
1265  return FALSE;
1266}
1267static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1268{
1269  /* left side is string, right side is list of string*/
1270  leftv hh=r;
1271  int sl = 1;
1272  char *s;
1273  char *t;
1274  int tl;
1275  /* find the length */
1276  while (hh!=NULL)
1277  {
1278    if (hh->Typ()!= STRING_CMD)
1279    {
1280      return TRUE;
1281    }
1282    sl += strlen((char *)hh->Data());
1283    hh = hh->next;
1284  }
1285  s = (char * )omAlloc(sl);
1286  sl=0;
1287  hh = r;
1288  while (hh!=NULL)
1289  {
1290    t=(char *)hh->Data();
1291    tl=strlen(t);
1292    memcpy(s+sl,t,tl);
1293    sl+=tl;
1294    hh = hh->next;
1295  }
1296  s[sl]='\0';
1297  omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1298  IDDATA((idhdl)(l->data))=s;
1299  return FALSE;
1300}
1301static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1302{
1303  /* right side is matrix, left side is list (of poly)*/
1304  BOOLEAN nok=FALSE;
1305  int i;
1306  matrix m=(matrix)r->CopyD(MATRIX_CMD);
1307  leftv h;
1308  leftv ol=l;
1309  leftv o_r=r;
1310  sleftv t;
1311  memset(&t,0,sizeof(sleftv));
1312  t.rtyp=POLY_CMD;
1313  int mxn=MATROWS(m)*MATCOLS(m);
1314  loop
1315  {
1316    i=0;
1317    while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1318    {
1319      t.data=(char *)m->m[i];
1320      m->m[i]=NULL;
1321      h=l->next;
1322      l->next=NULL;
1323      nok=jiAssign_1(l,&t);
1324      l->next=h;
1325      if (nok)
1326      {
1327        idDelete((ideal *)&m);
1328        goto ende;
1329      }
1330      i++;
1331      l=h;
1332    }
1333    idDelete((ideal *)&m);
1334    h=r;
1335    r=r->next;
1336    if (l==NULL)
1337    {
1338      if (r!=NULL)
1339      {
1340        Warn("list length mismatch in assign (l>r)");
1341        nok=TRUE;
1342      }
1343      break;
1344    }
1345    else if (r==NULL)
1346    {
1347      Warn("list length mismatch in assign (l<r)");
1348      nok=TRUE;
1349      break;
1350    }
1351    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1352    {
1353      m=(matrix)r->CopyD(MATRIX_CMD);
1354      mxn=MATROWS(m)*MATCOLS(m);
1355    }
1356    else if (r->Typ()==POLY_CMD)
1357    {
1358      m=mpNew(1,1);
1359      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1360      pNormalize(MATELEM(m,1,1));
1361      mxn=1;
1362    }
1363    else
1364    {
1365      nok=TRUE;
1366      break;
1367    }
1368  }
1369ende:
1370  o_r->CleanUp();
1371  ol->CleanUp();
1372  return nok;
1373}
1374static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1375{
1376  /*left side are strings, right side is a string*/
1377  /*e.g. s[2..3]="12" */
1378  /*the case s=t[1..4] is handled in iiAssign,
1379  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1380  BOOLEAN nok=FALSE;
1381  sleftv t;
1382  leftv h,l1=l;
1383  int i=0;
1384  char *ss;
1385  char *s=(char *)r->Data();
1386  int sl=strlen(s);
1387
1388  memset(&t,0,sizeof(sleftv));
1389  t.rtyp=STRING_CMD;
1390  while ((i<sl)&&(l!=NULL))
1391  {
1392    ss=(char *)omAlloc(2);
1393    ss[1]='\0';
1394    ss[0]=s[i];
1395    t.data=ss;
1396    h=l->next;
1397    l->next=NULL;
1398    nok=jiAssign_1(l,&t);
1399    if (nok)
1400    {
1401      break;
1402    }
1403    i++;
1404    l=h;
1405  }
1406  r->CleanUp();
1407  l1->CleanUp();
1408  return nok;
1409}
1410static BOOLEAN jiAssign_list(leftv l, leftv r)
1411{
1412  int i=l->e->start-1;
1413  if (i<0)
1414  {
1415    Werror("index[%d] must be positive",i+1);
1416    return TRUE;
1417  }
1418  if(l->attribute!=NULL)
1419  {
1420    atKillAll((idhdl)l);
1421    l->attribute=NULL;
1422  }
1423  l->flag=0;
1424  lists li;
1425  if (l->rtyp==IDHDL)
1426  {
1427    li=IDLIST((idhdl)l->data);
1428  }
1429  else
1430  {
1431    li=(lists)l->data;
1432  }
1433  if (i>li->nr)
1434  {
1435    li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1436    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1437    int j=li->nr+1;
1438    for(;j<=i;j++)
1439      li->m[j].rtyp=DEF_CMD;
1440    li->nr=i;
1441  }
1442  leftv ld=&(li->m[i]);
1443  ld->e=l->e->next;
1444  BOOLEAN b;
1445  if (/*(ld->rtyp!=LIST_CMD)
1446  &&*/(ld->e==NULL)
1447  &&(ld->Typ()!=r->Typ()))
1448  {
1449    sleftv tmp;
1450    memset(&tmp,0,sizeof(sleftv));
1451    tmp.rtyp=DEF_CMD;
1452    b=iiAssign(&tmp,r);
1453    ld->CleanUp();
1454    memcpy(ld,&tmp,sizeof(sleftv));
1455  }
1456  else
1457  {
1458    b=iiAssign(ld,r);
1459    if (l->e!=NULL) l->e->next=ld->e;
1460    ld->e=NULL;
1461  }
1462  return b;
1463}
1464static BOOLEAN jiAssign_rec(leftv l, leftv r)
1465{
1466  leftv l1=l;
1467  leftv r1=r;
1468  leftv lrest;
1469  leftv rrest;
1470  BOOLEAN b;
1471  do
1472  {
1473    lrest=l->next;
1474    rrest=r->next;
1475    l->next=NULL;
1476    r->next=NULL;
1477    b=iiAssign(l,r);
1478    l->next=lrest;
1479    r->next=rrest;
1480    l=lrest;
1481    r=rrest;
1482  } while  ((!b)&&(l!=NULL));
1483  l1->CleanUp();
1484  r1->CleanUp();
1485  return b;
1486}
1487BOOLEAN iiAssign(leftv l, leftv r)
1488{
1489  if (errorreported) return TRUE;
1490  int ll=l->listLength();
1491  int rl;
1492  int lt=l->Typ();
1493  int rt=NONE;
1494  BOOLEAN b;
1495  if (l->rtyp==ALIAS_CMD)
1496  {
1497    Werror("`%s` is read-only",l->Name());
1498  }
1499
1500  if (l->rtyp==IDHDL)
1501  {
1502    atKillAll((idhdl)l->data);
1503    IDFLAG((idhdl)l->data)=0;
1504    l->attribute=NULL;
1505  }
1506  else if (l->attribute!=NULL)
1507    atKillAll((idhdl)l);
1508  l->flag=0;
1509  if (ll==1)
1510  {
1511    /* l[..] = ... */
1512    if(l->e!=NULL)
1513    {
1514      BOOLEAN like_lists=0;
1515      blackbox *bb=NULL;
1516      int bt;
1517      if (((bt=l->rtyp)>MAX_TOK)
1518      || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1519      {
1520        bb=getBlackboxStuff(bt);
1521        like_lists=BB_LIKE_LIST(bb); // bb like a list
1522      }
1523      else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1524        || (l->rtyp==LIST_CMD))
1525      {
1526        like_lists=2; // bb in a list
1527      }
1528      if(like_lists)
1529      {
1530        if (TEST_V_ALLWARN) PrintS("assign list[..]=...or similiar\n");
1531        if (like_lists==1)
1532        {
1533          // check blackbox/newtype type:
1534          if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
1535        }
1536        b=jiAssign_list(l,r);
1537        if((!b) && (like_lists==2))
1538        {
1539          //Print("jjA_L_LIST: - 2 \n");
1540          if((l->rtyp==IDHDL) && (l->data!=NULL))
1541          {
1542            ipMoveId((idhdl)l->data);
1543            l->attribute=IDATTR((idhdl)l->data);
1544            l->flag=IDFLAG((idhdl)l->data);
1545          }
1546        }
1547        r->CleanUp();
1548        Subexpr h;
1549        while (l->e!=NULL)
1550        {
1551          h=l->e->next;
1552          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1553          l->e=h;
1554        }
1555        return b;
1556      }
1557    }
1558    // end of handling elems of list and similiar
1559    rl=r->listLength();
1560    if (rl==1)
1561    {
1562      /* system variables = ... */
1563      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1564      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1565      {
1566        b=iiAssign_sys(l,r);
1567        r->CleanUp();
1568        //l->CleanUp();
1569        return b;
1570      }
1571      rt=r->Typ();
1572      /* a = ... */
1573      if ((lt!=MATRIX_CMD)
1574      &&(lt!=INTMAT_CMD)
1575      &&((lt==rt)||(lt!=LIST_CMD)))
1576      {
1577        b=jiAssign_1(l,r);
1578        if (l->rtyp==IDHDL)
1579        {
1580          if ((lt==DEF_CMD)||(lt==LIST_CMD))
1581          {
1582            ipMoveId((idhdl)l->data);
1583          }
1584          l->attribute=IDATTR((idhdl)l->data);
1585          l->flag=IDFLAG((idhdl)l->data);
1586          l->CleanUp();
1587        }
1588        r->CleanUp();
1589        return b;
1590      }
1591      if (((lt!=LIST_CMD)
1592        &&((rt==MATRIX_CMD)
1593          ||(rt==INTMAT_CMD)
1594          ||(rt==INTVEC_CMD)
1595          ||(rt==MODUL_CMD)))
1596      ||((lt==LIST_CMD)
1597        &&(rt==RESOLUTION_CMD))
1598      )
1599      {
1600        b=jiAssign_1(l,r);
1601        if((l->rtyp==IDHDL)&&(l->data!=NULL))
1602        {
1603          if ((lt==DEF_CMD) || (lt==LIST_CMD))
1604          {
1605            //Print("ipAssign - 3.0\n");
1606            ipMoveId((idhdl)l->data);
1607          }
1608          l->attribute=IDATTR((idhdl)l->data);
1609          l->flag=IDFLAG((idhdl)l->data);
1610        }
1611        r->CleanUp();
1612        Subexpr h;
1613        while (l->e!=NULL)
1614        {
1615          h=l->e->next;
1616          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1617          l->e=h;
1618        }
1619        return b;
1620      }
1621    }
1622    if (rt==NONE) rt=r->Typ();
1623  }
1624  else if (ll==(rl=r->listLength()))
1625  {
1626    b=jiAssign_rec(l,r);
1627    return b;
1628  }
1629  else
1630  {
1631    if (rt==NONE) rt=r->Typ();
1632    if (rt==INTVEC_CMD)
1633      return jiA_INTVEC_L(l,r);
1634    else if (rt==VECTOR_CMD)
1635      return jiA_VECTOR_L(l,r);
1636    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1637      return jiA_MATRIX_L(l,r);
1638    else if ((rt==STRING_CMD)&&(rl==1))
1639      return jiA_STRING_L(l,r);
1640    Werror("length of lists in assignment does not match (l:%d,r:%d)",
1641      ll,rl);
1642    return TRUE;
1643  }
1644
1645  leftv hh=r;
1646  BOOLEAN nok=FALSE;
1647  BOOLEAN map_assign=FALSE;
1648  switch (lt)
1649  {
1650    case INTVEC_CMD:
1651      nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
1652      break;
1653    case INTMAT_CMD:
1654    {
1655      nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
1656      break;
1657    }
1658    case BIGINTMAT_CMD:
1659    {
1660      nok=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
1661      break;
1662    }
1663    case MAP_CMD:
1664    {
1665      // first element in the list sl (r) must be a ring
1666      if (((rt == RING_CMD)||(rt == QRING_CMD))&&(r->e==NULL))
1667      {
1668        omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
1669        IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
1670        /* advance the expressionlist to get the next element after the ring */
1671        hh = r->next;
1672        //r=hh;
1673      }
1674      else
1675      {
1676        WerrorS("expected ring-name");
1677        nok=TRUE;
1678        break;
1679      }
1680      if (hh==NULL) /* map-assign: map f=r; */
1681      {
1682        WerrorS("expected image ideal");
1683        nok=TRUE;
1684        break;
1685      }
1686      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
1687        return jiAssign_1(l,hh); /* map-assign: map f=r,i; */
1688      //no break, handle the rest like an ideal:
1689      map_assign=TRUE;
1690    }
1691    case MATRIX_CMD:
1692    case IDEAL_CMD:
1693    case MODUL_CMD:
1694    {
1695      sleftv t;
1696      matrix olm = (matrix)l->Data();
1697      int rk=olm->rank;
1698      char *pr=((map)olm)->preimage;
1699      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
1700      matrix lm ;
1701      int  num;
1702      int j,k;
1703      int i=0;
1704      int mtyp=MATRIX_CMD; /*Type of left side object*/
1705      int etyp=POLY_CMD;   /*Type of elements of left side object*/
1706
1707      if (lt /*l->Typ()*/==MATRIX_CMD)
1708      {
1709        num=olm->cols()*olm->rows();
1710        lm=mpNew(olm->rows(),olm->cols());
1711        int el;
1712        if ((TEST_V_ALLWARN) && (num!=(el=exprlist_length(hh))))
1713        {
1714          Warn("expression list length(%d) does not match matrix size(%d)",el,num);
1715        }
1716      }
1717      else /* IDEAL_CMD or MODUL_CMD */
1718      {
1719        num=exprlist_length(hh);
1720        lm=(matrix)idInit(num,1);
1721        rk=1;
1722        if (module_assign)
1723        {
1724          mtyp=MODUL_CMD;
1725          etyp=VECTOR_CMD;
1726        }
1727      }
1728
1729      int ht;
1730      loop
1731      {
1732        if (hh==NULL)
1733          break;
1734        else
1735        {
1736          matrix rm;
1737          ht=hh->Typ();
1738          if ((j=iiTestConvert(ht,etyp))!=0)
1739          {
1740            nok=iiConvert(ht,etyp,j,hh,&t);
1741            hh->next=t.next;
1742            if (nok) break;
1743            lm->m[i]=(poly)t.CopyD(etyp);
1744            pNormalize(lm->m[i]);
1745            if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
1746            i++;
1747          }
1748          else
1749          if ((j=iiTestConvert(ht,mtyp))!=0)
1750          {
1751            nok=iiConvert(ht,mtyp,j,hh,&t);
1752            hh->next=t.next;
1753            if (nok) break;
1754            rm = (matrix)t.CopyD(mtyp);
1755            if (module_assign)
1756            {
1757              j = si_min(num,rm->cols());
1758              rk=si_max(rk,(int)rm->rank);
1759            }
1760            else
1761              j = si_min(num-i,rm->rows() * rm->cols());
1762            for(k=0;k<j;k++,i++)
1763            {
1764              lm->m[i]=rm->m[k];
1765              pNormalize(lm->m[i]);
1766              rm->m[k]=NULL;
1767            }
1768            idDelete((ideal *)&rm);
1769          }
1770          else
1771          {
1772            nok=TRUE;
1773            break;
1774          }
1775          t.next=NULL;t.CleanUp();
1776          if (i==num) break;
1777          hh=hh->next;
1778        }
1779      }
1780      if (nok)
1781        idDelete((ideal *)&lm);
1782      else
1783      {
1784        idDelete((ideal *)&olm);
1785        if (module_assign)   lm->rank=rk;
1786        else if (map_assign) ((map)lm)->preimage=pr;
1787        l=l->LData();
1788        if (l->rtyp==IDHDL)
1789          IDMATRIX((idhdl)l->data)=lm;
1790        else
1791          l->data=(char *)lm;
1792      }
1793      break;
1794    }
1795    case STRING_CMD:
1796      nok=jjA_L_STRING(l,r);
1797      break;
1798    case DEF_CMD:
1799    case LIST_CMD:
1800      nok=jjA_L_LIST(l,r);
1801      break;
1802    case NONE:
1803    case 0:
1804      Werror("cannot assign to %s",l->Fullname());
1805      nok=TRUE;
1806      break;
1807    default:
1808      WerrorS("assign not impl.");
1809      nok=TRUE;
1810      break;
1811  } /* end switch: typ */
1812  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
1813  r->CleanUp();
1814  return nok;
1815}
1816void jjNormalizeQRingId(leftv I)
1817{
1818  if ((currQuotient!=NULL) && (!hasFlag(I,FLAG_QRING)))
1819  {
1820    if (I->e==NULL)
1821    {
1822      ideal I0=(ideal)I->Data();
1823      switch (I->Typ())
1824      {
1825        case IDEAL_CMD:
1826        case MODUL_CMD:
1827        {
1828          ideal F=idInit(1,1);
1829          ideal II=kNF(F,currQuotient,I0);
1830          idDelete(&F);
1831          if (I->rtyp!=IDHDL)
1832          {
1833            idDelete((ideal*)&(I0));
1834            I->data=II;
1835          }
1836          else
1837          {
1838            idhdl h=(idhdl)I->data;
1839            idDelete((ideal*)&IDIDEAL(h));
1840            IDIDEAL(h)=II;
1841            setFlag(h,FLAG_QRING);
1842          }
1843          break;
1844        }
1845        default: break;
1846      }
1847      setFlag(I,FLAG_QRING);
1848    }
1849  }
1850}
1851void jjNormalizeQRingP(leftv I)
1852{
1853  if ((currQuotient!=NULL) && (!hasFlag(I,FLAG_QRING)))
1854  {
1855    poly p=(poly)I->Data();
1856    if ((I->e==NULL) && (p!=NULL))
1857    {
1858      ideal F=idInit(1,1);
1859      poly II=kNF(F,currQuotient,p);
1860      idDelete(&F);
1861      if ((I->rtyp==POLY_CMD)
1862      || (I->rtyp==VECTOR_CMD))
1863      {
1864        pDelete(&p);
1865        I->data=II;
1866      }
1867      else if (I->rtyp==IDHDL)
1868      {
1869        pDelete(&p);
1870        idhdl h=(idhdl)I->data;
1871        IDPOLY(h)=II;
1872        setFlag(h,FLAG_QRING);
1873      }
1874      else
1875      {
1876        pDelete(&II);
1877      }
1878    }
1879    setFlag(I,FLAG_QRING);
1880  }
1881}
1882BOOLEAN jjIMPORTFROM(leftv, leftv u, leftv v)
1883{
1884  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
1885  assume(u->Typ()==PACKAGE_CMD);
1886  char *vn=(char *)v->Name();
1887  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
1888  if (h!=NULL)
1889  {
1890    //check for existence
1891    if (((package)(u->Data()))==basePack)
1892    {
1893      WarnS("source and destination packages are identical");
1894      return FALSE;
1895    }
1896    idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
1897    if (t!=NULL)
1898    {
1899      Warn("redefining `%s`",vn);
1900      killhdl(t);
1901    }
1902    sleftv tmp_expr;
1903    if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
1904    sleftv h_expr;
1905    memset(&h_expr,0,sizeof(h_expr));
1906    h_expr.rtyp=IDHDL;
1907    h_expr.data=h;
1908    h_expr.name=vn;
1909    return iiAssign(&tmp_expr,&h_expr);
1910  }
1911  else
1912  {
1913    Werror("`%s` not found in `%s`",v->Name(), u->Name());
1914    return TRUE;
1915  }
1916  return FALSE;
1917}
Note: See TracBrowser for help on using the repository browser.