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

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