source: git/Singular/ipassign.cc @ ea947e

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