source: git/Singular/ipassign.cc @ 0f4cea

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