source: git/Singular/ipassign.cc @ 0d008d

fieker-DuValspielwiese
Last change on this file since 0d008d was 0d008d, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix: allow assignment def=def (for "undefinig" list entries) (cherry picked from commit ee5be4b44ef3710c997a64552e4bf48a604dd4b3) Signed-off-by: Andreas Steenpass <steenpass@mathematik.uni-kl.de>
  • 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  if (lt>MAX_TOK)
890  {
891    blackbox *bb=getBlackboxStuff(lt);
892#ifdef BLACKBOX_DEVEL
893    Print("bb-assign: bb=%lx\n",bb);
894#endif
895    return (bb==NULL) || bb->blackbox_Assign(l,r);
896  }
897  while (((dAssign[i].res!=lt)
898      || (dAssign[i].arg!=rt))
899    && (dAssign[i].res!=0)) i++;
900  if (dAssign[i].res!=0)
901  {
902    if (TEST_V_ALLWARN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt));
903    BOOLEAN b;
904    b=dAssign[i].p(ld,r,l->e);
905    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
906    {
907      l->flag=ld->flag;
908      l->attribute=ld->attribute;
909    }
910    return b;
911  }
912  // implicite type conversion ----------------------------------------------
913  if (dAssign[i].res==0)
914  {
915    int ri;
916    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
917    BOOLEAN failed=FALSE;
918    i=0;
919    while ((dAssign[i].res!=lt)
920      && (dAssign[i].res!=0)) i++;
921    while (dAssign[i].res==lt)
922    {
923      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
924      {
925        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
926        if(!failed)
927        {
928          failed= dAssign[i].p(ld,rn,l->e);
929          if (TEST_V_ALLWARN)
930            Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed);
931        }
932        // everything done, clean up temp. variables
933        rn->CleanUp();
934        omFreeBin((ADDRESS)rn, sleftv_bin);
935        if (failed)
936        {
937          // leave loop, goto error handling
938          break;
939        }
940        else
941        {
942          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
943          {
944            l->flag=ld->flag;
945            l->attribute=ld->attribute;
946          }
947          // everything ok, return
948          return FALSE;
949        }
950     }
951     i++;
952    }
953    // error handling ---------------------------------------------------
954    if (!errorreported)
955    {
956      if ((l->rtyp==IDHDL) && (l->e==NULL))
957        Werror("`%s`(%s) = `%s` is not supported",
958          Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
959      else
960         Werror("`%s` = `%s` is not supported"
961             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
962      if (BVERBOSE(V_SHOW_USE))
963      {
964        i=0;
965        while ((dAssign[i].res!=lt)
966          && (dAssign[i].res!=0)) i++;
967        while (dAssign[i].res==lt)
968        {
969          Werror("expected `%s` = `%s`"
970              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
971          i++;
972        }
973      }
974    }
975  }
976  return TRUE;
977}
978/*2
979* assign sys_var = val
980*/
981static BOOLEAN iiAssign_sys(leftv l, leftv r)
982{
983  int rt=r->Typ();
984
985  if (rt==0)
986  {
987    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
988    return TRUE;
989  }
990  int i=0;
991  int lt=l->rtyp;
992  while (((dAssign_sys[i].res!=lt)
993      || (dAssign_sys[i].arg!=rt))
994    && (dAssign_sys[i].res!=0)) i++;
995  if (dAssign_sys[i].res!=0)
996  {
997    if (!dAssign_sys[i].p(l,r))
998    {
999      // everything ok, clean up
1000      return FALSE;
1001    }
1002  }
1003  // implicite type conversion ----------------------------------------------
1004  if (dAssign_sys[i].res==0)
1005  {
1006    int ri;
1007    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1008    BOOLEAN failed=FALSE;
1009    i=0;
1010    while ((dAssign_sys[i].res!=lt)
1011      && (dAssign_sys[i].res!=0)) i++;
1012    while (dAssign_sys[i].res==lt)
1013    {
1014      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
1015      {
1016        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
1017            || (dAssign_sys[i].p(l,rn)));
1018        // everything done, clean up temp. variables
1019        rn->CleanUp();
1020        omFreeBin((ADDRESS)rn, sleftv_bin);
1021        if (failed)
1022        {
1023          // leave loop, goto error handling
1024          break;
1025        }
1026        else
1027        {
1028          // everything ok, return
1029          return FALSE;
1030        }
1031     }
1032     i++;
1033    }
1034    // error handling ---------------------------------------------------
1035    if(!errorreported)
1036    {
1037      Werror("`%s` = `%s` is not supported"
1038             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1039      if (BVERBOSE(V_SHOW_USE))
1040      {
1041        i=0;
1042        while ((dAssign_sys[i].res!=lt)
1043          && (dAssign_sys[i].res!=0)) i++;
1044        while (dAssign_sys[i].res==lt)
1045        {
1046          Werror("expected `%s` = `%s`"
1047              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
1048          i++;
1049        }
1050      }
1051    }
1052  }
1053  return TRUE;
1054}
1055static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
1056{
1057  /* right side is intvec, left side is list (of int)*/
1058  BOOLEAN nok;
1059  int i=0;
1060  leftv l1=l;
1061  leftv h;
1062  sleftv t;
1063  intvec *iv=(intvec *)r->Data();
1064  memset(&t,0,sizeof(sleftv));
1065  t.rtyp=INT_CMD;
1066  while ((i<iv->length())&&(l!=NULL))
1067  {
1068    t.data=(char *)(*iv)[i];
1069    h=l->next;
1070    l->next=NULL;
1071    nok=jiAssign_1(l,&t);
1072    l->next=h;
1073    if (nok) return TRUE;
1074    i++;
1075    l=h;
1076  }
1077  l1->CleanUp();
1078  r->CleanUp();
1079  return FALSE;
1080}
1081static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
1082{
1083  /* right side is vector, left side is list (of poly)*/
1084  BOOLEAN nok;
1085  leftv l1=l;
1086  ideal I=idVec2Ideal((poly)r->Data());
1087  leftv h;
1088  sleftv t;
1089  int i=0;
1090  while (l!=NULL)
1091  {
1092    memset(&t,0,sizeof(sleftv));
1093    t.rtyp=POLY_CMD;
1094    if (i>=IDELEMS(I))
1095    {
1096      t.data=NULL;
1097    }
1098    else
1099    {
1100      t.data=(char *)I->m[i];
1101      I->m[i]=NULL;
1102    }
1103    h=l->next;
1104    l->next=NULL;
1105    nok=jiAssign_1(l,&t);
1106    l->next=h;
1107    t.CleanUp();
1108    if (nok)
1109    {
1110      idDelete(&I);
1111      return TRUE;
1112    }
1113    i++;
1114    l=h;
1115  }
1116  idDelete(&I);
1117  l1->CleanUp();
1118  r->CleanUp();
1119  //if (TEST_V_QRING && (currQuotient!=NULL)) jjNormalizeQRingP(l);
1120  return FALSE;
1121}
1122static BOOLEAN jjA_L_LIST(leftv l, leftv r)
1123/* left side: list/def, has to be a "real" variable
1124*  right side: expression list
1125*/
1126{
1127  int sl = r->listLength();
1128  lists L=(lists)omAllocBin(slists_bin);
1129  lists oldL;
1130  leftv h=NULL,o_r=r;
1131  int i;
1132  int rt;
1133
1134  L->Init(sl);
1135  for (i=0;i<sl;i++)
1136  {
1137    if (h!=NULL) { /* e.g. not in the first step:
1138                   * h is the pointer to the old sleftv,
1139                   * r is the pointer to the next sleftv
1140                   * (in this moment) */
1141                   h->next=r;
1142                 }
1143    h=r;
1144    r=r->next;
1145    h->next=NULL;
1146    rt=h->Typ();
1147    if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
1148    {
1149      L->Clean();
1150      Werror("`%s` is undefined",h->Fullname());
1151      //listall();
1152      goto err;
1153    }
1154    //if ((rt==RING_CMD)||(rt==QRING_CMD))
1155    //{
1156    //  L->m[i].rtyp=rt;
1157    //  L->m[i].data=h->Data();
1158    //  ((ring)L->m[i].data)->ref++;
1159    //}
1160    //else
1161      L->m[i].CleanUp();
1162      L->m[i].Copy(h);
1163      if(errorreported)
1164      {
1165        L->Clean();
1166        goto err;
1167      }
1168  }
1169  oldL=(lists)l->Data();
1170  if (oldL!=NULL) oldL->Clean();
1171  if (l->rtyp==IDHDL)
1172  {
1173    IDLIST((idhdl)l->data)=L;
1174    IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1175    ipMoveId((idhdl)l->data);
1176  }
1177  else
1178  {
1179    l->LData()->data=L;
1180    if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1181      l->rtyp=LIST_CMD;
1182  }
1183err:
1184  o_r->CleanUp();
1185  return errorreported;
1186}
1187static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1188{
1189  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1190  leftv hh=r;
1191  int i = 0;
1192  while (hh!=NULL)
1193  {
1194    if (i>=iv->length())
1195    {
1196      if (TEST_V_ALLWARN)
1197      {
1198        Warn("expression list length(%d) does not match intmat size(%d)",
1199             iv->length()+exprlist_length(hh),iv->length());
1200      }
1201      break;
1202    }
1203    if (hh->Typ() == INT_CMD)
1204    {
1205      (*iv)[i++] = (int)((long)(hh->Data()));
1206    }
1207    else if ((hh->Typ() == INTVEC_CMD)
1208            ||(hh->Typ() == INTMAT_CMD))
1209    {
1210      intvec *ivv = (intvec *)(hh->Data());
1211      int ll = 0,l = si_min(ivv->length(),iv->length());
1212      for (; l>0; l--)
1213      {
1214        (*iv)[i++] = (*ivv)[ll++];
1215      }
1216    }
1217    else
1218    {
1219      delete iv;
1220      return TRUE;
1221    }
1222    hh = hh->next;
1223  }
1224  if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1225  IDINTVEC((idhdl)l->data)=iv;
1226  return FALSE;
1227}
1228static BOOLEAN jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat *bim)
1229{
1230  /* left side is bigintmat, right side is list (of int,intvec,intmat)*/
1231  leftv hh=r;
1232  int i = 0;
1233  if (bim->length()==0) { WerrorS("bigintmat is 1x0"); delete bim; return TRUE; }
1234  while (hh!=NULL)
1235  {
1236    if (i>=bim->cols()*bim->rows())
1237    {
1238      if (TEST_V_ALLWARN)
1239      {
1240        Warn("expression list length(%d) does not match bigintmat size(%d x %d)",
1241              exprlist_length(hh),bim->rows(),bim->cols());
1242      }
1243      break;
1244    }
1245    if (hh->Typ() == INT_CMD)
1246    {
1247      number tp = n_Init((int)((long)(hh->Data())), coeffs_BIGINT);
1248      bim->set(i++, tp);
1249      n_Delete(&tp, coeffs_BIGINT);
1250    }
1251    else if (hh->Typ() == BIGINT_CMD)
1252    {
1253      bim->set(i++, (number)(hh->Data()));
1254    }
1255    /*
1256    ((hh->Typ() == INTVEC_CMD)
1257            ||(hh->Typ() == INTMAT_CMD))
1258    {
1259      intvec *ivv = (intvec *)(hh->Data());
1260      int ll = 0,l = si_min(ivv->length(),iv->length());
1261      for (; l>0; l--)
1262      {
1263        (*iv)[i++] = (*ivv)[ll++];
1264      }
1265    }*/
1266    else
1267    {
1268      delete bim;
1269      return TRUE;
1270    }
1271    hh = hh->next;
1272  }
1273  if (IDBIMAT((idhdl)l->data)!=NULL) delete IDBIMAT((idhdl)l->data);
1274  IDBIMAT((idhdl)l->data)=bim;
1275  return FALSE;
1276}
1277static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1278{
1279  /* left side is string, right side is list of string*/
1280  leftv hh=r;
1281  int sl = 1;
1282  char *s;
1283  char *t;
1284  int tl;
1285  /* find the length */
1286  while (hh!=NULL)
1287  {
1288    if (hh->Typ()!= STRING_CMD)
1289    {
1290      return TRUE;
1291    }
1292    sl += strlen((char *)hh->Data());
1293    hh = hh->next;
1294  }
1295  s = (char * )omAlloc(sl);
1296  sl=0;
1297  hh = r;
1298  while (hh!=NULL)
1299  {
1300    t=(char *)hh->Data();
1301    tl=strlen(t);
1302    memcpy(s+sl,t,tl);
1303    sl+=tl;
1304    hh = hh->next;
1305  }
1306  s[sl]='\0';
1307  omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1308  IDDATA((idhdl)(l->data))=s;
1309  return FALSE;
1310}
1311static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1312{
1313  /* right side is matrix, left side is list (of poly)*/
1314  BOOLEAN nok=FALSE;
1315  int i;
1316  matrix m=(matrix)r->CopyD(MATRIX_CMD);
1317  leftv h;
1318  leftv ol=l;
1319  leftv o_r=r;
1320  sleftv t;
1321  memset(&t,0,sizeof(sleftv));
1322  t.rtyp=POLY_CMD;
1323  int mxn=MATROWS(m)*MATCOLS(m);
1324  loop
1325  {
1326    i=0;
1327    while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1328    {
1329      t.data=(char *)m->m[i];
1330      m->m[i]=NULL;
1331      h=l->next;
1332      l->next=NULL;
1333      nok=jiAssign_1(l,&t);
1334      l->next=h;
1335      if (nok)
1336      {
1337        idDelete((ideal *)&m);
1338        goto ende;
1339      }
1340      i++;
1341      l=h;
1342    }
1343    idDelete((ideal *)&m);
1344    h=r;
1345    r=r->next;
1346    if (l==NULL)
1347    {
1348      if (r!=NULL)
1349      {
1350        Warn("list length mismatch in assign (l>r)");
1351        nok=TRUE;
1352      }
1353      break;
1354    }
1355    else if (r==NULL)
1356    {
1357      Warn("list length mismatch in assign (l<r)");
1358      nok=TRUE;
1359      break;
1360    }
1361    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1362    {
1363      m=(matrix)r->CopyD(MATRIX_CMD);
1364      mxn=MATROWS(m)*MATCOLS(m);
1365    }
1366    else if (r->Typ()==POLY_CMD)
1367    {
1368      m=mpNew(1,1);
1369      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1370      pNormalize(MATELEM(m,1,1));
1371      mxn=1;
1372    }
1373    else
1374    {
1375      nok=TRUE;
1376      break;
1377    }
1378  }
1379ende:
1380  o_r->CleanUp();
1381  ol->CleanUp();
1382  return nok;
1383}
1384static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1385{
1386  /*left side are strings, right side is a string*/
1387  /*e.g. s[2..3]="12" */
1388  /*the case s=t[1..4] is handled in iiAssign,
1389  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1390  BOOLEAN nok=FALSE;
1391  sleftv t;
1392  leftv h,l1=l;
1393  int i=0;
1394  char *ss;
1395  char *s=(char *)r->Data();
1396  int sl=strlen(s);
1397
1398  memset(&t,0,sizeof(sleftv));
1399  t.rtyp=STRING_CMD;
1400  while ((i<sl)&&(l!=NULL))
1401  {
1402    ss=(char *)omAlloc(2);
1403    ss[1]='\0';
1404    ss[0]=s[i];
1405    t.data=ss;
1406    h=l->next;
1407    l->next=NULL;
1408    nok=jiAssign_1(l,&t);
1409    if (nok)
1410    {
1411      break;
1412    }
1413    i++;
1414    l=h;
1415  }
1416  r->CleanUp();
1417  l1->CleanUp();
1418  return nok;
1419}
1420static BOOLEAN jiAssign_list(leftv l, leftv r)
1421{
1422  int i=l->e->start-1;
1423  if (i<0)
1424  {
1425    Werror("index[%d] must be positive",i+1);
1426    return TRUE;
1427  }
1428  if(l->attribute!=NULL)
1429  {
1430    atKillAll((idhdl)l);
1431    l->attribute=NULL;
1432  }
1433  l->flag=0;
1434  lists li;
1435  if (l->rtyp==IDHDL)
1436  {
1437    li=IDLIST((idhdl)l->data);
1438  }
1439  else
1440  {
1441    li=(lists)l->data;
1442  }
1443  if (i>li->nr)
1444  {
1445    li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1446    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1447    int j=li->nr+1;
1448    for(;j<=i;j++)
1449      li->m[j].rtyp=DEF_CMD;
1450    li->nr=i;
1451  }
1452  leftv ld=&(li->m[i]);
1453  ld->e=l->e->next;
1454  BOOLEAN b;
1455  if (/*(ld->rtyp!=LIST_CMD)
1456  &&*/(ld->e==NULL)
1457  &&(ld->Typ()!=r->Typ()))
1458  {
1459    sleftv tmp;
1460    memset(&tmp,0,sizeof(sleftv));
1461    tmp.rtyp=DEF_CMD;
1462    b=iiAssign(&tmp,r);
1463    ld->CleanUp();
1464    memcpy(ld,&tmp,sizeof(sleftv));
1465  }
1466  else
1467  {
1468    b=iiAssign(ld,r);
1469    if (l->e!=NULL) l->e->next=ld->e;
1470    ld->e=NULL;
1471  }
1472  return b;
1473}
1474static BOOLEAN jiAssign_rec(leftv l, leftv r)
1475{
1476  leftv l1=l;
1477  leftv r1=r;
1478  leftv lrest;
1479  leftv rrest;
1480  BOOLEAN b;
1481  do
1482  {
1483    lrest=l->next;
1484    rrest=r->next;
1485    l->next=NULL;
1486    r->next=NULL;
1487    b=iiAssign(l,r);
1488    l->next=lrest;
1489    r->next=rrest;
1490    l=lrest;
1491    r=rrest;
1492  } while  ((!b)&&(l!=NULL));
1493  l1->CleanUp();
1494  r1->CleanUp();
1495  return b;
1496}
1497BOOLEAN iiAssign(leftv l, leftv r)
1498{
1499  if (errorreported) return TRUE;
1500  int ll=l->listLength();
1501  int rl;
1502  int lt=l->Typ();
1503  int rt=NONE;
1504  BOOLEAN b;
1505  if (l->rtyp==ALIAS_CMD)
1506  {
1507    Werror("`%s` is read-only",l->Name());
1508  }
1509
1510  if (l->rtyp==IDHDL)
1511  {
1512    atKillAll((idhdl)l->data);
1513    IDFLAG((idhdl)l->data)=0;
1514    l->attribute=NULL;
1515  }
1516  else if (l->attribute!=NULL)
1517    atKillAll((idhdl)l);
1518  l->flag=0;
1519  if (ll==1)
1520  {
1521    /* l[..] = ... */
1522    if(l->e!=NULL)
1523    {
1524      BOOLEAN like_lists=0;
1525      blackbox *bb=NULL;
1526      int bt;
1527      if (((bt=l->rtyp)>MAX_TOK)
1528      || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1529      {
1530        bb=getBlackboxStuff(bt);
1531        like_lists=BB_LIKE_LIST(bb); // bb like a list
1532      }
1533      else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1534        || (l->rtyp==LIST_CMD))
1535      {
1536        like_lists=2; // bb in a list
1537      }
1538      if(like_lists)
1539      {
1540        if (TEST_V_ALLWARN) PrintS("assign list[..]=...or similiar\n");
1541        if (like_lists==1)
1542        {
1543          // check blackbox/newtype type:
1544          if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
1545        }
1546        b=jiAssign_list(l,r);
1547        if((!b) && (like_lists==2))
1548        {
1549          //Print("jjA_L_LIST: - 2 \n");
1550          if((l->rtyp==IDHDL) && (l->data!=NULL))
1551          {
1552            ipMoveId((idhdl)l->data);
1553            l->attribute=IDATTR((idhdl)l->data);
1554            l->flag=IDFLAG((idhdl)l->data);
1555          }
1556        }
1557        r->CleanUp();
1558        Subexpr h;
1559        while (l->e!=NULL)
1560        {
1561          h=l->e->next;
1562          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1563          l->e=h;
1564        }
1565        return b;
1566      }
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 ((TEST_V_ALLWARN) && (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.