source: git/Singular/ipassign.cc @ 4f80bb

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