source: git/Singular/ipassign.cc @ c4d065

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