source: git/Singular/ipassign.cc @ 8db6c3

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