source: git/Singular/ipassign.cc @ e2efbe9

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