source: git/Singular/ipassign.cc @ 1085d4

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