source: git/Singular/ipassign.cc @ 81418fb

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