source: git/Singular/ipassign.cc @ 61a050

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