source: git/Singular/ipassign.cc @ b1f3b55

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