source: git/Singular/ipassign.cc @ 2956123

spielwiese
Last change on this file since 2956123 was 2956123, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: 3-0-4-1 git-svn-id: file:///usr/local/Singular/svn/trunk@10445 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 36.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipassign.cc,v 1.92 2007-11-27 11:55:57 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,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, char *libname,
408                                          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) delete ((intvec *)res->data);
428  res->data=(void *)a->CopyD(INTVEC_CMD);
429  jiAssignAttr(res,a);
430  return FALSE;
431}
432static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr e)
433{
434  if (res->data!=NULL) idDelete((ideal*)&res->data);
435  res->data=(void *)a->CopyD(MATRIX_CMD);
436  if (a->rtyp==IDHDL) idNormalize((ideal)a->Data());
437  else                idNormalize((ideal)res->data);
438  jiAssignAttr(res,a);
439  if (((res->rtyp==IDEAL_CMD)||(res->rtyp==MODUL_CMD))
440  && (IDELEMS((ideal)(res->data))==1))
441  {
442    setFlag(res,FLAG_STD);
443  }
444  return FALSE;
445}
446static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr e)
447{
448  if (res->data!=NULL) syKillComputation((syStrategy)res->data);
449  res->data=(void *)a->CopyD(RESOLUTION_CMD);
450  jiAssignAttr(res,a);
451  return FALSE;
452}
453static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr e)
454{
455  if (res->data!=NULL) idDelete((ideal*)&res->data);
456  ideal I=idInit(1,1);
457  I->m[0]=(poly)a->CopyD(POLY_CMD);
458  if (I->m[0]!=NULL) pSetCompP(I->m[0],1);
459  pNormalize(I->m[0]);
460  res->data=(void *)I;
461  return FALSE;
462}
463static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr e)
464{
465  if (res->data!=NULL) idDelete((ideal*)&res->data);
466  matrix m=(matrix)a->CopyD(MATRIX_CMD);
467  IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m);
468  ((ideal)m)->rank=1;
469  MATROWS(m)=1;
470  idNormalize((ideal)m);
471  res->data=(void *)m;
472  return FALSE;
473}
474static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr e)
475{
476  si_link l=(si_link)res->data;
477
478  if (l!=NULL) slCleanUp(l);
479
480  if (a->Typ() == STRING_CMD)
481  {
482    if (l == NULL)
483    {
484      l = (si_link) omAlloc0Bin(sip_link_bin);
485      res->data = (void *) l;
486    }
487    return slInit(l, (char *) a->Data());
488  }
489  else if (a->Typ() == LINK_CMD)
490  {
491    if (l != NULL) omFreeBin(l, sip_link_bin);
492    res->data = slCopy((si_link)a->Data());
493    return FALSE;
494  }
495  return TRUE;
496}
497// assign map -> map
498static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr e)
499{
500  if (res->data!=NULL)
501  {
502    omFree((ADDRESS)((map)res->data)->preimage);
503    ((map)res->data)->preimage=NULL;
504    idDelete((ideal*)&res->data);
505  }
506  res->data=(void *)a->CopyD(MAP_CMD);
507  jiAssignAttr(res,a);
508  return FALSE;
509}
510// assign ideal -> map
511static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr e)
512{
513  map f=(map)res->data;
514  char *rn=f->preimage; // save the old/already assigned preimage ring name
515  f->preimage=NULL;
516  idDelete((ideal *)&f);
517  res->data=(void *)a->CopyD(IDEAL_CMD);
518  f=(map)res->data;
519  idNormalize((ideal)f);
520  f->preimage = rn;
521  return FALSE;
522}
523#if 0
524static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
525{
526  // the follwing can only happen, if:
527  //   - the left side is of type qring AND not an id
528  if ((e!=NULL)||(res->rtyp!=IDHDL))
529  {
530    WerrorS("qring_id expected");
531    return TRUE;
532  }
533  ring qr;
534  int i,j;
535  int *pi;
536
537  assumeStdFlag(a);
538  #ifdef HAVE_PLURAL
539  if(rIsPluralRing(currRing))
540  {
541    if (!hasFlag(a,FLAG_TWOSTD))
542    {
543      Warn("%s is no twosided standard basis",a->Name());
544    }
545  }
546  #endif
547  qr=(ring)res->Data();
548  ring qrr=rCopy(currRing);
549  memcpy4(qr,qrr,sizeof(ip_sring));
550  omFreeBin((ADDRESS)qrr, ip_sring_bin);
551  if (qr->qideal!=NULL) idDelete(&qr->qideal);
552  qr->qideal = (ideal)a->CopyD(IDEAL_CMD);
553  //currRing=qr;
554  //currRingHdl=(idhdl)res->data;
555  //currQuotient=qr->qideal;
556  rSetHdl((idhdl)res->data);
557  return FALSE;
558}
559#endif
560static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
561{
562  // the follwing can only happen, if:
563  //   - the left side is of type qring AND not an id
564  if ((e!=NULL)||(res->rtyp!=IDHDL))
565  {
566    WerrorS("qring_id expected");
567    return TRUE;
568  }
569
570  ring qr=(ring)res->Data(); // the declaration allocated space
571  ring qrr=rCopy(currRing); 
572                 // we have to fill it, but the copy also allocates space
573  memcpy4(qr,qrr,sizeof(ip_sring));
574  omFreeBin((ADDRESS)qrr, ip_sring_bin);
575  if (qr->qideal!=NULL) idDelete(&qr->qideal);
576  ideal id=(ideal)a->CopyD(IDEAL_CMD);
577  if (idElem(id)>1) assumeStdFlag(a);
578  qr->qideal = id;
579
580  // qr is a copy of currRing with the new qideal!
581  #ifdef HAVE_PLURAL
582  if(rIsPluralRing(currRing))
583  {
584    if (!hasFlag(a,FLAG_TWOSTD))
585    {
586      Warn("%s is no twosided standard basis",a->Name());
587    }
588
589    nc_SetupQuotient(qr, currRing); 
590  }
591  #endif
592  //currRing=qr;
593  //currRingHdl=(idhdl)res->data;
594  //currQuotient=qr->qideal;
595  rSetHdl((idhdl)res->data);
596  return FALSE;
597}
598
599static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e)
600{
601  BOOLEAN have_id=TRUE;
602  if ((e!=NULL)||(res->rtyp!=IDHDL))
603  {
604    //WerrorS("id expected");
605    //return TRUE;
606    have_id=FALSE;
607  }
608  ring r=(ring)a->Data();
609  if (have_id)
610  {
611    idhdl rl=(idhdl)res->data;
612    if (&IDRING(rl)!=NULL) rKill(rl);
613    IDRING(rl)=r;
614    if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing))
615      currRingHdl=(idhdl)res->data;
616  }
617  else
618  {
619    if (e==NULL) res->data=(char *)r;
620    else
621    {
622      WerrorS("id expected");
623      return TRUE;
624    }
625  }
626  r->ref++;
627  return FALSE;
628}
629static BOOLEAN jiA_PACKAGE(leftv res, leftv a, Subexpr e)
630{
631  res->data=(void *)a->CopyD(PACKAGE_CMD);
632  jiAssignAttr(res,a);
633  return FALSE;
634}
635/*=================== table =================*/
636struct sValAssign dAssign[]=
637{
638// proc         res             arg
639 {jiA_IDEAL,    IDEAL_CMD,      IDEAL_CMD }
640,{jiA_IDEAL_M,  IDEAL_CMD,      MATRIX_CMD }
641,{jiA_RESOLUTION,RESOLUTION_CMD,RESOLUTION_CMD }
642,{jiA_INT,      INT_CMD,        INT_CMD }
643,{jiA_IDEAL,    MATRIX_CMD,     MATRIX_CMD }
644,{jiA_MAP_ID,   MAP_CMD,        IDEAL_CMD }
645,{jiA_MAP,      MAP_CMD,        MAP_CMD }
646,{jiA_IDEAL,    MODUL_CMD,      MODUL_CMD }
647,{jiA_MODUL_P,  MODUL_CMD,      POLY_CMD }
648,{jiA_POLY,     POLY_CMD,       POLY_CMD }
649,{jiA_1x1MATRIX,POLY_CMD,       MATRIX_CMD }
650,{jiA_QRING,    QRING_CMD,      IDEAL_CMD }
651,{jiA_RING,     RING_CMD,       RING_CMD }
652,{jiA_RING,     QRING_CMD,      QRING_CMD }
653,{jiA_STRING,   STRING_CMD,     STRING_CMD }
654,{jiA_PROC,     PROC_CMD,       STRING_CMD }
655,{jiA_PROC,     PROC_CMD,       PROC_CMD }
656,{jiA_POLY,     VECTOR_CMD,     VECTOR_CMD }
657,{jiA_INTVEC,   INTVEC_CMD,     INTVEC_CMD }
658,{jiA_INTVEC,   INTMAT_CMD,     INTMAT_CMD }
659,{jiA_NUMBER,   NUMBER_CMD,     NUMBER_CMD }
660,{jiA_BIGINT,   BIGINT_CMD,     BIGINT_CMD }
661,{jiA_LIST_RES, LIST_CMD,       RESOLUTION_CMD }
662,{jiA_LIST,     LIST_CMD,       LIST_CMD }
663,{jiA_LINK,     LINK_CMD,       STRING_CMD }
664,{jiA_LINK,     LINK_CMD,       LINK_CMD }
665,{jiA_PACKAGE,  PACKAGE_CMD,    PACKAGE_CMD }
666,{NULL,         0,              0 }
667};
668struct sValAssign_sys dAssign_sys[]=
669{
670// sysvars:
671 {jjECHO,       VECHO,          INT_CMD }
672,{jjPAGELENGTH, VPAGELENGTH,    INT_CMD }
673,{jjPRINTLEVEL, VPRINTLEVEL,    INT_CMD }
674,{jjCOLMAX,     VCOLMAX,        INT_CMD }
675,{jjTIMER,      VTIMER,         INT_CMD }
676#ifdef HAVE_RTIMER
677,{jjRTIMER,     VRTIMER,        INT_CMD }
678#endif
679,{jjMAXDEG,     VMAXDEG,        INT_CMD }
680,{jjMAXMULT,    VMAXMULT,       INT_CMD }
681,{jjTRACE,      TRACE,          INT_CMD }
682,{jjSHORTOUT,   VSHORTOUT,      INT_CMD }
683,{jjMINPOLY,    VMINPOLY,       NUMBER_CMD }
684,{jjNOETHER,    VNOETHER,       POLY_CMD }
685,{NULL,         0,              0 }
686};
687/*=================== operations ============================*/
688/*2
689* assign a = b
690*/
691static BOOLEAN jiAssign_1(leftv l, leftv r)
692{
693  int rt=r->Typ();
694  if (rt==0)
695  {
696    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
697    return TRUE;
698  }
699
700  int lt=l->Typ();
701  if((lt==0)/*&&(l->name!=NULL)*/)
702  {
703    if (!errorreported) Werror("left side `%s` is undefined",l->Fullname());
704    return TRUE;
705  }
706  if((rt==DEF_CMD)||(rt==NONE))
707  {
708    WarnS("right side is not a datum, assignment ignored");
709    // if (!errorreported)
710    //   WerrorS("right side is not a datum");
711    //return TRUE;
712    return FALSE;
713  }
714
715  int i=0;
716  BOOLEAN nok=FALSE;
717
718  if (lt==DEF_CMD)
719  {
720    if (l->rtyp==IDHDL)
721    {
722      IDTYP((idhdl)l->data)=rt;
723    }
724    else if (l->name!=NULL)
725    {
726      sleftv ll;
727      iiDeclCommand(&ll,l,myynest,rt,&IDROOT);
728      memcpy(l,&ll,sizeof(sleftv));
729    }
730    else
731    {
732      l->rtyp=rt;
733    }
734    lt=rt;
735  }
736  else
737  {
738    if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
739      return FALSE;
740  }
741  leftv ld=l;
742  if ((l->rtyp==IDHDL)&&(lt!=QRING_CMD)&&(lt!=RING_CMD))
743    ld=(leftv)l->data;
744  while (((dAssign[i].res!=lt)
745      || (dAssign[i].arg!=rt))
746    && (dAssign[i].res!=0)) i++;
747  if (dAssign[i].res!=0)
748  {
749    BOOLEAN b;
750    b=dAssign[i].p(ld,r,l->e);
751    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
752    {
753      l->flag=ld->flag;
754      l->attribute=ld->attribute;
755    }
756    return b;
757  }
758  // implicite type conversion ----------------------------------------------
759  if (dAssign[i].res==0)
760  {
761    int ri;
762    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
763    BOOLEAN failed=FALSE;
764    i=0;
765    while ((dAssign[i].res!=lt)
766      && (dAssign[i].res!=0)) i++;
767    while (dAssign[i].res==lt)
768    {
769      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
770      {
771        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
772        if(!failed)
773        {
774          failed= dAssign[i].p(ld,rn,l->e);
775        }
776        // everything done, clean up temp. variables
777        rn->CleanUp();
778        omFreeBin((ADDRESS)rn, sleftv_bin);
779        if (failed)
780        {
781          // leave loop, goto error handling
782          break;
783        }
784        else
785        {
786          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
787          {
788            l->flag=ld->flag;
789            l->attribute=ld->attribute;
790          }
791          // everything ok, return
792          return FALSE;
793        }
794     }
795     i++;
796    }
797    // error handling ---------------------------------------------------
798    if (!errorreported)
799    {
800      if ((l->rtyp==IDHDL) && (l->e==NULL))
801        Werror("`%s`(%s) = `%s` is not supported",
802          Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
803      else
804         Werror("`%s` = `%s` is not supported"
805             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
806      if (BVERBOSE(V_SHOW_USE))
807      {
808        i=0;
809        while ((dAssign[i].res!=lt)
810          && (dAssign[i].res!=0)) i++;
811        while (dAssign[i].res==lt)
812        {
813          Werror("expected `%s` = `%s`"
814              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
815          i++;
816        }
817      }
818    }
819  }
820  return TRUE;
821}
822/*2
823* assign sys_var = val
824*/
825static BOOLEAN iiAssign_sys(leftv l, leftv r)
826{
827  int rt=r->Typ();
828
829  if (rt==0)
830  {
831    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
832    return TRUE;
833  }
834  int i=0;
835  int lt=l->rtyp;
836  while (((dAssign_sys[i].res!=lt)
837      || (dAssign_sys[i].arg!=rt))
838    && (dAssign_sys[i].res!=0)) i++;
839  if (dAssign_sys[i].res!=0)
840  {
841    if (!dAssign_sys[i].p(l,r))
842    {
843      // everything ok, clean up
844      return FALSE;
845    }
846  }
847  // implicite type conversion ----------------------------------------------
848  if (dAssign_sys[i].res==0)
849  {
850    int ri;
851    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
852    BOOLEAN failed=FALSE;
853    i=0;
854    while ((dAssign_sys[i].res!=lt)
855      && (dAssign_sys[i].res!=0)) i++;
856    while (dAssign_sys[i].res==lt)
857    {
858      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
859      {
860        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
861            || (dAssign_sys[i].p(l,rn)));
862        // everything done, clean up temp. variables
863        rn->CleanUp();
864        omFreeBin((ADDRESS)rn, sleftv_bin);
865        if (failed)
866        {
867          // leave loop, goto error handling
868          break;
869        }
870        else
871        {
872          // everything ok, return
873          return FALSE;
874        }
875     }
876     i++;
877    }
878    // error handling ---------------------------------------------------
879    if(!errorreported)
880    {
881      Werror("`%s` = `%s` is not supported"
882             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
883      if (BVERBOSE(V_SHOW_USE))
884      {
885        i=0;
886        while ((dAssign_sys[i].res!=lt)
887          && (dAssign_sys[i].res!=0)) i++;
888        while (dAssign_sys[i].res==lt)
889        {
890          Werror("expected `%s` = `%s`"
891              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
892          i++;
893        }
894      }
895    }
896  }
897  return TRUE;
898}
899static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
900{
901  /* right side is intvec, left side is list (of int)*/
902  BOOLEAN nok;
903  int i=0;
904  leftv l1=l;
905  leftv h;
906  sleftv t;
907  intvec *iv=(intvec *)r->Data();
908  memset(&t,0,sizeof(sleftv));
909  t.rtyp=INT_CMD;
910  while ((i<iv->length())&&(l!=NULL))
911  {
912    t.data=(char *)(*iv)[i];
913    h=l->next;
914    l->next=NULL;
915    nok=jiAssign_1(l,&t);
916    if (nok) return TRUE;
917    i++;
918    l=h;
919  }
920  l1->CleanUp();
921  r->CleanUp();
922  return FALSE;
923}
924static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
925{
926  /* right side is vector, left side is list (of poly)*/
927  BOOLEAN nok;
928  leftv l1=l;
929  ideal I=idVec2Ideal((poly)r->Data());
930  leftv h;
931  sleftv t;
932  int i=0;
933  while (l!=NULL)
934  {
935    memset(&t,0,sizeof(sleftv));
936    t.rtyp=POLY_CMD;
937    if (i>=IDELEMS(I))
938    {
939      t.data=NULL;
940    }
941    else
942    {
943      t.data=(char *)I->m[i];
944      I->m[i]=NULL;
945    }
946    h=l->next;
947    l->next=NULL;
948    nok=jiAssign_1(l,&t);
949    t.CleanUp();
950    if (nok)
951    {
952      idDelete(&I);
953      return TRUE;
954    }
955    i++;
956    l=h;
957  }
958  idDelete(&I);
959  l1->CleanUp();
960  r->CleanUp();
961  return FALSE;
962}
963static BOOLEAN jjA_L_LIST(leftv l, leftv r)
964/* left side: list/def, has to be a "real" variable
965*  right side: expression list
966*/
967{
968  int sl = r->listLength();
969  lists L=(lists)omAllocBin(slists_bin);
970  lists oldL;
971  leftv h=NULL,o_r=r;
972  int i;
973  int rt;
974
975  L->Init(sl);
976  for (i=0;i<sl;i++)
977  {
978    if (h!=NULL) { /* e.g. not in the first step:
979                   * h is the pointer to the old sleftv,
980                   * r is the pointer to the next sleftv
981                   * (in this moment) */
982                   h->next=r;
983                 }
984    h=r;
985    r=r->next;
986    h->next=NULL;
987    rt=h->Typ();
988    if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
989    {
990      L->Clean();
991      Werror("`%s` is undefined",h->Fullname());
992      //listall();
993      goto err;
994    }
995    //if ((rt==RING_CMD)||(rt==QRING_CMD))
996    //{
997    //  L->m[i].rtyp=rt;
998    //  L->m[i].data=h->Data();
999    //  ((ring)L->m[i].data)->ref++;
1000    //}
1001    //else
1002      L->m[i].CleanUp();
1003      L->m[i].Copy(h);
1004      if(errorreported)
1005      {
1006        L->Clean();
1007        goto err;
1008      }
1009  }
1010  oldL=(lists)l->Data(); 
1011  if (oldL!=NULL) oldL->Clean();
1012  if (l->rtyp==IDHDL)
1013  {
1014    IDLIST((idhdl)l->data)=L;
1015    IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1016    ipMoveId((idhdl)l->data);
1017  }
1018  else
1019  {
1020    l->LData()->data=L;
1021    if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1022      l->rtyp=LIST_CMD;
1023  }
1024err:
1025  o_r->CleanUp();
1026  return errorreported;
1027}
1028static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1029{
1030  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1031  leftv hh=r;
1032  int i = 0;
1033  while (hh!=NULL)
1034  {
1035    if (i>=iv->length()) break;
1036    if (hh->Typ() == INT_CMD)
1037    {
1038      (*iv)[i++] = (int)((long)(hh->Data()));
1039    }
1040    else if ((hh->Typ() == INTVEC_CMD)
1041            ||(hh->Typ() == INTMAT_CMD))
1042    {
1043      intvec *ivv = (intvec *)(hh->Data());
1044      int ll = 0,l = si_min(ivv->length(),iv->length());
1045      for (; l>0; l--)
1046      {
1047        (*iv)[i++] = (*ivv)[ll++];
1048      }
1049    }
1050    else
1051    {
1052      delete iv;
1053      return TRUE;
1054    }
1055    hh = hh->next;
1056  }
1057  if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1058  IDINTVEC((idhdl)l->data)=iv;
1059  return FALSE;
1060}
1061static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1062{
1063  /* left side is string, right side is list of string*/
1064  leftv hh=r;
1065  int sl = 1;
1066  char *s;
1067  char *t;
1068  int tl;
1069  /* find the length */
1070  while (hh!=NULL)
1071  {
1072    if (hh->Typ()!= STRING_CMD)
1073    {
1074      return TRUE;
1075    }
1076    sl += strlen((char *)hh->Data());
1077    hh = hh->next;
1078  }
1079  s = (char * )omAlloc(sl);
1080  sl=0;
1081  hh = r;
1082  while (hh!=NULL)
1083  {
1084    t=(char *)hh->Data();
1085    tl=strlen(t);
1086    memcpy(s+sl,t,tl);
1087    sl+=tl;
1088    hh = hh->next;
1089  }
1090  s[sl]='\0';
1091  omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1092  IDDATA((idhdl)(l->data))=s;
1093  return FALSE;
1094}
1095static BOOLEAN jjA_LIST_L(leftv l,leftv r)
1096{
1097  /*left side are something, right side are lists*/
1098  /*e.g. a,b,c=l */
1099  //int ll=l->listLength();
1100  if (l->listLength()==1) return jiAssign_1(l,r);
1101  BOOLEAN nok;
1102  sleftv t;
1103  leftv h;
1104  lists L=(lists)r->Data();
1105  int rl=L->nr;
1106  int i=0;
1107
1108  memset(&t,0,sizeof(sleftv));
1109  while ((i<=rl)&&(l!=NULL))
1110  {
1111    memset(&t,0,sizeof(sleftv));
1112    t.Copy(&L->m[i]);
1113    h=l->next;
1114    l->next=NULL;
1115    nok=jiAssign_1(l,&t);
1116    if (nok) return TRUE;
1117    i++;
1118    l=h;
1119  }
1120  r->CleanUp();
1121  return FALSE;
1122}
1123static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1124{
1125  /* right side is matrix, left side is list (of poly)*/
1126  BOOLEAN nok=FALSE;
1127  int i;
1128  matrix m=(matrix)r->CopyD(MATRIX_CMD);
1129  leftv h;
1130  leftv ol=l;
1131  leftv o_r=r;
1132  sleftv t;
1133  memset(&t,0,sizeof(sleftv));
1134  t.rtyp=POLY_CMD;
1135  int mxn=MATROWS(m)*MATCOLS(m);
1136  loop
1137  {
1138    i=0;
1139    while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1140    {
1141      t.data=(char *)m->m[i];
1142      m->m[i]=NULL;
1143      h=l->next;
1144      l->next=NULL;
1145      nok=jiAssign_1(l,&t);
1146      l->next=h;
1147      if (nok)
1148      {
1149        idDelete((ideal *)&m);
1150        goto ende;
1151      }
1152      i++;
1153      l=h;
1154    }
1155    idDelete((ideal *)&m);
1156    h=r;
1157    r=r->next;
1158    if (l==NULL)
1159    {
1160      if (r!=NULL)
1161      {
1162        Warn("list length mismatch in assign (l>r)");
1163        nok=TRUE;
1164      }
1165      break;
1166    }
1167    else if (r==NULL)
1168    {
1169      Warn("list length mismatch in assign (l<r)");
1170      nok=TRUE;
1171      break;
1172    }
1173    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1174    {
1175      m=(matrix)r->CopyD(MATRIX_CMD);
1176      mxn=MATROWS(m)*MATCOLS(m);
1177    }
1178    else if (r->Typ()==POLY_CMD)
1179    {
1180      m=mpNew(1,1);
1181      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1182      pNormalize(MATELEM(m,1,1));
1183      mxn=1;
1184    }
1185    else
1186    {
1187      nok=TRUE;
1188      break;
1189    }
1190  }
1191ende:
1192  o_r->CleanUp();
1193  ol->CleanUp();
1194  return nok;
1195}
1196static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1197{
1198  /*left side are strings, right side is a string*/
1199  /*e.g. s[2..3]="12" */
1200  /*the case s=t[1..4] is handled in iiAssign,
1201  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1202  int ll=l->listLength();
1203  int rl=r->listLength();
1204  BOOLEAN nok=FALSE;
1205  sleftv t;
1206  leftv h,l1=l;
1207  int i=0;
1208  char *ss;
1209  char *s=(char *)r->Data();
1210  int sl=strlen(s);
1211
1212  memset(&t,0,sizeof(sleftv));
1213  t.rtyp=STRING_CMD;
1214  while ((i<sl)&&(l!=NULL))
1215  {
1216    ss=(char *)omAlloc(2);
1217    ss[1]='\0';
1218    ss[0]=s[i];
1219    t.data=ss;
1220    h=l->next;
1221    l->next=NULL;
1222    nok=jiAssign_1(l,&t);
1223    if (nok)
1224    {
1225      break;
1226    }
1227    i++;
1228    l=h;
1229  }
1230  r->CleanUp();
1231  l1->CleanUp();
1232  return nok;
1233}
1234static BOOLEAN jiAssign_list(leftv l, leftv r)
1235{
1236  int i=l->e->start-1;
1237  if (i<0)
1238  {
1239    Werror("index[%d] must be positive",i+1);
1240    return TRUE;
1241  }
1242  if(l->attribute!=NULL)
1243  {
1244    atKillAll((idhdl)l);
1245    l->attribute=NULL;
1246  }
1247  l->flag=0;
1248  lists li;
1249  if (l->rtyp==IDHDL)
1250  {
1251    li=IDLIST((idhdl)l->data);
1252  }
1253  else
1254  {
1255    li=(lists)l->data;
1256  }
1257  if (i>li->nr)
1258  {
1259    li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1260    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1261    int j=li->nr+1;
1262    for(;j<=i;j++)
1263      li->m[j].rtyp=DEF_CMD;
1264    li->nr=i;
1265  }
1266  leftv ld=&(li->m[i]);
1267  ld->e=l->e->next;
1268  BOOLEAN b;
1269  if (/*(ld->rtyp!=LIST_CMD)
1270  &&*/(ld->e==NULL)
1271  &&(ld->Typ()!=r->Typ()))
1272  {
1273    sleftv tmp;
1274    memset(&tmp,0,sizeof(sleftv));
1275    tmp.rtyp=DEF_CMD;
1276    b=iiAssign(&tmp,r);
1277    ld->CleanUp();
1278    memcpy(ld,&tmp,sizeof(sleftv));
1279  }
1280  else
1281  {
1282    b=iiAssign(ld,r);
1283    if (l->e!=NULL) l->e->next=ld->e;
1284    ld->e=NULL;
1285  }
1286  return b;
1287}
1288static BOOLEAN jiAssign_rec(leftv l, leftv r)
1289{
1290  leftv l1=l;
1291  leftv r1=r;
1292  leftv lrest;
1293  leftv rrest;
1294  BOOLEAN b;
1295  do
1296  {
1297    lrest=l->next;
1298    rrest=r->next;
1299    l->next=NULL;
1300    r->next=NULL;
1301    b=iiAssign(l,r);
1302    l->next=lrest;
1303    r->next=rrest;
1304    l=lrest;
1305    r=rrest;
1306  } while  ((!b)&&(l!=NULL));
1307  l1->CleanUp();
1308  r1->CleanUp();
1309  return b;
1310}
1311BOOLEAN iiAssign(leftv l, leftv r)
1312{
1313  if (errorreported) return TRUE;
1314  int ll=l->listLength();
1315  int rl;
1316  int lt=l->Typ();
1317  int rt=NONE;
1318  BOOLEAN b;
1319
1320  if(l->attribute!=NULL)
1321  {
1322    if (l->rtyp==IDHDL)
1323    {
1324      atKillAll((idhdl)l->data);
1325      l->attribute=NULL;
1326    }
1327    else
1328      atKillAll((idhdl)l);
1329  }
1330  if(l->rtyp==IDHDL)
1331  {
1332    IDFLAG((idhdl)l->data)=0;
1333  }
1334  l->flag=0;
1335  if (ll==1)
1336  {
1337    /* l[..] = ... */
1338    if((l->e!=NULL)
1339    && (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1340      || (l->rtyp==LIST_CMD)))
1341    {
1342       b=jiAssign_list(l,r);
1343       if(!b)
1344       {
1345         //Print("jjA_L_LIST: - 2 \n");
1346         if((l->rtyp==IDHDL) && (l->data!=NULL))
1347         {
1348           ipMoveId((idhdl)l->data);
1349           l->attribute=IDATTR((idhdl)l->data);
1350           l->flag=IDFLAG((idhdl)l->data);
1351         }
1352       }
1353       r->CleanUp();
1354       Subexpr h;
1355       while (l->e!=NULL)
1356       {
1357         h=l->e->next;
1358         omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1359         l->e=h;
1360       }
1361       return b;
1362    }
1363    rl=r->listLength();
1364    if (rl==1)
1365    {
1366      /* system variables = ... */
1367      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1368      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1369      {
1370        b=iiAssign_sys(l,r);
1371        r->CleanUp();
1372        //l->CleanUp();
1373        return b;
1374      }
1375      rt=r->Typ();
1376      /* a = ... */
1377      if ((lt!=MATRIX_CMD)
1378      &&(lt!=INTMAT_CMD)
1379      &&((lt==rt)||(lt!=LIST_CMD)))
1380      {
1381        b=jiAssign_1(l,r);
1382        if (l->rtyp==IDHDL)
1383        {
1384          if ((lt==DEF_CMD)||(lt==LIST_CMD))
1385          {
1386            ipMoveId((idhdl)l->data);
1387          }
1388          l->attribute=IDATTR((idhdl)l->data);
1389          l->flag=IDFLAG((idhdl)l->data);
1390          l->CleanUp();
1391        }
1392        r->CleanUp();
1393        return b;
1394      }
1395      if (((lt!=LIST_CMD)
1396        &&((rt==MATRIX_CMD)
1397          ||(rt==INTMAT_CMD)
1398          ||(rt==INTVEC_CMD)
1399          ||(rt==MODUL_CMD)))
1400      ||((lt==LIST_CMD)
1401        &&(rt==RESOLUTION_CMD))
1402      )
1403      {
1404        b=jiAssign_1(l,r);
1405        if((l->rtyp==IDHDL)&&(l->data!=NULL))
1406        {
1407          if ((lt==DEF_CMD) || (lt==LIST_CMD))
1408          {
1409            //Print("ipAssign - 3.0\n");
1410            ipMoveId((idhdl)l->data);
1411          }
1412          l->attribute=IDATTR((idhdl)l->data);
1413          l->flag=IDFLAG((idhdl)l->data);
1414        }
1415        r->CleanUp();
1416        Subexpr h;
1417        while (l->e!=NULL)
1418        {
1419          h=l->e->next;
1420          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1421          l->e=h;
1422        }
1423        return b;
1424      }
1425    }
1426    if (rt==NONE) rt=r->Typ();
1427  }
1428  else if (ll==(rl=r->listLength()))
1429  {
1430    b=jiAssign_rec(l,r);
1431    return b;
1432  }
1433  else
1434  {
1435    if (rt==NONE) rt=r->Typ();
1436    if (rt==INTVEC_CMD)
1437      return jiA_INTVEC_L(l,r);
1438    else if (rt==VECTOR_CMD)
1439      return jiA_VECTOR_L(l,r);
1440    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1441      return jiA_MATRIX_L(l,r);
1442    else if ((rt==STRING_CMD)&&(rl==1))
1443      return jiA_STRING_L(l,r);
1444    Werror("length of lists in assignment does not match (l:%d,r:%d)",
1445      ll,rl);
1446    return TRUE;
1447  }
1448
1449  leftv hh=r;
1450  BOOLEAN nok=FALSE;
1451  BOOLEAN map_assign=FALSE;
1452  switch (lt)
1453  {
1454    case INTVEC_CMD:
1455      nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
1456      break;
1457    case INTMAT_CMD:
1458    {
1459      nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
1460      break;
1461    }
1462    case MAP_CMD:
1463    {
1464      // first element in the list sl (r) must be a ring
1465      if (((rt == RING_CMD)||(rt == QRING_CMD))&&(r->e==NULL))
1466      {
1467        omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
1468        IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
1469        /* advance the expressionlist to get the next element after the ring */
1470        hh = r->next;
1471        //r=hh;
1472      }
1473      else
1474      {
1475        WerrorS("expected ring-name");
1476        nok=TRUE;
1477        break;
1478      }
1479      if (hh==NULL) /* map-assign: map f=r; */
1480      {
1481        WerrorS("expected image ideal");
1482        nok=TRUE;
1483        break;
1484      }
1485      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
1486        return jiAssign_1(l,hh); /* map-assign: map f=r,i; */
1487      //no break, handle the rest like an ideal:
1488      map_assign=TRUE;
1489    }
1490    case MATRIX_CMD:
1491    case IDEAL_CMD:
1492    case MODUL_CMD:
1493    {
1494      sleftv t;
1495      matrix olm = (matrix)l->Data();
1496      int rk=olm->rank;
1497      char *pr=((map)olm)->preimage;
1498      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
1499      matrix lm ;
1500      int  num;
1501      int j,k;
1502      int i=0;
1503      int mtyp=MATRIX_CMD; /*Type of left side object*/
1504      int etyp=POLY_CMD;   /*Type of elements of left side object*/
1505
1506      if (lt /*l->Typ()*/==MATRIX_CMD)
1507      {
1508        num=olm->cols()*olm->rows();
1509        lm=mpNew(olm->rows(),olm->cols());
1510      }
1511      else /* IDEAL_CMD or MODUL_CMD */
1512      {
1513        num=exprlist_length(hh);
1514        lm=(matrix)idInit(num,1);
1515        rk=1;
1516        if (module_assign)
1517        {
1518          mtyp=MODUL_CMD;
1519          etyp=VECTOR_CMD;
1520        }
1521      }
1522
1523      int ht;
1524      loop
1525      {
1526        if (hh==NULL)
1527          break;
1528        else
1529        {
1530          matrix rm;
1531          ht=hh->Typ();
1532          if ((j=iiTestConvert(ht,etyp))!=0)
1533          {
1534            nok=iiConvert(ht,etyp,j,hh,&t);
1535            hh->next=t.next;
1536            if (nok) break;
1537            lm->m[i]=(poly)t.CopyD(etyp);
1538            pNormalize(lm->m[i]);
1539            if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
1540            i++;
1541          }
1542          else
1543          if ((j=iiTestConvert(ht,mtyp))!=0)
1544          {
1545            nok=iiConvert(ht,mtyp,j,hh,&t);
1546            hh->next=t.next;
1547            if (nok) break;
1548            rm = (matrix)t.CopyD(mtyp);
1549            if (module_assign)
1550            {
1551              j = si_min(num,rm->cols());
1552              rk=si_max(rk,(int)rm->rank);
1553            }
1554            else
1555              j = si_min(num-i,rm->rows() * rm->cols());
1556            for(k=0;k<j;k++,i++)
1557            {
1558              lm->m[i]=rm->m[k];
1559              pNormalize(lm->m[i]);
1560              rm->m[k]=NULL;
1561            }
1562            idDelete((ideal *)&rm);
1563          }
1564          else
1565          {
1566            nok=TRUE;
1567            break;
1568          }
1569          t.next=NULL;t.CleanUp();
1570          if (i==num) break;
1571          hh=hh->next;
1572        }
1573      }
1574      if (nok)
1575        idDelete((ideal *)&lm);
1576      else
1577      {
1578        idDelete((ideal *)&olm);
1579        if (module_assign)   lm->rank=rk;
1580        else if (map_assign) ((map)lm)->preimage=pr;
1581        l=l->LData();
1582        if (l->rtyp==IDHDL)
1583          IDMATRIX((idhdl)l->data)=lm;
1584        else
1585          l->data=(char *)lm;
1586      }
1587      break;
1588    }
1589    case STRING_CMD:
1590      nok=jjA_L_STRING(l,r);
1591      break;
1592    case DEF_CMD:
1593    case LIST_CMD:
1594      nok=jjA_L_LIST(l,r);
1595      break;
1596    case NONE:
1597    case 0:
1598      Werror("cannot assign to %s",l->Fullname());
1599      nok=TRUE;
1600      break;
1601    default:
1602      WerrorS("assign not impl.");
1603      nok=TRUE;
1604      break;
1605  } /* end switch: typ */
1606  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
1607  r->CleanUp();
1608  return nok;
1609}
1610BOOLEAN jjIMPORTFROM(leftv res, leftv u, leftv v)
1611{
1612  #ifdef HAVE_NS
1613  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
1614  assume(u->Typ()==PACKAGE_CMD);
1615  char *vn=(char *)v->Name();
1616  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
1617  if (h!=NULL)
1618  {
1619    //check for existence
1620    if (((package)(u->Data()))==basePack)
1621    {
1622      WarnS("source and destination packages are identical");
1623      return FALSE;
1624    }
1625    idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
1626    if (t!=NULL)
1627    {
1628      Warn("redefining `%s`",vn);
1629      killhdl(t);
1630    }
1631    sleftv tmp_expr;
1632    if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
1633    sleftv h_expr;
1634    memset(&h_expr,0,sizeof(h_expr));
1635    h_expr.rtyp=IDHDL;
1636    h_expr.data=h;
1637    h_expr.name=vn;
1638    return iiAssign(&tmp_expr,&h_expr);
1639  }
1640  else
1641  {
1642    Werror("`%s` not found in `%s`",v->Name(), u->Name());
1643    return TRUE;
1644  }
1645#endif
1646  return FALSE;
1647}
Note: See TracBrowser for help on using the repository browser.