source: git/Singular/ipassign.cc @ 0a7bf5

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