source: git/Singular/ipassign.cc @ cc3cf2

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