source: git/Singular/ipassign.cc @ 9fb928a

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