source: git/Singular/ipassign.cc @ db91b4

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