source: git/Singular/ipassign.cc @ b787fb6

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