source: git/Singular/ipassign.cc @ 8e7db4

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