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

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